Merge pull request #4 from pawelqs/fix-ggevidence-plot-bug

Fix ggevidence plot bug

Author: january3

.gitignore

@@ -4,5 +4,6 @@ user_manual/cache
 *.swp
 .Rhistory
 .RData
+.Rproj.user/
 /doc/
 /Meta/

DESCRIPTION

@@ -22,6 +22,12 @@ VignetteBuilder: knitr
 Imports:
     beeswarm,tagcloud,XML,methods,plotwidgets,RColorBrewer,gplots,tibble,pheatmap,ggplot2,tidyr,purrr,rlang,tidyselect,ggrepel
 Suggests:
-    testthat,knitr,rmarkdown,dplyr,pander,cowplot
+    testthat,
+    knitr,
+    rmarkdown,
+    dplyr,
+    pander,
+    cowplot,
+    vdiffr
 RoxygenNote: 7.3.2
 Encoding: UTF-8

R/visualizations.R

@@ -523,7 +523,7 @@ ggEvidencePlot <- function(l, m, mset=NULL, filter=FALSE, unique=TRUE,
   mm <- map(mm, ~ .x[ .x %in% l_orig ])
 
   coords <- imap_dfr(mm, ~ {
-    pos <- sort(match(.x, l_orig)) - 1:length(.x)
+    pos <- sort(match(.x, l_orig))
     pos <- rep(pos, each=2)
     pos <- c(1, pos, length(l_orig))
     y <- rep(c(0:length(.x)), each=2) / length(.x)
@@ -533,7 +533,7 @@ ggEvidencePlot <- function(l, m, mset=NULL, filter=FALSE, unique=TRUE,
   coords_segm <- imap_dfr(mm, ~ {
     .match <- match(.x, l_orig)
     .ord   <- order(.match)
-    x <- sort(.match) - 1:length(.x)
+    x <- sort(.match)
     ret <- data.frame(x=x, y=-.1, xend=x, yend=0, "mod"=.y, label=.x[.ord], gene=.x[.ord])
     if(!is.null(gene.labels) && !gene.labels) {
       ret$label <- ""

tests/testthat/_snaps/visualisations/ggevidenceplot.svg

@@ -4,3 +4,23 @@ data(tmod)
 context("Visualisations")
 
 
+test_that("ggEvidencePlot works", {
+  skip_if_not_installed("vdiffr")
+
+  genesets <- data.frame(
+    gene_symbol = paste0("gene", 1:10),
+    geneset = c(rep("diseaseA", 3), rep("diseaseB", 3), rep("diseaseC", 4))
+  )
+  ranked_genes <- paste0("gene", 1:10)
+
+  tmod_db <- makeTmodFromDataFrame(genesets)
+
+  p <- ggEvidencePlot(
+    ranked_genes,
+    m = c("diseaseA", "diseaseB"),
+    mset = tmod_db,
+    gene.labels = FALSE
+  )
+
+  vdiffr::expect_doppelganger("ggEvidencePlot", p)
+})