From 256623a3d849f452bef6beb7b2ca959d20de2cdc Mon Sep 17 00:00:00 2001 From: dmattek Date: Tue, 11 Apr 2017 17:53:36 +0200 Subject: [PATCH] Added: boxplots UI overhaul: side panel added --- auxfunc.R | 20 ++- server.R | 417 +++++++++++++++++++++++++++++++++++++----------------- ui.R | 188 +++++++++++++++++------- 3 files changed, 443 insertions(+), 182 deletions(-) diff --git a/auxfunc.R b/auxfunc.R index 4e3bf77..52fcaa2 100644 --- a/auxfunc.R +++ b/auxfunc.R @@ -41,12 +41,22 @@ myGgplotTraj = function(dt.arg, stim.bar.width.arg = 0.5) { p.tmp = ggplot(dt.arg, aes_string(x = x.arg, - y = y.arg)) + y = y.arg, + group = group.arg)) - if (is.null(line.col.arg)) - p.tmp = p.tmp + geom_line(aes_string(group = group.arg), alpha = 0.25, size = 0.25) - else - p.tmp = p.tmp + geom_line(aes_string(group = group.arg, colour = line.col.arg), alpha = 0.5, size = 0.5) + if (is.null(line.col.arg)) { + p.tmp = p.tmp + + geom_line(alpha = 0.25, + size = 0.25) + } + else { + p.tmp = p.tmp + + geom_line(aes_string(colour = line.col.arg), + alpha = 0.5, + size = 0.5) + + scale_color_manual(name = '', + values =c("FALSE" = rhg_cols[7], "TRUE" = rhg_cols[3], "SELECTED" = 'green', "NOT SEL" = rhg_cols[7])) + } p.tmp = p.tmp + stat_summary( diff --git a/server.R b/server.R index 2648df2..4350f59 100644 --- a/server.R +++ b/server.R @@ -29,6 +29,9 @@ shinyServer(function(input, output, session) { #dataLoadStim = isolate(input$inButLoadStim) ) + #### + ## UI for side panel + # This button will reset the inFileLoad observeEvent(input$inButReset, { reset("inFileLoadNuc") # reset is a shinyjs function @@ -56,14 +59,136 @@ shinyServer(function(input, output, session) { } }) - # load stimulation pattern - # dataLoadStim <- eventReactive(input$inButLoadStim, { - # cat("dataLoadStim\n") - # locFilePath = input$inFileLoadStim$datapath - # counter$dataLoadStim <- input$inButLoadStim - 1 - # - # return(fread(locFilePath)) - # }) + # This button will reset the inFileLoad + observeEvent(input$butReset, { + reset("inFileLoadNuc") # reset is a shinyjs function + # reset("inFileStimLoad") # reset is a shinyjs function + + }) + + + output$varSelTrackLabel = renderUI({ + cat(file = stderr(), 'UI varSelTrackLabel\n') + locCols = getDataNucCols() + locColSel = locCols[locCols %like% 'rack'][1] # index 1 at the end in case more matches; select 1st + + cat(locColSel, '\n') + selectInput( + 'inSelTrackLabel', + 'Select Track Label (e.g. objNuc_Track_ObjectsLabel):', + locCols, + width = '100%', + selected = locColSel + ) + }) + + output$varSelTime = renderUI({ + cat(file = stderr(), 'UI varSelTime\n') + locCols = getDataNucCols() + locColSel = locCols[locCols %like% 'RealTime'][1] # index 1 at the end in case more matches; select 1st + + cat(locColSel, '\n') + selectInput( + 'inSelTime', + 'Select time column (e.g. RealTime):', + locCols, + width = '100%', + selected = locColSel + ) + }) + + # This is main field to select plot facet grouping + # It's typically a column with the entire experimental description, + # e.g. in Yannick's case it's Stim_All_Ch or Stim_All_S. + # In Coralie's case it's a combination of 3 columns called Stimulation_... + output$varSelGroup = renderUI({ + cat(file = stderr(), 'UI varSelGroup\n') + locCols = getDataNucCols() + + if (!is.null(locCols)) { + locColSel = locCols[locCols %like% 'ite'] + if (length(locColSel) == 0) + locColSel = locCols[locCols %like% 'eries'][1] # index 1 at the end in case more matches; select 1st + else if (length(locColSel) > 1) { + locColSel = locColSel[1] + } + # cat('UI varSelGroup::locColSel ', locColSel, '\n') + selectInput( + 'inSelGroup', + 'Select one or more facet groupings (e.g. Site, Well, Channel):', + locCols, + width = '100%', + selected = locColSel, + multiple = TRUE + ) + } + + }) + + output$varSelSite = renderUI({ + cat(file = stderr(), 'UI varSelSite\n') + locCols = getDataNucCols() + locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st + + cat(locColSel, '\n') + selectInput( + 'inSelSite', + 'Select FOV (e.g. Metadata_Site or Metadata_Series):', + locCols, + width = '100%', + selected = locColSel + ) + }) + + + + + output$varSelMeas1 = renderUI({ + cat(file = stderr(), 'UI varSelMeas1\n') + locCols = getDataNucCols() + + if (!is.null(locCols)) { + locColSel = locCols[locCols %like% 'objCyto_Intensity_MeanIntensity_imErkCor.*' | locCols %like% 'Ratio'][1] # index 1 at the end in case more matches; select 1st + # cat(locColSel, '\n') + selectInput( + 'inSelMeas1', + 'Select 1st measurement:', + locCols, + width = '100%', + selected = locColSel + ) + } + }) + + + output$varSelMeas2 = renderUI({ + cat(file = stderr(), 'UI varSelMeas2\n') + locCols = getDataNucCols() + + if (!is.null(locCols) && + !(input$inSelMath %in% c('', '1 / '))) { + locColSel = locCols[locCols %like% 'objNuc_Intensity_MeanIntensity_imErkCor.*'][1] # index 1 at the end in case more matches; select 1st + # cat(locColSel, '\n') + selectInput( + 'inSelMeas2', + 'Select 2nd measurement', + locCols, + width = '100%', + selected = locColSel + ) + } + }) + + + #### + ## data processing + + # generate random dataset 1 + dataGen1 <- eventReactive(input$inDataGen1, { + cat("dataGen1\n") + + return(userDataGen()) + }) dataInBoth <- reactive({ # Without direct references to inDataGen1,2 and inFileLoad, inDataGen2 @@ -137,31 +262,41 @@ shinyServer(function(input, output, session) { return(loc.dt) }) - - - - # This button will reset the inFileLoad - observeEvent(input$butReset, { - reset("inFileLoadNuc") # reset is a shinyjs function - # reset("inFileStimLoad") # reset is a shinyjs function + # return all unique track object labels (created in dataMod) + # This will be used to display in UI for trajectory highlighting + getDataTrackObjLabUni <- reactive({ + cat(file = stderr(), 'getDataTrackObjLabUni\n') + loc.dt = dataMod() + if (is.null(loc.dt)) + return(NULL) + else + return(unique(loc.dt$trackObjectsLabelUni)) }) - # generate random dataset 1 - dataGen1 <- eventReactive(input$inDataGen1, { - cat("dataGen1\n") + # return all unique time points (real time) + # This will be used to display in UI for trajectory highlighting + getDataTpts <- reactive({ + cat(file = stderr(), 'getDataTpts\n') + loc.dt = dataMod() - return(userDataGen()) + if (is.null(loc.dt)) + return(NULL) + else + return(unique(loc.dt[[input$inSelTime]])) }) # prepare data for plotting time courses # returns dt with these columns: - # realtime - selected from input - # y - measurement selected from input (can be a single column or result of an operation on two cols) - # id - trackObjectsLabelUni (created in dataMod) - # group - grouping variable from input + # realtime - selected from input + # y - measurement selected from input + # (can be a single column or result of an operation on two cols) + # id - trackObjectsLabelUni (created in dataMod) + # group - grouping variable for facetting from input + # mid.in - column with trajectory selection status from the input file or + # highlight status from UI data4trajPlot <- reactive({ cat(file=stderr(), 'data4trajPlot\n') @@ -184,6 +319,10 @@ shinyServer(function(input, output, session) { loc.s.rt = input$inSelTime + # Assign tracks selected for highlighting in UI + loc.tracks.highlight = input$inSelHighlight + locBut = input$chBhighlightTraj + # if dataset contains column mid.in with trajectory filtering status, # then, include it in plotting if (sum(names(loc.dt) %in% 'mid.in') > 0) { @@ -194,6 +333,13 @@ shinyServer(function(input, output, session) { realtime = eval(parse(text = loc.s.rt)), mid.in = mid.in )] + + # add 3rd level with status of track selection + # to a column with trajectory filtering status + if (locBut) { + loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', mid.in)] + } + } else { loc.out = loc.dt[, .( y = eval(parse(text = loc.s.y)), @@ -201,133 +347,61 @@ shinyServer(function(input, output, session) { group = eval(parse(text = loc.s.gr)), realtime = eval(parse(text = loc.s.rt)) )] + + # add a column with status of track selection + if (locBut) { + loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', 'NOT SEL')] + } } # remove rows with NA return(loc.out[complete.cases(loc.out)]) }) - output$varSelSite = renderUI({ - cat(file = stderr(), 'UI varSelSite\n') - locCols = getDataNucCols() - locColSel = locCols[locCols %like% 'ite'][1] # index 1 at the end in case more matches; select 1st - - cat(locColSel, '\n') - selectInput( - 'inSelSite', - 'Select FOV (e.g. Metadata_Site or Metadata_Series):', - locCols, - width = '100%', - selected = locColSel - ) - }) - - output$varSelTrackLabel = renderUI({ - cat(file = stderr(), 'UI varSelTrackLabel\n') - locCols = getDataNucCols() - locColSel = locCols[locCols %like% 'rack'][1] # index 1 at the end in case more matches; select 1st - - cat(locColSel, '\n') - selectInput( - 'inSelTrackLabel', - 'Select Track Label (e.g. objNuc_Track_ObjectsLabel):', - locCols, - width = '100%', - selected = locColSel - ) - }) - - output$varSelTime = renderUI({ - cat(file = stderr(), 'UI varSelTime\n') - locCols = getDataNucCols() - locColSel = locCols[locCols %like% 'RealTime'][1] # index 1 at the end in case more matches; select 1st - - cat(locColSel, '\n') - selectInput( - 'inSelTime', - 'Select X-axis (e.g. RealTime):', - locCols, - width = '100%', - selected = locColSel - ) - }) - - # This is main field to select plot facet grouping - # It's typically a column with the entire experimental description, - # e.g. in Yannick's case it's Stim_All_Ch or Stim_All_S. - # In Coralie's case it's a combination of 3 columns called Stimulation_... - output$varSelGroup = renderUI({ - cat(file = stderr(), 'UI varSelGroup\n') - locCols = getDataNucCols() + # prepare data for plotting boxplots + # uses the same dt as for trajectory plotting + # returns dt with these columns: + data4boxPlot <- reactive({ + cat(file=stderr(), 'data4trajPlot\n') - if (!is.null(locCols)) { - locColSel = locCols[locCols %like% 'ite'] - if (length(locColSel) == 0) - locColSel = locCols[locCols %like% 'eries'][1] # index 1 at the end in case more matches; select 1st - else if (length(locColSel) > 1) { - locColSel = locColSel[1] - } - # cat('UI varSelGroup::locColSel ', locColSel, '\n') - selectInput( - 'inSelGroup', - 'Select one or more facet groupings (e.g. Site, Well, Channel):', - locCols, - width = '100%', - selected = locColSel, - multiple = TRUE - ) - } + loc.dt = data4trajPlot() + if(is.null(loc.dt)) + return(NULL) + loc.out = loc.dt[realtime %in% input$inSelTpts] }) + #### + ## UI for trajectory plot - output$varSelMeas1 = renderUI({ - cat(file = stderr(), 'UI varSelMeas1\n') - locCols = getDataNucCols() + output$varSelHighlight = renderUI({ + cat(file = stderr(), 'UI varSelHighlight\n') - if (!is.null(locCols)) { - locColSel = locCols[locCols %like% 'objCyto_Intensity_MeanIntensity_imErkCor.*'][1] # index 1 at the end in case more matches; select 1st - # cat(locColSel, '\n') - selectInput( - 'inSelMeas1', - 'Select Y-axis:', - locCols, - width = '100%', - selected = locColSel - ) - } - }) - - - output$varSelMeas2 = renderUI({ - cat(file = stderr(), 'UI varSelMeas2\n') - locCols = getDataNucCols() + locBut = input$chBhighlightTraj + if (!locBut) + return(NULL) - if (!is.null(locCols) && - !(input$inSelMath %in% c('', '1 / '))) { - locColSel = locCols[locCols %like% 'objNuc_Intensity_MeanIntensity_imErkCor.*'][1] # index 1 at the end in case more matches; select 1st - # cat(locColSel, '\n') + loc.v = getDataTrackObjLabUni() + if(!is.null(loc.v)) { selectInput( - 'inSelMeas2', - 'Select 2nd opernad for Y-axis', - locCols, + 'inSelHighlight', + 'Select one or more rajectories:', + loc.v, width = '100%', - selected = locColSel + multiple = TRUE ) } }) - output$uiPlot = renderUI({ + output$uiPlotTraj = renderUI({ - plotlyOutput("plotTraj", width = paste0(input$inPlotWidth, '%'), height = paste0(input$inPlotHeight, 'px')) + plotlyOutput("plotTraj", width = paste0(input$inPlotTrajWidth, '%'), height = paste0(input$inPlotTrajHeight, 'px')) }) - output$plotTraj <- renderPlotly({ - cat(file=stderr(), 'plotTraj: in\n') - locBut = input$butGo + locBut = input$butPlotTraj if (locBut == 0) { cat(file=stderr(), 'plotTraj: Go button not pressed\n') @@ -362,7 +436,7 @@ shinyServer(function(input, output, session) { xlab.arg = 'Time (min)', line.col.arg = loc.line.col.arg ) - + # This is required to avoid # "Warning: Error in : cannot open file 'Rplots.pdf'" @@ -375,4 +449,95 @@ shinyServer(function(input, output, session) { return(p.out.ly) }) + + #### + ## UI for box-plot + + output$varSelTpts = renderUI({ + cat(file = stderr(), 'UI varSelTpts\n') + + loc.v = getDataTpts() + if(!is.null(loc.v)) { + selectInput( + 'inSelTpts', + 'Select one or more timepoints:', + loc.v, + width = '100%', + selected = 0, + multiple = TRUE + ) + } + }) + + # Boxplot - display + output$outPlotBox = renderPlot({ + + locBut = input$butPlotBox + + if (locBut == 0) { + cat(file=stderr(), 'plotBox: Go button not pressed\n') + return(NULL) + } + + plotBox() + + }, height = 800) + + # Boxplot - download pdf + output$downPlotBox <- downloadHandler( + filename = 'boxplot.pdf', + + content = function(file) { + cat(file = stderr(), input$inPlotBoxWidth, input$inPlotBoxHeight, "\n") + ggsave(file, limitsize = FALSE, + plotBox(), + width = input$inPlotBoxWidth, + height = input$inPlotBoxHeight) + } + ) + + + # Function instead of reactive as per: + # http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r + # This function is used to plot and to downoad a pdf + + plotBox <- function(){ + cat(file = stderr(), 'plotBox\n') + + loc.dt = data4boxPlot() + + cat(file=stderr(), "plotBox: on to plot\n\n") + if (is.null(loc.dt)) { + cat(file=stderr(), 'plotBox: dt is NULL\n') + return(NULL) + } + + cat(file=stderr(), 'plotBox:dt not NULL\n') + + ggplot(loc.dt, aes(x = as.factor(realtime), y = y)) + + geom_boxplot(aes(fill = group), + #position = position_dodge(width = 1), + notch = input$inPlotBoxNotches, + outlier.colour = ifelse(input$inPlotBoxOutliers, 'red', NA)) + + scale_fill_discrete(name = '') + + xlab('\nTime (min)') + + ylab('') + + theme_bw(base_size = 18, base_family = "Helvetica") + + theme( + panel.grid.minor = element_blank(), + panel.grid.major = element_blank(), + panel.border = element_blank(), + axis.line.x = element_line(color = "black", size = 0.25), + axis.line.y = element_line(color = "black", size = 0.25), + axis.text.x = element_text(size = 12), + axis.text.y = element_text(size = 12), + strip.text.x = element_text(size = 14, face = "bold"), + strip.text.y = element_text(size = 14, face = "bold"), + strip.background = element_blank(), + legend.key = element_blank(), + legend.key.height = unit(1, "lines"), + legend.key.width = unit(2, "lines"), + legend.position = input$selPlotBoxLegendPos + ) + } }) diff --git a/ui.R b/ui.R index 8ac4950..8c67bcb 100644 --- a/ui.R +++ b/ui.R @@ -1,4 +1,5 @@ + # This is the user-interface definition of a Shiny web application. # You can find out more about building applications with Shiny here: # @@ -10,59 +11,144 @@ library(shinyjs) #http://deanattali.com/shinyjs/ library(plotly) shinyUI(fluidPage( - useShinyjs(), # Include shinyjs + useShinyjs(), + # Include shinyjs # Application title title = "Timecourse Inspector", - fluidRow( - column(3, - h4("Load data files"), - #Selector for file upload - fileInput( - 'inFileLoadNuc', - 'Select file (e.g. tCoursesSelected.csv) and press "Load Data"', - accept = c('text/csv', 'text/comma-separated-values,text/plain') - ), - actionButton("inButLoadNuc", "Load Data"), - actionButton("butReset", "Reset file input"), - actionButton('inDataGen1', 'Generate artificial dataset'), - - # fileInput( - # 'inFileStimLoad', - # 'Choose CSV file with stimulation times, e.g. stimT.csv', - # accept = c('text/csv', 'text/comma-separated-values,text/plain') - # ), - - h4("Plot format"), - fluidRow( - column(4, - numericInput('inFacetNcol', '#Columns:', value = 4, min = 1, width = '100px', step = 1)), - column(4, - numericInput('inPlotHeight', 'Height [px]:', value = 800, min = 100, width = '100px', step = 50)), - column(4, - numericInput('inPlotWidth', 'Width [%]:', value = 100, min = 10, max = 100, width = '100px', step = 10)) - ), - - actionButton('butGo', 'Plot!')), - - column(3, offset = 1, - uiOutput('varSelSite'), - uiOutput('varSelTrackLabel'), - uiOutput('varSelTime'), - uiOutput('varSelMeas1'), - radioButtons('inSelMath', 'Math operation 1st and 2nd meas.:', c('None' = '', - 'Divide' = " / ", - 'Sum' = " + ", - 'Multiply' = " * ", - 'Subtract' = ' - ', - '1 / X' = '1 / ')), - uiOutput('varSelMeas2')), - - column(3, offset = 1, - uiOutput('varSelGroup')) + sidebarLayout( + sidebarPanel( + h4("Load data files"), + + #Selector for file upload + fileInput( + 'inFileLoadNuc', + 'Select file (e.g. tCoursesSelected.csv) and press "Load Data"', + accept = c('text/csv', 'text/comma-separated-values,text/plain') + ), + actionButton("inButLoadNuc", "Load Data"), + actionButton("butReset", "Reset file input"), + actionButton('inDataGen1', 'Generate artificial dataset'), + tags$hr(), + uiOutput('varSelSite'), + uiOutput('varSelTrackLabel'), + uiOutput('varSelGroup'), + uiOutput('varSelTime'), + uiOutput('varSelMeas1'), + radioButtons( + 'inSelMath', + 'Math operation 1st and 2nd meas.:', + c( + 'None' = '', + 'Divide' = " / ", + 'Sum' = " + ", + 'Multiply' = " * ", + 'Subtract' = ' - ', + '1 / X' = '1 / ' + ) + ), + uiOutput('varSelMeas2') ), - br(), - uiOutput('uiPlot') -)) - + + mainPanel(tabsetPanel( + tabPanel( + "Time courses", + br(), + fluidRow( + column( + 4, + numericInput( + 'inPlotTrajFacetNcol', + '#Columns:', + value = 4, + min = 1, + width = '100px', + step = 1 + ) + ), + column( + 4, + numericInput( + 'inPlotTrajHeight', + 'Height [px]:', + value = 800, + min = 100, + width = '100px', + step = 50 + ) + ), + column( + 4, + numericInput( + 'inPlotTrajWidth', + 'Width [%]:', + value = 100, + min = 10, + max = 100, + width = '100px', + step = 10 + ) + ) + ), + checkboxInput('chBhighlightTraj', 'Highlight trajectories?', FALSE), + uiOutput('varSelHighlight'), + br(), + actionButton('butPlotTraj', 'Plot!'), + uiOutput('uiPlotTraj') + ), + tabPanel("Box-plots", + br(), + fluidRow( + column( + 6, + checkboxInput('inPlotBoxNotches', 'Box plot notches?', FALSE), + checkboxInput('inPlotBoxOutliers', 'Box plot outliers?', TRUE) + ), + column( + 6, + selectInput('selPlotBoxLegendPos', + label = 'Select legend position', + choices = list( + "Top" = 'top', + "Right" = 'right', + "Bottom" = 'bottom' + ), + selected = 'top') + ) + ), + + uiOutput('varSelTpts'), + + actionButton('butPlotBox', 'Plot!'), + plotOutput('outPlotBox', height = 800), + h4('Download plot'), + fluidRow( + column( + 3, + numericInput( + 'inPlotBoxWidth', + "Width", + 10, + min = 1, + width = 100 + ) + ), + column( + 3, + numericInput( + 'inPlotBoxHeight', + "Height", + 7, + min = 1, + width = 100 + ) + ), + column(6, + downloadButton('downPlotBox', 'PDF')) + ) + #uiOutput('uiPlotBox') + ) + )) + ) +)) \ No newline at end of file -- GitLab