pval_star does not work

[oldi]

When I run pval_star on your example data set (actually on any data set), it throws up the error:

Error in annotation[i, ] : incorrect number of dimensions

[s6juncheng]

Hi @oldi, thanks for trying out ggpval. Could you provide your sessionInfo() result? I'm mainly interested in your R version, ggpval version and ggplot version.

Here is the session for me that everything works fine:

R version 3.5.1 (2018-07-02)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Scientific Linux 7.7 (Nitrogen)

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
 [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8    LC_PAPER=en_US.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C             LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] ggplot2_3.1.1     data.table_1.12.2 ggpval_0.2.2     

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.1        pillar_1.4.0      compiler_3.5.1    plyr_1.8.4        prettyunits_1.0.2 remotes_2.0.4    
 [7] tools_3.5.1       testthat_2.1.1    digest_0.6.19     packrat_0.5.0     pkgbuild_1.0.3    pkgload_1.0.2    
[13] memoise_1.1.0     tibble_2.1.1      gtable_0.3.0      pkgconfig_2.0.2   rlang_0.3.4       cli_1.1.0        
[19] rstudioapi_0.10   curl_3.3          withr_2.1.2       dplyr_0.8.1       fs_1.3.1          desc_1.2.0       
[25] devtools_2.0.2    rprojroot_1.3-2   grid_3.5.1        tidyselect_0.2.5  glue_1.3.1        R6_2.4.0         
[31] processx_3.3.1    sessioninfo_1.1.1 purrr_0.3.2       callr_3.2.0       magrittr_1.5      usethis_1.5.0    
[37] scales_1.0.0      backports_1.1.4   ps_1.3.0          assertthat_0.2.1  colorspace_1.4-1  labeling_0.3     
[43] lazyeval_0.2.2    munsell_0.5.0     crayon_1.3.4     

[oldi]

Hi! Thank you for your quick response. I hope you can find the bug.

Here is the output of my sessioninfo()

sessionInfo() R version 3.6.1 (2019-07-05) Platform: x86_64-w64-mingw32/x64 (64-bit) Running under: Windows >= 8 x64 (build 9200)

Matrix products: default

locale: [1] LC_COLLATE=German_Germany.1252 LC_CTYPE=German_Germany.1252
[3] LC_MONETARY=German_Germany.1252 LC_NUMERIC=C
[5] LC_TIME=German_Germany.1252

attached base packages: [1] stats graphics grDevices utils datasets methods base

other attached packages: [1] ggpval_0.2.2 forcats_0.4.0 stringr_1.4.0 dplyr_0.8.3 purrr_0.3.2
[6] readr_1.3.1 tidyr_0.8.3 tibble_2.1.3 ggplot2_3.2.0 tidyverse_1.2.1

loaded via a namespace (and not attached): [1] Rcpp_1.0.2 cellranger_1.1.0 pillar_1.4.2 compiler_3.6.1 tools_3.6.1
[6] zeallot_0.1.0 jsonlite_1.6 lubridate_1.7.4 gtable_0.3.0 nlme_3.1-140
[11] lattice_0.20-38 pkgconfig_2.0.2 rlang_0.4.0 cli_1.1.0 rstudioapi_0.10
[16] yaml_2.2.0 haven_2.1.1 withr_2.1.2 xml2_1.2.1 httr_1.4.1
[21] generics_0.0.2 vctrs_0.2.0 hms_0.5.0 grid_3.6.1 tidyselect_0.2.5 [26] data.table_1.12.2 glue_1.3.1 R6_2.4.0 fansi_0.4.0 readxl_1.3.1
[31] modelr_0.1.5 magrittr_1.5 backports_1.1.4 scales_1.0.0 rvest_0.3.4
[36] assertthat_0.2.1 colorspace_1.4-1 labeling_0.3 utf8_1.1.4 stringi_1.4.3
[41] lazyeval_0.2.2 munsell_0.5.0 broom_0.5.2 crayon_1.3.4

