Commit 47483105 authored by dmattek's avatar dmattek

Initial commit

parents
## Custom plotting
rhg_cols <- c(
"#771C19",
"#AA3929",
"#E25033",
"#F27314",
"#F8A31B",
"#E2C59F",
"#B6C5CC",
"#8E9CA3",
"#556670",
"#000000"
)
md_cols <- c(
"#FFFFFF",
"#F8A31B",
"#F27314",
"#E25033",
"#AA3929",
"#FFFFCC",
"#C2E699",
"#78C679",
"#238443"
)
myGgplotTraj = function(dt.arg,
x.arg,
y.arg,
group.arg,
facet.arg,
facet.ncol.arg = 2,
line.col.arg = NULL,
xlab.arg = NULL,
ylab.arg = NULL,
plotlab.arg = NULL,
dt.stim.arg = NULL,
tfreq.arg = 1,
maxrt.arg = 60,
xaxisbreaks.arg = 10,
ylim.arg = c(0,1),
stim.bar.height.arg = 0.1,
stim.bar.width.arg = 0.5) {
p.tmp = ggplot(dt.arg,
aes_string(x = x.arg,
y = y.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)
p.tmp = p.tmp +
stat_summary(
aes_string(y = y.arg, group = 1),
fun.y = mean,
colour = 'blue',
linetype = 'solid',
size = 1,
geom = "line",
group = 1
) +
facet_wrap(as.formula(paste("~", facet.arg)),
ncol = facet.ncol.arg,
scales = "free_x")
if(!is.null(dt.stim.arg)) {
p.tmp = p.tmp + geom_segment(data = dt.stim.arg,
aes(x = Stimulation_time - tfreq.arg,
xend = Stimulation_time - tfreq.arg,
y = ylim.arg[1],
yend = ylim.arg[1] + abs(ylim.arg[2] - ylim.arg[1]) * stim.bar.height.arg),
colour = rhg_cols[[3]],
size = stim.bar.width.arg,
group = 1)
}
p.tmp = p.tmp +
scale_x_continuous(breaks = seq(0, maxrt.arg, xaxisbreaks.arg)) +
coord_cartesian(ylim = ylim.arg) +
xlab(paste0(xlab.arg, "\n")) +
ylab(paste0("\n", ylab.arg)) +
ggtitle(plotlab.arg) +
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 = "top"
)
p.tmp
}
userDataGen <- function() {
cat(file=stderr(), 'userDataGen: in\n')
locNtp = 13
locNtracks = 5
locNsites = 4
locNwells = 2
dt.nuc = data.table(Metadata_Site = rep(1:locNsites, each = locNtp * locNtracks),
Metadata_Well = rep(1:locNwells, each = locNtp * locNsites * locNtracks / locNwells),
Metadata_Time = rep(1:locNtp, locNsites* locNtracks),
meas_MeanIntensity_cyto = rnorm(locNtp * locNtracks * locNsites, .5, 0.1),
meas_MeanIntensity_nuc = rnorm(locNtp * locNtracks * locNsites, .5, 0.1),
TrackLabel = rep(1:(locNtracks*locNsites), each = locNtp))
cat(colnames(dt.nuc))
return(dt.nuc)
}
# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#
library(shiny)
library(shinyjs) #http://deanattali.com/shinyjs/
library(data.table)
library(ggplot2)
library(plotly)
options(shiny.maxRequestSize=30*1024^2)
source('auxfunc.R')
shinyServer(function(input, output) {
butCounter <- reactiveValues(
dataLoadNuc = isolate(ifelse(is.null(input$inFileNucLoad), 0, 1)),
dataLoadStim = isolate(ifelse(is.null(input$inFileStimLoad), 0, 1)),
dataGen = isolate(input$butDataGen)
)
getDataNucCols <- reactive({
cat(file=stderr(), 'getDataNucCols: in\n')
return(colnames(dataInBoth()))
})
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 Grouping (e.g. Metadata_Site or Well):', 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% 'ime'][1] # index 1 at the end in case more matches; select 1st
cat(locColSel, '\n')
selectInput('inSelTime', 'Select Time (e.g. RealTime):', locCols, width = '100%', selected = locColSel)
})
output$varSelMeas1 = renderUI({
cat(file=stderr(), 'UI varSelMeas1\n')
locCols = getDataNucCols()
locColSel = locCols[locCols %like% 'MeanIntensity'][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$varSelRatio = renderUI({
cat(file=stderr(), 'UI varSelRatio\n')
checkboxInput('inSelRatio', 'Divide by:', 0)
})
output$varSelMeas2 = renderUI({
cat(file=stderr(), 'UI varSelMeas2\n')
locCols = getDataNucCols()
locColSel = locCols[locCols %like% 'Intensity'][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)
})
output$outPlot = renderUI({
plotlyOutput("trajPlot", width = paste0(input$inPlotWidth, '%'), height = paste0(input$inPlotHeight, 'px'))
})
userDataNuc <- eventReactive(input$inFileNucLoad, {
cat(file=stderr(), 'userDataNuc: in\n')
infile = input$inFileNucLoad
dt = fread(infile$datapath)
cat(file=stderr(), 'userDataNuc: out\n')
return(dt)
})
userDataNucMod = reactive({
# make unique cell identifier based on metadata.site
cat(file=stderr(), 'userDataNucMod: in\n')
# dt = userDataNuc()
dt = dataInBoth()
colNameSite = input$inSelSite
colNameTrackLabel = input$inSelTrackLabel
if (colNameSite == '' && colNameTrackLabel == '') {
cat(file=stderr(), 'userDataNucMod: no colName\n')
return(NULL)
}
dt[, trackObjectsLabelUni := paste(sprintf("%04d", get(colNameSite)),
sprintf("%04d", get(colNameTrackLabel)),
sep = "_")]
loc.colnames = colnames(dt)
if (sum(loc.colnames %like% 'Stimulation') == 0) {
dt[, metadata.site.stim := get(colNameSite)]
} else {
dt[, metadata.site.stim := paste(
sprintf('%02d', get(colNameSite)),
': ',
Stimulation_duration,
' ',
Stimulation_intensity,
' ',
Stimulation_treatment,
sep = ''
)]
}
cat(file=stderr(), 'userDataNucMod: out\n')
return(dt)
})
userDataStim <- eventReactive(input$inFileStimLoad, {
cat(file=stderr(), 'userDataStim: in\n')
infile = input$inFileStimLoad
dt = fread(infile$datapath)
cat(file=stderr(), 'userDataStim: out\n')
return(dt)
})
# This button will reset the inFileLoad
observeEvent(input$butReset, {
reset("inFileNucLoad") # reset is a shinyjs function
reset("inFileStimLoad") # reset is a shinyjs function
})
dataInBoth <- reactive({
cat(file=stderr(), 'dataInBoth: in\n')
locInGen = input$butDataGen
locInLoadNuc = ifelse(is.null(input$inFileNucLoad), 0, isolate(butCounter$dataLoadNuc) + 1)
locInLoadStim = ifelse(is.null(input$inFileStimLoad), 0, isolate(butCounter$dataLoadStim) + 1)
cat(file=stderr(), "dataInBoth\n1: ", locInGen, "\n2: ", locInLoadNuc, "\n3: ", locInLoadStim, "\n")
# isolate the checks of counter reactiveValues
# as we set the values in this same reactive
if (locInLoadNuc != isolate(butCounter$dataLoadNuc)) {
cat(file=stderr(), "dataInBoth if inFileNucLoad\n")
dm = userDataNuc()
# no need to isolate updating the counter reactive values!
butCounter$dataLoad <- locInLoadNuc
} else if (locInGen != isolate(butCounter$dataGen)) {
cat(file=stderr(), "dataInBoth if inDataGen\n")
dm = userDataGen()
cat(colnames(dm))
# no need to isolate updating the counter reactive values!
butCounter$dataGen <- locInGen
} else dm = NULL
cat(file=stderr(), 'dataInBoth: out\n')
return(dm)
})
output$trajPlot <- renderPlotly({
cat(file=stderr(), 'trajPlot: in\n')
locBut = input$butGo
if (locBut == 0) {
cat(file=stderr(), 'trajPlot: Go button not pressed\n')
return(NULL)
}
dt.nuc = (userDataNucMod())
locInLoadStim = isolate(input$inFileStimLoad)
if (is.null(dt.nuc) && is.null(locInLoadStim)) {
cat(file=stderr(), 'trajPlot: Data not yet loaded\n')
return(NULL)
} else if (is.null(locInLoadStim)) {
cat(file=stderr(), 'trajPlot: only timecourses loaded\n')
dt.stim = NULL
} else {
cat(file=stderr(), 'trajPlot: timecourses and stimulation pattern loaded\n')
dt.stim = userDataStim()
}
loc.facet.ncol.arg = isolate(input$inFacetNcol)
loc.time = isolate(input$inSelTime)
loc.meas.1 = isolate(input$inSelMeas1)
if (isolate(input$inSelRatio)) {
loc.meas.2 = isolate(input$inSelMeas2)
loc.y.arg = paste0(loc.meas.1, ' / ', loc.meas.2)
} else
loc.y.arg = loc.meas.1
cat(loc.y.arg)
p.out = myGgplotTraj(
dt.arg = dt.nuc,
x.arg = loc.time,
y.arg = loc.y.arg,
group.arg = "trackObjectsLabelUni",
facet.arg = 'metadata.site.stim',
# xlab.arg = "Time (min)",
# ylab.arg = loc.y.arg,
# plotlab.arg = "Raw data from illumination-corrected images",
dt.stim.arg = dt.stim,
tfreq.arg = 1,
maxrt.arg = 120,
xaxisbreaks.arg = 10,
facet.ncol.arg = loc.facet.ncol.arg,
ylim.arg = c(0, 1.2),
stim.bar.height.arg = 0.05,
stim.bar.width.arg = 1
)
#ggplotly(p.out)
cat(file=stderr(), 'trajPlot: out\n')
return(ggplotly(p.out))
})
})
# This is the user-interface definition of a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#
library(shiny)
library(plotly)
shinyUI(fluidPage(
useShinyjs(), # Include shinyjs
# Application title
title = "Timecourse Inspector",
fluidRow(
column(3,
h4("Load data files"),
#Selector for file upload
fileInput(
'inFileNucLoad',
'Choose CSV file with measurement data, e.g. tCoursesSelected.csv',
accept = c('text/csv', 'text/comma-separated-values,text/plain')
),
fileInput(
'inFileStimLoad',
'Choose CSV file with stimulation times, e.g. stimT.csv',
accept = c('text/csv', 'text/comma-separated-values,text/plain')
),
actionButton("butReset", "Reset file input"),
actionButton('butDataGen', 'Generate artificial dataset'),
actionButton('butGo', 'Go!')),
column(4, offset = 1,
uiOutput('varSelSite'),
uiOutput('varSelTrackLabel'),
uiOutput('varSelTime'),
uiOutput('varSelMeas1'),
uiOutput('varSelRatio'),
uiOutput('varSelMeas2')),
column(2, offset = 1,
numericInput('inFacetNcol', 'No. of plot columns:', value = 4, min = 1, width = '150px', step = 1),
numericInput('inPlotHeight', 'Plot Height [px]:', value = 400, min = 100, width = '150px', step = 50),
numericInput('inPlotWidth', 'Plot Width [%]:', value = 100, min = 10, max = 100, width = '150px', step = 10))
),
br(),
uiOutput('outPlot')
))
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