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

Commit 5dde0200 authored by dmattek's avatar dmattek
Browse files

Added: read wide format. Mod: track ID as factor

parent fbdd2ba7
......@@ -59,7 +59,7 @@ shinyServer(function(input, output, session) {
# Generate random dataset
dataGen1 <- eventReactive(input$inDataGen1, {
if (DEB)
cat("dataGen1\n")
cat("server:dataGen1\n")
return(LOCgenTraj(in.nwells = 3, in.addout = 3))
})
......@@ -67,7 +67,7 @@ shinyServer(function(input, output, session) {
# Load main data file
dataLoadNuc <- eventReactive(input$inButLoadNuc, {
if (DEB)
cat("dataLoadNuc\n")
cat("server:dataLoadNuc\n")
locFilePath = input$inFileLoadNuc$datapath
......@@ -76,7 +76,7 @@ shinyServer(function(input, output, session) {
if (is.null(locFilePath) || locFilePath == '')
return(NULL)
else {
return(fread(locFilePath))
return(fread(locFilePath, strip.white = T))
}
})
......@@ -88,7 +88,7 @@ shinyServer(function(input, output, session) {
# Load data with trajectories to remove
dataLoadTrajRem <- eventReactive(input$inButLoadTrajRem, {
if (DEB)
cat(file = stdout(), "dataLoadTrajRem\n")
cat(file = stdout(), "server:dataLoadTrajRem\n")
locFilePath = input$inFileLoadTrajRem$datapath
......@@ -104,7 +104,7 @@ shinyServer(function(input, output, session) {
# Load data with stimulation pattern
dataLoadStim <- eventReactive(input$inButLoadStim, {
if (DEB)
cat(file = stdout(), "dataLoadStim\n")
cat(file = stdout(), "server:dataLoadStim\n")
locFilePath = input$inFileLoadStim$datapath
......@@ -121,7 +121,7 @@ shinyServer(function(input, output, session) {
# UI for loading csv with cell IDs for trajectory removal
output$uiFileLoadTrajRem = renderUI({
if (DEB)
cat(file = stdout(), 'UI uiFileLoadTrajRem\n')
cat(file = stdout(), 'server:uiFileLoadTrajRem\n')
if(input$chBtrajRem)
fileInput(
......@@ -133,7 +133,7 @@ shinyServer(function(input, output, session) {
output$uiButLoadTrajRem = renderUI({
if (DEB)
cat(file = stdout(), 'UI uiButLoadTrajRem\n')
cat(file = stdout(), 'server:uiButLoadTrajRem\n')
if(input$chBtrajRem)
actionButton("inButLoadTrajRem", "Load Data")
......@@ -142,7 +142,7 @@ shinyServer(function(input, output, session) {
# UI for loading csv with stimulation pattern
output$uiFileLoadStim = renderUI({
if (DEB)
cat(file = stdout(), 'UI uiFileLoadStim\n')
cat(file = stdout(), 'server:uiFileLoadStim\n')
if(input$chBstim)
fileInput(
......@@ -154,7 +154,7 @@ shinyServer(function(input, output, session) {
output$uiButLoadStim = renderUI({
if (DEB)
cat(file = stdout(), 'UI uiButLoadStim\n')
cat(file = stdout(), 'server:uiButLoadStim\n')
if(input$chBstim)
actionButton("inButLoadStim", "Load Data")
......@@ -165,7 +165,7 @@ shinyServer(function(input, output, session) {
# UI-side-panel-column-selection ----
output$varSelTrackLabel = renderUI({
if (DEB)
cat(file = stdout(), 'UI varSelTrackLabel\n')
cat(file = stdout(), 'server:varSelTrackLabel\n')
locCols = getDataNucCols()
locColSel = locCols[grep('(T|t)rack|ID|id', locCols)[1]] # index 1 at the end in case more matches; select 1st; matches TrackLabel, tracklabel, Track Label etc
......@@ -181,7 +181,7 @@ shinyServer(function(input, output, session) {
output$varSelTime = renderUI({
if (DEB)
cat(file = stdout(), 'UI varSelTime\n')
cat(file = stdout(), 'server:varSelTime\n')
locCols = getDataNucCols()
locColSel = locCols[grep('(T|t)ime|Metadata_T', locCols)[1]] # index 1 at the end in case more matches; select 1st; matches RealTime, realtime, real time, etc.
......@@ -197,7 +197,7 @@ shinyServer(function(input, output, session) {
output$varSelTimeFreq = renderUI({
if (DEB)
cat(file = stdout(), 'UI varSelTimeFreq\n')
cat(file = stdout(), 'server:varSelTimeFreq\n')
if (input$chBtrajInter) {
numericInput(
......@@ -217,7 +217,7 @@ shinyServer(function(input, output, session) {
# e.g.2 a combination of 3 columns called Stimulation_...
output$varSelGroup = renderUI({
if (DEB)
cat(file = stdout(), 'UI varSelGroup\n')
cat(file = stdout(), 'server:varSelGroup\n')
if (input$chBgroup) {
......@@ -243,7 +243,7 @@ shinyServer(function(input, output, session) {
# the track ID unique across entire dataset
output$varSelSite = renderUI({
if (DEB)
cat(file = stdout(), 'UI varSelSite\n')
cat(file = stdout(), 'server:varSelSite\n')
if (input$chBtrackUni) {
locCols = getDataNucCols()
......@@ -263,7 +263,7 @@ shinyServer(function(input, output, session) {
output$varSelMeas1 = renderUI({
if (DEB)
cat(file = stdout(), 'UI varSelMeas1\n')
cat(file = stdout(), 'server:varSelMeas1\n')
locCols = getDataNucCols()
if (!is.null(locCols)) {
......@@ -282,7 +282,7 @@ shinyServer(function(input, output, session) {
output$varSelMeas2 = renderUI({
if (DEB)
cat(file = stdout(), 'UI varSelMeas2\n')
cat(file = stdout(), 'server:varSelMeas2\n')
locCols = getDataNucCols()
......@@ -303,7 +303,7 @@ shinyServer(function(input, output, session) {
# UI-side-panel-trim x-axis (time) ----
output$uiSlTimeTrim = renderUI({
if (DEB)
cat(file = stdout(), 'UI uiSlTimeTrim\n')
cat(file = stdout(), 'server:uiSlTimeTrim\n')
if (input$chBtimeTrim) {
locTpts = getDataTpts()
......@@ -329,7 +329,7 @@ shinyServer(function(input, output, session) {
# UI-side-panel-normalization ----
output$uiChBnorm = renderUI({
if (DEB)
cat(file = stdout(), 'UI uiChBnorm\n')
cat(file = stdout(), 'server:uiChBnorm\n')
if (input$chBnorm) {
radioButtons(
......@@ -342,7 +342,7 @@ shinyServer(function(input, output, session) {
output$uiSlNorm = renderUI({
if (DEB)
cat(file = stdout(), 'UI uiSlNorm\n')
cat(file = stdout(), 'server:uiSlNorm\n')
if (input$chBnorm) {
locTpts = getDataTpts()
......@@ -366,7 +366,7 @@ shinyServer(function(input, output, session) {
output$uiChBnormRobust = renderUI({
if (DEB)
cat(file = stdout(), 'UI uiChBnormRobust\n')
cat(file = stdout(), 'server:uiChBnormRobust\n')
if (input$chBnorm) {
checkboxInput('chBnormRobust',
......@@ -377,7 +377,7 @@ shinyServer(function(input, output, session) {
output$uiChBnormGroup = renderUI({
if (DEB)
cat(file = stdout(), 'UI uiChBnormGroup\n')
cat(file = stdout(), 'server:uiChBnormGroup\n')
if (input$chBnorm) {
radioButtons('chBnormGroup',
......@@ -403,13 +403,13 @@ shinyServer(function(input, output, session) {
locInLoadNuc = input$inButLoadNuc
#locInLoadStim = input$inButLoadStim
# Don't wrap around if(DEB)
# Don't wrap around if(DEB) !!!
cat(
"dataInBoth\ninGen1: ",
"server:dataInBoth\n inGen1: ",
locInGen1,
" prev=",
" prev=",
isolate(counter$dataGen1),
"\ninDataNuc: ",
"\n inDataNuc: ",
locInLoadNuc,
" prev=",
isolate(counter$dataLoadNuc),
......@@ -420,20 +420,33 @@ shinyServer(function(input, output, session) {
"\n"
)
# isolate the checks of counter reactiveValues
# isolate the checks of the counter reactiveValues
# as we set the values in this same reactive
if (locInGen1 != isolate(counter$dataGen1)) {
cat("dataInBoth if inDataGen1\n")
cat("server:dataInBoth if inDataGen1\n")
dm = dataGen1()
# no need to isolate updating the counter reactive values!
counter$dataGen1 <- locInGen1
} else if (locInLoadNuc != isolate(counter$dataLoadNuc)) {
cat("dataInBoth if inDataLoadNuc\n")
cat("server:dataInBoth if inDataLoadNuc\n")
dm = dataLoadNuc()
# convert to long format if radio box set to "wide"
# the input data in long format should contain:
# - the first row with a header: ID, 1, 2, 3...
# - consecutive rows with time series, where columns are time points
if (input$inRbutLongWide == 1) {
# long to wide
dm = melt(dm, id.vars = names(dm)[1], variable.name = COLRT, value.name = COLY)
# convert column names with time points to a number
dm[, (COLRT) := as.numeric(levels(get(COLRT)))[get(COLRT)]]
}
# no need to isolate updating the counter reactive values!
counter$dataLoadNuc <- locInLoadNuc
} else {
cat("dataInBoth else\n")
cat("server:dataInBoth else\n")
dm = NULL
}
return(dm)
......@@ -442,7 +455,7 @@ shinyServer(function(input, output, session) {
# return column names of the main dt
getDataNucCols <- reactive({
if (DEB)
cat(file = stdout(), 'getDataNucCols: in\n')
cat(file = stdout(), 'server:getDataNucCols: in\n')
loc.dt = dataInBoth()
......@@ -455,7 +468,7 @@ shinyServer(function(input, output, session) {
# return dt with an added column with unique track object label
dataMod <- reactive({
if (DEB)
cat(file = stdout(), 'dataMod\n')
cat(file = stdout(), 'server:dataMod\n')
loc.dt = dataInBoth()
......@@ -475,7 +488,7 @@ shinyServer(function(input, output, session) {
if (input$chBtrajRem) {
if (DEB)
cat(file = stdout(), 'dataMod: trajRem not NULL\n')
cat(file = stdout(), 'server:dataMod: trajRem not NULL\n')
loc.dt.rem = dataLoadTrajRem()
loc.dt = loc.dt[!(trackObjectsLabelUni %in% loc.dt.rem[[1]])]
......@@ -488,7 +501,7 @@ shinyServer(function(input, output, session) {
# This will be used to display in UI for trajectory highlighting
getDataTrackObjLabUni <- reactive({
if (DEB)
cat(file = stdout(), 'getDataTrackObjLabUni\n')
cat(file = stdout(), 'server:getDataTrackObjLabUni\n')
loc.dt = dataMod()
......@@ -504,7 +517,7 @@ shinyServer(function(input, output, session) {
# These timepoints are from the original dt and aren't affected by trimming of x-axis
getDataTpts <- reactive({
if (DEB)
cat(file = stdout(), 'getDataTpts\n')
cat(file = stdout(), 'server:getDataTpts\n')
loc.dt = dataMod()
......@@ -531,7 +544,7 @@ shinyServer(function(input, output, session) {
# pos.x,y - created if columns with x and y positions present in the input data
data4trajPlot <- reactive({
if (DEB)
cat(file = stdout(), 'data4trajPlot\n')
cat(file = stdout(), 'server:data4trajPlot\n')
loc.dt = dataMod()
if (is.null(loc.dt))
......@@ -574,7 +587,7 @@ shinyServer(function(input, output, session) {
loc.s.pos.y = names(loc.dt)[grep('(L|l)ocation.*Y|(P|p)os.y|(P|p)osy', names(loc.dt))[1]]
if (DEB)
cat('Position columns: ', loc.s.pos.x, loc.s.pos.y, '\n')
cat('server:data4trajPlot:\n Position columns: ', loc.s.pos.x, loc.s.pos.y, '\n')
if (!is.na(loc.s.pos.x) & !is.na(loc.s.pos.y))
locPos = TRUE
......@@ -632,6 +645,11 @@ shinyServer(function(input, output, session) {
# create final dt for output based on columns selected above
loc.out = loc.dt[, eval(parse(text = s.colexpr))]
# Convert track ID to a factor.
# This is necessary for, e.g. merging data with cluster assignments.
# If input dataset has track ID as a number, such a merge would fail.
loc.out[, (COLID) := as.factor(get(COLID))]
# if track selection ON
if (locButHighlight){
......@@ -660,7 +678,7 @@ shinyServer(function(input, output, session) {
# x-check: print all rows with NA's
if (DEB) {
cat(file = stdout(), 'Rows with NAs:\n')
cat(file = stdout(), 'server:data4trajPlot: Rows with NAs:\n')
print(loc.out[rowSums(is.na(loc.out)) > 0, ])
}
......@@ -734,30 +752,27 @@ shinyServer(function(input, output, session) {
# time points as rows
data4clust <- reactive({
if (DEB)
cat(file = stdout(), 'data4clust\n')
cat(file = stdout(), 'server:data4clust\n')
loc.dt = data4trajPlotNoOut()
if (is.null(loc.dt))
return(NULL)
#print(loc.dt)
loc.out = dcast(loc.dt, as.formula(paste0(COLID, "~", COLRT)), value.var = COLY)
#print(loc.out)
loc.rownames = loc.out[[COLID]]
# convert from long to wide format
loc.dt.wide = dcast(loc.dt,
reformulate(response = COLID, termlabels = COLRT),
value.var = COLY)
# store row names for later
loc.rownames = loc.dt.wide[[COLID]]
loc.out = as.matrix(loc.out[, -1])
rownames(loc.out) = loc.rownames
# omit first column that contains row names
loc.m.out = as.matrix(loc.dt.wide[, -1])
# This might be removed entirely because all NA treatment happens in data4trajPlot
# Clustering should work with NAs present. These might result from data itself or from missing time point rows that were turned into NAs when dcast-ing from long format.
# Remove NA's
# na.interpolation from package imputeTS works with multidimensional data
# but imputation is performed for each column independently
# The matrix for clustering contains time series in rows, hence transposing it twice
# loc.out = t(na.interpolation(t(loc.out)))
# assign row names to the matrix
rownames(loc.m.out) = loc.rownames
return(loc.out)
return(loc.m.out)
})
......@@ -765,17 +780,17 @@ shinyServer(function(input, output, session) {
# this dataset is displayed underneath of trajectory plot (modules/trajPlot.R) as geom_segment
data4stimPlot <- reactive({
if (DEB)
cat(file = stdout(), 'data4stimPlot\n')
cat(file = stdout(), 'server:data4stimPlot\n')
if (input$chBstim) {
if (DEB)
cat(file = stdout(), 'data4stimPlot: stim not NULL\n')
cat(file = stdout(), 'server:data4stimPlot: stim not NULL\n')
loc.dt.stim = dataLoadStim()
return(loc.dt.stim)
} else {
if (DEB)
cat(file = stdout(), 'data4stimPlot: stim is NULL\n')
cat(file = stdout(), 'server:data4stimPlot: stim is NULL\n')
return(NULL)
}
......@@ -796,7 +811,7 @@ shinyServer(function(input, output, session) {
# The output data table of data4trajPlot is modified based on inSelHighlight field
output$varSelHighlight = renderUI({
if (DEB)
cat(file = stdout(), 'UI varSelHighlight\n')
cat(file = stdout(), 'server:varSelHighlight\n')
locBut = input$chBhighlightTraj
if (!locBut)
......@@ -806,7 +821,7 @@ shinyServer(function(input, output, session) {
if (!is.null(loc.v)) {
selectInput(
'inSelHighlight',
'Select one or more rajectories:',
'Select one or more trajectories:',
loc.v,
width = '100%',
multiple = TRUE
......
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