[s6juncheng]

Thanks a lot for reporting this bug. It is now fixed and I have updated the github version. The CRAN version will be updated for the next one or two days. For now you can update with the github version with devtools. e.g. remove.packages('ggpval'); devtools::install_github("s6juncheng/ggpval")

[ljacks-stats]

Hello, I am getting the same error as original poster when I run this function.

sessionInfo() R version 4.0.5 (2021-03-31) Platform: x86_64-w64-mingw32/x64 (64-bit) Running under: Windows 10 x64 (build 19042)

Matrix products: default

locale: [1] LC_COLLATE=English_United States.1252 [2] LC_CTYPE=English_United States.1252
[3] LC_MONETARY=English_United States.1252 [4] LC_NUMERIC=C
[5] LC_TIME=English_United States.1252

attached base packages: [1] stats graphics grDevices utils datasets [6] methods base

other attached packages: [1] table1_1.3 kableExtra_1.3.4 readxl_1.3.1
[4] forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7
[7] purrr_0.3.4 readr_1.4.0 tidyr_1.1.3
[10] tibble_3.1.0 ggplot2_3.3.5 tidyverse_1.3.0 [13] ggpval_0.2.4

[Ganthark]

I had this issue too with version 2.4 and made a quick fix for that. It also allows to use FC and stars at the same time. Here is a copy/paste version to include directly in a script:

Click to expand

