Updates to native pipe

Author: lianos

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: FacileAnalysis
 Type: Package
 Title: Modularized and interactive analyses over a FacileDataStore
-Version: 0.98.16
+Version: 0.98.17
 Authors@R: c(
     person(
       "Steve", "Lianoglou",
@@ -22,15 +22,15 @@ Description: Provides modularized analysis methods commonly performed over
 URL: https://github.com/facilebio/FacileAnalysis
 BugReports: https://github.com/facilebio/FacileAnalysis/issues
 Depends:
-    R (>= 3.6)
+    R (>= 4.2.0)
 Imports:
     broom,
     checkmate,
     crosstalk,
     dplyr,
     DT,
     edgeR,
-    FacileData (>= 0.98.0),
+    FacileData (>= 0.98.5),
     FacileShine (>= 0.98.0),
     FacileViz (>= 0.98.0),
     ggplot2,
@@ -42,6 +42,7 @@ Imports:
     miniUI,
     sparrow (>= 0.98.5),
     sparrow.shiny,
+    statmod (>= 1.5.0),
     plotly (>= 4.9.0),
     shiny (>= 1.3.1),
     shinycssloaders,
@@ -53,6 +54,7 @@ Imports:
     tidyr
 Suggests:
     airway,
+    BiasedUrn,
     curl,
     DESeq2,
     FacileBiocData,
@@ -88,7 +90,7 @@ License: Apache License (>= 2.0)
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.3
 Collate: 
     'api.R'
     'biocbox.R'

NAMESPACE

@@ -151,7 +151,6 @@ S3method(viz,FacileGadgetResult)
 S3method(viz,FacilePcaAnalysisResult)
 S3method(viz,FacileTtestAnalysisResult)
 S3method(viz,FacileTtestComparisonAnalysisResult)
-export("%>%")
 export(annotation)
 export(callModule)
 export(comparable)
@@ -226,7 +225,6 @@ importFrom(DT,datatable)
 importFrom(DT,formatRound)
 importFrom(DT,renderDT)
 importFrom(DT,replaceData)
-importFrom(FacileData,"%>%")
 importFrom(FacileShine,ReactiveFacileDataStore)
 importFrom(FacileShine,active_samples)
 importFrom(FacileShine,annotation)

R/api.R

@@ -320,10 +320,10 @@ param.BiocBox <- function(x, name = NULL, ...) {
 #' the genes under test.
 #'
 #' ```
-#' dge <- FacileData::exampleFacileDataSet() %>%
-#'   FacileData::filter_samples(indication == "BLCA") %>%
+#' dge <- FacileData::exampleFacileDataSet() |>
+#'   FacileData::filter_samples(indication == "BLCA") |>
 #'   flm_def(covariate = "sample_type",numer = "tumor", denom = "normal",
-#'           batch = "sex") %>%
+#'           batch = "sex") |>
 #'   fdge()
 #' ```
 #'
@@ -387,23 +387,23 @@ ranks <- function(x, ...) {
 #' result.
 #'
 #' ```r
-#' sigs1 <- FacileData::exampleFacileDataSet() %>%
-#'   FacileData::filter_samples(indication == "CRC") %>%
-#'   fpca() %>%
+#' sigs1 <- FacileData::exampleFacileDataSet() |>
+#'   FacileData::filter_samples(indication == "CRC") |>
+#'   fpca() |>
 #'   signature()
-#' sigs2 <- FacileData::exampleFacileDataSet() %>%
-#'   FacileData::filter_samples(indication == "CRC") %>%
-#'   fpca() %>%
-#'   ranks() %>%
+#' sigs2 <- FacileData::exampleFacileDataSet() |>
+#'   FacileData::filter_samples(indication == "CRC") |>
+#'   fpca() |>
+#'   ranks() |>
 #'   signature()
 #' ```
 #'
 #' @export
 #' @param x A `FacileAnalysisResult`.
 #' @examples
-#' pca.sigs <- FacileData::exampleFacileDataSet() %>%
-#'   FacileData::filter_samples(indication == "CRC") %>%
-#'   fpca() %>%
+#' pca.sigs <- FacileData::exampleFacileDataSet() |>
+#'   FacileData::filter_samples(indication == "CRC") |>
+#'   fpca() |>
 #'   signature()
 signature <- function(x, ...) {
   UseMethod("signature", x)

R/fdge-compare.R

@@ -22,26 +22,26 @@ NULL
 #' # Let's compare the tumor vs normal DGE results in CRC vs BLCA
 #'
 #' efds <- FacileData::exampleFacileDataSet()
-#' dge.crc <- FacileData::filter_samples(efds, indication == "CRC") %>%
-#'   flm_def("sample_type", "tumor", "normal", "sex") %>%
+#' dge.crc <- FacileData::filter_samples(efds, indication == "CRC") |>
+#'   flm_def("sample_type", "tumor", "normal", "sex") |>
 #'   fdge()
-#' dge.blca <- FacileData::filter_samples(efds, indication == "BLCA") %>%
-#'   flm_def("sample_type", "tumor", "normal", "sex") %>%
+#' dge.blca <- FacileData::filter_samples(efds, indication == "BLCA") |>
+#'   flm_def("sample_type", "tumor", "normal", "sex") |>
 #'   fdge()
 #' dge.comp <- compare(dge.crc, dge.blca)
-#' comp.hi <- tidy(dge.comp) %>%
-#'   dplyr::group_by(interaction_group) %>%
-#'   dplyr::slice(1:3) %>%
+#' comp.hi <- tidy(dge.comp) |>
+#'   dplyr::group_by(interaction_group) |>
+#'   dplyr::slice(1:3) |>
 #'   dplyr::ungroup()
 #' # Static visualization generates the main "4-way" plot, as well as the
 #' # facets for each category.
 #' sviz <- viz(dge.comp, labels = c(x = "CRC", y = "BLCA"),
 #'             subtitle = "Tumor vs normal comparisons across indications",
 #'             highlight = comp.hi)
 #' # highlight some of them
-#' s.hi <- sviz$input_data %>%
-#'   dplyr::group_by(interaction_group) %>%
-#'   dplyr::slice(1:3) %>%
+#' s.hi <- sviz$input_data |>
+#'   dplyr::group_by(interaction_group) |>
+#'   dplyr::slice(1:3) |>
 #'   dplyr::ungroup()
 #' if (requireNamespace("patchwork")) {
 #'   patchwork::wrap_plots(
@@ -131,7 +131,7 @@ compare.FacileTtestAnalysisResult <- function(x, y,
     by = c("feature_type", "feature_id"))
 
   if (isTRUE(idge[["with_stats"]])) {
-    ires <- tidy(idge[["result"]]) %>%
+    ires <- tidy(idge[["result"]]) |>
       select(feature_type, feature_id, {{stat.cols}})
   } else {
     ires <- idge[["result"]]
@@ -232,7 +232,7 @@ tidy.FacileTtestComparisonAnalysisResult <- function(
        .xsig &  .ysig         ~ labels["both"],
        .xsig & !.ysig         ~ labels["x"],
       !.xsig &  .ysig         ~ labels["y"],
-      TRUE                    ~ labels["none"])) %>%
+      TRUE                    ~ labels["none"])) |>
     select(interaction_group, everything())
   attr(out, "labels") <- labels
   out
@@ -329,7 +329,7 @@ viz.FacileTtestComparisonAnalysisResult <- function(
   xdat$padj.min <- pmin(xdat$padj, xdat$padj.x, xdat$padj.y)
   xdat <- arrange(xdat, interaction_group, desc(padj.min))
 
-  gg.base <- xdat %>%
+  gg.base <- xdat |>
     ggplot2::ggplot(ggplot2::aes(x = logFC.x, y = logFC.y)) +
     ggplot2::geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
     ggplot2::geom_vline(xintercept = 0, color = "red", linetype = "dashed")
@@ -433,8 +433,8 @@ viz.FacileTtestComparisonAnalysisResult <- function(
 
   # Calculate estimated logFC's between the *.x and *.y logFC in case we don't
   # make it all the way through the formal interaction analysis
-  ires.tmp <- xres %>%
-    full_join(yres, by = c("feature_id", "feature_type", "name")) %>%
+  ires.tmp <- xres |>
+    full_join(yres, by = c("feature_id", "feature_type", "name")) |>
     transmute(feature_id, feature_type, name, logFC = logFC.x - logFC.y,
               pval = NA_real_, padj = NA_real_)
 

R/fdge-interact.R

@@ -467,24 +467,24 @@ report.FacileTtestAnalysisResult <- function(x, type = c("dge", "features"),
     ntop <- ntop
   }
 
-  dat.all <- tidy(x) %>%
+  dat.all <- tidy(x) |>
     select(symbol, feature_id, logFC, padj, pval)
 
-  dat.sig <- dat.all %>%
+  dat.sig <- dat.all |>
     filter(
       (abs(logFC) >= min_logFC & padj <= max_padj) |
         feature_id %in% highlight)
 
-  dat.up <- dat.sig %>%
-    arrange(desc(logFC)) %>%
+  dat.up <- dat.sig |>
+    arrange(desc(logFC)) |>
     head(ntop / 2)
-  dat.down <- dat.sig %>%
-    arrange(logFC) %>%
+  dat.down <- dat.sig |>
+    arrange(logFC) |>
     head(ntop / 2)
 
-  dat <- dat.up %>%
-    bind_rows(dat.down) %>%
-    rename(FDR = padj) %>%
+  dat <- dat.up |>
+    bind_rows(dat.down) |>
+    rename(FDR = padj) |>
     distinct(feature_id, .keep_all = TRUE)
 
   # Add link for gene and axe feature_id
@@ -511,7 +511,7 @@ report.FacileTtestAnalysisResult <- function(x, type = c("dge", "features"),
   # Generate volcano given the filtered data
   yaxis <- list(range = c(0, max(-log10(dat$pval)) + 0.1))
   xaxis <- list(range = (max(abs(dat$logFC)) + 0.2) * c(-1, 1))
-  p <- sdat %>%
+  p <- sdat |>
     plot_ly(x = ~logFC, y = ~-log10(pval),
             type = "scatter", mode = "markers",
             hoverinfo = "text",
@@ -529,9 +529,9 @@ report.FacileTtestAnalysisResult <- function(x, type = c("dge", "features"),
               "Symbol: ", symbol, "<br>",
               sprintf(paste0("logFC: %.", round_digits, "f<br>"), logFC),
               sprintf(paste0("FDR: %.", round_digits, "f<br>"), FDR),
-              sprintf(paste0("pvalue: %.", round_digits, "f<br>"), pval))) %>%
+              sprintf(paste0("pvalue: %.", round_digits, "f<br>"), pval))) |>
     layout(yaxis = yaxis, xaxis = xaxis, dragmode = "select",
-           showlegend = FALSE) %>%
+           showlegend = FALSE) |>
     config(displaylogo = FALSE)
 
   if (webgl) p <- toWebGL(p)
@@ -541,11 +541,11 @@ report.FacileTtestAnalysisResult <- function(x, type = c("dge", "features"),
   if (isTRUE(all.equal(dat$symbol, dat$feature_id))) {
     noshow <- c(noshow, "symbol")
   }
-  dtable <- sdat %>%
+  dtable <- sdat |>
     datatable(filter = "top", extensions = "Scroller", style = "bootstrap",
               class = "compact", width = "100%", rownames = FALSE,
               options = dtopts, escape = !link_feature,
-              colnames = setdiff(colnames(dat), noshow)) %>%
+              colnames = setdiff(colnames(dat), noshow)) |>
     formatRound(c("logFC", "FDR", "pval"), round_digits)
 
   # Title

R/fdge-shiny-runOptions.R

@@ -64,9 +64,9 @@ fdgeRunOptions <- function(input, output, session, rfds, model, assay, ...) {
     method. <- req(dge_method(), !unselected(dge_method()))
     ainfo <- req(assay$assay_info())
     atype <- req(ainfo$assay_type, !unselected(ainfo$assay_type))
-    fdge_methods() %>%
-      filter(.data$assay_type == .env$atype, .data$dge_method == .env$method.) %>%
-      pull(can_sample_weight) %>%
+    fdge_methods() |>
+      filter(.data$assay_type == .env$atype, .data$dge_method == .env$method.) |>
+      pull(can_sample_weight) |>
       isTRUE()
   })
 

R/fdge-shiny.R

@@ -31,11 +31,11 @@ NULL
 #' # run tumor vs normal comparisons vs each, then run compare() on the results
 #' options(facile.log.level.fshine = "trace")
 #' efds <- FacileData::exampleFacileDataSet()
-#' dge.crc <- efds %>%
-#'   FacileData::filter_samples(indication == "CRC") %>%
+#' dge.crc <- efds |>
+#'   FacileData::filter_samples(indication == "CRC") |>
 #'   fdgeGadget(viewer = "pane")
-#' dge.blca <- efds %>%
-#'   FacileData::filter_samples(indication == "BLCA") %>%
+#' dge.blca <- efds |>
+#'   FacileData::filter_samples(indication == "BLCA") |>
 #'   fdgeGadget(viewer = "pane")
 #' dge.comp <- compare(dge.crc, dge.blca)
 #'
@@ -441,9 +441,9 @@ fdgeView <- function(input, output, session, rfds, dgeres, ...,
       paste0(name, ".csv")
     },
     content = function(file) {
-      dat <- req(featureviz()) %>%
-        FacileViz::input_data() %>%
-        select(dataset, sample_id, feature_id, feature_name, value) %>%
+      dat <- req(featureviz()) |>
+        FacileViz::input_data() |>
+        select(dataset, sample_id, feature_id, feature_name, value) |>
         with_sample_covariates()
       write.csv(dat, file, row.names = FALSE)
     }
@@ -457,9 +457,9 @@ fdgeView <- function(input, output, session, rfds, dgeres, ...,
     if (is.null(selected)) {
       selected <- tibble(dataset = character(), sample_id = character())
     } else {
-      selected <- featureviz() %>%
-        input_data() %>%
-        slice(as.integer(selected$key)) %>%
+      selected <- featureviz() |>
+        input_data() |>
+        slice(as.integer(selected$key)) |>
         select(dataset, sample_id)
     }
     current <- paste(state$boxplot_select$dataset,
@@ -482,7 +482,7 @@ fdgeView <- function(input, output, session, rfds, dgeres, ...,
     },
     content = function(file) {
       .fdge <- req(isolate(dge()))
-      # .result <- ranks(.fdge) %>% result()
+      # .result <- ranks(.fdge) |> result()
       .result <- req(dge.stats())
       if ("padj" %in% colnames(.result)) {
         .result <- rename(.result, FDR = "padj")
@@ -512,13 +512,13 @@ fdgeView <- function(input, output, session, rfds, dgeres, ...,
                    pageLength = 15,
                    lengthMenu = c(15, 30, 50))
 
-    dtable <- dat %>%
+    dtable <- dat |>
       datatable(filter = "top",
                 # extensions = "Scroller",
                 style = "bootstrap",
                 class = "display", width = "100%", rownames = FALSE,
                 selection = list(mode = "single", selected = 1, target = "row"),
-                options = dtopts) %>%
+                options = dtopts) |>
       formatRound(num.cols, 3)
     dtable
   }, server = TRUE)