Fixed structure plots by using geom_tile instead of geom_col; address…

…es Issue #60.

.circleci/config.yml

@@ -19,7 +19,7 @@ jobs:
           command: |
             mkdir -p ~/R/Library
             Rscript -e 'update.packages("Matrix")'
-            Rscript -e 'install.packages(c("devtools","remotes","quadprog","gtools","irlba","Rtsne","uwot","dplyr","Rcpp","RcppArmadillo","RcppParallel","progress","pbapply","ggplot2","ggrepel","cowplot","plotly","htmlwidgets","testthat","Ternary","RhpcBLASctl"))'
+            Rscript -e 'install.packages(c("devtools","remotes","quadprog","gtools","irlba","Rtsne","uwot","dplyr","rlang","tidyr","Rcpp","RcppArmadillo","RcppParallel","progress","pbapply","ggplot2","ggrepel","cowplot","plotly","htmlwidgets","testthat","Ternary","RhpcBLASctl"))'
             Rscript -e 'devtools::install_github("slowkow/ggrepel",upgrade="never",force=TRUE)'
             Rscript -e 'devtools::install_github("stephens999/ashr",upgrade="never",force=TRUE)'
             Rscript -e 'devtools::install_github("linxihui/NNLM",upgrade="never",force=TRUE)'

.github/workflows/R-CMD-check.yaml

@@ -25,8 +25,8 @@ jobs:
           update.packages("Matrix")
           install.packages(c("remotes","rcmdcheck"))
           install.packages(c("devtools","remotes","quadprog","gtools"))
-          install.packages(c("irlba","Rtsne","uwot","dplyr","Rcpp"))
-          install.packages(c("RcppArmadillo","RcppParallel","pbapply"))
+          install.packages(c("irlba","Rtsne","uwot","dplyr","tidyr","rlang"))
+          install.packages(c("Rcpp","RcppArmadillo","RcppParallel","pbapply"))
           install.packages(c("progress","ggplot2","ggrepel","cowplot"))
           install.packages(c("plotly","htmlwidgets","testthat","Ternary"))
           install.packages("RhpcBLASctl")

.travis.yml

@@ -8,7 +8,7 @@ r_check_args: --as-cran
 # This is the minimal set of R packages needed to run "R CMD check" on
 # the package.
 install:
-  - R -e 'install.packages(c("devtools","covr","testthat","knitr","rmarkdown","quadprog","gtools","irlba","Rtsne","uwot","dplyr","Rcpp","RcppArmadillo","RcppParallel","progress","pbapply","ggplot2","ggrepel","cowplot","plotly","htmlwidgets","Ternary","RhpcBLASctl"))'
+  - R -e 'install.packages(c("devtools","covr","testthat","knitr","rmarkdown","quadprog","gtools","irlba","Rtsne","uwot","dplyr","rlang","tidyr","Rcpp","RcppArmadillo","RcppParallel","progress","pbapply","ggplot2","ggrepel","cowplot","plotly","htmlwidgets","Ternary","RhpcBLASctl"))'
   - R -e 'devtools::install_github("linxihui/NNLM",upgrade="never",force=TRUE)'
   - R -e 'devtools::install_github("slowkow/ggrepel",upgrade="never",force=TRUE)'
   - R -e 'devtools::install_github("stephens999/ashr",upgrade="never",force=TRUE)'

DESCRIPTION

@@ -1,8 +1,8 @@
 Encoding: UTF-8
 Type: Package
 Package: fastTopics