```R add_pval_2 <- function (ggplot_obj, pairs = NULL, test = "wilcox.test", heights = NULL, barheight = NULL, textsize = 5, pval_text_adj = NULL, annotation = NULL, log = FALSE, pval_star = FALSE, plotly = FALSE, fold_change = FALSE, parse_text = NULL, response = "infer", ...) { if (is.null(pairs)) { total_groups <- length(unique(ggplot_obj$data[[ggpval:::get_in_parenthesis(as.character(ggplot_obj$mapping[1]))]])) if (total_groups == 2) { pairs <- list(c(1, 2)) } else { pairs <- lapply(2:total_groups, function(x) c(1, x)) } } if (is.null(parse_text)) { if (is.null(annotation)) { parse_text <- TRUE } else { parse_text <- FALSE } } facet <- NULL n_facet <- 1 ggplot_obj$data <- data.table(ggplot_obj$data) if (class(ggplot_obj$facet)[1] != "FacetNull") { if (class(ggplot_obj$facet)[1] == "FacetGrid") { facet <- c(names(ggplot_obj$facet$params$cols), names(ggplot_obj$facet$params$rows)) } else { facet <- names(ggplot_obj$facet$params$facets) } if (length(facet) > 1) { facet_ <- NULL ggplot_obj$data[, `:=`(facet_, paste0(get(facet[1]), get(facet[2])))] comb <- expand.grid(levels(as.factor(ggplot_obj$data[, get(facet[1])])), levels(as.factor(ggplot_obj$data[, get(facet[2])]))) facet_level <- paste0(comb[, 1], comb[, 2]) facet <- "facet_" } else { facet_level <- levels(as.factor(ggplot_obj$data[, get(facet)])) } n_facet <- length(unique(ggplot_obj$data[, get(facet)])) } if (!is.null(heights)) { if (length(pairs) != length(heights)) { pairs <- rep_len(heights, length(pairs)) } } ggplot_obj$data$group__ <- ggplot_obj$data[, get(ggpval:::get_in_parenthesis(as.character(ggplot_obj$mapping[1])))] ggplot_obj$data$group__ <- factor(ggplot_obj$data$group__) if (response == "infer") { response_ <- ggpval:::infer_response(ggplot_obj) } else { response_ <- response } ggplot_obj$data$response <- ggplot_obj$data[, get(response_)] y_range <- layer_scales(ggplot_obj)$y$range$range if (is.null(barheight)) { barheight <- (y_range[2] - y_range[1])/20 } if (is.null(heights)) { heights <- y_range[2] + barheight heights <- rep(heights, length = length(pairs)) } if (length(barheight) != length(pairs)) { barheight <- rep(barheight, length = length(pairs)) } if (is.null(pval_text_adj)) { pval_text_adj <- barheight * 0.5 } if (length(pval_text_adj) != length(pairs)) { pval_text_adj <- rep(pval_text_adj, length = length(pairs)) } if (!is.null(annotation)) { if ((length(annotation) != length(pairs)) && length(annotation) != n_facet) { annotation <- rep(annotation, length = length(pairs)) } if (is.list(annotation)) { if (length(annotation[[1]]) != length(pairs)) { annotation <- lapply(annotation, function(a) rep(a, length = length(pairs))) } } annotation <- data.frame(annotation) } if (log) { barheight <- exp(log(heights) + barheight) - heights pval_text_adj <- exp(log(heights) + pval_text_adj) - heights } V1 <- aes <- annotate <- geom_line <- group__ <- response <- labs <- NULL for (i in seq(length(pairs))) { if (length(unique(pairs[[1]])) != 2) { stop("Each vector in pairs must have two different groups to compare, e.g. c(1,2) to compare first and second box.") } test_groups <- levels(ggplot_obj$data$group__)[pairs[[i]]] data_2_test <- ggplot_obj$data[ggplot_obj$data$group__ %in% test_groups, ] if (!is.null(facet)) { pval <- data_2_test[, lapply(.SD, function(i) get(test)(response ~ as.character(group__), ...)$p.value), by = facet, .SDcols = c("response", "group__")] pval <- pval[, `:=`(facet, factor(get(facet), levels = facet_level))][order(facet), group__] } else { pval <- get(test)(data = data_2_test, response ~ group__, ...)$p.value } if (pval_star) { pval <- ggpval:::pvars2star(pval) if (fold_change) { fc <- data_2_test[, median(response), by = group__][order(group__)][, .SD[1]/.SD[2], .SDcols = "V1"][, V1] fc <- paste0("FC=", round(fc, digits = 2)) pval <- paste(pval, fc) } if(is.null(annotation)) { annotation <- t(t(pval)) } else { annotation <- rbind(annotation, t(t(pval))) } } height <- heights[i] df_path <- data.frame(group__ = rep(pairs[[i]], each = 2), response = c(height, height + barheight[i], height + barheight[i], height)) ggplot_obj <- ggplot_obj + geom_line(data = df_path, aes(x = group__, y = response), inherit.aes = F) if (is.null(annotation)) { if (fold_change) { fc <- data_2_test[, median(response), by = group__][order(group__)][, .SD[1]/.SD[2], .SDcols = "V1"][, V1] fc <- paste0("FC=", round(fc, digits = 2)) pval <- paste(pval, fc) } labels <- sapply(pval, function(i) ggpval:::format_pval(i, plotly)) } else { labels <- unlist(annotation[i, ]) } if (is.null(facet)) { anno <- data.table(x = (pairs[[i]][1] + pairs[[i]][2])/2, y = height + barheight[i] + pval_text_adj[i], labs = labels) } else { anno <- data.table(x = rep((pairs[[i]][1] + pairs[[i]][2])/2, n_facet), y = rep(height + barheight[i] + pval_text_adj[i], n_facet), labs = labels, facet = facet_level) setnames(anno, "facet", eval(facet)) } labs <- geom_text <- x <- y <- NULL ggplot_obj <- ggplot_obj + geom_text(data = anno, aes(x = x, y = y, label = labs), parse = !pval_star & !plotly, inherit.aes = FALSE) } ggplot_obj } ```

[s6juncheng]

@Ganthark Thanks for making a fix! Could you include your fix in a pull request?

[Ganthark]

@s6juncheng I just did it, it should hopefully be good enough to implement.