R
Syntax for Figureshttps://research-git.uiowa.edu/PetersenLab/R-Plotting/-/tree/main/Analyses
You can download the lab fonts for figures here1: https://drive.google.com/drive/u/0/folders/1fqlrnEe7NFnWZoIrsHmr8ulDS4nhs-H3
#install.packages("remotes")
#remotes::install_github("DevPsyLab/petersenlab")
library("petersenlab")
library("ellipse")
library("ggplot2")
library("grid")
library("reshape")
library("plyr")
library("RColorBrewer")
library("reshape2")
library("ggExtra")
library("viridis")
library("ggthemes")
library("ggpubr")
set.seed(52242)
n <- 1000
predictor <- rbeta(n, 1.5, 5) * 100
outcome <- predictor + rnorm(n, mean = 0, sd = 20) + 50
number <- sample(1:1000, replace = TRUE)
predictorOverplot <- sample(1:50, n, replace = TRUE)
outcomeOverplot <- predictorOverplot + sample(1:75, n, replace = TRUE)
df <- data.frame(predictor = predictor,
outcome = outcome,
predictorOverplot = predictorOverplot,
outcomeOverplot = outcomeOverplot)
df[sample(1:n, size = 10), "predictor"] <- NA
df[sample(1:n, size = 10), "outcome"] <- NA
df[sample(1:n, size = 10), "predictorOverplot"] <- NA
df[sample(1:n, size = 10), "outcomeOverplot"] <- NA
plot.new()
lines(
x = seq(from = -10, to = 10, length.out = 100),
y = seq(from = -25, to = 25, length.out = 100))
curve(x^3 - 3*x, from = -2, to = 2)
curve(x^2 - 2, add = TRUE, col = "violet")
plot(outcome ~ predictor, data = df)
plot(df$predictor, df$outcome)
plot(outcome ~ predictor, data = df)
abline(lm(outcome ~ predictor, data = df), col = "red") #regression line (y~x)
plot(outcome ~ predictor, data = df)
abline(lm(outcome ~ predictor, data = df), col = "red") #regression line (y~x)
addText(x = df$predictor, y = df$outcome)
plot(outcome ~ predictor, data = df)
lines(loess.smooth(df$predictor, df$outcome)) #loess line (x,y)
ggplot2
ggplot(df, aes(x = predictor, y = outcome)) +
geom_point() +
theme_classic()
ggplot(df, aes(x = predictor, y = outcome)) +
geom_point() +
stat_smooth(method = "lm", formula = y ~ x) +
theme_classic()
ggplot(df, aes(x = predictor, y = outcome)) +
geom_point() +
stat_smooth(method = "lm", formula = y ~ x) +
stat_cor(
cor.coef.name = "r",
p.accuracy = 0.001,
r.accuracy = 0.01) +
theme_classic()
ggplot(df, aes(x = predictor, y = outcome)) +
geom_point() +
stat_smooth(method = "loess", formula = y ~ x) +
theme_classic()
basePlot <- ggplot(df, aes(x = predictor, y = outcome)) +
geom_point()
basePlot
theme_gray()
basePlot + theme_gray() + theme(text = element_text(family = "Gotham"))
theme_bw()
basePlot + theme_bw() + theme(text = element_text(family = "Gotham"))
theme_linedraw()
A theme with only black lines of various widths on white backgrounds, reminiscent of a line drawing. Note that this theme has some very thin lines (<< 1 pt) which some journals may refuse.
basePlot + theme_linedraw() + theme(text = element_text(family = "Gotham"))
theme_light()
basePlot + theme_light() + theme(text = element_text(family = "Gotham"))
theme_dark()
basePlot + theme_dark() + theme(text = element_text(family = "Gotham"))
theme_minimal()
basePlot + theme_minimal() + theme(text = element_text(family = "Gotham"))
theme_classic()
basePlot + theme_classic() + theme(text = element_text(family = "Gotham"))
theme_void()
basePlot + theme_void() + theme(text = element_text(family = "Gotham"))
theme_test()
basePlot + theme_test() + theme(text = element_text(family = "Gotham"))
theme_tufte()
Theme based on Edward Tufte.
basePlot + theme_tufte()
theme_wsj()
Theme based on the publication, the Wall Street Journal.
basePlot + theme_wsj()
theme_fivethirtyeight()
Theme based on the publication, FiveThirtyEight.
basePlot + theme_fivethirtyeight()
theme_economist()
Theme based on the publication, The Economist.
basePlot + theme_economist()
theme_few()
Theme based on the rules and examples from Stephen Few’s Show Me the Numbers and “Practical Rules for Using Color in Charts”.
basePlot + theme_few()
scatterplot <- ggplot(df, aes(x = predictor, y = outcome)) +
geom_point() +
theme_classic() +
theme(text = element_text(family = "Gotham"))
densityMarginal <- ggMarginal(scatterplot, type = "density", xparams = list(fill = "gray"), yparams = list(fill = "gray"))
print(densityMarginal, newpage = TRUE)
histogramMarginal <- ggMarginal(scatterplot, type = "histogram", xparams = list(fill = "gray"), yparams = list(fill = "gray"))
print(histogramMarginal, newpage = TRUE)
boxplotMarginal <- ggMarginal(scatterplot, type = "boxplot", xparams = list(fill = "gray"), yparams = list(fill = "gray"))
print(boxplotMarginal, newpage = TRUE)
violinMarginal <- ggMarginal(scatterplot, type = "violin", xparams = list(fill = "gray"), yparams = list(fill = "gray"))
print(violinMarginal, newpage = TRUE)
densigramMarginal <- ggMarginal(scatterplot, type = "densigram", xparams = list(fill = "gray"), yparams = list(fill = "gray"))
print(densigramMarginal, newpage = TRUE)
ggplot(df, aes(x = predictor, y = outcome)) +
geom_point() +
stat_ellipse(alpha = 0.4, level = 0.95, geom = "polygon", fill = "red", color = "red") +
theme_classic() +
theme(text = element_text(family = "Gotham"))
ggplot(df, aes(x = predictor, y = outcome)) +
geom_point() +
stat_ellipse(alpha = 0.4, level = 0.95, geom = "polygon", fill = "red", color = "red") +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
coord_fixed(ratio = (max(predictor, na.rm = TRUE) - min(predictor, na.rm = TRUE))/(max(outcome, na.rm = TRUE) - min(outcome, na.rm = TRUE)),
xlim = c(0, max(predictor, na.rm = TRUE)),
ylim = c(0, max(outcome, na.rm = TRUE))) +
theme_classic() +
theme(text = element_text(family = "Gotham"))
ggplot(df, aes(x = predictor, y = outcome)) +
geom_point(size = 0.5) +
stat_ellipse(alpha = 0.4, level = 0.95, geom = "polygon", fill = "red", color = "red") +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
coord_fixed(ratio = (max(predictor, na.rm = TRUE) - min(predictor, na.rm = TRUE))/(max(outcome, na.rm = TRUE) - min(outcome, na.rm = TRUE)),
xlim = c(0, max(predictor, na.rm = TRUE)),
ylim = c(0, max(outcome, na.rm = TRUE))) +
theme_classic() +
theme(text = element_text(family = "Gotham"))
ggplot(df, aes(x = predictor, y = outcome)) +
geom_point(alpha = 0.3) +
stat_ellipse(alpha = 0.4, level = 0.95, geom = "polygon", fill = "red", color = "red") +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
coord_fixed(ratio = (max(predictor, na.rm = TRUE) - min(predictor, na.rm = TRUE))/(max(outcome, na.rm = TRUE) - min(outcome, na.rm = TRUE)),
xlim = c(0, max(predictor, na.rm = TRUE)),
ylim = c(0, max(outcome, na.rm = TRUE))) +
theme_classic() +
theme(text = element_text(family = "Gotham"))
ggplot(df, aes(x = predictorOverplot, y = outcomeOverplot)) +
geom_count(aes(size = ..n..)) +
scale_size_area() +
theme_classic() +
theme(text = element_text(family = "Gotham"))
ggplot(df, aes(x = predictorOverplot, y = outcomeOverplot)) +
geom_count(aes(size = ..n..)) +
scale_size_continuous(breaks = c(1, 2, 3, 4), range = c(1, 7)) +
theme_classic() +
theme(text = element_text(family = "Gotham"))
ggplot(df, aes(x = predictor, y = outcome)) +
stat_density_2d(aes(fill = ..density..), geom = "raster", contour = FALSE) +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
scale_fill_viridis() +
theme(
legend.position = "none",
text = element_text(family = "Gotham")
)
ggplot2
ggplot(df, aes(x = predictorOverplot, y = outcomeOverplot)) +
geom_count(alpha = .6, color = rgb(0,0,.7,.5)) +
scale_size_continuous(breaks = c(1, 2, 3, 4), range = c(1, 7)) +
stat_smooth(method = "loess", se = TRUE, color = "green") +
stat_smooth(method = "lm") +
stat_ellipse(alpha = 0.4, level = 0.95, geom = "polygon", fill = "red", color = "red") +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
coord_fixed(ratio = (max(predictorOverplot, na.rm = TRUE) - min(predictorOverplot, na.rm = TRUE))/(max(outcomeOverplot, na.rm = TRUE) - min(outcomeOverplot, na.rm = TRUE)),
xlim = c(0, max(predictorOverplot, na.rm = TRUE)),
ylim = c(0, max(outcomeOverplot, na.rm = TRUE))) +
theme_classic() +
theme(text = element_text(family = "Gotham"))
`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'
ggplot(df, aes(x = predictorOverplot, y = outcomeOverplot)) +
geom_count(alpha = .6, color = rgb(0,0,.7,.5)) +
scale_size_continuous(breaks = c(1, 2, 3, 4), range = c(1, 7)) +
stat_smooth(method = "loess", se = TRUE, color = "green") +
stat_smooth(method = "lm") +
stat_ellipse(color = "red", size = 1.5) +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
coord_fixed(ratio = (max(predictorOverplot, na.rm = TRUE) - min(predictorOverplot, na.rm = TRUE))/(max(outcomeOverplot, na.rm = TRUE) - min(outcomeOverplot, na.rm = TRUE)),
xlim = c(0, max(predictorOverplot, na.rm = TRUE)),
ylim = c(0, max(outcomeOverplot, na.rm = TRUE))) +
theme_classic() +
theme(text = element_text(family = "Gotham"))
`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'
From: https://stats.stackexchange.com/questions/7899/complex-regression-plot-in-r
ggplot2
df$x <- df$predictorOverplot
df$y <- df$outcomeOverplot
xc <- with(df, xyTable(x, y))
df2 <- cbind.data.frame(x = xc$x, y = xc$y, number = xc$number)
df2$n <- cut(df2$number, c(0,1.5,2.5,Inf), labels = c(1,2,4))
df.ell <- as.data.frame(with(df, ellipse(cor(df$x, df$y, use = "pairwise.complete.obs"),
scale = c(sd(df$x, na.rm = TRUE), sd(df$y, na.rm = TRUE)),
centre = c(mean(df$x, na.rm = TRUE), mean(df$y, na.rm = TRUE)),
level = .95)))
ggplot(data = na.omit(df2), aes(x = x, y = y)) +
geom_point(aes(size = n), alpha = .6, color = rgb(0,0,.7,.5)) +
stat_smooth(data = df, method = "loess", se = FALSE, color = "green") +
stat_smooth(data = df, method = "lm", col = "red") +
geom_path(data = df.ell, colour = "green", size = 1) +
coord_cartesian(xlim = c(-1,60), ylim = c(-1,130))
`geom_smooth()` using formula = 'y ~ x'
`geom_smooth()` using formula = 'y ~ x'
R
do.it <- function(df, type="confidence", ...) {
require(ellipse)
lm0 <- lm(y ~ x, data=df)
xc <- with(df, xyTable(x, y))
df.new <- data.frame(x = seq(min(df$x), max(df$x), 0.1))
pred.ulb <- predict(lm0, df.new, interval = type)
pred.lo <- predict(loess(y ~ x, data = df), df.new)
plot(xc$x, xc$y, cex = xc$number*1/4, xlab = "x", ylab = "y", ...) #change number*X to change dot size
abline(lm0, col = "red")
lines(df.new$x, pred.lo, col="green", lwd = 2)
lines(df.new$x, pred.ulb[,"lwr"], lty = 2, col = "red")
lines(df.new$x, pred.ulb[,"upr"], lty = 2, col = "red")
lines(ellipse(cor(df$x, df$y), scale=c(sd(df$x),sd(df$y)),
centre = c(mean(df$x), mean(df$y)), level = .95), lwd = 2, col = "green")
invisible(lm0)
}
df3 <- na.omit(df[sample(nrow(df), nrow(df), rep = TRUE),])
df3$x <- df3$predictorOverplot
df3$y <- df3$outcomeOverplot
do.it(df3, pch = 19, col = rgb(0,0,.7,.5))
vwReg(outcome ~ predictor, data = df)
vwReg(outcome ~ predictor, data = df, shade = TRUE, spag = FALSE, show.lm = TRUE, show.CI = TRUE, bw = FALSE, B = 1000, quantize = "continuous")
vwReg(outcome ~ predictor, data = df, shade = TRUE, spag = FALSE, show.lm = TRUE, show.CI = TRUE, bw = FALSE, B = 1000, quantize = "SD")
vwReg(outcome ~ predictor, data = df, shade = FALSE, spag = TRUE, show.lm = TRUE, show.CI = TRUE, bw = FALSE, B = 1000)
vwReg(outcome ~ predictor, data = df, shade = FALSE, spag = TRUE, show.lm = FALSE, show.CI = FALSE, bw = FALSE, B = 1000)
vwReg(outcome ~ predictor, data = df, shade = TRUE, spag = FALSE, show.lm = TRUE, show.CI = TRUE, bw = TRUE, B = 1000, quantize = "continuous")
vwReg(outcome ~ predictor, data = df, shade = TRUE, spag = FALSE, show.lm = TRUE, show.CI = TRUE, bw = TRUE, B = 1000, quantize = "SD")
vwReg(outcome ~ predictor, data = df, shade = FALSE, spag = TRUE, show.lm = TRUE, show.CI = TRUE, bw = TRUE, B = 1000, quantize = "SD")
Used for: distribution of one numeric variable
Used for: association between two numeric variables
R
plot(x, y)
http://www.cookbook-r.com/Graphs/Scatterplots_(ggplot2)/
ggplot(data, aes(x, y)) +
geom_point()
vwReg()
function from the
petersenlab
package: https://github.com/DevPsyLab/petersenlab/blob/main/R/vwReg.RUsed for: association between one categorical variable and one numeric variable (or for depicting the frequency of categories of a categorical variable)
Used for: association between multiple numeric variables
For correlation matrices, I do the following:
cor.table()
function (with
type = "manuscript"
) from the petersenlab
package to create a correlation matrix..csv
file.
corrplot
package: https://cran.r-project.org/web/packages/corrplot/vignettes/corrplot-intro.htmlcorrgram
package: https://cran.r-project.org/web/packages/corrgram/vignettes/corrgram_examples.htmlpsych
package: https://personality-project.org/r/psych/help/pairs.panels.html
I depict examples of correlograms and pairs panels here: https://isaactpetersen.github.io/Principles-Psychological-Assessment/factor-analysis-PCA.html#correlations-factorAnalysis
Used for: SEM/CFA/path analysis
If you are just trying to visualize the results of a SEM model fitted
using the lavaan
package, I recommend the
semPlot
package (http://sachaepskamp.com/semPlot/examples) in
R
. You can see examples of my implementation here: https://isaactpetersen.github.io/Principles-Psychological-Assessment/sem.html#semModelPathDiagram-sem
If you are trying to create a figure for a paper or poster, you might want something that you can draw and customize yourself. I use Adobe Illustrator for hand-drawn figures.
You can look at various options below:
semPlot
packageAdobe Illustrator
Onyx
: https://onyx-sem.comyworks
: https://www.yworks.comMicrosoft Visio
: https://www.microsoft.com/en-us/microsoft-365/visio/flowchart-softwareMicrosoft Powerpoint
AMOS
Warppls
Graphviz
: https://graphviz.org
R
port—this is what we use for our study
flowchart via the DiagrammeR
package: https://rich-iannone.github.io/DiagrammeR/index.htmlGallery: https://r-graph-gallery.com/interactive-charts.html
Gallery: https://r-graph-gallery.com/3d.html
Polychrome
package: https://stackoverflow.com/a/62939405 (archived at https://perma.cc/3HWM-MMFS)pals
package: https://stackoverflow.com/a/41230685 (archived at https://perma.cc/WH56-HMVD)Color palettes for color-blindness:
Safe
palette from the rcartocolor
package:
https://stackoverflow.com/a/56066712 (archived at https://perma.cc/WUH5-F4Z7)# From here: https://github.com/clauswilke/colorblindr/blob/master/R/palettes.R
# Two color palettes taken from the article ["Color Universal Design" by Okabe and Ito](https://web.archive.org/web/20210108233739/http://jfly.iam.u-tokyo.ac.jp/color/)
# The variant `palette_OkabeIto` contains a gray color, while `palette_OkabeIto_black` contains black instead
palette_OkabeIto <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7", "#999999")
pie(rep(1, 8), col = palette_OkabeIto)
palette_OkabeIto_black <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7", "#000000")
pie(rep(1, 8), col = palette_OkabeIto_black)
https://stackoverflow.com/a/9568659 (archived at https://perma.cc/5ALZ-3AQD)
c25 <- c(
"dodgerblue2", "#E31A1C", # red
"green4",
"#6A3D9A", # purple
"#FF7F00", # orange
"black", "gold1",
"skyblue2", "#FB9A99", # lt pink
"palegreen2",
"#CAB2D6", # lt purple
"#FDBF6F", # lt orange
"gray70", "khaki2",
"maroon", "orchid1", "deeppink1", "blue1", "steelblue4",
"darkturquoise", "green1", "yellow4", "yellow3",
"darkorange4", "brown"
)
pie(rep(1, 25), col = c25)
# from: Polychrome::palette36.colors(36)
c36 <- c("#5A5156","#E4E1E3","#F6222E","#FE00FA","#16FF32","#3283FE","#FEAF16","#B00068","#1CFFCE","#90AD1C","#2ED9FF","#DEA0FD","#AA0DFE","#F8A19F","#325A9B","#C4451C","#1C8356","#85660D","#B10DA1","#FBE426","#1CBE4F","#FA0087",
"#FC1CBF","#F7E1A0","#C075A6","#782AB6","#AAF400","#BDCDFF","#822E1C","#B5EFB5","#7ED7D1","#1C7F93","#D85FF7","#683B79","#66B0FF","#3B00FB")
pie(rep(1, 36), col = c36)
sessionInfo()
R version 4.4.2 (2024-10-31)
Platform: x86_64-pc-linux-gnu
Running under: Ubuntu 22.04.5 LTS
Matrix products: default
BLAS: /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3
LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.20.so; LAPACK version 3.10.0
locale:
[1] LC_CTYPE=C.UTF-8 LC_NUMERIC=C LC_TIME=C.UTF-8
[4] LC_COLLATE=C.UTF-8 LC_MONETARY=C.UTF-8 LC_MESSAGES=C.UTF-8
[7] LC_PAPER=C.UTF-8 LC_NAME=C LC_ADDRESS=C
[10] LC_TELEPHONE=C LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C
time zone: UTC
tzcode source: system (glibc)
attached base packages:
[1] grid stats graphics grDevices utils datasets methods
[8] base
other attached packages:
[1] ggpubr_0.6.0 ggthemes_5.1.0 viridis_0.6.5 viridisLite_0.4.2
[5] ggExtra_0.10.1 reshape2_1.4.4 RColorBrewer_1.1-3 plyr_1.8.9
[9] reshape_0.8.9 ggplot2_3.5.1 ellipse_0.5.0 petersenlab_1.1.0
loaded via a namespace (and not attached):
[1] tidyselect_1.2.1 psych_2.4.6.26 farver_2.1.2 dplyr_1.1.4
[5] fastmap_1.2.0 promises_1.3.0 digest_0.6.37 rpart_4.1.23
[9] mime_0.12 lifecycle_1.0.4 cluster_2.1.6 magrittr_2.0.3
[13] compiler_4.4.2 rlang_1.1.4 Hmisc_5.2-0 sass_0.4.9
[17] tools_4.4.2 utf8_1.2.4 yaml_2.3.10 data.table_1.16.2
[21] knitr_1.49 ggsignif_0.6.4 labeling_0.4.3 htmlwidgets_1.6.4
[25] mnormt_2.1.1 abind_1.4-8 miniUI_0.1.1.1 foreign_0.8-87
[29] withr_3.0.2 purrr_1.0.2 nnet_7.3-19 stats4_4.4.2
[33] fansi_1.0.6 lavaan_0.6-19 xtable_1.8-4 colorspace_2.1-1
[37] MASS_7.3-61 scales_1.3.0 cli_3.6.3 mvtnorm_1.3-2
[41] rmarkdown_2.29 generics_0.1.3 rstudioapi_0.17.1 DBI_1.2.3
[45] cachem_1.1.0 stringr_1.5.1 splines_4.4.2 parallel_4.4.2
[49] base64enc_0.1-3 mitools_2.4 vctrs_0.6.5 Matrix_1.7-1
[53] carData_3.0-5 jsonlite_1.8.9 car_3.1-3 rstatix_0.7.2
[57] Formula_1.2-5 htmlTable_2.4.3 tidyr_1.3.1 jquerylib_0.1.4
[61] glue_1.8.0 stringi_1.8.4 gtable_0.3.6 later_1.3.2
[65] quadprog_1.5-8 munsell_0.5.1 tibble_3.2.1 pillar_1.9.0
[69] htmltools_0.5.8.1 R6_2.5.1 mix_1.0-12 evaluate_1.0.1
[73] shiny_1.9.1 pbivnorm_0.6.0 lattice_0.22-6 backports_1.5.0
[77] broom_1.0.7 httpuv_1.6.15 bslib_0.8.0 Rcpp_1.0.13-1
[81] gridExtra_2.3 nlme_3.1-166 checkmate_2.3.2 mgcv_1.9-1
[85] xfun_0.49 pkgconfig_2.0.3
Ask me to give you access.↩︎