-Version: 0.6-194
-Date: 2024-12-12
+Version: 0.7-1
+Date: 2025-01-29
 Title: Fast Algorithms for Fitting Topic Models and Non-Negative
     Matrix Factorizations to Count Data
 Authors@R: c(person("Peter","Carbonetto",role=c("aut","cre"),
@@ -47,7 +47,9 @@ Imports:
     gtools,
     quadprog,
     irlba,
+    rlang,
     dplyr,
+    tidyr,
     Rtsne,
     uwot,
     ashr,

NAMESPACE

@@ -72,16 +72,24 @@ importFrom(Rtsne,Rtsne)
 importFrom(ashr,ash)
 importFrom(cowplot,plot_grid)
 importFrom(cowplot,theme_cowplot)
+importFrom(dplyr,arrange)
+importFrom(dplyr,coalesce)
+importFrom(dplyr,group_by)
+importFrom(dplyr,join_by)
+importFrom(dplyr,lag)
+importFrom(dplyr,left_join)
+importFrom(dplyr,mutate)
 importFrom(dplyr,select)
+importFrom(dplyr,ungroup)
 importFrom(ggplot2,aes_q)
 importFrom(ggplot2,aes_string)
 importFrom(ggplot2,after_stat)
 importFrom(ggplot2,element_blank)
 importFrom(ggplot2,element_text)
 importFrom(ggplot2,geom_boxplot)
-importFrom(ggplot2,geom_col)
 importFrom(ggplot2,geom_line)
 importFrom(ggplot2,geom_point)
+importFrom(ggplot2,geom_tile)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,labs)
 importFrom(ggplot2,scale_color_manual)
@@ -110,6 +118,7 @@ importFrom(plotly,layout)
 importFrom(plotly,plot_ly)
 importFrom(progress,progress_bar)
 importFrom(quadprog,solve.QP)
+importFrom(rlang,.data)
 importFrom(stats,dpois)
 importFrom(stats,formula)
 importFrom(stats,glm)
@@ -125,6 +134,7 @@ importFrom(stats,rnorm)
 importFrom(stats,rpois)
 importFrom(stats,runif)
 importFrom(stats,summary.glm)
+importFrom(tidyr,crossing)
 importFrom(utils,combn)
 importFrom(utils,modifyList)
 importFrom(utils,read.table)

R/fit_poisson_nmf.R

@@ -455,7 +455,7 @@ fit_poisson_nmf <- function (X, k, fit0, numiter = 100,
     cat(sprintf("Running at most %d %s updates, %s extrapolation ",
                 numiter,method.text,
                 ifelse(control$extrapolate,"with","without")))
-    cat("(fastTopics 0.6-194).\n")
+    cat("(fastTopics 0.7-1).\n")
   }
 
   # INITIALIZE ESTIMATES

R/structure_plot.R

@@ -79,6 +79,9 @@
 #'   \code{structure_plot_ggplot_call} with your own function to
 #'   customize the appearance of the plot.
 #'
+#' @param res The resolution of the tiling along the y-axis
+#'   (in units of topic probabilities).
+#'
 #' @param \dots Additional arguments passed to \code{structure_plot}
 #'   (for the \code{plot} method) or \code{embed_method} (for
 #'   function \code{structure_plot}).
@@ -167,9 +170,10 @@
 #'
 structure_plot <-
   function (fit, topics, grouping, loadings_order = "embed", n = 2000,
-            colors, gap = 1,
+            colors, gap = 1, 
             embed_method = structure_plot_default_embed_method,
-            ggplot_call = structure_plot_ggplot_call, ...) {
+            ggplot_call = structure_plot_ggplot_call, res = 0.01,
+            ...) {
 
   # Check and process input argument "fit".
   if (is.matrix(fit)) {
@@ -266,7 +270,7 @@ structure_plot <-
     return(ggplot_call(dat,colors))
   } else {
     out <- compile_grouped_structure_plot_data(fit$L,topics,grouping,gap)
-    return(ggplot_call(out$dat,colors,out$ticks))
+    return(ggplot_call(out$dat,colors,out$ticks,res = res))
   }
 }
 
@@ -328,12 +332,21 @@ plot.multinom_topic_model_fit <- function (x, ...)
 #'   \code{ticks = NULL}.
 #'
 #' @param font.size Font size used in plot.
-#' 
+#'
+#' @importFrom rlang .data
+#' @importFrom dplyr group_by
+#' @importFrom dplyr ungroup
+#' @importFrom dplyr arrange
+#' @importFrom dplyr mutate
+#' @importFrom dplyr coalesce
+#' @importFrom dplyr lag
+#' @importFrom dplyr left_join
+#' @importFrom dplyr join_by
+#' @importFrom tidyr crossing
 #' @importFrom ggplot2 ggplot
 #' @importFrom ggplot2 aes_string
-#' @importFrom ggplot2 geom_col
+#' @importFrom ggplot2 geom_tile
 #' @importFrom ggplot2 scale_x_continuous
-#' @importFrom ggplot2 scale_color_manual
 #' @importFrom ggplot2 scale_fill_manual
 #' @importFrom ggplot2 labs
 #' @importFrom ggplot2 theme
@@ -344,19 +357,29 @@ plot.multinom_topic_model_fit <- function (x, ...)
 #' @export
 #'
 structure_plot_ggplot_call <- function (dat, colors, ticks = NULL,
-                                        font.size = 9)
-  ggplot(dat,aes_string(x = "sample",y = "prop",color = "topic",
-                        fill = "topic")) +
-    geom_col() +
-    scale_x_continuous(limits = c(0,max(dat$sample) + 1),breaks = ticks,
-                       labels = names(ticks)) +
-    scale_color_manual(values = colors) +
-    scale_fill_manual(values = colors) +
-    labs(x = "",y = "topic proportion") +
-    theme_cowplot(font.size) +
-    theme(axis.line   = element_blank(),
-          axis.ticks  = element_blank(),
-          axis.text.x = element_text(angle = 45,hjust = 1))
+                                        font.size = 9, res = 0.01) {
+  dat <- group_by(dat,.data$sample)
+  dat <- arrange(dat,.data$topic)
+  dat <- mutate(dat,"top" = cumsum(.data$prop))
+  dat <- mutate(dat,"bot" = coalesce(lag(.data$top),0))
+  dat <- ungroup(dat)
+  dat <- dat[,c("sample","topic","top","bot")]
+  rasterdat <- dat["sample"]
+  rasterdat <- crossing(rasterdat,
+                        data.frame("y" = seq(0 + res/2,1 - res/2,by = res)))
+  rasterdat <- left_join(rasterdat,dat,
+                         by = join_by("sample",x$y > y$bot,x$y < y$top))
+  return(ggplot(rasterdat,aes_string(x = "sample",y = "y",fill = "topic")) +
+         geom_tile() +
+         scale_fill_manual(values = colors) +
+         scale_x_continuous(limits = c(0,max(dat$sample) + 1),breaks = ticks,
+                            labels = names(ticks)) +
+         labs(x = "",y = "topic proportion") +
+         theme_cowplot(font.size) +
+         theme(axis.line   = element_blank(),
+               axis.ticks  = element_blank(),
+               axis.text.x = element_text(angle = 45,hjust = 1)))
+}
 
 # This is used by structure_plot to create a data frame suitable for
 # plotting with 'ggplot'. Input argument L is the topic proportions

appveyor.yml

@@ -24,7 +24,7 @@ environment:
 # This is the minimal set of R packages needed to run "R CMD check" on
 # the package.
 build_script:
-  - R -e install.packages(c('devtools','testthat','quadprog','gtools','irlba','Rtsne','uwot','dplyr','Rcpp','RcppArmadillo','RcppParallel','RhpcBLASctl','progress','pbapply','ggplot2','cowplot','plotly','htmlwidgets'),head(.libPaths(),1),'http://cran.wustl.edu')
+  - R -e install.packages(c('devtools','testthat','quadprog','gtools','irlba','Rtsne','uwot','dplyr','rlang','tidyr','Rcpp','RcppArmadillo','RcppParallel','RhpcBLASctl','progress','pbapply','ggplot2','cowplot','plotly','htmlwidgets'),head(.libPaths(),1),'http://cran.wustl.edu')
   - R -e devtools::install_github('slowkow/ggrepel',upgrade='never',force=TRUE)
   - R -e devtools::install_github('stephens999/ashr',upgrade='never',force=TRUE)