diff --git a/server-filterdata.R b/server-filterdata.R index 6e0a578..8fb2ab3 100644 --- a/server-filterdata.R +++ b/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? diff --git a/ui-tab-filterdata.R b/ui-tab-filterdata.R index 83732bf..e21447d 100644 --- a/ui-tab-filterdata.R +++ b/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 diff --git a/ui.R b/ui.R index c278fa4..f8dc79c 100644 --- a/ui.R +++ b/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 ## =========================================================================== ##