fix issue with selecting test/expr names before updating test names

fun-input-analyze-data.R

@@ -4,7 +4,15 @@ required_data_names <- c("group_names","sampledata","results","data_long","genei
 load_existing_rdata <- function(rdata_filepath) {
 
   start_data <- load(rdata_filepath)
-  start_results <- get(start_data)
+  start_results <-  list(
+    countdata = countdata,
+    geneids = geneids,
+    group_names = group_names,
+    sampledata = sampledata,
+    results = results,
+    data_long = data_long,
+    data_results_table = data_results_table
+  )
   loaded_datanames <- names(start_results)
   missing_datanames <- setdiff(required_data_names,loaded_datanames)
   validate(
@@ -41,7 +49,6 @@ extract_count_data <- function(alldata, tmpexprcols, tmpgenecols) {
   validate(need(length(tmpkeep)>0,
                 message = "Your data is empty. Please check file format is .csv. 
                                   You may need a non-empty gene identifier column."))
-
   geneids = geneids[tmpkeep,,drop=FALSE]
   countdata = countdata[tmpkeep,,drop=FALSE]
   alldata = alldata[tmpkeep,,drop=FALSE]
@@ -95,7 +102,6 @@ analyze_expression_data <- function(alldata, analysis_method = "edgeR", numgenei
 
   datalist <- extract_count_data(alldata, tmpexprcols, tmpgenecols)
 
-
   # do not perform voom/edgeR on non-counts and assume log2 uploaded intensities
   # is_counts <- is_datacounts(tmpcount$countdata)
 
@@ -262,7 +268,11 @@ analyze_expression_data <- function(alldata, analysis_method = "edgeR", numgenei
 load_analyzed_data <- function(alldata, tmpgenecols, tmpexprcols, tmpfccols, tmppvalcols, tmpqvalcols, isfclogged) {
 
   tmpcount <- extract_count_data(alldata, tmpexprcols, tmpgenecols)
-  list2env(tmpcount)
+  countdata = tmpcount$countdata
+  geneids = tmpcount$geneids
+  group_names = tmpcount$group_names
+  sampledata = tmpcount$sampledata
+  alldata = tmpcount$alldata
 
   tmpfc = alldata[,tmpfccols,drop=F]
   if(isfclogged=="No (Log my data please)") {log2(tmpfc)}
@@ -282,17 +292,18 @@ load_analyzed_data <- function(alldata, tmpgenecols, tmpexprcols, tmpfccols, tmp
   tmpres = full_join(fcdatalong,pvaldatalong)
   tmpres = full_join(tmpres,qvaldatalong)
 
-  tmpdat = cbind("unique_id"=geneids$unique_id,expr_data)
+  tmpdat = cbind("unique_id"=geneids$unique_id,countdata)
   tmpdatlong = tmpdat%>%gather(key="sampleid",value="expr",-1)
   data_long = left_join(tmpdatlong,sampledata%>%select(sampleid,group))
   # add summized means by group/unique id for scatterplot
 
   tmpres$test = as.character(tmpres$test)
 
-  return(list("group_names"=group_names,
+  return(list("countdata"=countdata,
+              "group_names"=group_names,
               "sampledata"=sampledata,
               "results"=tmpres,
               "data_long"=data_long, 
-              "geneids"=geneids,
+              "geneids"=geneids, 
               "data_results_table"=alldata))
 }

server-filterdata.R

@@ -28,8 +28,7 @@ observe({
   tmpsamples = as.character(data_analyzed$sampledata$sampleid)
   tmpgeneids = data_analyzed$geneids
   data_analyzedgenes = as.character(unlist(tmpgeneids))
-  tmpdat = data_analyzed$results
-  tmptests = unique(as.character(tmpdat$test))
+  tmptests = unique(as.character(data_analyzed$results$test))
 
   updateSelectizeInput(session,"datafilter_groups", 
                        choices=tmpgroups,selected=tmpgroups)
@@ -44,14 +43,16 @@ observe({
   updateRadioButtons(session,'datafilter_selectexpr',
                      choices=sort(tmpynames,decreasing = TRUE))
 
-})
+}, priority=1)
 
 # after selecting test
 
 observe({
   print("server-datafilter-update-tests")
   data_analyzed = analyzeDataReactive()
-  if(!(input$datafilter_selecttest=="")) {
+  tmptests = unique(as.character(data_analyzed$results$test))
+
+  if(input$datafilter_selecttest%in%tmptests) {
     tmptest = input$datafilter_selecttest
     # get max abs fold change for this test
     tmpdat = data_analyzed$results
@@ -64,13 +65,15 @@ observe({
       updateNumericInput(session,"datafilter_fccut",
                          min=0,max= ceiling(tmpmax),value=0)
   }
-})
+}, priority = 2)
 
 # after selecting expression value
 observe({
   print("server-datafilter-update-expr")
   data_analyzed = analyzeDataReactive()
-  if(!(input$datafilter_selectexpr=="")) {
+  tmpynames = data_analyzed$data_long%>%select(-unique_id,-sampleid,-group,-one_of("rep"))%>%colnames()
+
+  if(input$datafilter_selectexpr%in%tmpynames) {
     exprname = input$datafilter_selectexpr
     #calculate miin and max
     tmpdat = data_analyzed$data_long # add filter by group and sample id
@@ -82,7 +85,7 @@ observe({
     updateNumericInput(session,"datafilter_exprmax",
                        min=floor(tmpmin),max= ceiling(tmpmax),value=ceiling(tmpmax))
   }
-})
+}, priority = 2)
 
 
 

server-inputdata.R

@@ -119,7 +119,7 @@ outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE)
 analyzeDataReactive <- 
   eventReactive(input$upload_data,
                 ignoreNULL = FALSE, {
-                  withProgress(message = "Analyzing RNA-seq data, please wait",{
+                  withProgress(message = "Analyzing data, please wait",{
 
                     print("analysisCountDataReactive")
                     ## ==================================================================================== ##

tests.R

@@ -44,3 +44,12 @@ tmp3 <- analyze_expression_data(alldata, analysis_method="edgeR")
 # sample heatmaps not working
 
 
+testdata <- read_csv("data/testdata_analyzed_onecomparison.csv")
+data_analyzed = load_analyzed_data(testdata, tmpgenecols = 1:2, tmpexprcols = 3:12,
+                         tmpfccols = 13, tmppvalcols = 14, tmpqvalcols = 15, isfclogged = TRUE)
+tmpdatlong = data_analyzed$data_long
+(tmpynames = tmpdatlong%>%select(-unique_id,-sampleid,-group,-one_of("rep"))%>%colnames())
+(tmpgroups = data_analyzed$group_names)
+(tmpsamples = as.character(data_analyzed$sampledata$sampleid))
+tmpdat = data_analyzed$results
+(tmptests = unique(as.character(tmpdat$test)))