Back to Index

Spaghetti Plot with ggplot2

library(Wu)
library(data.table)

dt <- data.table(
    id = 1:6
  , num = c(3, 5, 6, 3, 4, 5)
  , m = c(1.1, 1.2, 1.3, 1.2, 1.4, 1.3)
)

rnorm_vec <- function(x){
    rnorm(n = 1, mean = x)
}
rnorm_vec <- Vectorize(rnorm_vec)


dt2 <- dt[rep(1:.N, times = num)]
dt2 <- dt2[, value := rnorm_vec(m)
           ][, times := 1:.N, by = .(id)]



nudge_x <- -0.2

ggplot(data = dt2
     , aes(x = times
         , y = value
         ## , type = type
         ## , id = redcap_id
         , group = id
         , color = factor(id)
           )) +
    geom_line(
        alpha = 0.3
      , size = 1.2
      ## , color = "#333333"
        ## , color = factor(record_id)
    ) +
    geom_point(
        shape = 19
      , size = 3
      ## , color = "#333333"
        ## , color = factor(record_id)
      ## , stroke = sqrt(dr2$size)/2
      , alpha = 0.5
    ) +
    geom_text(aes(label = id), nudge_x =  nudge_x)+ 
    xlab("Times") +
    scale_x_continuous(breaks = c(1, 2, 3, 4, 5, 6), labels = c(1, 2, 3, 4, 5, 6)) +
    ylab("Value") +
    ## scale_fill_manual(values = Colors) +
    ## scale_y_log10() +
    ## annotation_logticks() +
    ## coord_cartesian(xlim = c(-90, 900)) +
    theme(legend.position = "none", axis.ticks = element_blank()) -> p
p

dt2 %>% prt()

Spaghetti Plot with plotly by loop

library(Wu)
library(data.table)
library(plotly)

dt <- data.table(
    id = 1:6
  , num = c(10, 8, 6, 13, 14, 15)
  , m = 1:6
)

rnorm_vec <- function(x){
    rnorm(n = 1, mean = x)
}
rnorm_vec <- Vectorize(rnorm_vec)


dt2 <- dt[rep(1:.N, times = num)]
dt2 <- dt2[, value := rnorm_vec(m)
           ][, times := 1:.N, by = .(id)]


ids <- unique(dt2$id)
p <- plot_ly(width = 1400, height = 600)
for (i in 1:length(ids)){
    p <- p %>% add_trace(
                   data = dt2[id %in% ids[i]]
                 , x = ~ times
                 , y = ~ value
                 , name = as.character(ids[i])
                 , inherit = FALSE
                 , type = "scatter"
                 , mode = "lines"
                   ## , hoverinfo = "text"
                   ## , text = ~ str
                   ## , marker = list(symbol = 2, size = 10)
                 , line = list(alpha = 0.5)
               ) 
}


p

Spaghetti Plot with plotly with group_by

• To avoid plotly plot overflows, add the code to chunk option

 out.height='200%'

library(Wu)
library(data.table)
library(plotly)

dt <- data.table(
    id = 1:6
  , num = c(10, 8, 6, 13, 14, 15)
  , m = 1:6
)

rnorm_vec <- function(x){
    rnorm(n = 1, mean = x)
}
rnorm_vec <- Vectorize(rnorm_vec)


dt2 <- dt[rep(1:.N, times = num)]
dt2 <- dt2[, value := rnorm_vec(m)
           ][, times := 1:.N, by = .(id)
             ][, id := factor(id)]


get_colors <- function(x){
    grDevices::colorRampPalette(RColorBrewer::brewer.pal(11, "RdBu")[-c(5,6,7)])(x)
}

dt2 %>%
    group_by("id") %>%
    plot_ly(x = ~ times
          , y = ~ value
          , type = "scatter"
          , mode = "lines+marker"
          , color = ~ id
            , colors = get_colors(length(unique(dt2$id)))
            ) %>%
    layout(showlegend = FALSE
         , xaxis = list(title = "Days")
         , yaxis = list(title = "Value"
                      ## , type = "log"
                        )
         , width = 1200
         , height = 600
           )

Spaghetti Plot with Menus

library(Wu)
library(data.table)
library(plotly)

dt <- data.table(
    id = 1:6
  , num = c(10, 8, 6, 13, 14, 15)
  , m = 1:6
)

rnorm_vec <- function(x){
    rnorm(n = 1, mean = x)
}
rnorm_vec <- Vectorize(rnorm_vec)


