Commit 082b907a authored by dmattek's avatar dmattek

Bug fixes

parent c167348d
......@@ -7,10 +7,11 @@ 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/aucPlot.R')
source('modules/distPlot.R')
source('modules/clDistPlot.R')
source('modules/tabScatter.R')
source('modules/tabBoxPlot.R')
source('modules/tabDist.R')
source('modules/tabAUC.R')
source('modules/tabClHier.R')
source('modules/tabClHierSpar.R')
\ No newline at end of file
This diff is collapsed.
......@@ -129,16 +129,16 @@ l.col.pal.dend.2 = list(
# Clustering algorithms ----
s.cl.linkage = c("average",
"complete",
s.cl.linkage = c("complete",
"average",
"single",
"centroid",
"ward.D",
"ward.D2",
"mcquitty")
s.cl.spar.linkage = c("average",
"complete",
s.cl.spar.linkage = c("complete",
"average",
"single",
"centroid")
......@@ -191,10 +191,9 @@ help.text.short = c(
'Normalise with respect to this time span.', #12
'Calculate fold-change and z-score using the median and Median Absolute Deviation, instead of the mean and sd.', #13
'Normalise to mean/median of selected time calculated globally, per group, or for individual time series.', #14
'Instead of the value at a selected time point, y-axis can display a difference between values at time points on y- and x-axis.',#15
'Instead of the value at a selected time point, y-axis can display a difference between values at two selected time points.', #15
'Add a line with linear regression and regions of 95% confidence interval.', #16
'A number of time points left & right of selected time points; use the mean/min/max of values from these time points for the scatterplot.', #17
'Operations to perform on values at time points selected in the field above.' #18
'A number of time points left & right of selected time points; use the mean of values from these time points for the scatterplot.' #17
)
# Functions for data processing ----
......@@ -809,7 +808,7 @@ LOCggplotScat = function(dt.arg,
trend.arg = T,
ci.arg = 0.95) {
p.tmp = ggplot(dt.arg, aes(x = x, y = y)) +
p.tmp = ggplot(dt.arg, aes(x = x, y = y, label = id)) +
geom_point(alpha = alpha.arg)
if (trend.arg) {
......
......@@ -65,7 +65,7 @@ modClDistPlot = function(input, output, session, in.data, in.cols = NULL, in.fna
p.out = p.out +
scale_y_continuous(labels = percent) +
ylab("Percentage of time-series\n") +
ylab("Percentage of time series\n") +
xlab("Groups") +
LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT,
......
#
# Time Course Inspector: Shiny app for plotting time series data
# Author: Maciej Dobrzynski
#
# This module is for plotting distrubutions at selected time points as a choice of box/violin/dot-plots
# Assumes in.data contains columns:
# realtime
# y
# group
# id
# UI ----
modDistPlotUI = function(id, label = "Plot distributions") {
ns <- NS(id)
tagList(
fluidRow(
column(
4,
checkboxInput(ns("chBplotTypeBox"), "Box-plot", value = T),
checkboxInput(ns("chBplotTypeDot"), "Dot-plot", value = F),
checkboxInput(ns("chBplotTypeViol"), "Violin-plot", value = F),
checkboxInput(ns("chBplotTypeLine"), "Line-plot", value = F),
checkboxInput(ns('chBplotInt'), 'Interactive Plot'),
actionButton(ns('butPlot'), 'Plot!')
),
column(
4,
uiOutput(ns('uiPlotBoxNotches')),
uiOutput(ns('uiPlotBoxOutliers')),
uiOutput(ns('uiPlotBoxDodge')),
uiOutput(ns('uiPlotBoxAlpha')),
uiOutput(ns('uiPlotDotNbins')),
uiOutput(ns('uiPlotDotAlpha')),
uiOutput(ns('uiPlotViolAlpha')),
uiOutput(ns('uiPlotLineAlpha'))
),
column(
4,
selectInput(
ns('selPlotBoxLegendPos'),
label = 'Legend position',
choices = list(
"Top" = 'top',
"Right" = 'right',
"Bottom" = 'bottom'
),
width = "120px",
selected = 'top'
),
radioButtons(ns("rBAxisLabelsRotate"), "X-axis labels",
c("horizontal" = 0,
"45 deg" = 45,
"90 deg" = 90)),
numericInput(
ns('inPlotBoxWidth'),
'Width [%]',
value = PLOTWIDTH,
min = 10,
width = '100px',
step = 10
),
numericInput(
ns('inPlotBoxHeight'),
'Height [px]',
value = PLOTBOXHEIGHT,
min = 100,
width = '100px',
step = 50
)
)
),
uiOutput(ns('uiPlotBox')),
downPlotUI(ns('downPlotBox'), "Download PDF")
)
}
# SERVER ----
modDistPlot = function(input, output, session,
in.data, # input data table in long format
in.cols = list(meas.x = COLRT, # column names
meas.y = COLY,
group = COLGR,
id = COLID),
in.labels = list(x = "", # plot labels
y = "",
legend = ""),
in.fname) { # file name for saving the plot
ns <- session$ns
output$uiPlotBoxNotches = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotBoxNotches\n')
ns <- session$ns
if(input$chBplotTypeBox)
checkboxInput(ns('chBplotBoxNotches'), 'Notches in box-plot ', FALSE)
})
output$uiPlotBoxOutliers = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotBoxOutliers\n')
ns <- session$ns
if(input$chBplotTypeBox)
checkboxInput(ns('chBplotBoxOutliers'), 'Outliers in box-plot', FALSE)
})
output$uiPlotBoxDodge = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotBoxDodge\n')
ns <- session$ns
# Adjust spacing between box-, violin-, dot-plots.
# Valid only when plotting multiple groups at a time point.
# For line plot, each group is drawn separately per facet, thus no need for dodging..
if(!input$chBplotTypeLine)
sliderInput(ns('slPlotBoxDodge'), 'Space between groups', min = 0, max = 1, value = .4, step = 0.05)
})
output$uiPlotBoxAlpha = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotBoxAlpha\n')
ns <- session$ns
if(input$chBplotTypeBox)
sliderInput(ns('slPlotBoxAlpha'), 'Box-plot transparency', min = 0, max = 1, value = 1, step = 0.1)
})
output$uiPlotViolAlpha = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotViolAlpha\n')
ns <- session$ns
if(input$chBplotTypeViol)
sliderInput(ns('slPlotViolAlpha'), 'Violin-plot transparency', min = 0, max = 1, value = 1, step = 0.1)
})
output$uiPlotDotAlpha = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotDotAlpha\n')
ns <- session$ns
if(input$chBplotTypeDot)
sliderInput(ns('slPlotDotAlpha'), 'Dot-plot transparency', min = 0, max = 1, value = 1, step = 0.1)
})
output$uiPlotLineAlpha = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotLineAlpha\n')
ns <- session$ns
if(input$chBplotTypeLine)
sliderInput(ns('slPlotLineAlpha'), 'Line-plot transparency', min = 0, max = 1, value = 1, step = 0.1)
})
output$uiPlotDotNbins = renderUI({
cat(file = stderr(), 'boxPlot:uiPlotDotNbins\n')
ns <- session$ns
if(input$chBplotTypeDot)
sliderInput(ns('slPlotDotNbins'), 'Number of bins in dot-plot', min = 2, max = 50, value = 30, step = 1)
})
# Boxplot - display
output$outPlotBox = renderPlot({
locBut = input$butPlot
if (locBut == 0) {
cat(file = stderr(), 'boxPlot:Go button not pressed\n')
return(NULL)
}
plotBox()
})
output$outPlotBoxInt = renderPlotly({
locBut = input$butPlot
if (locBut == 0) {
cat(file = stderr(), 'boxPlot:Go button not pressed\n')
return(NULL)
}
# 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)
return( ggplotly(plotBox()) %>% layout(boxmode = 'group', width = '100%', height = '100%'))
})
output$uiPlotBox <- renderUI({
ns <- session$ns
if (input$chBplotInt)
plotlyOutput(ns("outPlotBoxInt"),
width = paste0(input$inPlotBoxWidth, '%'),
height = paste0(input$inPlotBoxHeight, 'px'))
else
plotOutput(ns('outPlotBox'),
width = paste0(input$inPlotBoxWidth, '%'),
height = paste0(input$inPlotBoxHeight, 'px'))
})
# Boxplot - download pdf
callModule(downPlot, "downPlotBox", in.fname, plotBox, TRUE)
# Function instead of reactive as per:
# http://stackoverflow.com/questions/26764481/downloading-png-from-shiny-r
# This function is used to plot and to downoad a pdf
plotBox <- function() {
cat(file = stderr(), 'plotBox\n')
loc.dt = in.data()
cat(file = stderr(), "plotBox: on to plot\n\n")
if (is.null(loc.dt)) {
cat(file = stderr(), 'plotBox: dt is NULL\n')
return(NULL)
}
cat(file = stderr(), 'plotBox:dt not NULL\n')
if(!input$chBplotTypeLine) {
# Dodging series only for box-, dot-, and violin-plots
loc.par.dodge <- position_dodge(width = input$slPlotBoxDodge)
# Color fill for all oplots except line, in which groups are plotted per facet
p.out = ggplot(loc.dt, aes_string(x = sprintf("factor(%s)", in.cols$meas.x),
y = in.cols$meas.y,
fill = in.cols$group))
}
else {
loc.par.dodge = position_dodge(width = 1)
p.out = ggplot(loc.dt, aes_string(x = sprintf("factor(%s)", in.cols$meas.x),
y = in.cols$meas.y))
}
if(input$chBplotTypeDot)
p.out = p.out + geom_dotplot(color = NA,
binaxis = "y",
stackdir = "center",
position = loc.par.dodge,
binwidth = abs(max(loc.dt[[ in.cols$meas.y ]],
na.rm = T) -
min(loc.dt[[ in.cols$meas.y ]],
na.rm = T)) / (input$slPlotDotNbins - 1),
method = 'histodot',
alpha = input$slPlotDotAlpha)
if(input$chBplotTypeViol)
p.out = p.out +
geom_violin(position = loc.par.dodge,
width = 0.2,
alpha = input$slPlotViolAlpha)
if(input$chBplotTypeLine)
p.out = p.out +
geom_path(aes_string(group = in.cols$id),
alpha = input$slPlotLineAlpha) +
facet_wrap(as.formula(paste("~", in.cols$group)))
if (input$chBplotTypeBox)
p.out = p.out + geom_boxplot(
position = loc.par.dodge,
notch = input$chBplotBoxNotches,
alpha = input$slPlotBoxAlpha,
outlier.colour = if (input$chBplotBoxOutliers)
'red'
else
NA
)
p.out = p.out +
scale_fill_discrete(name = in.labels$legend) +
xlab(in.labels$x) +
ylab(in.labels$y) +
LOCggplotTheme(in.font.base = PLOTFONTBASE,
in.font.axis.text = PLOTFONTAXISTEXT,
in.font.axis.title = PLOTFONTAXISTITLE,
in.font.strip = PLOTFONTFACETSTRIP,
in.font.legend = PLOTFONTLEGEND) +
theme(legend.position = input$selPlotBoxLegendPos,
axis.text.x = LOCrotatedAxisElementText(as.numeric(input$rBAxisLabelsRotate),
size = PLOTFONTAXISTEXT))
return(p.out)
}
}
\ No newline at end of file
......@@ -7,25 +7,26 @@
# Calculates area under curve (AUC) for every single time course provided in the input
# UI ----
modAUCplotUI = function(id, label = "Plot Area Under Curves") {
tabAUCplotUI = function(id, label = "Plot Area Under Curves") {
ns <- NS(id)
tagList(
h4(
"Calculate area under curve and plot per group"
"Area under curve (AUC)"
),
actionLink(ns("alAUC"), "Learn more"),
br(),
uiOutput(ns('uiSlTimeTrim')),
modStatsUI(ns('dispStats')),
br(),
modBoxPlotUI(ns('boxPlot')
modAUCplotUI(ns('aucPlot')
)
)
}
# SERVER ----
modAUCplot = function(input, output, session, in.data, in.fname) {
tabAUCplot = function(input, output, session, in.data, in.fname) {
ns <- session$ns
......@@ -83,14 +84,20 @@ modAUCplot = function(input, output, session, in.data, in.fname) {
in.bycols = COLGR,
in.fname = 'data4boxplotAUC.csv')
callModule(modBoxPlot, 'boxPlot',
callModule(modAUCplot, 'aucPlot',
in.data = AUCcells,
in.cols = list(meas.x = COLGR,
meas.y = 'AUC',
group = COLGR,
id = COLID),
in.labels = list(x = "Groups", y = "", legend = ""),
in.fname = in.fname)
addPopover(session,
id = ns("alAUC"),
title = "AUC",
content = "Calculate area under curve (AUC) for every time series using trapezoidal rule",
trigger = "click")
}
......
......@@ -149,9 +149,9 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
)
),
downPlotUI(ns('downPlotHier'), "Download PNG"),
actionButton(ns('butPlotHierHeatMap'), 'Plot!'),
withSpinner(plotOutput(ns('outPlotHier')))
withSpinner(plotOutput(ns('outPlotHier'))),
downPlotUI(ns('downPlotHier'), "Download PNG")
),
tabPanel('Averages',
......
......@@ -156,17 +156,13 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") {
),
br(),
p('Note: columns in the heatmap labeled according to their \"importance\":'),
tags$ol(
tags$li("Black - not taken into account"),
tags$li("Blue with \"*\" - low importance (weight factor in (0, 0.1]"),
tags$li("Green with \"**\" - medium importance (weight factor in (0.1, 0.5]"),
tags$li("Red with \"***\" - high importance (weight factor in (0.5, 1.0]")),
downPlotUI(ns('downPlotHierSparHM'), "Download PNG"),
actionButton(ns('butPlotHierSparHeatMap'), 'Plot!'),
br(),
"Columns in the heatmap labeled according to their ",
actionLink(ns("alImportance"), "importance"),
withSpinner(plotOutput(ns('outPlotHierSpar')))
),
tabPanel('Averages',
......@@ -179,7 +175,7 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") {
tabPanel('PSD',
br(),
modPSDPlotUI(ns('modPlotHierPsd'))),
modPSDPlotUI(ns('modPlotHierSparPsd'))),
tabPanel('Cluster distribution',
br(),
......@@ -189,7 +185,12 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") {
}
# SERVER ----
clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlot, in.data4stimPlot) {
clustHierSpar <- function(input, output, session,
in.data4clust,
in.data4trajPlot,
in.data4stimPlot) {
ns = session$ns
# UI for advanced options
output$uiPlotHierSparNperms = renderUI({
......@@ -384,7 +385,9 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
#cat('rownames: ', rownames(in.data4clust()), '\n')
# get cellIDs with cluster assignments based on dendrogram cut
loc.dt.cl = getDataClSpar(userFitDendHierSpar(), input$inPlotHierSparNclust, getDataTrackObjLabUni_afterTrim())
loc.dt.cl = getDataClSpar(userFitDendHierSpar(),
input$inPlotHierSparNclust,
getDataTrackObjLabUni_afterTrim())
####
## PROBLEM!!!
......@@ -426,7 +429,10 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
},
content = function(file) {
write.csv(x = getDataClSpar(userFitDendHierSpar(), input$inPlotHierSparNclust, getDataTrackObjLabUni_afterTrim()), file = file, row.names = FALSE)
write.csv(x = getDataClSpar(userFitDendHierSpar(),
input$inPlotHierSparNclust,
getDataTrackObjLabUni_afterTrim()),
file = file, row.names = FALSE)
}
)
......@@ -617,5 +623,22 @@ clustHierSpar <- function(input, output, session, in.data4clust, in.data4trajPlo
plotHierSpar()
}, height = getPlotHierSparHeatMapHeight)
}
\ No newline at end of file
addPopover(session,
ns("alImportance"),
title = "Variable importance",
content = paste0("<p>Weight factors (WF) calculated during clustering ",
"reflect the importance of time points in the clustering. ",
"The following labels are used to indicate the importance:",
"<li>Black - time point not taken into account</li>",
"<li><p, style=\"color:DodgerBlue;\">* - low, WF∈(0, 0.1]</p></li>",
"<li><p, style=\"color:MediumSeaGreen;\">** - medium, WF∈(0.1, 0.5]</p></li>",
"<li><p, style=\"color:Tomato;\">*** - high, WF∈(0.5, 1.0]</p></li>",
"</p><p>Witten and Tibshirani (2010): ",
"<i>A framework for feature selection in clustering</i>; ",
"Journal of the American Statistical Association 105(490): 713-726.</p>"),
trigger = "click")
}
......@@ -6,7 +6,7 @@
#
# UI ----
tabBoxPlotUI = function(id, label = "Snapshots at time points") {
tabDistPlotUI = function(id, label = "Snapshots at time points") {
ns <- NS(id)
tagList(
......@@ -26,12 +26,12 @@ tabBoxPlotUI = function(id, label = "Snapshots at time points") {
modStatsUI(ns('dispStats')),
br(),
modBoxPlotUI(ns('boxPlot'))
modDistPlotUI(ns('distPlot'))
)
}
# SERVER ----
tabBoxPlot = function(input, output, session, in.data, in.fname) {
tabDistPlot = function(input, output, session, in.data, in.fname) {
callModule(modStats, 'dispStats',
in.data = data4boxPlot,
......@@ -39,12 +39,13 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) {
in.bycols = c(COLRT, COLGR),
in.fname = 'data4boxplotTP.csv')
callModule(modBoxPlot, 'boxPlot',
callModule(modDistPlot, 'distPlot',
in.data = data4boxPlot,
in.cols = list(meas.x = COLRT,
meas.y = COLY,
group = COLGR,
id = 'id'),
id = COLID),
in.labels = list(x = "Time points", y = "", legend = "Groups:"),
in.fname = in.fname)
# return all unique time points (real time)
......@@ -108,7 +109,7 @@ tabBoxPlot = function(input, output, session, in.data, in.fname) {
if (!is.null(loc.v)) {
selectInput(
ns('inSelTpts'),
'Select one or more t-points:',
'Select one or more time points:',
loc.v,
width = '100%',
selected = loc.v[[1]],
......
......@@ -22,6 +22,7 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
h4(
"Scatter plot between two time points"
),
actionLink(ns("alScatter"), "Learn more"),
br(),
fluidRow(
......@@ -29,33 +30,37 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
4,
uiOutput(ns('uiSelTptX')),
uiOutput(ns('uiSelTptY')),
checkboxInput(ns('chBfoldChange'), 'Difference between two time points on Y-axis'),
bsTooltip(ns('chBfoldChange'), help.text.short[15], placement = "right", trigger = "hover", options = NULL),
bsAlert("alert2differentTpts"),
radioButtons(ns('rBfoldChange'), 'Y-axis',
choices = c("Y" = "y", "Y-X" = "diff"),
width = "100px", inline = T),
bsTooltip(ns('rBfoldChange'), help.text.short[15], placement = "right", trigger = "hover", options = NULL),
checkboxInput(ns('chBregression'), 'Linear regression with 95% CI'),
bsTooltip(ns('chBregression'), help.text.short[16], placement = "right", trigger = "hover", options = NULL)
),
column(
4,
numericInput(ns('inNeighTpts'), 'Time points left & right:', value = 0, step = 1, min = 0),
bsTooltip(ns('inNeighTpts'), help.text.short[17], placement = "right", trigger = "hover", options = NULL),
radioButtons(ns('rBstats'), 'Operation:', list('Mean' = 1, 'Min' = 2, 'Max' = 3)),
bsTooltip(ns('inNeighTpts'), help.text.short[18], placement = "right", trigger = "hover", options = NULL)
numericInput(ns('inNeighTpts'), 'Smoothing', value = 0, step = 1, min = 0, width = "150px"),
bsTooltip(ns('inNeighTpts'), help.text.short[17], placement = "right", trigger = "hover", options = NULL)
),
column(
4,
numericInput(
ns('inPlotHeight'),
'Display plot height [px]',
'Height [px]',
value = PLOTSCATTERHEIGHT,
min = 100,
step = 100
step = 100,
width = "100px"
),
numericInput(
ns('inPlotNcolFacet'),
'#Columns',
'#columns',
value = PLOTNFACETDEFAULT,
min = 1,
step = 1
step = 1,
width = "100px"
)
)
),
......@@ -73,6 +78,8 @@ tabScatterPlotUI <- function(id, label = "Comparing t-points") {
# SERVER ----
tabScatterPlot <- function(input, output, session, in.data, in.fname) {
ns <- session$ns
# return all unique time points (real time)
# This will be used to display in UI for box-plot
# These timepoints are from the original dt and aren't affected by trimming of x-axis
......@@ -95,9 +102,9 @@ output$uiSelTptX = renderUI({
if (!is.null(loc.v)) {
selectInput(
ns('inSelTptX'),
'Time point for X-axis:',
'Time point for X-axis',
loc.v,
width = '100%',
width = '200px',
selected = 0,
multiple = FALSE
)
......@@ -113,10 +120,10 @@ output$uiSelTptY = renderUI({
if (!is.null(loc.v)) {
selectInput(
ns('inSelTptY'),
'Time point for Y-axis:',
'Time point for Y-axis',
loc.v,
width = '100%',
selected = 0,
width = '200px',
selected = 1,
multiple = FALSE
)
}
......@@ -129,47 +136,62 @@ data4scatterPlot <- reactive({
if(is.null(loc.dt.in))
return(NULL)
loc.tpts.x = input$inSelTptX
loc.tpts.y = input$inSelTptY
# obtain selected time points from UI
loc.tpts.x = as.integer(input$inSelTptX)
loc.tpts.y = as.integer(input$inSelTptY)
# if neigbbouring points selected
if (loc.tpts.x == loc.tpts.y) {
createAlert(session, "alert2differentTpts", "exampleAlert", title = "",
content = "Select two different time points.", append = FALSE)
return(NULL)
} else {
closeAlert(session, "exampleAlert")
}
# if neigbbouring points selected, obtain time points for which the aggregation will be calculated
if (input$inNeighTpts > 0) {
# get all time points in the dataset
loc.dt.in.tpts = unique(loc.dt.in[[COLRT]])
# get indices of time points around selected time points
loc.tpts.x.id = seq(which(loc.dt.in.tpts == loc.tpts.x) - input$inNeighTpts, which(loc.dt.in.tpts == loc.tpts.x) + input$inNeighTpts, 1)
loc.tpts.y.id = seq(which(loc.dt.in.tpts == loc.tpts.y) - input$inNeighTpts, which(loc.dt.in.tpts == loc.tpts.y) + input$inNeighTpts, 1)
# get only indices of time points that are greater than 0
loc.tpts.x.id = loc.tpts.x.id[loc.tpts.x.id > 0]
loc.tpts.y.id = loc.tpts.y.id[loc.tpts.y.id > 0]
# update time points used for aggregation
loc.tpts.x = loc.dt.in.tpts[loc.tpts.x.id]
loc.tpts.y = loc.dt.in.tpts[loc.tpts.y.id]
# aggregate separately each time point sets
loc.dt.x = loc.dt.in[get(COLRT) %in% loc.tpts.x, .(y.aggr = mean(get(COLY))), by = c(COLGR, COLID)]
loc.dt.y = loc.dt.in[get(COLRT) %in% loc.tpts.y, .(y.aggr = mean(get(COLY))), by = c(COLGR, COLID)]