This server has been upgraded to GitLab release 12.10.6.

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:
* shiny
* shinyjs
* shinybs
* data.table
* DT
* ggplot2
......@@ -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(c("shiny", "shinyjs",
install.packages(c("shiny", "shinyjs", "shinybs",
"data.table", "DT",
"ggplot2", "gplots", "plotly", "scales", "grid",
"dendextend", "RColorBrewer",
......
......@@ -19,11 +19,11 @@ require(Hmisc) # for CI calculation
DEB = T
# font sizes in pts for plots
PLOTFONTBASE = 12
PLOTFONTAXISTEXT = 12
PLOTFONTAXISTITLE = 12
PLOTFONTFACETSTRIP = 14
PLOTFONTLEGEND = 12
PLOTFONTBASE = 8
PLOTFONTAXISTEXT = 8
PLOTFONTAXISTITLE = 8
PLOTFONTFACETSTRIP = 10
PLOTFONTLEGEND = 8
# default number of facets in plots
PLOTNFACETDEFAULT = 3
......@@ -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.'
)
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 ----
#' Calculate the mean and CI around time series
#'
......
......@@ -16,7 +16,7 @@ modBoxPlotUI = function(id, label = "Plot Box-plots") {
'Violin-plot' = 'viol',
'Box-plot' = 'box',
'Line-plot' = 'line'), selected = 'box'),
checkboxInput(ns('chBPlotBoxInt'), 'Interactive Plot?'),
checkboxInput(ns('chBPlotBoxInt'), 'Interactive Plot'),
actionButton(ns('butPlotBox'), 'Plot!')
),
column(
......@@ -85,7 +85,7 @@ modBoxPlot = function(input, output, session,
ns <- session$ns
if('box' %in% input$inPlotType)
checkboxInput(ns('inPlotBoxNotches'), 'Box plot notches?', FALSE)
checkboxInput(ns('inPlotBoxNotches'), 'Box plot notches', FALSE)
})
output$uiPlotBoxOutliers = renderUI({
......@@ -94,7 +94,7 @@ modBoxPlot = function(input, output, session,
ns <- session$ns
if('box' %in% input$inPlotType)
checkboxInput(ns('inPlotBoxOutliers'), 'Box plot outliers?', FALSE)
checkboxInput(ns('inPlotBoxOutliers'), 'Box plot outliers', FALSE)
})
output$uiPlotBoxDodge = renderUI({
......
......@@ -21,7 +21,7 @@ modSelOutliersUI = function(id, label = "Outlier Selection") {
max = 100,
value = 0,
step = 0.05, width = '100px'),
checkboxInput(ns('chBtrajInter'), 'Interpolate gaps?', value = F)
checkboxInput(ns('chBtrajInter'), 'Interpolate gaps', value = F)
),
column(2,
radioButtons(ns('rbOutliersType'),
......@@ -40,7 +40,9 @@ modSelOutliersUI = function(id, label = "Outlier Selection") {
downloadButton(ns('downOutlierCSV'), label = 'CSV with outlier IDs'),
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) {
}
)
# 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
dtReturn = reactive({
cat(file = stdout(), 'modSelOutliers: dtReturn\n')
......
......@@ -3,7 +3,7 @@ tabBoxPlotUI = function(id, label = "Comparing t-points") {
tagList(
h4(
"Box-/dot-/violin plot at selected time points"
"Box-/dot-/violin plot at selected t-points"
),
br(),
......@@ -99,7 +99,7 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) {
if (!is.null(loc.v)) {
selectInput(
ns('inSelTpts'),
'Select one or more timepoints:',
'Select one or more t-points:',
loc.v,
width = '100%',
selected = 0,
......
......@@ -20,7 +20,7 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
tagList(
h4(
"Scatter plot between two time points"
"Scatter plot between two t-points"
),
br(),
......@@ -90,7 +90,7 @@ output$uiSelTptX = renderUI({
if (!is.null(loc.v)) {
selectInput(
ns('inSelTptX'),
'Select timepoint for X-axis:',
'Select t-point for X-axis:',
loc.v,
width = '100%',
selected = 0,
......@@ -108,7 +108,7 @@ output$uiSelTptY = renderUI({
if (!is.null(loc.v)) {
selectInput(
ns('inSelTptY'),
'Select timepoint for Y-axis:',
'Select t-point for Y-axis:',
loc.v,
width = '100%',
selected = 0,
......
......@@ -25,7 +25,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") {
width = '100px',
step = 1
),
checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot?'),
checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot'),
actionButton(ns('butPlotTraj'), 'Plot!')
),
column(
......@@ -282,7 +282,7 @@ modTrajPlot = function(input, output, session,
x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'),
stim.bar.width.arg = 1,
xlab.arg = 'Time (min)',
xlab.arg = 'Time',
line.col.arg = loc.line.col.arg,
aux.label1 = if (locPos) 'pos.x' else NULL,
aux.label2 = if (locPos) 'pos.y' else NULL,
......
......@@ -7,7 +7,7 @@ modTrajRibbonPlotUI = function(id, label = "Plot Individual Time Series") {
fluidRow(
column(
3,
checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot?'),
checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot'),
radioButtons(ns('rBlegendPos'), 'Legend placement:', list('top' = 'top', 'right' = 'right')),
actionButton(ns('butPlotTraj'), 'Plot!')
),
......@@ -208,7 +208,7 @@ modTrajRibbonPlot = function(input, output, session,
dt.stim.arg = loc.dt.stim,
x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'),
xlab.arg = 'Time (min)',
xlab.arg = 'Time',
ylab.arg = '') +
LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT,
......
......@@ -120,7 +120,7 @@ shinyServer(function(input, output, session) {
if(input$chBtrajRem)
fileInput(
'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')
)
})
......@@ -141,7 +141,7 @@ shinyServer(function(input, output, session) {
if(input$chBstim)
fileInput(
'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')
)
})
......@@ -182,7 +182,7 @@ shinyServer(function(input, output, session) {
selectInput(
'inSelTime',
'Select time column (e.g. Metadata_T, RealTime):',
'Select time column:',
locCols,
width = '100%',
selected = locColSel
......@@ -196,7 +196,7 @@ shinyServer(function(input, output, session) {
if (input$chBtrajInter) {
numericInput(
'inSelTimeFreq',
'Provide time frequency:',
'Frequency of time units:',
min = 1,
step = 1,
width = '100%',
......@@ -265,7 +265,7 @@ shinyServer(function(input, output, session) {
selectInput(
'inSelMeas1',
'Select 1st measurement:',
'Select 1st meas.:',
locCols,
width = '100%',
selected = locColSel
......@@ -286,7 +286,7 @@ shinyServer(function(input, output, session) {
selectInput(
'inSelMeas2',
'Select 2nd measurement',
'Select 2nd meas.',
locCols,
width = '100%',
selected = locColSel
......
......@@ -8,6 +8,7 @@
library(shiny)
library(shinyjs) #http://deanattali.com/shinyjs/
library(shinyBS)
shinyUI(fluidPage(
useShinyjs(),
......@@ -21,65 +22,50 @@ shinyUI(fluidPage(
#Selector for file upload
fileInput(
'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')
),
actionButton("inButLoadNuc", "Load Data"),
actionButton("butReset", "Reset file input"),
actionButton('inDataGen1', 'Generate artificial dataset'),
actionButton('inDataGen1', 'Synthetic data'),
tags$hr(),
checkboxInput('chBtrajRem', 'Upload IDs to remove'),
helpPopup(
title = 'Remove time series',
content = help.text[1],
placement = 'right',
trigger = 'hover'
),
bsTooltip('chBtrajRem', help.text.short[1], placement = "right", trigger = "hover", options = NULL),
uiOutput('uiFileLoadTrajRem'),
uiOutput('uiButLoadTrajRem'),
tags$hr(),
#tags$hr(),
checkboxInput('chBstim', 'Upload stimulation pattern'),
helpPopup(
title = 'Upload stimulations',
content = help.text[4],
placement = 'right',
trigger = 'hover'
),
bsTooltip('chBstim', help.text.short[4], placement = "right", trigger = "hover", options = NULL),
uiOutput('uiFileLoadStim'),
uiOutput('uiButLoadStim'),
tags$hr(),
checkboxInput('chBtrajInter', 'Interpolate NAs and missing data?', value = F),
helpPopup(
title = 'Interpolation of NAs and missing data',
content = help.text[3],
placement = 'right',
trigger = 'hover'
),
#tags$hr(),
checkboxInput('chBtrajInter', 'Interpolate NAs and missing data', value = F),
bsTooltip('chBtrajInter', help.text.short[3], placement = "right", trigger = "hover", options = NULL),
uiOutput('varSelTimeFreq'),
checkboxInput('chBtrackUni', 'Create unique TrackLabel', F),
helpPopup(
title = 'Create unique cell ID',
content = help.text[2],
placement = 'right',
trigger = 'hover'
),
checkboxInput('chBtrackUni', 'Create unique track ID', F),
bsTooltip('chBtrackUni', help.text.short[2], placement = "right", trigger = "hover", options = NULL),
tags$hr(),
uiOutput('varSelSite'),
uiOutput('varSelTrackLabel'),
tags$hr(),
checkboxInput('chBgroup', 'Dataset contains grouping column (e.g. treatment, condition)', F),
checkboxInput('chBgroup', 'Select grouping column', F),
bsTooltip('chBgroup', help.text.short[5], placement = "right", trigger = "hover", options = NULL),
uiOutput('varSelGroup'),
uiOutput('varSelTime'),
uiOutput('varSelMeas1'),
radioButtons(
'inSelMath',
'Math operation 1st and 2nd meas.:',
'inSelMath', width = '25%',
'Math on 1st and 2nd meas.:',
c(
'None' = '',
'Divide' = " / ",
......@@ -89,19 +75,25 @@ shinyUI(fluidPage(
'1 / X' = '1 / '
)
),
bsTooltip('inSelMath', help.text.short[6], placement = "right", trigger = "hover", options = NULL),
uiOutput('varSelMeas2'),
tags$hr(),
checkboxInput('chBtimeTrim', 'Trim x-axis', FALSE),
bsTooltip('chBtimeTrim', help.text.short[7], placement = "right", trigger = "hover", options = NULL),
uiOutput('uiSlTimeTrim'),
tags$hr(),
checkboxInput('chBnorm', 'Normalization', FALSE),
bsTooltip('chBnorm', help.text.short[8], placement = "right", trigger = "hover", options = NULL),
uiOutput('uiChBnorm'),
uiOutput('uiSlNorm'),
uiOutput('uiChBnormRobust'),
uiOutput('uiChBnormGroup'),
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(
......@@ -122,7 +114,7 @@ shinyUI(fluidPage(
tabPanel(
"Individual",
br(),
checkboxInput('chBhighlightTraj', 'Highlight trajectories?', FALSE),
checkboxInput('chBhighlightTraj', 'Highlight trajectories', FALSE),
uiOutput('varSelHighlight'),
br(),
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