dt2 <- dt[rep(1:.N, times = num)]
dt2 <- dt2[, value := rnorm_vec(m)
           ][, times := 1:.N, by = .(id)
             ][, str := paste0("ID: ", as.character(id), ", Times: ", as.character(times))
               ][, type := case_when(
                       id %in% c(1, 3, 5) ~ "Odd"
                       , TRUE ~ "Even"
                           )]


ids <- unique(dt2$id)


Colors4 <- grDevices::colorRampPalette(RColorBrewer::brewer.pal(11, "RdBu")[-c(5,6,7)])(4)
p <- plot_ly(width = 1200, height = 600)
for (i in 1:length(ids)){
    p <- p %>% add_trace(
                   data = dt2[id %in% ids[i]]
                 , x = ~ times
                 , y = ~ value
                   ## , color = ~ code_color
                   ## , colors = Colors4
                 , name = as.character(i)
                 , inherit = FALSE
                 , type = "scatter"
                 , mode = "lines+markers"
                 , hoverinfo = "text"
                 , text = ~ str
                 , transforms = list(
                       list(
                           type = "groupby"
                         , groups = ~ type
                         , styles = list(
                               list(
                                   target = "Odd"
                                 , value = list(
                                       marker = list(color = Colors4[1])
                                     , line = list(color = Colors4[1])
                                   )
                               )
                             , list(
                                   target = "Even"
                                 , value = list(
                                       marker = list(color = Colors4[2])
                                     , line = list(color = Colors4[2])
                                   )
                               )
                           )
                       )
                   )
               )
}



bts <- lapply(
    1:length(ids)
  , function(x){
      list(
          label = as.character(x)
        , method = "update"
        , args = list(list(
              visible = 1:length(ids) %in% x
          ))
      )
  }
)


updatemenus <- list(
    list(
        active = -1
      , type = "buttons"
      , xref = "paper"
      , yref = "paper"
      , x = 1
      , y = 1
      , align = "left"
      , direction = "right"
      , buttons = bts
    )
)


p %>%
    layout(title = "Charts"
         , showlegend = FALSE
         , updatemenus = updatemenus
         , xaxis = list(title = "Multiple Lines"
                      ## , tick0 = 0
                      , dtick = 180
                        )
         , yaxis = list(title = "Value"
                      , range = c(-3, 10)
                      ## , tick0 = 0
                      ## , dtick = 10
                        )
           )

R sessionInfo

sessionInfo()

R version 4.1.2 (2021-11-01) 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-27.1
[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.8.0 kableExtra_1.3.4 plotly_4.9.4.1
[13] gridExtra_2.3 ggplot2_3.3.6 DT_0.18
[16] tableone_0.13.0 magrittr_2.0.3 lubridate_1.7.10
[19] dplyr_1.0.9 plyr_1.8.6 data.table_1.14.2
[22] rmdformats_1.0.2 knitr_1.39

loaded via a namespace (and not attached): [1] httr_1.4.2 sass_0.4.0 tidyr_1.1.3 jsonlite_1.7.2
[5] viridisLite_0.4.0 splines_4.1.2 bslib_0.2.5.1 assertthat_0.2.1
[9] highr_0.9 yaml_2.3.5 pillar_1.7.0 lattice_0.20-45
[13] glue_1.6.2 digest_0.6.29 RColorBrewer_1.1-3 rvest_1.0.0
[17] minqa_1.2.4 colorspace_2.0-3 htmltools_0.5.2 survey_4.0
[21] pkgconfig_2.0.3 haven_2.4.1 bookdown_0.22 purrr_0.3.4
[25] webshot_0.5.2 svglite_2.1.0 tibble_3.1.7 farver_2.1.0
[29] generics_0.1.2 ellipsis_0.3.2 withr_2.5.0 klippy_0.0.0.9500 [33] lazyeval_0.2.2 cli_3.3.0 survival_3.2-13 crayon_1.5.1
[37] evaluate_0.15 fansi_1.0.3 MASS_7.3-54 forcats_0.5.1
[41] xml2_1.3.3 tools_4.1.2 hms_1.1.0 mitools_2.4
[45] lifecycle_1.0.1 stringr_1.4.0 munsell_0.5.0 compiler_4.1.2
[49] jquerylib_0.1.4 systemfonts_1.0.2 rlang_1.0.2 grid_4.1.2
[53] nloptr_1.2.2.2 rstudioapi_0.13 htmlwidgets_1.5.4 crosstalk_1.1.1
[57] labeling_0.4.2 rmarkdown_2.10 boot_1.3-28 gtable_0.3.0
[61] DBI_1.1.1 R6_2.5.1 fastmap_1.1.0 utf8_1.2.2
[65] stringi_1.7.6 Rcpp_1.0.8.3 vctrs_0.4.1 tidyselect_1.1.2
[69] xfun_0.31