## ----message=FALSE, warning=FALSE, echo=TRUE, eval=TRUE----------------------- ## Load relevant packages library(superb) # for superbPlot library(ggplot2) # for all the graphic directives library(gridExtra) # for grid.arrange ## ----------------------------------------------------------------------------- Astats <- data.frame( MNs = c(6.75, 6.00, 5.50, 6.50, 8.00, 8.75), SDs = c(2.00, 3.00, 3.50, 3.50, 1.25, 1.25) ) dtaA <- apply(Astats, 1, function(stat) {rnorm(100, mean=stat[1], sd=stat[2])} ) dtaA <- data.frame(dtaA) colnames(dtaA) <- c("Verbal", "Numerical", "Spatial", "Creativity", "Intrapersonal", "Interpersonal") Bstats <- data.frame( MNs = c(3.33, 3.00, 2.50, 3.00, 2.75, 3.50), SDs = c(0.25, 0.50, 0.66, 0.50, 0.25, 0.25) ) dtaB <- apply(Bstats, 1, function(stat) {rnorm(100, mean=stat[1], sd=stat[2])} ) dtaB <- data.frame(dtaB) colnames(dtaB) <- c("Verbal", "Numerical", "Spatial", "Creativity", "Intrapersonal", "Interpersonal") ## ----------------------------------------------------------------------------- mycolors <- c("seagreen","chocolate2","mediumpurple3","deeppink","chartreuse4", "darkgoldenrod1") mylabels <- c("Verbal", "Numerical", "Spatial", "Creativity", "Intrapersonal", "Interpersonal") ## ----message=FALSE, fig.width=6.7, fig.height=2.5, fig.cap="Figure 2, preliminary version"---- pltA <- superb( crange(Verbal, Interpersonal) ~ ., # no between-subject factors dtaA, # plot for the first data set... WSFactors = "Domain(6)", # ...a within-subject design with 6 levels adjustments = list( purpose = "difference", # we want to compare means decorrelation = "CM" # and error bars are correlated-adjusted ), plotStyle="raincloud", # the following (optional) arguments are adjusting some of the visuals pointParams = list(size = 0.75), jitterParams = list(width =0.1, shape=21,size=0.05,alpha=1), # less dispersed jitter dots, violinParams = list(trim=TRUE, alpha=1), # not transparent, errorbarParams = list(width = 0.1, linewidth=0.5) # wider bars, thicker lines. ) pltA ## ----message=FALSE, fig.width=6.7, fig.height=2.5, fig.cap="Figure 2, version with colors"---- pltA + aes(fill = factor(Domain), colour = factor(Domain)) ## ----------------------------------------------------------------------------- commonstyle <- list( theme_classic(), # It has no background, no bounding box. # We customize this theme further: theme(axis.line=element_line(linewidth=0.50), # We make the axes thicker... axis.text = element_text(size = 10), # their text bigger... axis.title = element_text(size = 12), # their labels bigger... plot.title = element_text(size = 10), # and the title bigger as well. panel.grid = element_blank(), # We remove the grid lines legend.position = "none" # ... and we hide the side legend. ), # Finally, we place tick marks on the units scale_y_continuous( breaks=1:10 ), # set the labels to be displayed scale_x_discrete(name="Domain", labels = mylabels), # and set colours to both colour and fill layers scale_discrete_manual(aesthetic =c("fill","colour"), values = mycolors) ) ## ----message=FALSE, fig.width=6.7, fig.height=2.5, fig.cap="Figure 2, final version"---- finalpltA <- pltA + aes(fill = factor(Domain), colour = factor(Domain)) + commonstyle + # all the above directive are added; coord_cartesian( ylim = c(1,10) ) + # the y-axis bounds are given ; labs(title="A") + # the plot is labeled "A"... ylab("Self-worth relevance") # and the y-axis label given. finalpltA ## ----message=FALSE, fig.width=6.7, fig.height=2.5, fig.cap="Figure 2, bottom row"---- pltB <- superb( crange(Verbal, Interpersonal) ~ ., # no between-subject factors dtaB, # the second data set... WSFactors = "Domain(6)", # ...a within-subject design with 6 levels adjustments = list( purpose = "difference", # we want to compare means decorrelation = "CM" # and error bars are correlated-adjusted ), plotStyle="raincloud", # the following (optional) arguments are adjusting some of the visuals pointParams = list(size = 0.75), jitterParams = list(width =0.1, shape=21,size=0.05,alpha=1), # less dispersed jitter dots, violinParams = list(trim=TRUE, alpha=1,adjust=3), # not semi-transparent, smoother errorbarParams = list(width = 0.1, linewidth=0.5) # wider bars, thicker lines. ) finalpltB <- pltB + aes(fill = factor(Domain), colour = factor(Domain)) + commonstyle + # the following three lines are the differences: coord_cartesian( ylim = c(1,5) ) + # the limits, 1 to 5, are different labs(title="B") + # the plot is differently-labeled ylab("Judgment certainty") # and the y-axis label differns. finalpltB ## ----message=FALSE, fig.width=6.7, fig.height=5.0, fig.cap="Figure 2, final version"---- finalplt <- grid.arrange(finalpltA, finalpltB, ncol=1) ## ----echo=TRUE, eval=FALSE---------------------------------------------------- # ggsave( "Figure2.png", # plot=finalplt, # device = "png", # dpi = 320, # pixels per inche # units = "cm", # or "in" for dimensions in inches # width = 17, # as found in the article # height = 13 # ) ## ----message=FALSE, warning=FALSE, echo=FALSE, eval=TRUE---------------------- # load manually the data for the purpose of the vignette cleandata <- data.frame( subject = c(201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224), absentrt = c(0.9069648,0.7501645,0.8143321,0.9850208,0.9279098,0.9620722,1.0160006,0.8921083,0.6041074,0.647717,0.6705584,0.9938026,0.8073152,1.079257,0.8648441,0.7923577,0.7683727,0.9004377,0.9590628,0.7619962,0.7245308,0.9070973,0.6244701,0.6991465), presentrt = c(0.8805836,0.7227798,0.7173632,0.9084251,0.8596929,0.8488763,0.9039185,0.867465,0.5874631,0.6320984,0.6598097,0.9046643,0.7659111,0.8824536,0.8235161,0.783525,0.6950923,0.8531382,0.8037397,0.674048,0.6987675,0.8272449,0.6298569,0.6853342), absentacc = c(0.984375,0.9375,0.953125,0.984375,0.875,0.859375,0.953125,0.953125,0.9375,0.921875,0.953125,0.875,0.96875,0.984375,0.84375,0.921875,0.921875,0.90625,0.953125,1,0.9375,0.984375,0.96875,0.9375), presentacc= c(0.984375,0.9921875,0.9765625,0.9921875,0.9375,0.9140625,0.9921875,0.9453125,0.96875,0.9609375,0.9765625,0.9375,0.984375,0.9765625,0.9765625,0.9140625,0.96875,0.9140625,0.9921875,0.9609375,0.9921875,0.9765625,0.9375,0.890625) ) ## ----------------------------------------------------------------------------- cleandata$absentrt = cleandata$absentrt*1000 cleandata$presentrt = cleandata$presentrt*1000 ## ----------------------------------------------------------------------------- head(cleandata) ## ----------------------------------------------------------------------------- mycolors = c("black","lightgray") ## ----------------------------------------------------------------------------- library(scales) # for a translated scale using trans_new() shift_trans = function(d = 0) { scales::trans_new("shift", transform = function(x) x - d, inverse = function(y) y + d) } ## ----fig.width=3, fig.height=4, fig.cap="Figure 1, preliminary version"------- # defaults are means with 95% confidence intervals, so not specified pltA <- superbPlot( cleandata, WSFactors = "target(2)", variables = c("absentrt", "presentrt"), adjustments = list( purpose = "difference", decorrelation = "CM"), errorbarParams = list(colour = "gray35", width = 0.05) ) pltA ## ----fig.width=3, fig.height=4, fig.cap="Figure 2, version with adequate vertical scale"---- # attached the shifted scale to it pltA <- pltA + scale_y_continuous( trans = shift_trans(720), # use translated bars limits = c(720,899), # limit the plot range breaks = seq(720,880,20), # define major ticks expand = c(0,0) ) # no expansions over the plotting area pltA ## ----fig.width=3, fig.height=4, fig.cap="Figure 3, version with theme and details adjusted"---- ornaments <- list( theme_classic(base_size = 14) + theme( legend.position = "none" ), aes(width = 0.5, fill = factor(target), colour = factor(target) ), scale_discrete_manual(aesthetic =c("fill","colour"), values = mycolors), scale_x_discrete(name="Color Singleton\nDistractor", labels = c("Absent","Present")) ) pltA <- pltA + ornaments + ylab("Reaction time (ms)") pltA ## ----fig.width=3, fig.height=4, fig.cap="Figure 4, final version for RTs"----- pltA <- pltA + showSignificance( c(1,2), 870, -8, "Singleton presence\nbenefit, p < .001", segmentParams = list(linewidth = 1)) # this is it! Check the result pltA ## ----fig.width=3, fig.height=4, fig.cap="Figure 5, final version for mean accuracies"---- pltB <- superbPlot( cleandata, WSFactors = "target(2)", variables = c("absentacc", "presentacc"), adjustments = list( purpose = "difference", decorrelation = "CM"), errorbarParams = list(colour = "gray35", width = 0.05) ) + scale_y_continuous( trans = shift_trans(0.9), # use translated bars limits = c(0.9, 1.0), # limit the plot range breaks = seq(0.90, 1.00, 0.01), # define major ticks expand = c(0,0) ) + # remove empty space around plotting surface ornaments + ylab("Accuracy (proportion correct)") + showSignificance( c(1,2), 0.985, -0.005, "Singleton presence\nbenefit, p = .010", segmentParams = list(linewidth = 1) ) # this is it! Check the result pltB ## ----fig.width=6, fig.height=4, fig.cap="Figure 6, final version"------------- finalplt <- grid.arrange(pltA, pltB, ncol=2) #ggsave( "Figure2b.png", # plot=finalplt, # device = "png", # dpi = 320, # pixels per inche # units = "cm", # or "in" for dimensions in inches # width = 20, # as found in the article # height = 15 #) ## ----------------------------------------------------------------------------- ## superb::FYI: The HyunhFeldtEpsilon measure of sphericity per group are 1.000 ## superb::FYI: All the groups' data are compound symmetric. Consider using CA.