From 89559932c24a6b0a529bfad6af488c5710e55665 Mon Sep 17 00:00:00 2001 From: dmattek Date: Thu, 22 Nov 2018 17:48:26 +0100 Subject: [PATCH] Bug fixes --- modules/auxfunc.R | 53 ++++++++++++++---------- modules/trajPlot.R | 15 ++++++- server.R | 100 ++++++++++++++++++--------------------------- ui.R | 11 +++-- 4 files changed, 89 insertions(+), 90 deletions(-) diff --git a/modules/auxfunc.R b/modules/auxfunc.R index 7c5c0ec..38e9a07 100644 --- a/modules/auxfunc.R +++ b/modules/auxfunc.R @@ -1,9 +1,17 @@ -## Custom plotting +# +# Time Course Inspector: Shiny app for plotting time series data +# Author: Maciej Dobrzynski +# +# These are auxilary functions +# + + require(ggplot2) require(RColorBrewer) require(gplots) # for heatmap.2 require(grid) # for modifying grob +# Colour definitions ---- rhg_cols <- c( "#771C19", "#AA3929", @@ -29,22 +37,6 @@ md_cols <- c( "#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 l.col.pal = list( "White-Orange-Red" = 'OrRd', @@ -66,6 +58,26 @@ l.col.pal.dend = list( "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 # From: https://gist.github.com/jcheng5/5913297 helpPopup <- function(title, content, @@ -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) # This one works wth dist & hclust pair @@ -168,8 +178,7 @@ getClCol <- function(in.dend, in.k) { } -##### -## Common plotting functions +# Custom plotting functions ---- # Build Function to Return Element Text Object # From: https://stackoverflow.com/a/36979201/1898713 diff --git a/modules/trajPlot.R b/modules/trajPlot.R index aded742..7f8fe23 100644 --- a/modules/trajPlot.R +++ b/modules/trajPlot.R @@ -1,5 +1,15 @@ +# +# Time Course Inspector: Shiny app for plotting time series data +# Author: Maciej Dobrzynski +# +# This is the module for plotting individual time series +# + + require(DT) +# UI ---- + modTrajPlotUI = function(id, label = "Plot Individual Time Series") { ns <- NS(id) @@ -66,7 +76,7 @@ modTrajPlotUI = function(id, label = "Plot Individual Time Series") { ) } - +# Server ---- modTrajPlot = function(input, output, session, in.data, in.data.stim, @@ -270,7 +280,8 @@ modTrajPlot = function(input, output, session, facet.color.arg = loc.facet.col, dt.stim.arg = loc.dt.stim, 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)', line.col.arg = loc.line.col.arg, aux.label1 = if (locPos) 'pos.x' else NULL, diff --git a/server.R b/server.R index d351a14..212b928 100644 --- a/server.R +++ b/server.R @@ -1,10 +1,8 @@ - - - -# 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) @@ -24,41 +22,34 @@ library(dtw) # for dynamic time warping library(imputeTS) # for interpolating NAs 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) +# Server logic ---- shinyServer(function(input, output, session) { useShinyjs() # 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 counter <- reactiveValues( - # The value of inDataGen1,2 actionButton is the number of times they were pressed - dataGen1 = isolate(input$inDataGen1), - dataLoadNuc = isolate(input$inButLoadNuc), + # The value of actionButton is the number of times the button is pressed + dataGen1 = isolate(input$inDataGen1), + dataLoadNuc = isolate(input$inButLoadNuc), dataLoadTrajRem = isolate(input$inButLoadTrajRem), dataLoadStim = isolate(input$inButLoadStim) ) - #### - ## UI for side panel + # UI-side-panel-data-load ---- - # FILE LOAD - # 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 + # Generate random dataset dataGen1 <- eventReactive(input$inDataGen1, { cat("dataGen1\n") return(tca::genTraj(in.nwells = 3)) }) - # load main data file + # Load main data file dataLoadNuc <- eventReactive(input$inButLoadNuc, { cat("dataLoadNuc\n") locFilePath = input$inFileLoadNuc$datapath @@ -75,11 +66,9 @@ shinyServer(function(input, output, session) { # This button will reset the inFileLoad observeEvent(input$butReset, { 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, { cat(file = stderr(), "dataLoadTrajRem\n") locFilePath = input$inFileLoadTrajRem$datapath @@ -93,7 +82,7 @@ shinyServer(function(input, output, session) { } }) - # load data with stimulation pattern + # Load data with stimulation pattern dataLoadStim <- eventReactive(input$inButLoadStim, { cat(file = stderr(), "dataLoadStim\n") locFilePath = input$inFileLoadStim$datapath @@ -148,7 +137,7 @@ shinyServer(function(input, output, session) { - # COLUMN SELECTION + # UI-side-panel-column-selection ---- output$varSelTrackLabel = renderUI({ cat(file = stderr(), 'UI varSelTrackLabel\n') locCols = getDataNucCols() @@ -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, - # 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_... + # e.g.1 Stim_All_Ch or Stim_All_S. + # e.g.2 a combination of 3 columns called Stimulation_... output$varSelGroup = renderUI({ cat(file = stderr(), 'UI varSelGroup\n') @@ -237,8 +226,6 @@ shinyServer(function(input, output, session) { }) - - output$varSelMeas1 = renderUI({ cat(file = stderr(), 'UI varSelMeas1\n') locCols = getDataNucCols() @@ -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({ cat(file = stderr(), 'UI uiSlTimeTrim\n') @@ -300,8 +287,7 @@ shinyServer(function(input, output, session) { } }) - # UI for normalization - + # UI-side-panel-normalization ---- output$uiChBnorm = renderUI({ cat(file = stderr(), 'UI uiChBnorm\n') @@ -358,7 +344,7 @@ shinyServer(function(input, output, session) { }) - # UI for removing outliers + # UI-side-panel-remove-outliers ---- output$uiSlOutliers = renderUI({ cat(file = stderr(), 'UI uiSlOutliers\n') @@ -377,18 +363,8 @@ shinyServer(function(input, output, session) { } }) - output$uiTxtOutliers = renderUI({ - if (input$chBoutliers) { - - p("Total tracks") - - } - - }) - - #### - ## data processing + # Processing-data ---- dataInBoth <- reactive({ # Without direct references to inDataGen1,2 and inFileLoad, inDataGen2 @@ -799,19 +775,9 @@ shinyServer(function(input, output, session) { } ) - ###### Trajectory plotting - callModule(modTrajRibbonPlot, 'modTrajRibbon', - in.data = data4trajPlot, - 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 + # Plotting-trajectories ---- + + # UI for selecting trajectories # The output data table of data4trajPlot is modified based on inSelHighlight field output$varSelHighlight = renderUI({ cat(file = stderr(), 'UI varSelHighlight\n') @@ -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 callModule(modAUCplot, 'tabAUC', data4trajPlot, in.fname = function() return('boxplotAUC.pdf')) diff --git a/ui.R b/ui.R index 992cb41..6992819 100644 --- a/ui.R +++ b/ui.R @@ -1,14 +1,13 @@ - - -# 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(shinyjs) #http://deanattali.com/shinyjs/ -library(plotly) shinyUI(fluidPage( useShinyjs(), -- GitLab