Commit aa825c82 authored by dmattek's avatar dmattek

Refactoring: assignments of color palettes when plotting clusters. Make Color...

Refactoring: assignments of color palettes when plotting clusters. Make Color Blind palette a default.
parent af7403e9
......@@ -62,6 +62,7 @@ COLPOSY = 'pos.y'
COLIDX = 'IDX'
COLIDXDIFF = 'IDXdiff'
COLCL = 'cl'
COLNTRAJ = "nCells"
# file names
FCSVOUTLIERS = 'outliers.csv'
......@@ -795,20 +796,25 @@ getDataClSpar = function(in.dend, in.k, in.id) {
# prepares a table with cluster numbers in 1st column and colour assignments in 2nd column
# the number of rows is determined by dendrogram cut
getClCol <- function(in.dend, in.k) {
# Returns a table with 2 columns:
# - gr.no - group numbers, e.g. cluster,
# - gr.col - color assignments.
#
# The number of rows is determined by dendrogram cut, parameter in.k.
# Colours are obtained from the dendrogram, parameter in.dend, using dendextend::get_leaves_branches_col
LOCgetClCol <- function(in.dend, in.k) {
loc.col_labels <- dendextend::get_leaves_branches_col(in.dend)
loc.col_labels <- loc.col_labels[order(order.dendrogram(in.dend))]
return(unique(
data.table(
cl.no = dendextend::cutree(in.dend, k = in.k, order_clusters_as_data = TRUE),
cl.col = loc.col_labels
gr.no = dendextend::cutree(in.dend, k = in.k, order_clusters_as_data = TRUE),
gr.col = loc.col_labels
)
))
}
# Custom plotting functions ----
......@@ -881,6 +887,36 @@ LOCrotatedAxisElementText = function(angle,
)
}
#' Return recycled tableau palette
#'
#' Cycle through a tableau palette (e.g. "Color Blind") and return repeated
#' colours depending on the required number of colours
#'
#' @param inPalName Name of the tableau colour palette, e.g. "Color Blind"
#' @param inNcolors Number of required colours, default 10
#'
#' @return A vector with a requested number of colors
#' @export
#'
#' @examples
#' # The Color Blind palette has only 10 colors; here the 11th will be recycled
#' LOCreturnTableauPalette("Color Blind", 11)
LOCreturnTableauPalette = function(inPalName, inNcolors = 10) {
# get the max N of colours in the palette
loc.max.col = attr(ggthemes::tableau_color_pal(inPalName), "max_n")
# get all colours in the palette
loc.col = ggthemes::tableau_color_pal(inPalName)(n = loc.max.col)
# repeat the full palette for the required number of colours
loc.col = rep(loc.col, ((inNcolors-1) %/% loc.max.col) + 1)
# return only the required number of colurs
return(loc.col[1:inNcolors])
}
# Plot individual time series
LOCplotTraj = function(dt.arg,
# input data table
......@@ -1062,35 +1098,50 @@ LOCplotTraj = function(dt.arg,
return(p.tmp)
}
# Plot average time series with CI together in one facet
#' Plot average time series with CI together in one facet
#'
#' @param dt.arg Data.table with aggregated time series in long format
#' @param x.arg String with column name for x-axis
#' @param y.arg String with column name for y-axis
#' @param group.arg String with column name for grouping time series (e.g. a column with grouping by condition)
#' @param col.arg Colour pallette for individual time series
#' @param dt.stim.arg Data.table with stimulation segments to plot under time series
#' @param x.stim.arg Column names in stimulation dt with x and xend parameters, default c('tstart', 'tend')
#' @param y.stim.arg Column names in stimulation dt with y and yend parameters, default c('ystart', 'yend')
#' @param stim.bar.width.arg Width of the stimulation segment, default 0.5
#' @param xlim.arg Limits of x-axis; for visualisation only, not trimmimng data
#' @param ylim.arg Limits of y-axis; for visualisation only, not trimmimng data
#' @param ribbon.lohi.arg Column names containing lower and upper bound for plotting the ribbon, e.g. for CI; default c('Lower', 'Upper'); set to NULL to avoid plotting the ribbon
#' @param ribbon.fill.arg Color to fill the ribbon, default 'grey50'
#' @param ribbon.alpha.arg Transparency of the ribbon, default 0.5
#' @param xlab.arg X-axis label
#' @param ylab.arg Y-axis label
#' @param plotlab.arg Plot label
#'
#' @return Ggplot object
#' @export
#'
#' @examples
LOCplotTrajRibbon = 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)
col.arg = NULL,
# colour pallette for individual time series
dt.stim.arg = NULL,
# data table with stimulation pattern
x.stim.arg = c('tstart', 'tend'),
# column names in stimulation dt with x and xend parameters
y.stim.arg = c('ystart', 'yend'),
# column names in stimulation dt with y and yend parameters
stim.bar.width.arg = 0.5,
xlim.arg = NULL,
# limits of x-axis; for visualisation only, not trimmimng data
ylim.arg = NULL,
# limits of y-axis; for visualisation only, not trimmimng data
ribbon.lohi.arg = c('Lower', 'Upper'),
# column names containing lower and upper bound for plotting the ribbon, e.g. for CI; set to NULL to avoid plotting the ribbon
ribbon.fill.arg = 'grey50',
ribbon.alpha.arg = 0.5,
xlab.arg = NULL,
ylab.arg = NULL,
plotlab.arg = NULL) {
p.tmp = ggplot(dt.arg, aes_string(x = x.arg, group = group.arg))
if (!is.null(ribbon.lohi.arg))
......
......@@ -26,10 +26,15 @@ modClDistPlotUI = function(id, label = "Plot distribution of clusters per group
# Params:
# in.data - data prepared with data4clDistPlot f-n
# in.cols - table with 1st column as cluster number, 2nd column colour assignments
# prepared with getClColHier
# in.colors - table with two columns:
# - gr.no - with group/cluster number,
# - gr.col - with colour assignments
# prepared with getClColHier
# in.fname - file name for plot download
modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fname = 'clDist.pdf') {
modClDistPlot = function(input, output, session,
in.data,
in.colors = NULL,
in.fname = 'clDist.pdf') {
ns <- session$ns
......@@ -38,26 +43,23 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna
cat(file = stderr(), 'plotClDist: in\n')
loc.dt = in.data()
if (is.null(loc.dt)) {
cat(file = stderr(), 'plotClDist: dt is NULL\n')
return(NULL)
}
validate(
need(!is.null(loc.dt), "Nothing to plot. Load data first!")
)
# Two statements: "position_fill(reverse = TRUE)" and "guide_legend(reverse = T)"
# result in stacked bar plot with categories ordered from the bottom to top of the stacked bar
p.out = ggplot(loc.dt[], aes(x = group, y = nCells)) +
geom_bar(aes(fill = as.factor(cl)), stat = 'identity', position = position_fill(reverse = TRUE)) +
# result in a stacked bar plot with categories ordered from the bottom to top of the stacked bar
p.out = ggplot(loc.dt, aes_string(x = COLGR, y = COLNTRAJ)) +
geom_bar(aes_string(fill = paste0("as.factor(", COLCL, ")")),
stat = 'identity',
position = position_fill(reverse = TRUE)) +
guides(fill = guide_legend(reverse = T))
if(is.null(in.cols))
if(is.null(in.colors))
p.out = p.out + scale_fill_discrete(name = "Cluster no.")
else
p.out = p.out + scale_fill_manual(name = "Cluster no.",
values = in.cols()$cl.col) #,
#breaks = in.cols()$cl.no,
#labels = in.cols()$cl.no,
#limits = in.cols()$cl.no)
values = in.colors()[["gr.col"]])
loc.rads = as.numeric(input$rBAxisLabelsRotate) * pi / 180
loc.hjust = 0.5*(1-sin(loc.rads))
......
......@@ -274,15 +274,10 @@ modDistPlot = function(input, output, session,
else
NA
)
# If more than max.col groups, cycle through the palette ("Color Blind" can return 10 colors at maximum)
loc.pal = "Color Blind"
max.col = attr(ggthemes::tableau_color_pal(loc.pal), "max_n")
loc.col = ggthemes::tableau_color_pal(loc.pal)(n = max.col)
ngroups = uniqueN(loc.dt[, get(in.cols$group)]) - 1
loc.col = rep(loc.col, (ngroups %/% max.col) + 1)
loc.col = loc.col[1:(ngroups+1)]
# Get a tableau "Color Blind" palette; recycle 10 available colours, if more groups
loc.ngroups = uniqueN(loc.dt[, get(in.cols$group)])
loc.col = LOCreturnTableauPalette("Color Blind", loc.ngroups)
p.out = p.out +
xlab(in.labels$x) +
......@@ -295,7 +290,8 @@ modDistPlot = function(input, output, session,
theme(legend.position = input$selPlotBoxLegendPos,
axis.text.x = LOCrotatedAxisElementText(as.numeric(input$rBAxisLabelsRotate),
size = PLOTFONTAXISTEXT)) +
scale_fill_manual(name = in.labels$legend, values = loc.col)
scale_fill_manual(name = in.labels$legend,
values = loc.col)
return(p.out)
......
......@@ -169,11 +169,11 @@ clustHierUI <- function(id, label = "Hierarchical Clustering") {
withSpinner(plotOutput(ns('outPlotHier')))
),
tabPanel('Averages',
tabPanel('Cluster averages',
br(),
modTrajRibbonPlotUI(ns('modPlotHierTrajRibbon'))),
tabPanel('Time series',
tabPanel('Time series in clusters',
br(),
modTrajPlotUI(ns('modPlotHierTraj'))),
......@@ -343,8 +343,10 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
})
# returns table prepared with f-n getClCol
# for hierarchical clustering
# Returns a table prepared with f-n getClCol
# for hierarchical clustering.
# The table contains colours assigned to clusters.
# Colours are obtained from the dendrogram using dendextend::get_leaves_branches_col
getClColHier <- reactive({
cat(file = stderr(), 'getClColHier \n')
......@@ -352,15 +354,19 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
if (is.null(loc.dend))
return(NULL)
loc.dt = getClCol(loc.dend, returnNclust())
# obtain relations between cluster and colors from the dendrogram
loc.dt = LOCgetClCol(loc.dend, returnNclust())
# Display clusters specified in the inPlotHierClSel field
# Data is ordered according to the order of clusters specified in this field
if(input$chBPlotHierClSel) {
loc.dt = loc.dt[cl.no %in% input$inPlotHierClSel]
loc.dt[, cl.no := factor(cl.no, levels = input$inPlotHierClSel)]
setkey(loc.dt, cl.no)
# kepp only clusters specified in input$inPlotHierClSel
loc.dt = loc.dt[gr.no %in% input$inPlotHierClSel]
loc.dt[, gr.no := factor(gr.no, levels = input$inPlotHierClSel)]
}
# set the key to allow subsetting
setkey(loc.dt, gr.no)
return(loc.dt)
})
......@@ -465,6 +471,10 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
# get cell id's with associated cluster numbers
loc.dt.cl = getDataCl(loc.dend, returnNclust())
if (is.null(loc.dt.cl)) {
cat(file = stderr(), 'plotClDist: loc.dt.cl is NULL\n')
return(NULL)
}
# get cellIDs with condition name
loc.dt.gr = getDataCond()
......@@ -473,17 +483,19 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
return(NULL)
}
# add grouping to clusters+ids
loc.dt = merge(loc.dt.cl, loc.dt.gr, by = COLID)
loc.dt.aggr = loc.dt[, .(nCells = .N), by = .(group, cl)]
# count number of time series per group, per cluster
loc.dt.aggr = loc.dt[, .(xxx = .N), by = c(COLGR, COLCL)]
setnames(loc.dt.aggr, "xxx", COLNTRAJ)
# Display clusters specified in the inPlotHierClSel field
# Data is ordered according to the order of clusters specified in this field
if(input$chBPlotHierClSel) {
loc.dt.aggr = loc.dt.aggr[cl %in% input$inPlotHierClSel]
loc.dt.aggr[, cl := factor(cl, levels = input$inPlotHierClSel)]
setkey(loc.dt.aggr, cl)
loc.dt.aggr[, (COLCL) := factor(get(COLCL), levels = input$inPlotHierClSel)]
setkeyv(loc.dt.aggr, COLCL)
}
return(loc.dt.aggr)
......@@ -606,7 +618,7 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
callModule(modTrajPlot, 'modPlotHierTraj',
in.data = data4trajPlotCl,
in.data.stim = data4stimPlotCl,
in.facet = 'cl',
in.facet = COLCL,
in.facet.color = getClColHier,
in.fname = createFnameTrajPlot)
......@@ -614,21 +626,21 @@ clustHier <- function(input, output, session, in.dataWide, in.dataLong, in.dataS
callModule(modTrajRibbonPlot, 'modPlotHierTrajRibbon',
in.data = data4trajPlotCl,
in.data.stim = data4stimPlotCl,
in.facet = 'cl',
in.facet.color = getClColHier,
in.group = COLCL,
in.group.color = getClColHier,
in.fname = createFnameRibbonPlot)
# plot cluster PSD
callModule(modPSDPlot, 'modPlotHierPsd',
in.data = data4trajPlotCl,
in.facet = 'cl',
in.facet = COLCL,
in.facet.color = getClColHier,
in.fname = createFnamePsdPlot)
# plot distribution barplot
callModule(modClDistPlot, 'hierClDistPlot',
in.data = data4clDistPlot,
in.cols = getClColHier,
in.colors = getClColHier,
in.fname = createFnameDistPlot)
......
......@@ -344,8 +344,10 @@ clustHierSpar <- function(input, output, session,
return(dend)
})
# returns table prepared with f-n getClCol
# for sparse hierarchical clustering
# Returns a table prepared with f-n getClCol
# for hierarchical clustering.
# The table contains colours assigned to clusters.
# Colours are obtained from the dendrogram using dendextend::get_leaves_branches_col
getClColHierSpar <- reactive({
cat(file = stderr(), 'getClColHierSpar \n')
......@@ -353,10 +355,13 @@ clustHierSpar <- function(input, output, session,
if (is.null(loc.dend))
return(NULL)
loc.cut = getClCol(loc.dend, input$inPlotHierSparNclust)
# obtain relations between cluster and colors from the dendrogram
loc.dt = LOCgetClCol(loc.dend, input$inPlotHierSparNclust)
# set the key to allow subsetting
setkey(loc.dt, gr.no)
return(loc.cut)
return(loc.dt)
})
......@@ -413,7 +418,7 @@ clustHierSpar <- function(input, output, session,
## the following merge won't work...
## No idea how to solve it
loc.dt = merge(loc.dt, loc.dt.cl, by = 'id')
loc.dt = merge(loc.dt, loc.dt.cl, by = COLID)
# display only selected clusters
if(input$chBPlotHierSparClSel)
......@@ -513,7 +518,6 @@ clustHierSpar <- function(input, output, session,
# when changing the number of clusters to highlight
loc.k = returnNclust()
# create column labels according to importance weights
loc.colnames = paste0(ifelse(loc.hc$ws == 0, "",
ifelse(
......@@ -618,7 +622,7 @@ clustHierSpar <- function(input, output, session,
callModule(modTrajPlot, 'modPlotHierSparTraj',
in.data = data4trajPlotClSpar,
in.data.stim = data4stimPlotClSpar,
in.facet = 'cl',
in.facet = COLCL,
in.facet.color = getClColHierSpar,
in.fname = createFnameTrajPlot)
......@@ -626,21 +630,21 @@ clustHierSpar <- function(input, output, session,
callModule(modTrajRibbonPlot, 'modPlotHierSparTrajRibbon',
in.data = data4trajPlotClSpar,
in.data.stim = data4stimPlotClSpar,
in.facet = 'cl',
in.facet.color = getClColHierSpar,
in.group = COLCL,
in.group.color = getClColHierSpar,
in.fname = createFnameRibbonPlot)
# plot cluster PSD
callModule(modPSDPlot, 'modPlotHierSparPsd',
in.data = data4trajPlotClSpar,
in.facet = 'cl',
in.facet = COLCL,
in.facet.color = getClColHierSpar,
in.fname = createFnamePsdPlot)
# plot distribution barplot
callModule(modClDistPlot, 'hierClSparDistPlot',
in.data = data4clSparDistPlot,
in.cols = getClColHierSpar,
in.colors = getClColHierSpar,
in.fname = createFnameDistPlot)
......
......@@ -318,6 +318,8 @@ clustValid <- function(input, output, session, in.dataWide) {
if (sum(is.na(loc.dm)) > 0)
return(NULL)
# Tha tableau "Color Blind" palette has only 10 colours;
# change to "Tableau 20" if more clusters requested
loc.pal = ifelse(returnNclust() <= 10, "Color Blind", "Tableau 20")
loc.col = ggthemes::tableau_color_pal(loc.pal)(n = returnNclust())
......
......@@ -285,27 +285,17 @@ modTrajPlot = function(input, output, session,
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]])
# in.facet.color is typically used when plotting time series per clusters.
# The number of colours in the palette has to be equal to the number of groups.
# This might differ if the user selects manually groups (e.g. clusters) to display.
if (is.null(in.facet.color)) {
loc.facet.color = NULL
} else {
# get existing groups in dt;
loc.facets = unique(loc.dt[, ..in.facet])
# 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]
# subset group-color assignments with existing groups
loc.facet.color = in.facet.color()[loc.facets][["gr.col"]]
}
......@@ -326,7 +316,7 @@ modTrajPlot = function(input, output, session,
group.arg = COLID,
facet.arg = in.facet,
facet.ncol.arg = input$inPlotTrajFacetNcol,
facet.color.arg = loc.facet.col,
facet.color.arg = loc.facet.color,
dt.stim.arg = loc.dt.stim,
x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'),
......
......@@ -74,12 +74,30 @@ modTrajRibbonPlotUI = function(id, label = "Plot Individual Time Series") {
}
#' Module for plotting an aggregated ribbon plot of time series
#'
#' @param input
#' @param output
#' @param session
#' @param in.data Data.table with individual (non-aggregated) times series in long format
#' @param in.data.stim Optional long-format data.table for plotting stimulation segments
#' @param in.group String with the name of a grouping column
#' @param in.group.color Data.table with assignments of colours to groups in in.data.
#' Contains two columns:
#' gr.no - group id,
#' gr.col - colour assignments
#' @param in.fname File name for saving the plot
#'
#' @return
#' @export
#'
#' @examples
modTrajRibbonPlot = function(input, output, session,
in.data,
in.data.stim,
in.facet = 'group',
in.facet.color = NULL,
in.fname) {
in.data.stim = NULL,
in.group = 'group',
in.group.color = NULL,
in.fname = "trajAverages.pdf") {
ns <- session$ns
......@@ -192,7 +210,7 @@ modTrajRibbonPlot = function(input, output, session,
callModule(modTrackStats, 'dispTrackStats',
in.data = in.data,
in.bycols = in.facet)
in.bycols = in.group)
output$outPlotTraj <- renderPlot({
......@@ -222,12 +240,6 @@ modTrajRibbonPlot = function(input, output, session,
})
# Trajectory plot - download pdf
callModule(downPlot, "downPlotTraj",
in.fname = in.fname,
plotTraj, TRUE)
plotTraj <- function() {
cat(file = stderr(), 'plotTrajRibbon: in\n')
locBut = input$butPlotTraj
......@@ -249,7 +261,6 @@ modTrajRibbonPlot = function(input, output, session,
cat(file = stderr(), 'plotTrajRibbon: stim is NULL\n')
} else {
cat(file = stderr(), 'plotTrajRibbon: stim not NULL\n')
# choose only 1st group of stimulation pattern for ribbon plot
loc.groups = unique(loc.dt.stim[['group']])
......@@ -259,8 +270,6 @@ modTrajRibbonPlot = function(input, output, session,
}
}
# 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
......@@ -284,42 +293,34 @@ modTrajRibbonPlot = function(input, output, session,
else
locObjNum = FALSE
# in.group.color is typically used when plotting time series within clusters.
# The number of colours in the palette has to be equal to the number of groups.
# This might differ if the user selects manually groups (e.g. clusters) to display.
# Get existing groups in dt for subsetting externally provided group-color table
loc.groups = unique(loc.dt[, ..in.group])
# 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]
if (is.null(in.group.color)) {
# Assign ColorBlind palette from Tableau
loc.group.color = LOCreturnTableauPalette("Color Blind", nrow(loc.groups))
} else {
# Use externally provided translation between groups/clusters and colors
# Subset group-color assignments with existing groups
loc.group.color = in.group.color()[loc.groups][["gr.col"]]
}
# aggregate data; calculate Mean, CI or SE
loc.ribbon.lohi = NULL
if(input$rBPlotTrajStat == "Mean") {
# calculate the mean
loc.dt.aggr = loc.dt[, .(Mean = mean(get(COLY), na.rm = T)), by = c(in.facet, COLRT)]
loc.dt.aggr = loc.dt[, .(Mean = mean(get(COLY), na.rm = T)), by = c(in.group, COLRT)]
} else if(input$rBPlotTrajStat == "CI") {
# calculate the mean and the confidence intervals
loc.dt.aggr = LOCcalcTrajCI(in.dt = loc.dt,
in.col.meas = COLY,
in.col.by = c(in.facet, COLRT),
in.col.by = c(in.group, COLRT),
in.type = 'normal')
loc.ribbon.lohi = c('Lower', 'Upper')
......@@ -329,7 +330,7 @@ modTrajRibbonPlot = function(input, output, session,
loc.dt.aggr = loc.dt[, .(Mean = mean(get(COLY), na.rm = T),
Lower = mean(get(COLY), na.rm = T) - LOCstderr(get(COLY), na.rm = T),
Upper = mean(get(COLY), na.rm = T) + LOCstderr(get(COLY), na.rm = T)),
by = c(in.facet, COLRT)]
by = c(in.group, COLRT)]
loc.ribbon.lohi = c('Lower', 'Upper')
}
......@@ -337,7 +338,7 @@ modTrajRibbonPlot = function(input, output, session,
# set the grouing column to a factor (for plotting)
loc.dt.aggr[, (in.facet) := as.factor(get(in.facet))]
loc.dt.aggr[, (in.group) := as.factor(get(in.group))]
# setting bounds for displaying of x and y axes
loc.xlim.arg = NULL
......@@ -350,19 +351,11 @@ modTrajRibbonPlot = function(input, output, session,
loc.ylim.arg = c(input$inSetYboundsLow, input$inSetYboundsHigh)
}
# If more than max.col groups, cycle through the palette ("Color Blind" can return 10 colors at maximum)
loc.pal = "Color Blind"
max.col = attr(ggthemes::tableau_color_pal(loc.pal), "max_n")
loc.col = ggthemes::tableau_color_pal(loc.pal)(n = max.col)
ngroups = uniqueN(loc.dt.aggr[, ..in.facet]) - 1
loc.col = rep(loc.col, (ngroups %/% max.col) + 1)
loc.col = loc.col[1:(ngroups+1)]
p.out = LOCplotTrajRibbon(dt.arg = loc.dt.aggr,
x.arg = COLRT,
y.arg = 'Mean',
col.arg = loc.facet.col,
group.arg = in.facet,
col.arg = loc.group.color,
group.arg = in.group,
dt.stim.arg = loc.dt.stim,
x.stim.arg = c('tstart', 'tend'),
y.stim.arg = c('ystart', 'yend'),
......@@ -376,9 +369,14 @@ modTrajRibbonPlot = function(input, output, session,
in.font.axis.title = PLOTFONTAXISTITLE,
in.font.strip = PLOTFONTFACETSTRIP,
in.font.legend = PLOTFONTLEGEND) +
theme(legend.position = input$rBlegendPos) +
scale_colour_manual(values = loc.col)
theme(legend.position = input$rBlegendPos)
return(p.out)
}
# Trajectory plot - download pdf
callModule(downPlot, "downPlotTraj",
in.fname = in.fname,
plotTraj, TRUE)
}
\ No newline at end of file
......@@ -971,6 +971,8 @@ shinyServer(function(input, output, session) {
callModule(modTrajRibbonPlot, 'modTrajRibbon',
in.data = dataLongNoOut,
in.data.stim = dataStim,
in.group = COLGR,
in.group.color = NULL,
in.fname = function() return(FPDFTCMEAN))
# Trajectory plotting - individual
......@@ -988,13 +990,19 @@ shinyServer(function(input, output, session) {
# Tabs ----
###### AUC calculation and plotting
callModule(tabAUCplot, 'tabAUC', dataLongNoOut, in.fname = function() return(FPDFBOXAUC))
callModule(tabAUCplot, 'tabAUC',
dataLongNoOut,
in.fname = function() return(FPDFBOXAUC))
###### Box-plot
callModule(tabDistPlot, 'tabDistPlot', dataLongNoOut, in.fname = function() return(FPDFBOXTP))
callModule(tabDistPlot, 'tabDistPlot',
dataLongNoOut,
in.fname = function() return(FPDFBOXTP))
###### Scatter plot
callModule(tabScatterPlot, 'tabScatter', dataLongNoOut, in.fname = function() return(FPDFSCATTER))
callModule(tabScatterPlot, 'tabScatter',
dataLongNoOut,
in.fname = function() return(FPDFSCATTER))
##### Hierarchical validation
callModule(clustValid, 'tabClValid', dataWide)
......
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