Plotly Scatter Plot
Scatter Plot
- Scatter plot with histogram on both sides
- Use subplot to combine several plots together
n <- 100
dt <- data.table(
id = 1:n
, x = sample(1:25, size = n, replace = TRUE)
, y = sample(1:15, size = n, replace = TRUE)
, group = sample(c("A", "B", "C"), size = n, replace = TRUE, prob = c(0.5, 0.3, 0.2))
)
dt <- dt[, str := paste0("ID: ", id, "\n", "Group:", group)]
dt <- dt[, jitter := runif(n)][, y_jitter := y + jitter / 10]
fq_x <- dt[,.(count = .N), by = list(group, x)]
p1 <- plot_ly(
fq_x
, color = ~ group
, x = ~ x
, y = ~ count
, type = 'bar'
) %>%
layout(showlegend = FALSE, barmode = "stack")
p2 <- plotly_empty() %>% style(showlegend = FALSE)
p3 <- plot_ly(
data = dt
, x = ~ x
, y = ~ y_jitter
, type = 'scatter'
, mode = 'markers'
, symbol = ~ group
, color = ~ group
, text = ~ str
, hoverinfo = "text"
, size = 3
, alpha = 1
) %>% style(showlegend = FALSE)
fq_y <- dt[,.(count = .N), by = list(group, y)]
p4 <- plot_ly(
fq_y
, color = ~ group
, y = ~ y
, x = ~ count
, type = 'bar'
, orientation = 'h'
) %>%
layout(showlegend = FALSE, barmode = "stack")
plotly::subplot(
p1
, p2
, p3
, p4
, nrows = 2
, heights = c(.2, .8)
, widths = c(.8, .2)
, margin = 0
, shareX = TRUE
, shareY = TRUE
)Boxplot
- Box and whiskers
Scatter Plot with Fitted Line
dt <- data.table(x = rnorm(200))
dt <- dt[, err := rnorm(200) / 20][, y := (x + err) * (2 + err)][x > -2][x < 2][y > -4][y < 4]
m <- lm(y ~ x, data = dt)
prd <- predict(m, newdata = dt, interval = "confidence", exclude = FALSE)
prd <- as.data.table(prd)
prd$x <- dt$x
u <- dt$x
u <- sort(u)
plt_ci(data = prd
, x = x
, u = u
, xlabel = "x"
, ylabel = "y"
, fit = fit
, lower = lwr
, upper = upr
, xrange = c(-2, 2)
, xtick0 = -2
, xdtick = 0.5
, yrange = c(-4, 4)
, ytick0 = -4
,ydtick = 0.5
) %>%
add_markers(
data = dt
, x = ~ x
, y = ~ y
, inherit = FALSE
)Scatter Plot with Segmented Median Lines
dt <- data.table(x = rnorm(200))
dt <- dt[order(x)]
gp <- sample(c("A", "B", "C"), replace = TRUE, size = 200)
gp <- sort(gp)
dt <- dt[, group := gp]
dt <- dt[, err := rnorm(200) / 20][, y := (x + err) * (2 + err)][x > -2][x < 2][y > -4][y < 4]
mds <- dt[, .(mdn = median(x)), by = .(group)][, txt := paste0("Median of ", group)][order(group)]
plot_ly(data =dt
, x = ~ x
, y = ~ y, type = "scatter",
mode = "markers", marker = list(opacity = 0.9, colors = Wu::Blues(5))
## , hoverinfo = "text", text = txt
, showlegend = FALSE) %>%
add_segments(
x = min(dt[group == "A"]$x)
, xend = max(dt[group == "A"]$x)
, y = mds$mdn[1]
, yend = mds$mdn[1]
, name = as.character(mds$txt[1])
, line = list(color = Blues(1), alpha = 0.5)
, inherit = FALSE
) %>%
add_segments(
x = min(dt[group == "B"]$x)
, xend = max(dt[group == "B"]$x)
, y = mds$mdn[2]
, yend = mds$mdn[2]
, name = as.character(mds$txt[2])
, line = list(color = Blues(1), alpha = 0.5)
, inherit = FALSE
) %>%
add_segments(
x = min(dt[group == "C"]$x)
, xend = max(dt[group == "C"]$x)
, y = mds$mdn[3]
, yend = mds$mdn[3]
, name = as.character(mds$txt[3])
, line = list(color = Blues(1), alpha = 0.5)
, inherit = FALSE
)Correlation Grid
dt <- data.table(x = rnorm(30), y = rnorm(30), z = rnorm(30))
dt <- dt[x < 2 & x > -2 & y < 2 & y > -2 & z > -2 & y < 2]
label(dt$x) <- "X"
label(dt$y) <- "Y"
label(dt$z) <- "Z"
p11 <- plt_scatter(data = dt, xvar = x, yvar = z)
p12 <- plt_scatter(data = dt, xvar = x, yvar = y)
p13 <- plt_hist(dt$x)
p21 <- plt_scatter(data = dt, xvar = y, yvar = x)
p22 <- plt_hist(dt$y)
p23 <- plt_scatter(data = dt, xvar = y, yvar = z)
p32 <- plt_scatter(data = dt, xvar = z, yvar = x)
p33 <- plt_scatter(data = dt, xvar = z, yvar = y)
p31 <- plt_hist(dt$z)
subplot(
p13, p12, p11, p21, p22, p23, p31, p32, p33
, nrows = 3
, shareX = FALSE
, shareY = FALSE
, titleX = TRUE
, titleY = TRUE
, margin = 0.01
, heights = c(1/3, 1/3, 1/3)
, widths = c(1/3, 1/3, 1/3)
) %>% layout(width = 800, height = 800)R sessionInfo
R version 4.2.0 (2022-04-22) Platform: x86_64-pc-linux-gnu (64-bit) Running under: Ubuntu 20.04.3 LTS
Matrix products: default BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0 LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.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
attached base packages: [1] stats graphics grDevices utils datasets methods base
other attached packages: [1] Wu_0.0.0.9000 flexdashboard_0.5.2 lme4_1.1-29
[4] Matrix_1.4-0 mgcv_1.8-38 nlme_3.1-152
[7] png_0.1-7 scales_1.2.0 nnet_7.3-16
[10] labelled_2.9.1 kableExtra_1.3.4 plotly_4.10.0
[13] gridExtra_2.3 ggplot2_3.3.6 DT_0.23
[16] tableone_0.13.2 magrittr_2.0.3 lubridate_1.8.0
[19] dplyr_1.0.9 plyr_1.8.7 data.table_1.14.2
[22] rmdformats_1.0.4 knitr_1.39
loaded via a namespace (and not attached): [1] httr_1.4.3 sass_0.4.1 tidyr_1.2.0 jsonlite_1.8.0
[5] viridisLite_0.4.0 splines_4.2.0 bslib_0.3.1 assertthat_0.2.1
[9] yaml_2.3.5 pillar_1.8.0 lattice_0.20-45 glue_1.6.2
[13] digest_0.6.29 RColorBrewer_1.1-3 rvest_1.0.2 minqa_1.2.4
[17] colorspace_2.0-3 htmltools_0.5.3 survey_4.1-1 pkgconfig_2.0.3
[21] haven_2.5.0 bookdown_0.27 purrr_0.3.4 webshot_0.5.3
[25] svglite_2.1.0 tibble_3.1.8 farver_2.1.1 generics_0.1.3
[29] ellipsis_0.3.2 withr_2.5.0 klippy_0.0.0.9500 lazyeval_0.2.2
[33] cli_3.3.0 survival_3.2-13 evaluate_0.15 fansi_1.0.3
[37] MASS_7.3-54 forcats_0.5.1 xml2_1.3.3 tools_4.2.0
[41] hms_1.1.1 mitools_2.4 lifecycle_1.0.1 stringr_1.4.0
[45] munsell_0.5.0 compiler_4.2.0 jquerylib_0.1.4 systemfonts_1.0.4 [49] rlang_1.0.4 grid_4.2.0 nloptr_2.0.3 rstudioapi_0.13
[53] htmlwidgets_1.5.4 crosstalk_1.2.0 labeling_0.4.2 rmarkdown_2.14
[57] boot_1.3-28 gtable_0.3.0 DBI_1.1.2 R6_2.5.1
[61] fastmap_1.1.0 utf8_1.2.2 stringi_1.7.8 Rcpp_1.0.9
[65] vctrs_0.4.1 tidyselect_1.1.2 xfun_0.31