update filter

server-filterdata.R

@@ -77,14 +77,102 @@ observe({
     tmpmax = max(tmpdat[,colnames(tmpdat)==exprname],na.rm=T)
 
     updateNumericInput(session,"datafilter_exprmin",
-                 min=tmpmin,max= tmpmax,value=tmpmin)
+                       min=tmpmin,max= tmpmax,value=tmpmin)
     updateNumericInput(session,"datafilter_exprmax",
-                 min=tmpmin,max= tmpmax,value=tmpmax)
+                       min=tmpmin,max= tmpmax,value=tmpmax)
   }
 })
 
 
 
+filterDataReactive <- reactive({
+  print("filterDataReactive")
+  data_analyzed = analyzeDataReactive()
+  tmpsampledata = data_analyzed$sampledata
+  tmpgeneids = data_analyzed$geneids
+  tmpres = data_analyzed$results
+
+
+
+  # tmpdatlong = data_analyzed$data_long
+  # tmpynames = tmpdatlong%>%select(-unique_id,-sampleid,-group)%>%colnames()
+  # 
+  # tmptests = unique(as.character(tmpdat$test))
+
+  mydata <- data_analyzed$data_results_table
+  mydata_genes = left_join(mydata,tmpgeneids) # need also to have unique id
+
+  groupids = lapply(tmpgroups,function(k) grep(k,colnames(mydata)))
+
+  # filter by group
+  if(!(input$datafilter_groups[1]=="")) {
+    tmpselected = input$datafilter_groups
+    tmprem = match(as.character(tmpsampledata$sampleid[which(!(tmpsampledata$group%in%tmpselected))]),colnames(mydata))
+    tmpkeep = setdiff(1:ncol(mydata),tmprem)
+    mydata = mydata[,tmpkeep]
+  }
+
+  # filter by sampleid
+  if(!(input$datafilter_samples[1]=="")) {
+    tmpselected = input$datafilter_samples
+    tmpsamplesrem = setdiff(as.character(tmpsampledata$sampleid),tmpselected) # leftover samples
+    tmprem = match(tmpsamplesrem,colnames(mydata))
+    tmpkeep = setdiff(1:ncol(mydata),tmprem)
+    mydata = mydata[,tmpkeep]
+  }
+
+  # filter by geneid or name
+  if((input$datafilter_genelist)&(length(input$datafilter_gene_select)>0)) {
+    tmpselected = input$datafilter_gene_select
+
+    # find the columns with gene identifiers
+    tmpmydata_genes = mydata_genes[,match(colnames(tmpgeneids),colnames(mydata_genes),nomatch=0)]
+    # try to match gene names to each column, then take the union of all the indx
+    tmpind = unique(na.omit(c(apply(tmpmydata_genes,2,function(k) match(tmpselected,k)))))
+
+    mydata = mydata[tmpind,]
+    mydata_genes = mydata_genes[tmpind,]
+  }
+
+  #add filter by gene name file like in heatmap
+
+  if(input$datafilter_signif) {
+    tmpres_filter = tmpres%>%filter(test==input$datafilter_selecttest)
+    tmpres_filter = tmpres_filter%>%filter(P.Value<=input$datafilter_pvaluecut,
+                                           adj.P.Val<=input$datafilter_qvaluecut)
+    tmpres_up = tmpres_filter%>%filter(logFC>=input$datafilter_fccut)
+    tmpres_down = tmpres_filter%>%filter(logFC<=input$datafilter_fccut)
+    if(input$datafilter_logfc_dir=="up") {
+      tmpgenes=as.character(tmpres_up$unique_id)
+    }else if(input$datafilter_logfc_dir=="down"){
+      tmpgenes=as.character(tmpres_down$unique_id)
+    }else{
+      tmpgenes=c(as.character(tmpres_up$unique_id),as.character(tmpres_down$unique_id))
+    }
+    tmpind = match(tmpgenes,mydata_genes$unique_id,nomatch=0)
+
+    mydata = mydata[tmpind,]
+    mydata_genes = mydata_genes[tmpind,]
+  }
+
+  mydata
+
+  # filter results by test and expression and then take intersection of gene ids with mydata?
+  # if nrow(mydata)==0 validate send message no data
+  # save data as file with filter settings concatinated?
+  # show number of genes that pass filter like in heatmap
+  # get rid of rownames
+})
+
+
+output$filterdataoutput <- renderDataTable({
+  print("output$filterdataoutput")
+  res <- filterDataReactive()
+  res[,sapply(res,is.numeric)] <- signif(res[,sapply(res,is.numeric)],3)
+  datatable(res)
+})
+
+
 #download buttons
 #DF display, make prettier?
 #data summary?

ui-tab-filterdata.R

@@ -28,6 +28,7 @@ tabPanel("Filter Data",
          ## Left hand column has the filtera settings and options
          ## ==================================================================================== ##
          fluidRow(column(4,wellPanel(
+           h5("Note: this does not redo any analysis, it merely filters the data already analyzed based on gene identifiers or sample/group names."),
            selectizeInput("datafilter_groups", label="Select Groups",
                           choices=NULL,
                           multiple=TRUE),
@@ -87,7 +88,7 @@ tabPanel("Filter Data",
          ## Right hand column shows data input DT and data analysis result DT
          ## ==================================================================================== ##
          column(8,wellPanel(
-
+           dataTableOutput('filterdataoutput')
          )#wellpanel
          )#column
          )#fluidRow

ui.R

@@ -52,7 +52,7 @@ tagList(
     ## DOWNLOAD DATA TABS
     ## =========================================================================== ##
     source("ui-tab-inputdata.R",local=TRUE)$value,
-    source("ui-tab-data-output.R",local=TRUE)$value,
+    source("ui-tab-filterdata.R",local=TRUE)$value,
     ## =========================================================================== ##
     ## Visualization TABS
     ## =========================================================================== ##