bugfix curve fitting

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: omicsViewer
 Title: Interactive and explorative visualization of SummarizedExperssionSet or ExpressionSet using omicsViewer
-Version: 1.7.7
+Version: 1.7.8
 Authors@R: person("Chen", "Meng", email = "mengchen18@gmail.com",
                   role = c("aut", "cre"))
 Description: omicsViewer visualizes ExpressionSet (or SummarizedExperiment) in an interactive way. The omicsViewer has a separate back- and front-end. In the back-end, users need to prepare an ExpressionSet that contains all the necessary information for the downstream data interpretation. Some extra requirements on the headers of phenotype data or feature data are imposed so that the provided information can be clearly recognized by the front-end, at the same time, keep a minimum modification on the existing ExpressionSet object. The pure dependency on R/Bioconductor guarantees maximum flexibility in the statistical analysis in the back-end. Once the ExpressionSet is prepared, it can be visualized using the front-end, implemented by shiny and plotly. Both features and samples could be selected from (data) tables or graphs (scatter plot/heatmap). Different types of analyses, such as enrichment analysis (using Bioconductor package fgsea or fisher's exact test) and STRING network analysis, will be performed on the fly and the results are visualized simultaneously. When a subset of samples and a phenotype variable is selected, a significance test on means (t-test or ranked based test; when phenotype variable is quantitative) or test of independence (chi-square or fisher’s exact test; when phenotype data is categorical) will be performed to test the association between the phenotype of interest with the selected samples. Additionally, other analyses can be easily added as extra shiny modules. Therefore, omicsViewer will greatly facilitate data exploration, many different hypotheses can be explored in a short time without the need for knowledge of R. In addition, the resulting data could be easily shared using a shiny server. Otherwise, a standalone version of omicsViewer together with designated omics data could be easily created by integrating it with portable R, which can be shared with collaborators or submitted as supplementary data together with a manuscript. 

R/L1_module_result_space.R

@@ -93,7 +93,11 @@ L1_result_space_module <- function(
     reactive_expr = reactive_expr, 
     reactive_i = reactive_i,
     reactive_phenoData = reactive_phenoData,
-    reactive_featureData = reactive_featureData
+    reactive_featureData = reactive_featureData,
+    reactive_attr_drc = reactive({
+      req(object())
+      attr(object(), "S6.6_drc")
+      })
   )
 
   # 

R/module_doseResponse.R

@@ -23,41 +23,27 @@ dose_response_ui <- function(id) {
 #' @param reactive_i reactive index of rows to be selected (for ORA)
 #' @param reactive_featureData reactive feature data
 #' @importFrom fastmatch fmatch
-#' @examples 
-#' #' # source("Git/R/auxi_fgsea.R")
-#' # source("Git/R/auxi_vectORA.R")
-#' # source("Git/R/module_barplotGsea.R")
-# dat <- readRDS("inst/extdata/demo.RDS")
-# obj <- tallGS(dat)
-# fd <- Biobase::fData(obj)
-# fdgs <- attr(fd, "GS")
-# selected_ids <- rownames(fd)[fd$`PCA|All|PC1(10.1%)` > 0.02]
-# ui <- fluidPage(
-#   enrichment_analysis_ui("ea")
-# )
-# server <- function(input, output, session) {
-#   callModule(
-#     enrichment_analysis_module, id = "ea",
-#     reactive_featureData = reactive(fd), reactive_i = reactive(selected_ids)
-#   )
-# }
-# shinyApp(ui, server)
-
 
 dose_response_module <- function(
     input, output, session, 
     reactive_expr, 
     reactive_phenoData, 
     reactive_featureData,
-    reactive_i
+    reactive_i,
+    reactive_attr_drc
 ) {
 
   ns <- session$ns
 
   dr1 <- reactive({
     req(length(reactive_i()) == 1)
     req(reactive_featureData())
-    attr(reactive_featureData(), "ResponseCurve")
+    req(reactive_attr_drc())
+    v <- reactive_attr_drc()
+    list(
+      col_dose = paste("General", "All", v["dose_col"], sep = "|"),
+      col_curveid = paste("General", "All", v["curveid_col"], sep = "|")
+      )
   })
 
   tabs <- reactive({
@@ -85,10 +71,6 @@ dose_response_module <- function(
     )
   })
 
-  output$feature <- DT::renderDT(
-    form
-  )
-
   callModule(
     dataTableDownload_module, id = "feature", reactive_table = reactive(tabs()$featInfo), prefix = "Response_featureInfo_"
   )

R/proc_doseCurve.R

@@ -121,7 +121,6 @@ plotDC <- function(mod, ylab = "Abundance", lty = 2, pch = 19, cex = 1, ...) {
 #' @param prefix for column header, the column will be named as prefix|curveid|curveparameter
 #' @note
 #' when LL2.X is used, e is estimated as log(e), this function will return e in linear scale instead. 
-
 extractParamDC <- function(mod, prefix = "ResponseCurve") {
 
   pm <- mod$parmMat
@@ -144,8 +143,14 @@ extractParamDC <- function(mod, prefix = "ResponseCurve") {
 
   uv <- unique(iv <- mod_id)
   m2 <- sapply(uv, function(i) {
-    d <- mod$predres[iv == i, ]
-    cc <- cor.test(d[, 1], rowSums(d))
+    if (length(uv) == 1 && all(uv == "(Intercept)") && length(unique(mod$dataList$curveid)) == 1)
+      d <- mod$predres else
+        d <- mod$predres[mod$dataList$curveid == i, ]
+    cc <- try(cor.test(d[, 1], rowSums(d)), silent = TRUE)
+    if (inherits(cc, "try-error"))
+      return(
+        c(Pval = NA, log.Pval = NA, Pseudo.rsq = NA)
+      )
     c(Pval = cc$p.value, log.Pval = -log10(cc$p.value), Pseudo.rsq = cc[["estimate"]][[1]]^2)
   })
   colnames(m2) <- uv
@@ -206,7 +211,7 @@ extractParamDCList <- function(x, prefix = "ResponseCurve") {
 #' @param return.par logical value. If true, no plot generated,
 #'   the function only returns the parameters of models.
 
-plotDCMat <- function(expr, pd, fd, featid, dose.var, curve.var, only.par = FALSE) {
+plotDCMat <- function(expr, pd, fd, featid, dose.var, curve.var=NULL, only.par = FALSE) {
 
   op <- par(no.readonly = TRUE)
   on.exit(par(op))
@@ -232,7 +237,11 @@ plotDCMat <- function(expr, pd, fd, featid, dose.var, curve.var, only.par = FALS
     return(ll)
   }
 
-  cid <- pd[, curve.var]
+  if (is.null(curve.var))
+    cid <- rep("(Intercept)", nrow(pd)) else if (curve.var %in% colnames(pd))
+      cid <- pd[, curve.var] else 
+        cid <- rep("(Intercept)", nrow(pd))
+
   dose <- pd[, dose.var]
   dd <- data.frame(
     feat = expr[featid, ],