Commit 89559932 authored by dmattek's avatar dmattek
Browse files

Bug fixes

parent bbcd3d20
## Custom plotting #
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# These are auxilary functions
#
require(ggplot2) require(ggplot2)
require(RColorBrewer) require(RColorBrewer)
require(gplots) # for heatmap.2 require(gplots) # for heatmap.2
require(grid) # for modifying grob require(grid) # for modifying grob
# Colour definitions ----
rhg_cols <- c( rhg_cols <- c(
"#771C19", "#771C19",
"#AA3929", "#AA3929",
...@@ -29,22 +37,6 @@ md_cols <- c( ...@@ -29,22 +37,6 @@ md_cols <- c(
"#238443" "#238443"
) )
s.cl.linkage = c("ward.D",
"ward.D2",
"single",
"complete",
"average",
"mcquitty",
"centroid")
s.cl.spar.linkage = c("average",
"complete",
"single",
"centroid")
s.cl.diss = c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski", "DTW")
s.cl.spar.diss = c("squared.distance","absolute.value")
# list of palettes for the heatmap # list of palettes for the heatmap
l.col.pal = list( l.col.pal = list(
"White-Orange-Red" = 'OrRd', "White-Orange-Red" = 'OrRd',
...@@ -66,6 +58,26 @@ l.col.pal.dend = list( ...@@ -66,6 +58,26 @@ l.col.pal.dend = list(
"Diverge HSV" = 'diverge_hsv' "Diverge HSV" = 'diverge_hsv'
) )
# Clustering algorithms ----
s.cl.linkage = c("ward.D",
"ward.D2",
"single",
"complete",
"average",
"mcquitty",
"centroid")
s.cl.spar.linkage = c("average",
"complete",
"single",
"centroid")
s.cl.diss = c("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski", "DTW")
s.cl.spar.diss = c("squared.distance","absolute.value")
# Help text ----
# Creates a popup with help text # Creates a popup with help text
# From: https://gist.github.com/jcheng5/5913297 # From: https://gist.github.com/jcheng5/5913297
helpPopup <- function(title, content, helpPopup <- function(title, content,
...@@ -102,9 +114,7 @@ help.text = c( ...@@ -102,9 +114,7 @@ help.text = c(
) )
##### # Functions for clustering ----
## Functions for clustering
# Return a dt with cell IDs and corresponding cluster assignments depending on dendrogram cut (in.k) # Return a dt with cell IDs and corresponding cluster assignments depending on dendrogram cut (in.k)
# This one works wth dist & hclust pair # This one works wth dist & hclust pair
...@@ -168,8 +178,7 @@ getClCol <- function(in.dend, in.k) { ...@@ -168,8 +178,7 @@ getClCol <- function(in.dend, in.k) {
} }
##### # Custom plotting functions ----
## Common plotting functions
# Build Function to Return Element Text Object # Build Function to Return Element Text Object
# From: https://stackoverflow.com/a/36979201/1898713 # From: https://stackoverflow.com/a/36979201/1898713
......
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This is the module for plotting individual time series
#
require(DT) require(DT)
# UI ----
modTrajPlotUI = function(id, label = "Plot Individual Time Series") { modTrajPlotUI = function(id, label = "Plot Individual Time Series") {
ns <- NS(id) ns <- NS(id)
...@@ -66,7 +76,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") { ...@@ -66,7 +76,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") {
) )
} }
# Server ----
modTrajPlot = function(input, output, session, modTrajPlot = function(input, output, session,
in.data, in.data,
in.data.stim, in.data.stim,
...@@ -270,7 +280,8 @@ modTrajPlot = function(input, output, session, ...@@ -270,7 +280,8 @@ modTrajPlot = function(input, output, session,
facet.color.arg = loc.facet.col, facet.color.arg = loc.facet.col,
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'),
stim.bar.width.arg = 1,
xlab.arg = 'Time (min)', xlab.arg = 'Time (min)',
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,
......
# 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 # Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This is the server logic for a Shiny web application.
# #
library(shiny) library(shiny)
...@@ -24,41 +22,34 @@ library(dtw) # for dynamic time warping ...@@ -24,41 +22,34 @@ library(dtw) # for dynamic time warping
library(imputeTS) # for interpolating NAs library(imputeTS) # for interpolating NAs
library(tca) # for time series manipulatiom, e.g. normTraj, genTraj, plotTrajRibbon library(tca) # for time series manipulatiom, e.g. normTraj, genTraj, plotTrajRibbon
# increase file upload limit # change to increase the limit of the upload file size
options(shiny.maxRequestSize = 200 * 1024 ^ 2) options(shiny.maxRequestSize = 200 * 1024 ^ 2)
# Server logic ----
shinyServer(function(input, output, session) { shinyServer(function(input, output, session) {
useShinyjs() useShinyjs()
# This is only set at session start # This is only set at session start
# we use this as a way to determine which input was # We use this as a way to determine which input was
# clicked in the dataInBoth reactive # clicked in the dataInBoth reactive
counter <- reactiveValues( counter <- reactiveValues(
# The value of inDataGen1,2 actionButton is the number of times they were pressed # The value of actionButton is the number of times the button is pressed
dataGen1 = isolate(input$inDataGen1), dataGen1 = isolate(input$inDataGen1),
dataLoadNuc = isolate(input$inButLoadNuc), dataLoadNuc = isolate(input$inButLoadNuc),
dataLoadTrajRem = isolate(input$inButLoadTrajRem), dataLoadTrajRem = isolate(input$inButLoadTrajRem),
dataLoadStim = isolate(input$inButLoadStim) dataLoadStim = isolate(input$inButLoadStim)
) )
#### # UI-side-panel-data-load ----
## UI for side panel
# FILE LOAD # Generate random dataset
# This button will reset the inFileLoad
observeEvent(input$inButReset, {
reset("inFileLoadNuc") # reset is a shinyjs function
#reset("inButLoadStim") # reset is a shinyjs function
})
# generate random dataset 1
dataGen1 <- eventReactive(input$inDataGen1, { dataGen1 <- eventReactive(input$inDataGen1, {
cat("dataGen1\n") cat("dataGen1\n")
return(tca::genTraj(in.nwells = 3)) return(tca::genTraj(in.nwells = 3))
}) })
# load main data file # Load main data file
dataLoadNuc <- eventReactive(input$inButLoadNuc, { dataLoadNuc <- eventReactive(input$inButLoadNuc, {
cat("dataLoadNuc\n") cat("dataLoadNuc\n")
locFilePath = input$inFileLoadNuc$datapath locFilePath = input$inFileLoadNuc$datapath
...@@ -75,11 +66,9 @@ shinyServer(function(input, output, session) { ...@@ -75,11 +66,9 @@ shinyServer(function(input, output, session) {
# This button will reset the inFileLoad # This button will reset the inFileLoad
observeEvent(input$butReset, { observeEvent(input$butReset, {
reset("inFileLoadNuc") # reset is a shinyjs function reset("inFileLoadNuc") # reset is a shinyjs function
# reset("inFileStimLoad") # reset is a shinyjs function
}) })
# load data with trajectories to remove # Load data with trajectories to remove
dataLoadTrajRem <- eventReactive(input$inButLoadTrajRem, { dataLoadTrajRem <- eventReactive(input$inButLoadTrajRem, {
cat(file = stderr(), "dataLoadTrajRem\n") cat(file = stderr(), "dataLoadTrajRem\n")
locFilePath = input$inFileLoadTrajRem$datapath locFilePath = input$inFileLoadTrajRem$datapath
...@@ -93,7 +82,7 @@ shinyServer(function(input, output, session) { ...@@ -93,7 +82,7 @@ shinyServer(function(input, output, session) {
} }
}) })
# load data with stimulation pattern # Load data with stimulation pattern
dataLoadStim <- eventReactive(input$inButLoadStim, { dataLoadStim <- eventReactive(input$inButLoadStim, {
cat(file = stderr(), "dataLoadStim\n") cat(file = stderr(), "dataLoadStim\n")
locFilePath = input$inFileLoadStim$datapath locFilePath = input$inFileLoadStim$datapath
...@@ -148,7 +137,7 @@ shinyServer(function(input, output, session) { ...@@ -148,7 +137,7 @@ shinyServer(function(input, output, session) {
# COLUMN SELECTION # UI-side-panel-column-selection ----
output$varSelTrackLabel = renderUI({ output$varSelTrackLabel = renderUI({
cat(file = stderr(), 'UI varSelTrackLabel\n') cat(file = stderr(), 'UI varSelTrackLabel\n')
locCols = getDataNucCols() locCols = getDataNucCols()
...@@ -192,10 +181,10 @@ shinyServer(function(input, output, session) { ...@@ -192,10 +181,10 @@ shinyServer(function(input, output, session) {
} }
}) })
# This is main field to select plot facet grouping # This is the main field to select plot facet grouping
# It's typically a column with the entire experimental description, # 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. # e.g.1 Stim_All_Ch or Stim_All_S.
# In Coralie's case it's a combination of 3 columns called Stimulation_... # e.g.2 a combination of 3 columns called Stimulation_...
output$varSelGroup = renderUI({ output$varSelGroup = renderUI({
cat(file = stderr(), 'UI varSelGroup\n') cat(file = stderr(), 'UI varSelGroup\n')
...@@ -237,8 +226,6 @@ shinyServer(function(input, output, session) { ...@@ -237,8 +226,6 @@ shinyServer(function(input, output, session) {
}) })
output$varSelMeas1 = renderUI({ output$varSelMeas1 = renderUI({
cat(file = stderr(), 'UI varSelMeas1\n') cat(file = stderr(), 'UI varSelMeas1\n')
locCols = getDataNucCols() locCols = getDataNucCols()
...@@ -275,7 +262,7 @@ shinyServer(function(input, output, session) { ...@@ -275,7 +262,7 @@ shinyServer(function(input, output, session) {
} }
}) })
# UI for trimming x-axis (time) # UI-side-panel-trim x-axis (time) ----
output$uiSlTimeTrim = renderUI({ output$uiSlTimeTrim = renderUI({
cat(file = stderr(), 'UI uiSlTimeTrim\n') cat(file = stderr(), 'UI uiSlTimeTrim\n')
...@@ -300,8 +287,7 @@ shinyServer(function(input, output, session) { ...@@ -300,8 +287,7 @@ shinyServer(function(input, output, session) {
} }
}) })
# UI for normalization # UI-side-panel-normalization ----
output$uiChBnorm = renderUI({ output$uiChBnorm = renderUI({
cat(file = stderr(), 'UI uiChBnorm\n') cat(file = stderr(), 'UI uiChBnorm\n')
...@@ -358,7 +344,7 @@ shinyServer(function(input, output, session) { ...@@ -358,7 +344,7 @@ shinyServer(function(input, output, session) {
}) })
# UI for removing outliers # UI-side-panel-remove-outliers ----
output$uiSlOutliers = renderUI({ output$uiSlOutliers = renderUI({
cat(file = stderr(), 'UI uiSlOutliers\n') cat(file = stderr(), 'UI uiSlOutliers\n')
...@@ -377,18 +363,8 @@ shinyServer(function(input, output, session) { ...@@ -377,18 +363,8 @@ shinyServer(function(input, output, session) {
} }
}) })
output$uiTxtOutliers = renderUI({
if (input$chBoutliers) {
p("Total tracks")
}
})
# Processing-data ----
####
## data processing
dataInBoth <- reactive({ dataInBoth <- reactive({
# Without direct references to inDataGen1,2 and inFileLoad, inDataGen2 # Without direct references to inDataGen1,2 and inFileLoad, inDataGen2
...@@ -799,19 +775,9 @@ shinyServer(function(input, output, session) { ...@@ -799,19 +775,9 @@ shinyServer(function(input, output, session) {
} }
) )
###### Trajectory plotting # Plotting-trajectories ----
callModule(modTrajRibbonPlot, 'modTrajRibbon',
in.data = data4trajPlot, # UI for selecting trajectories
in.data.stim = data4stimPlot,
in.fname = function() return( "tCoursesMeans.pdf"))
###### Trajectory plotting
callModule(modTrajPlot, 'modTrajPlot',
in.data = data4trajPlot,
in.data.stim = data4stimPlot,
in.fname = function() {return( "tCourses.pdf")})
## UI for selecting trajectories
# The output data table of data4trajPlot is modified based on inSelHighlight field # The output data table of data4trajPlot is modified based on inSelHighlight field
output$varSelHighlight = renderUI({ output$varSelHighlight = renderUI({
cat(file = stderr(), 'UI varSelHighlight\n') cat(file = stderr(), 'UI varSelHighlight\n')
...@@ -832,6 +798,20 @@ shinyServer(function(input, output, session) { ...@@ -832,6 +798,20 @@ shinyServer(function(input, output, session) {
} }
}) })
# Trajectory plotting - ribbon
callModule(modTrajRibbonPlot, 'modTrajRibbon',
in.data = data4trajPlot,
in.data.stim = data4stimPlot,
in.fname = function() return( "tCoursesMeans.pdf"))
###### Trajectory plotting - individual
callModule(modTrajPlot, 'modTrajPlot',
in.data = data4trajPlot,
in.data.stim = data4stimPlot,
in.fname = function() {return( "tCourses.pdf")})
# Tabs ----
###### AUC calculation and plotting ###### AUC calculation and plotting
callModule(modAUCplot, 'tabAUC', data4trajPlot, in.fname = function() return('boxplotAUC.pdf')) callModule(modAUCplot, 'tabAUC', data4trajPlot, in.fname = function() return('boxplotAUC.pdf'))
......
# 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 # Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
# #
# This is the user-interface definition for a Shiny web application.
#
library(shiny) library(shiny)
library(shinyjs) #http://deanattali.com/shinyjs/ library(shinyjs) #http://deanattali.com/shinyjs/
library(plotly)
shinyUI(fluidPage( shinyUI(fluidPage(
useShinyjs(), useShinyjs(),
......
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