From d42364c9f29ce5d3f86162528a93985a7c9497bc Mon Sep 17 00:00:00 2001 From: Jessica Minnier Date: Wed, 4 Dec 2019 17:18:41 -0800 Subject: [PATCH] fix issue with selecting test/expr names before updating test names --- fun-input-analyze-data.R | 25 ++++++++++++++++++------- server-filterdata.R | 17 ++++++++++------- server-inputdata.R | 2 +- tests.R | 9 +++++++++ 4 files changed, 38 insertions(+), 15 deletions(-) diff --git a/fun-input-analyze-data.R b/fun-input-analyze-data.R index fb1eb85..72c3d43 100644 --- a/fun-input-analyze-data.R +++ b/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)) } \ No newline at end of file diff --git a/server-filterdata.R b/server-filterdata.R index ec19f80..c5f81a1 100644 --- a/server-filterdata.R +++ b/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) diff --git a/server-inputdata.R b/server-inputdata.R index 0e3b215..f866809 100644 --- a/server-inputdata.R +++ b/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") ## ==================================================================================== ## diff --git a/tests.R b/tests.R index a33bd38..b52edc2 100644 --- a/tests.R +++ b/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)))