Commit 602f8b92 authored by Maciej Dobrzynski's avatar Maciej Dobrzynski

Changes in the UI, shinyBS help tips, added data distribution plot in outlier selection.

parent 45edd7c3
...@@ -11,6 +11,7 @@ Following packages need to be installed in order to run the app locally: ...@@ -11,6 +11,7 @@ Following packages need to be installed in order to run the app locally:
* shiny * shiny
* shinyjs * shinyjs
* shinybs
* data.table * data.table
* DT * DT
* ggplot2 * ggplot2
...@@ -31,7 +32,7 @@ Following packages need to be installed in order to run the app locally: ...@@ -31,7 +32,7 @@ Following packages need to be installed in order to run the app locally:
Install packages using `install.packages('name_of_the_package_from_the_list_above')` command in RStudio command line. Install packages using `install.packages('name_of_the_package_from_the_list_above')` command in RStudio command line.
``` ```
install.packages(c("shiny", "shinyjs", install.packages(c("shiny", "shinyjs", "shinybs",
"data.table", "DT", "data.table", "DT",
"ggplot2", "gplots", "plotly", "scales", "grid", "ggplot2", "gplots", "plotly", "scales", "grid",
"dendextend", "RColorBrewer", "dendextend", "RColorBrewer",
......
...@@ -19,11 +19,11 @@ require(Hmisc) # for CI calculation ...@@ -19,11 +19,11 @@ require(Hmisc) # for CI calculation
DEB = T DEB = T
# font sizes in pts for plots # font sizes in pts for plots
PLOTFONTBASE = 12 PLOTFONTBASE = 8
PLOTFONTAXISTEXT = 12 PLOTFONTAXISTEXT = 8
PLOTFONTAXISTITLE = 12 PLOTFONTAXISTITLE = 8
PLOTFONTFACETSTRIP = 14 PLOTFONTFACETSTRIP = 10
PLOTFONTLEGEND = 12 PLOTFONTLEGEND = 8
# default number of facets in plots # default number of facets in plots
PLOTNFACETDEFAULT = 3 PLOTNFACETDEFAULT = 3
...@@ -152,6 +152,18 @@ help.text = c( ...@@ -152,6 +152,18 @@ help.text = c(
'Accepts CSV file with 5 columns: grouping (e.g. condition), start and end time points of stimulation, start and end points of y-position, dummy column with id.' 'Accepts CSV file with 5 columns: grouping (e.g. condition), start and end time points of stimulation, start and end points of y-position, dummy column with id.'
) )
help.text.short = c(
'Load CSV file with a column of cell IDs for removal. IDs should correspond to those used for plotting.',
'If the track ID is unique only within a group, make it unique globally by combining with the grouping column.',
'Interpolate missing tpts and pre-existing NAs. When checked, the interval of time column must be provided!',
'Load CSV file with 5 columns: grouping, start and end tpts of stimulation, start and end of y-position, dummy column with id.',
'Select columns to group data according to treatment, condition, etc.',
'Select math operation to perform on a single or two columns,',
'Select range of time for further processing.',
'Normalise data to a selected region.',
'Download data after modification in this section.'
)
# Functions for data processing ---- # Functions for data processing ----
#' Calculate the mean and CI around time series #' Calculate the mean and CI around time series
#' #'
......
...@@ -16,7 +16,7 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") { ...@@ -16,7 +16,7 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
'Violin-plot' = 'viol', 'Violin-plot' = 'viol',
'Box-plot' = 'box', 'Box-plot' = 'box',
'Line-plot' = 'line'), selected = 'box'), 'Line-plot' = 'line'), selected = 'box'),
checkboxInput(ns('chBPlotBoxInt'), 'Interactive Plot?'), checkboxInput(ns('chBPlotBoxInt'), 'Interactive Plot'),
actionButton(ns('butPlotBox'), 'Plot!') actionButton(ns('butPlotBox'), 'Plot!')
), ),
column( column(
...@@ -85,7 +85,7 @@ modBoxPlot = function(input, output, session, ...@@ -85,7 +85,7 @@ modBoxPlot = function(input, output, session,
ns <- session$ns ns <- session$ns
if('box' %in% input$inPlotType) if('box' %in% input$inPlotType)
checkboxInput(ns('inPlotBoxNotches'), 'Box plot notches?', FALSE) checkboxInput(ns('inPlotBoxNotches'), 'Box plot notches', FALSE)
}) })
output$uiPlotBoxOutliers = renderUI({ output$uiPlotBoxOutliers = renderUI({
...@@ -94,7 +94,7 @@ modBoxPlot = function(input, output, session, ...@@ -94,7 +94,7 @@ modBoxPlot = function(input, output, session,
ns <- session$ns ns <- session$ns
if('box' %in% input$inPlotType) if('box' %in% input$inPlotType)
checkboxInput(ns('inPlotBoxOutliers'), 'Box plot outliers?', FALSE) checkboxInput(ns('inPlotBoxOutliers'), 'Box plot outliers', FALSE)
}) })
output$uiPlotBoxDodge = renderUI({ output$uiPlotBoxDodge = renderUI({
......
...@@ -21,7 +21,7 @@ modSelOutliersUI = function(id, label = "Outlier Selection") { ...@@ -21,7 +21,7 @@ modSelOutliersUI = function(id, label = "Outlier Selection") {
max = 100, max = 100,
value = 0, value = 0,
step = 0.05, width = '100px'), step = 0.05, width = '100px'),
checkboxInput(ns('chBtrajInter'), 'Interpolate gaps?', value = F) checkboxInput(ns('chBtrajInter'), 'Interpolate gaps', value = F)
), ),
column(2, column(2,
radioButtons(ns('rbOutliersType'), radioButtons(ns('rbOutliersType'),
...@@ -40,7 +40,9 @@ modSelOutliersUI = function(id, label = "Outlier Selection") { ...@@ -40,7 +40,9 @@ modSelOutliersUI = function(id, label = "Outlier Selection") {
downloadButton(ns('downOutlierCSV'), label = 'CSV with outlier IDs'), downloadButton(ns('downOutlierCSV'), label = 'CSV with outlier IDs'),
htmlOutput(ns("txtOutliersPerc")) htmlOutput(ns("txtOutliersPerc"))
) )
) ),
checkboxInput(ns('chBplotDist'), 'Plot data distribution', value = F),
uiOutput(ns('uiDistPlot'))
) )
} }
...@@ -84,6 +86,117 @@ modSelOutliers = function(input, output, session, in.data) { ...@@ -84,6 +86,117 @@ modSelOutliers = function(input, output, session, in.data) {
} }
) )
# Plot of value distribution
output$uiDistPlot <- renderUI({
ns <- session$ns
if (input$chBplotDist) {
locDT = in.data()
if (is.null(locDT)) {
return(NULL)
}
output$densPlot = renderPlot({
# main density plot
locP = ggplot(locDT, aes_string(x = COLY)) +
geom_density()
# Shade regions of the density plot according to
# value set in input$numOutliersPerc.
# extract data from density plot
locDTtmp = as.data.table(ggplot_build(locP)$data[[1]])
# shade region on the right
if (input$rbOutliersType == 'top') {
# find position of the right boundary
locQuantR = quantile(locDT[[COLY]],
1 - input$numOutliersPerc * 0.01,
na.rm = T,
type = 3)
# select only those points of the density plot right to the right boundary
locDTtmpSub = locDTtmp[x > locQuantR]
# add shaded RIGHT region to the plot
if (nrow(locDTtmpSub) > 0 )
locP = locP +
geom_area(data = locDTtmpSub, aes(x=x, y=y), fill="red") +
geom_vline(xintercept = locQuantR, linetype = 'dashed', color = 'red')
} else
# shade region on the left
if (input$rbOutliersType == 'bot') {
# find position of the right boundary
locQuantL = quantile(locDT[[COLY]],
input$numOutliersPerc * 0.01,
na.rm = T,
type = 3)
# select only those points of the density plot left to the left boundary
locDTtmpSub = locDTtmp[x < locQuantL]
# add shaded LEFT region to the plot
if (nrow(locDTtmpSub) > 0 )
locP = locP +
geom_area(data = locDTtmpSub, aes(x=x, y=y), fill="red") +
geom_vline(xintercept = locQuantL, linetype = 'dashed', color = 'red')
} else
# shade region on the left
if (input$rbOutliersType == 'mid') {
# find position of the right boundary
locQuantR = quantile(locDT[[COLY]],
1 - input$numOutliersPerc * 0.005,
na.rm = T,
type = 3)
# find position of the left boundary
locQuantL = quantile(locDT[[COLY]],
input$numOutliersPerc * 0.005,
na.rm = T,
type = 3)
# select only those points of the density plot left or right of the boundaries
locDTtmpSubL = locDTtmp[x < locQuantL]
locDTtmpSubR = locDTtmp[x > locQuantR]
# add shaded LEFT region to the plot
if (nrow(locDTtmpSubL) > 0 )
locP = locP +
geom_area(data = locDTtmpSubL, aes(x=x, y=y), fill="red") +
geom_vline(xintercept = locQuantL, linetype = 'dashed', color = 'red')
if (nrow(locDTtmpSubR) > 0 )
locP = locP +
geom_area(data = locDTtmpSubR, aes(x=x, y=y), fill="red") +
geom_vline(xintercept = locQuantR, linetype = 'dashed', color = 'red')
}
locP = locP +
xlab('Measurement value') +
LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT,
in.font.axis.title = PLOTFONTAXISTITLE,
in.font.strip = PLOTFONTFACETSTRIP,
in.font.legend = PLOTFONTLEGEND)
return(locP)
})
} else
return(NULL)
plotOutput(ns('densPlot'))
})
# Identify outliers and remove them from dt # Identify outliers and remove them from dt
dtReturn = reactive({ dtReturn = reactive({
cat(file = stdout(), 'modSelOutliers: dtReturn\n') cat(file = stdout(), 'modSelOutliers: dtReturn\n')
......
...@@ -3,7 +3,7 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") { ...@@ -3,7 +3,7 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") {
tagList( tagList(
h4( h4(
"Box-/dot-/violin plot at selected time points" "Box-/dot-/violin plot at selected t-points"
), ),
br(), br(),
...@@ -99,7 +99,7 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) { ...@@ -99,7 +99,7 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) {
if (!is.null(loc.v)) { if (!is.null(loc.v)) {
selectInput( selectInput(
ns('inSelTpts'), ns('inSelTpts'),
'Select one or more timepoints:', 'Select one or more t-points:',
loc.v, loc.v,
width = '100%', width = '100%',
selected = 0, selected = 0,
......
...@@ -20,7 +20,7 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") { ...@@ -20,7 +20,7 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
tagList( tagList(
h4( h4(
"Scatter plot between two time points" "Scatter plot between two t-points"
), ),
br(), br(),
...@@ -90,7 +90,7 @@ output$uiSelTptX = renderUI({ ...@@ -90,7 +90,7 @@ output$uiSelTptX = renderUI({
if (!is.null(loc.v)) { if (!is.null(loc.v)) {
selectInput( selectInput(
ns('inSelTptX'), ns('inSelTptX'),
'Select timepoint for X-axis:', 'Select t-point for X-axis:',
loc.v, loc.v,
width = '100%', width = '100%',
selected = 0, selected = 0,
...@@ -108,7 +108,7 @@ output$uiSelTptY = renderUI({ ...@@ -108,7 +108,7 @@ output$uiSelTptY = renderUI({
if (!is.null(loc.v)) { if (!is.null(loc.v)) {
selectInput( selectInput(
ns('inSelTptY'), ns('inSelTptY'),
'Select timepoint for Y-axis:', 'Select t-point for Y-axis:',
loc.v, loc.v,
width = '100%', width = '100%',
selected = 0, selected = 0,
......
...@@ -25,7 +25,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") { ...@@ -25,7 +25,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") {
width = '100px', width = '100px',
step = 1 step = 1
), ),
checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot?'), checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot'),
actionButton(ns('butPlotTraj'), 'Plot!') actionButton(ns('butPlotTraj'), 'Plot!')
), ),
column( column(
...@@ -282,7 +282,7 @@ modTrajPlot = function(input, output, session, ...@@ -282,7 +282,7 @@ modTrajPlot = function(input, output, session,
x.stim.arg = c('tstart', 'tend'), x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'), y.stim.arg = c('ystart', 'yend'),
stim.bar.width.arg = 1, stim.bar.width.arg = 1,
xlab.arg = 'Time (min)', xlab.arg = 'Time',
line.col.arg = loc.line.col.arg, line.col.arg = loc.line.col.arg,
aux.label1 = if (locPos) 'pos.x' else NULL, aux.label1 = if (locPos) 'pos.x' else NULL,
aux.label2 = if (locPos) 'pos.y' else NULL, aux.label2 = if (locPos) 'pos.y' else NULL,
......
...@@ -7,7 +7,7 @@ modTrajRibbonPlotUI = function(id, label = "Plot Individual Time Series") { ...@@ -7,7 +7,7 @@ modTrajRibbonPlotUI = function(id, label = "Plot Individual Time Series") {
fluidRow( fluidRow(
column( column(
3, 3,
checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot?'), checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot'),
radioButtons(ns('rBlegendPos'), 'Legend placement:', list('top' = 'top', 'right' = 'right')), radioButtons(ns('rBlegendPos'), 'Legend placement:', list('top' = 'top', 'right' = 'right')),
actionButton(ns('butPlotTraj'), 'Plot!') actionButton(ns('butPlotTraj'), 'Plot!')
), ),
...@@ -208,7 +208,7 @@ modTrajRibbonPlot = function(input, output, session, ...@@ -208,7 +208,7 @@ modTrajRibbonPlot = function(input, output, session,
dt.stim.arg = loc.dt.stim, dt.stim.arg = loc.dt.stim,
x.stim.arg = c('tstart', 'tend'), x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'), y.stim.arg = c('ystart', 'yend'),
xlab.arg = 'Time (min)', xlab.arg = 'Time',
ylab.arg = '') + ylab.arg = '') +
LOCggplotTheme(in.font.base = PLOTFONTBASE, LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT, in.font.axis.text = PLOTFONTAXISTEXT,
......
...@@ -120,7 +120,7 @@ shinyServer(function(input, output, session) { ...@@ -120,7 +120,7 @@ shinyServer(function(input, output, session) {
if(input$chBtrajRem) if(input$chBtrajRem)
fileInput( fileInput(
'inFileLoadTrajRem', 'inFileLoadTrajRem',
'Select data file (e.g. badTraj.csv) and press "Load Data"', 'Select file and press "Load Data"',
accept = c('text/csv', 'text/comma-separated-values,text/plain') accept = c('text/csv', 'text/comma-separated-values,text/plain')
) )
}) })
...@@ -141,7 +141,7 @@ shinyServer(function(input, output, session) { ...@@ -141,7 +141,7 @@ shinyServer(function(input, output, session) {
if(input$chBstim) if(input$chBstim)
fileInput( fileInput(
'inFileLoadStim', 'inFileLoadStim',
'Select data file (e.g. stim.csv) and press "Load Data"', 'Select file and press "Load Data"',
accept = c('text/csv', 'text/comma-separated-values,text/plain') accept = c('text/csv', 'text/comma-separated-values,text/plain')
) )
}) })
...@@ -182,7 +182,7 @@ shinyServer(function(input, output, session) { ...@@ -182,7 +182,7 @@ shinyServer(function(input, output, session) {
selectInput( selectInput(
'inSelTime', 'inSelTime',
'Select time column (e.g. Metadata_T, RealTime):', 'Select time column:',
locCols, locCols,
width = '100%', width = '100%',
selected = locColSel selected = locColSel
...@@ -196,7 +196,7 @@ shinyServer(function(input, output, session) { ...@@ -196,7 +196,7 @@ shinyServer(function(input, output, session) {
if (input$chBtrajInter) { if (input$chBtrajInter) {
numericInput( numericInput(
'inSelTimeFreq', 'inSelTimeFreq',
'Provide time frequency:', 'Frequency of time units:',
min = 1, min = 1,
step = 1, step = 1,
width = '100%', width = '100%',
...@@ -265,7 +265,7 @@ shinyServer(function(input, output, session) { ...@@ -265,7 +265,7 @@ shinyServer(function(input, output, session) {
selectInput( selectInput(
'inSelMeas1', 'inSelMeas1',
'Select 1st measurement:', 'Select 1st meas.:',
locCols, locCols,
width = '100%', width = '100%',
selected = locColSel selected = locColSel
...@@ -286,7 +286,7 @@ shinyServer(function(input, output, session) { ...@@ -286,7 +286,7 @@ shinyServer(function(input, output, session) {
selectInput( selectInput(
'inSelMeas2', 'inSelMeas2',
'Select 2nd measurement', 'Select 2nd meas.',
locCols, locCols,
width = '100%', width = '100%',
selected = locColSel selected = locColSel
......
...@@ -8,6 +8,7 @@ ...@@ -8,6 +8,7 @@
library(shiny) library(shiny)
library(shinyjs) #http://deanattali.com/shinyjs/ library(shinyjs) #http://deanattali.com/shinyjs/
library(shinyBS)
shinyUI(fluidPage( shinyUI(fluidPage(
useShinyjs(), useShinyjs(),
...@@ -21,65 +22,50 @@ shinyUI(fluidPage( ...@@ -21,65 +22,50 @@ shinyUI(fluidPage(
#Selector for file upload #Selector for file upload
fileInput( fileInput(
'inFileLoadNuc', 'inFileLoadNuc',
'Select data file (e.g. file.csv) and press "Load Data"', 'Select main data file and press "Load Data"',
accept = c('text/csv', 'text/comma-separated-values,text/plain') accept = c('text/csv', 'text/comma-separated-values,text/plain')
), ),
actionButton("inButLoadNuc", "Load Data"), actionButton("inButLoadNuc", "Load Data"),
actionButton("butReset", "Reset file input"), actionButton("butReset", "Reset file input"),
actionButton('inDataGen1', 'Generate artificial dataset'), actionButton('inDataGen1', 'Synthetic data'),
tags$hr(), tags$hr(),
checkboxInput('chBtrajRem', 'Upload IDs to remove'), checkboxInput('chBtrajRem', 'Upload IDs to remove'),
helpPopup( bsTooltip('chBtrajRem', help.text.short[1], placement = "right", trigger = "hover", options = NULL),
title = 'Remove time series',
content = help.text[1],
placement = 'right',
trigger = 'hover'
),
uiOutput('uiFileLoadTrajRem'), uiOutput('uiFileLoadTrajRem'),
uiOutput('uiButLoadTrajRem'), uiOutput('uiButLoadTrajRem'),
tags$hr(), #tags$hr(),
checkboxInput('chBstim', 'Upload stimulation pattern'), checkboxInput('chBstim', 'Upload stimulation pattern'),
helpPopup( bsTooltip('chBstim', help.text.short[4], placement = "right", trigger = "hover", options = NULL),
title = 'Upload stimulations',
content = help.text[4],
placement = 'right',
trigger = 'hover'
),
uiOutput('uiFileLoadStim'), uiOutput('uiFileLoadStim'),
uiOutput('uiButLoadStim'), uiOutput('uiButLoadStim'),
tags$hr(), #tags$hr(),
checkboxInput('chBtrajInter', 'Interpolate NAs and missing data?', value = F), checkboxInput('chBtrajInter', 'Interpolate NAs and missing data', value = F),
helpPopup( bsTooltip('chBtrajInter', help.text.short[3], placement = "right", trigger = "hover", options = NULL),
title = 'Interpolation of NAs and missing data',
content = help.text[3],
placement = 'right',
trigger = 'hover'
),
uiOutput('varSelTimeFreq'), uiOutput('varSelTimeFreq'),
checkboxInput('chBtrackUni', 'Create unique TrackLabel', F),
helpPopup( checkboxInput('chBtrackUni', 'Create unique track ID', F),
title = 'Create unique cell ID', bsTooltip('chBtrackUni', help.text.short[2], placement = "right", trigger = "hover", options = NULL),
content = help.text[2],
placement = 'right', tags$hr(),
trigger = 'hover'
),
uiOutput('varSelSite'), uiOutput('varSelSite'),
uiOutput('varSelTrackLabel'), uiOutput('varSelTrackLabel'),
tags$hr(), checkboxInput('chBgroup', 'Select grouping column', F),
checkboxInput('chBgroup', 'Dataset contains grouping column (e.g. treatment, condition)', F), bsTooltip('chBgroup', help.text.short[5], placement = "right", trigger = "hover", options = NULL),
uiOutput('varSelGroup'), uiOutput('varSelGroup'),
uiOutput('varSelTime'), uiOutput('varSelTime'),
uiOutput('varSelMeas1'), uiOutput('varSelMeas1'),
radioButtons( radioButtons(
'inSelMath', 'inSelMath', width = '25%',
'Math operation 1st and 2nd meas.:', 'Math on 1st and 2nd meas.:',
c( c(
'None' = '', 'None' = '',
'Divide' = " / ", 'Divide' = " / ",
...@@ -89,19 +75,25 @@ shinyUI(fluidPage( ...@@ -89,19 +75,25 @@ shinyUI(fluidPage(
'1 / X' = '1 / ' '1 / X' = '1 / '
) )
), ),
bsTooltip('inSelMath', help.text.short[6], placement = "right", trigger = "hover", options = NULL),
uiOutput('varSelMeas2'), uiOutput('varSelMeas2'),
tags$hr(), tags$hr(),
checkboxInput('chBtimeTrim', 'Trim x-axis', FALSE), checkboxInput('chBtimeTrim', 'Trim x-axis', FALSE),
bsTooltip('chBtimeTrim', help.text.short[7], placement = "right", trigger = "hover", options = NULL),
uiOutput('uiSlTimeTrim'), uiOutput('uiSlTimeTrim'),
tags$hr(),
checkboxInput('chBnorm', 'Normalization', FALSE), checkboxInput('chBnorm', 'Normalization', FALSE),
bsTooltip('chBnorm', help.text.short[8], placement = "right", trigger = "hover", options = NULL),
uiOutput('uiChBnorm'), uiOutput('uiChBnorm'),
uiOutput('uiSlNorm'), uiOutput('uiSlNorm'),
uiOutput('uiChBnormRobust'), uiOutput('uiChBnormRobust'),
uiOutput('uiChBnormGroup'), uiOutput('uiChBnormGroup'),
tags$hr(), tags$hr(),
downloadButton('downloadDataClean', 'Download mod\'d data') downloadButton('downloadDataClean', 'Download mod\'d data'),
bsTooltip('downloadDataClean', help.text.short[9], placement = "right", trigger = "hover", options = NULL)
), ),
mainPanel( mainPanel(
...@@ -122,7 +114,7 @@ shinyUI(fluidPage( ...@@ -122,7 +114,7 @@ shinyUI(fluidPage(
tabPanel( tabPanel(
"Individual", "Individual",
br(), br(),
checkboxInput('chBhighlightTraj', 'Highlight trajectories?', FALSE), checkboxInput('chBhighlightTraj', 'Highlight trajectories', FALSE),
uiOutput('varSelHighlight'), uiOutput('varSelHighlight'),
br(), br(),
modTrajPlotUI('modTrajPlot') modTrajPlotUI('modTrajPlot')
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment