In order to mitigate against the brute force attacks against Gitlab accounts, we are moving to all edu-ID Logins. We would like to remind you to link your account with your edu-id. Login will be possible only by edu-ID after November 30, 2021. Here you can find the instructions for linking your account.

If you don't have a SWITCH edu-ID, you can create one with this guide here

kind regards

This Server has been upgraded to GitLab release 14.2.6

Unverified Commit 2b6b221d authored by Maciej Dobrzynski's avatar Maciej Dobrzynski Committed by GitHub
Browse files

Merge pull request #1 from majpark21/master

Power Spectral Density
parents a8f6e87c 3acb6728
......@@ -6,6 +6,7 @@ source('modules/dispStats.R')
source('modules/dispTrackStats.R')
source('modules/trajPlot.R')
source('modules/trajRibbonPlot.R')
source('modules/trajPsdPlot.R')
source('modules/boxPlot.R')
source('modules/tabAUC.R')
source('modules/clDistPlot.R')
......
......@@ -53,6 +53,7 @@ FCSVOUTLIERS = 'outliers.csv'
FCSVTCCLEAN = 'tCoursesSelected_clean.csv'
FPDFTCMEAN = "tCoursesMeans.pdf"
FPDFTCSINGLE = "tCourses.pdf"
FPDFTCPSD = 'tCoursesPsd.pdf'
FPDFBOXAUC = 'boxplotAUC.pdf'
FPDFBOXTP = 'boxplotTP.pdf'
FPDFSCATTER = 'scatter.pdf'
......@@ -206,6 +207,57 @@ LOCcalcTrajCI = function(in.dt, in.col.meas, in.col.by = NULL, in.type = c('norm
return(loc.dt)
}
#' Calculate the power spectrum density for time-series
#'
#' @param in.dt Data table in long format
#' @param in.col.meas Name of the column with the measurement
#' @param in.col.id Name of the column with the unique series identifier
#' @param in.col.by Column names for grouping (default NULL - no grouping). PSD of individual trajectories will be averaged within a group.
#' @param in.method Name of the method for PSD estimation, must be one of c("pgram", "ar"). Default to "pgram*.
#' @param in.return.period Wheter to return densities though periods (1/frequencies) instead of frequencies.
#' @param ... Other paramters to pass to stats::spectrum()
#'
#' @return Datatable with columns: (frequency or period), spec (the density) and grouping column
#' @export
#' @import data.table
#'
#' @examples
LOCcalcPSD <- function(in.dt,
in.col.meas,
in.col.id,
in.col.by,
in.method = "pgram",
in.return.period = TRUE,
...){
require(data.table)
# Method "ar" returns $spec as matrix whereas "pgram" returns a vector, custom function to homogenze output format
mySpectrum <- function(x, ...){
args_spec <- list(x=x, plot=FALSE)
inargs <- list(...)
args_spec[names(inargs)] <- inargs
out <- do.call(spectrum, args_spec)
out$spec <- as.vector(out$spec)
return(out)
}
if(!in.method %in% c("pgram", "ar")){
stop('Method should be one of: c("pgram", "ar"')
}
dt_spec <- in.dt[, (mySpectrum(get(in.col.meas), plot = FALSE, method = in.method)[c("freq", "spec")]), by = in.col.id]
dt_group <- in.dt[, .SD[1, get(in.col.by)], by = in.col.id]
setnames(dt_group, "V1", in.col.by)
dt_spec <- merge(dt_spec, dt_group, by = in.col.id)
dt_agg <- dt_spec[, .(spec = mean(spec)), by = c(in.col.by, "freq")]
if(in.return.period){
dt_agg[, period := 1/freq]
dt_agg[, frequency := NULL]
} else {
setnames(dt_agg, "freq", "frequency")
}
return(dt_agg)
}
#' Generate synthetic CellProfiler output with single cell time series
#'
#'
......@@ -644,7 +696,34 @@ LOCplotTrajRibbon = function(dt.arg, # input data table
return(p.tmp)
}
# Plot average power spectrum density per facet
LOCplotPSD <- function(dt.arg, # input data table
x.arg, # string with column name for x-axis
y.arg, # string with column name for y-axis
group.arg=NULL, # string with column name for grouping time series (here, it's a column corresponding to grouping by condition)
xlab.arg = x.arg,
ylab.arg = y.arg,
col.arg = NULL){
require(ggplot2)
if(length(setdiff(c(x.arg, y.arg, group.arg), colnames(dt.arg))) > 0){
stop(paste("Missing columns in dt.arg: ", setdiff(c(x.arg, y.arg, group.arg), colnames(dt.arg))))
}
p.tmp <- ggplot(dt.arg, aes_string(x=x.arg, y=y.arg)) +
geom_line() +
geom_rug(sides="b", alpha = 1, color = "lightblue") +
facet_wrap(group.arg) +
labs(x = xlab.arg, y = ylab.arg)
if (is.null(col.arg)) {
p.tmp = p.tmp +
scale_color_discrete(name = '')
} else {
p.tmp = p.tmp +
scale_colour_manual(values = col.arg, name = '')
}
return(p.tmp)
}
# Plots a scatter plot with marginal histograms
# Points are connected by a line (grouping by cellID)
......
......@@ -172,6 +172,9 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
tabPanel('Time-courses',
modTrajPlotUI(ns('modPlotHierTraj'))),
tabPanel('PSD',
modPSDPlotUI(ns('modPlotHierPsd'))),
tabPanel('Cluster dist.',
modClDistPlotUI(ns('hierClDistPlot'), 'xxx'))
......@@ -528,13 +531,22 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i
'.pdf')
})
createFnamePsdPlot = reactive({
paste0('clust_hierch_tCoursesPsd_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)],
'_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)],
'.pdf')
})
createFnameDistPlot = reactive({
paste0('clust_hierch_clDist_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)],
'_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf') })
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf')
})
# Hierarchical - Heat Map - download pdf
......@@ -556,6 +568,13 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i
in.facet.color = getClColHier,
in.fname = createFnameRibbonPlot)
# plot cluster PSD
callModule(modPSDPlot, 'modPlotHierPsd',
in.data = data4trajPlotCl,
in.facet = 'cl',
in.facet.color = getClColHier,
in.fname = createFnamePsdPlot)
# plot distribution barplot
callModule(modClDistPlot, 'hierClDistPlot',
in.data = data4clDistPlot,
......
require(DT)
# UI ----
modPSDPlotUI = function(id, label = "Plot PSD of average trajectory.") {
ns <- NS(id)
tagList(
fluidRow(
column(
3,
checkboxInput(ns('chBplotTrajInt'), 'Interactive Plot'),
actionButton(ns('butPlotTraj'), 'Plot!')
),
column(
3,
selectInput(ns('inPSDxchoice'), 'Xaxis:', list('Period'= TRUE, 'Frequency'= FALSE)),
radioButtons(ns('rBPSDmethod'), 'Method for PSD estimation:', list('Smoothed Fourier' = 'pgram', 'AR Fit' = 'ar'))
),
column(
3,
selectInput(ns('inPSDlogtype'), 'Log function:', list('log2'= 'log2', 'log10'= 'log10', 'ln'= 'log')),
checkboxGroupInput(ns('chBGPSDlogaxis'), 'Log the axis:', list('x' = 'x', 'y' = 'y'), inline = TRUE)
),
column(
3,
numericInput(
ns('inPlotTrajWidth'),
'Width [%]:',
value = 100,
min = 10,
max = 100,
width = '100px',
step = 10
),
numericInput(
ns('inPlotTrajHeight'),
'Height [px]:',
value = 800,
min = 100,
width = '100px',
step = 50
)
)
),
uiOutput(ns('uiPlotTraj')),
br(),
modTrackStatsUI(ns('dispTrackStats')),
downPlotUI(ns('downPlotTraj'), "Download PDF")
)
}
# Server ----
modPSDPlot = function(input, output, session,
in.data,
in.fname,
in.facet = 'group',
in.facet.color = NULL
) {
ns <- session$ns
output$uiPlotTraj = renderUI({
if (input$chBplotTrajInt)
plotlyOutput(
ns("outPlotTrajInt"),
width = paste0(input$inPlotTrajWidth, '%'),
height = paste0(input$inPlotTrajHeight, 'px')
) else
plotOutput(
ns("outPlotTraj"),
width = paste0(input$inPlotTrajWidth, '%'),
height = paste0(input$inPlotTrajHeight, 'px')
)
})
callModule(modTrackStats, 'dispTrackStats',
in.data = in.data)
output$outPlotTraj <- renderPlot({
loc.p = plotTraj()
if(is.null(loc.p))
return(NULL)
return(loc.p)
})
output$outPlotTrajInt <- renderPlotly({
# This is required to avoid
# "Warning: Error in <Anonymous>: cannot open file 'Rplots.pdf'"
# When running on a server. Based on:
# https://github.com/ropensci/plotly/issues/494
if (names(dev.cur()) != "null device")
dev.off()
pdf(NULL)
loc.p = plotTraj()
if(is.null(loc.p))
return(NULL)
return(plotly_build(loc.p))
})
# PSD plot - download pdf
callModule(downPlot, "downPlotTraj",
in.fname = in.fname,
plotTraj, TRUE)
plotTraj <- function() {
cat(file = stderr(), 'plotPSD: in\n')
locBut = input$butPlotTraj
if (locBut == 0) {
cat(file = stderr(), 'plotPSD: Go button not pressed\n')
return(NULL)
}
# check if main data exists
loc.dt = isolate(in.data())
cat("plotPSD: on to plot\n\n")
if (is.null(loc.dt)) {
cat(file = stderr(), 'plotPSD: dt is NULL\n')
return(NULL)
}
cat(file = stderr(), 'plotPSD: dt not NULL\n')
# Future: change such that a column with colouring status is chosen by the user
# colour trajectories, if dataset contains mid.in column
# with filtering status of trajectory
if (sum(names(loc.dt) %in% 'mid.in') > 0)
loc.line.col.arg = 'mid.in'
else
loc.line.col.arg = NULL
# select every other point for plotting (fixed for PSD because lead to false interpretation of PSD)
loc.dt = loc.dt[, .SD[seq(1, .N, 1)], by = id]
# check if columns with XY positions are present
if (sum(names(loc.dt) %like% 'pos') == 2)
locPos = TRUE
else
locPos = FALSE
# check if column with ObjectNumber is present
if (sum(names(loc.dt) %like% 'obj.num') == 1)
locObjNum = TRUE
else
locObjNum = FALSE
# If in.facet.color present,
# make sure to include the same number of colours in the palette,
# as the number of groups in dt.
# in.facet.color is typically used when plotting time series within clusters.
# Then, the number of colours in the palette has to be equal to the number of clusters (facetted according to in.facet variable).
# This might differ if the user selects manually clusters to display.
if (is.null(in.facet.color))
loc.facet.col = NULL
else {
# get group numbers in dt;
# loc.dt[, c(in.facet), with = FALSE] returns a data table with a single column
# [[1]] at the end extracts the first column and returns as a vector
loc.groups = unique(loc.dt[, c(in.facet), with = FALSE][[1]])
# get colour palette
# the length is equal to the number of groups in the original dt.
# When plotting time series within clusters, the length equals the number of clusters.
loc.facet.col = in.facet.color()$cl.col
loc.facet.col = loc.facet.col[loc.groups]
}
loc.dt.aggr <- LOCcalcPSD(in.dt = loc.dt,
in.col.meas = 'y',
in.col.id = 'id',
in.col.by = in.facet,
in.method = input$rBPSDmethod,
in.return.period = input$inPSDxchoice
)
loc.dt.aggr[, (in.facet) := as.factor(get(in.facet))]
x_arg <- ifelse('period' %in% colnames(loc.dt.aggr), 'period', 'frequency')
x_arg_str <- paste0(toupper(substr(x_arg, 1, 1)), tolower(substring(x_arg, 2))) # capitalized
p.out <- LOCplotPSD(dt.arg = loc.dt.aggr,
x.arg = x_arg,
y.arg = 'spec',
group.arg = in.facet,
col.arg = loc.facet.col,
xlab.arg = x_arg_str,
ylab.arg = '') +
LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT,
in.font.axis.title = PLOTFONTAXISTITLE,
in.font.strip = PLOTFONTFACETSTRIP,
in.font.legend = PLOTFONTLEGEND)
if("x" %in% input$chBGPSDlogaxis){
p.out <- p.out + scale_x_continuous(trans = input$inPSDlogtype)
}
if("y" %in% input$chBGPSDlogaxis){
p.out <- p.out + scale_y_continuous(trans = input$inPSDlogtype)
}
return(p.out)
}
}
\ No newline at end of file
......@@ -823,6 +823,11 @@ shinyServer(function(input, output, session) {
in.data.stim = data4stimPlot,
in.fname = function() {return(FPDFTCSINGLE)})
# Trajectory plotting - PSD
callModule(modPSDPlot, 'modPSDPlot',
in.data = data4trajPlotNoOut,
in.fname = function() {return(FPDFTCPSD)})
# Tabs ----
###### AUC calculation and plotting
......
......@@ -118,6 +118,12 @@ shinyUI(fluidPage(
uiOutput('varSelHighlight'),
br(),
modTrajPlotUI('modTrajPlot')
),
tabPanel(
"Power Spectral Density",
br(),
modPSDPlotUI('modPSDPlot')
)
)
),
......
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