Skip to content

S
shiny-timecourse-inspector
Commit c8a2e909 authored by dmattek's avatar dmattek
Browse files
Options

Rebuilt section for creating internal dt. Added ObjectNumber to labels... 

Rebuilt section for creating internal dt. Added ObjectNumber to labels displayd in interactive trajectory plotting.
parent 0f2d73ff
Hide whitespace changes
Inline Side-by-side
Showing with 82 additions and 88 deletions
modules/auxfunc.R
View file @ c8a2e909
......@@ -175,6 +175,7 @@ myGgplotTraj = function(dt.arg, # data table
stim.bar.width.arg = 0.5,
aux.label1 = NULL, # 1st point label; used for interactive plotting; displayed in the tooltip; typically used to display values of column holding x & y coordinates
aux.label2 = NULL,
aux.label3 = NULL,
stat.arg = c('', 'mean', 'CI', 'SE')) {
# match arguments for stat plotting
......@@ -187,7 +188,8 @@ myGgplotTraj = function(dt.arg, # data table
y = y.arg,
group = group.arg,
label = aux.label1,
label2 = aux.label2))
label2 = aux.label2,
label3 = aux.label3))
if (is.null(line.col.arg)) {
p.tmp = p.tmp +
......
modules/trajPlot.R
View file @ c8a2e909
......@@ -122,7 +122,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
# Future: change such that a column with colouring status is chosen by the user
# colour trajectories, if dataset contains mi.din column
# 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'
......@@ -138,6 +138,14 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
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.
......@@ -172,6 +180,7 @@ modTrajPlot = function(input, output, session, in.data, in.facet = 'group', in.f
line.col.arg = loc.line.col.arg,
aux.label1 = if (locPos) 'pos.x' else NULL,
aux.label2 = if (locPos) 'pos.y' else NULL,
aux.label3 = if (locObjNum) 'obj.num' else NULL,
stat.arg = input$chBPlotTrajStat
)
......
server.R
View file @ c8a2e909
......@@ -489,10 +489,14 @@ shinyServer(function(input, output, session) {
# realtime - selected from input
# y - measurement selected from input
# (can be a single column or result of an operation on two cols)
# id - trackObjectsLabelUni (created in dataMod)
# id - trackObjectsLabelUni; created in dataMod based on TrackObjects_Label
# and FOV column such as Series or Site (if TrackObjects_Label not unique across entire dataset)
# group - grouping variable for facetting from input
# mid.in - column with trajectory selection status from the input file or
# highlight status from UI
# highlight status from UI
# (column created if mid.in present in uploaded data or tracks are selected in the UI)
# obj.num - created if ObjectNumber column present in the input data
# pos.x,y - created if columns with x and y positions present in the input data
data4trajPlot <- reactive({
cat(file = stderr(), 'data4trajPlot\n')
......@@ -500,7 +504,7 @@ shinyServer(function(input, output, session) {
if (is.null(loc.dt))
return(NULL)
# create expression for 'y' column based on measurements and math operations selected in UI
if (input$inSelMath == '')
loc.s.y = input$inSelMeas1
else if (input$inSelMath == '1 / ')
......@@ -508,7 +512,7 @@ shinyServer(function(input, output, session) {
else
loc.s.y = paste0(input$inSelMeas1, input$inSelMath, input$inSelMeas2)
# create expression for parsing
# create expression for 'group' column
# creates a merged column based on other columns from input
# used for grouping of plot facets
if (input$chBgroup) {
......@@ -529,7 +533,7 @@ shinyServer(function(input, output, session) {
# Assign tracks selected for highlighting in UI
loc.tracks.highlight = input$inSelHighlight
locBut = input$chBhighlightTraj
locButHighlight = input$chBhighlightTraj
# Find column names with position
......@@ -541,56 +545,66 @@ shinyServer(function(input, output, session) {
else
locPos = FALSE
# Find column names with ObjectNumber
# This is different from TrackObject_Label and is handy to keep
# because labels on segmented images are typically ObjectNumber
loc.s.objnum = names(loc.dt)[names(loc.dt) %like% c('ObjectNumber')]
if (length(loc.s.objnum) == 1)
locObjNum = TRUE
else
locObjNum = FALSE
# if dataset contains column mid.in with trajectory filtering status,
# then, include it in plotting
if (sum(names(loc.dt) %in% 'mid.in') > 0) {
if (locPos) # position columns present
loc.out = loc.dt[, .(
y = eval(parse(text = loc.s.y)),
id = trackObjectsLabelUni,
group = eval(parse(text = loc.s.gr)),
realtime = eval(parse(text = loc.s.rt)),
pos.x = get(loc.s.pos.x),
pos.y = get(loc.s.pos.y),
mid.in = mid.in
)] else
loc.out = loc.dt[, .(
y = eval(parse(text = loc.s.y)),
id = trackObjectsLabelUni,
group = eval(parse(text = loc.s.gr)),
realtime = eval(parse(text = loc.s.rt)),
mid.in = mid.in
)]
# add 3rd level with status of track selection
# to a column with trajectory filtering status
if (locBut) {
loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', mid.in)]
}
} else {
if (locPos) # position columns present
loc.out = loc.dt[, .(
y = eval(parse(text = loc.s.y)),
id = trackObjectsLabelUni,
group = eval(parse(text = loc.s.gr)),
realtime = eval(parse(text = loc.s.rt)),
pos.x = get(loc.s.pos.x),
pos.y = get(loc.s.pos.y)
)] else
loc.out = loc.dt[, .(
y = eval(parse(text = loc.s.y)),
id = trackObjectsLabelUni,
group = eval(parse(text = loc.s.gr)),
realtime = eval(parse(text = loc.s.rt))
)]
if (sum(names(loc.dt) %in% 'mid.in') > 0)
locMidIn = TRUE
else
locMidIn = FALSE
## Build expression for selecting columns from loc.dt
# Core columns
s.colexpr = paste0('.(y = ', loc.s.y,
', id = trackObjectsLabelUni',
', group = ', loc.s.gr,
', realtime = ', loc.s.rt)
# account for the presence of 'mid.in' column in uploaded data
if(locMidIn)
s.colexpr = paste0(s.colexpr,
', mid.in = mid.in')
# include position x,y columns in uploaded data
if(locPos)
s.colexpr = paste0(s.colexpr,
', pos.x = ', loc.s.pos.x,
', pos.y = ', loc.s.pos.y)
# include ObjectNumber column
if(locObjNum)
s.colexpr = paste0(s.colexpr,
', obj.num = ', loc.s.objnum)
# close bracket, finish the expression
s.colexpr = paste0(s.colexpr, ')')
# create final dt for output based on columns selected above
loc.out = loc.dt[, eval(parse(text = s.colexpr))]
# if track selection ON
if (locButHighlight){
# add a 3rd level with status of track selection
# to a column with trajectory filtering status in the uploaded file
if(locMidIn)
loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', mid.in)]
else
# add a column with status of track selection
if (locBut) {
loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', 'NOT SEL')]
}
loc.out[, mid.in := ifelse(id %in% loc.tracks.highlight, 'SELECTED', 'NOT SEL')]
}
## Interpolate NA's and data points not include
# From: https://stackoverflow.com/questions/28073752/r-how-to-add-rows-for-missing-values-for-unique-group-sequences
......@@ -598,35 +612,6 @@ shinyServer(function(input, output, session) {
setkey(loc.out, group, id, realtime)
loc.out = loc.out[setkey(loc.out[, .(min(realtime):max(realtime)), by = .(group, id)], group, id, V1)]
# # dt with a full span of realtime for every group and cell id
# # (here id is already unique across entire dataset) combination
# loc.dt.IdRt = CJ(id = loc.out[['id']],
# realtime = loc.out[['realtime']],
# unique = TRUE, sorted = TRUE )
#
# print('loc.dt.IdRt:')
# print(loc.dt.IdRt)
#
# # dt with all cell id's and their associated group names
# loc.dt.GrId = loc.out[, .(group = first(group)), by = id]
#
# print('loc.dt.GrId:')
# print(loc.dt.GrId)
#
# # merge the 2 above to have all id~rt combinations with associated group names
# loc.dt.GrIdRt = merge(loc.dt.IdRt, loc.dt.GrId, by = 'id')
#
# print('loc.dt.GrIdRt:')
# print(loc.dt.GrIdRt)
#
# # join with the original to expand it and create NA's for non-existing group-id-rt combinations
# loc.out = merge(loc.dt.GrIdRt, loc.out, all.x = TRUE, by = c('group', 'id', 'realtime'))
#
# print('loc.out:')
# print(loc.out)
#
# x-check: print all rows with NA's
print('Rows with NAs:')
print(loc.out[rowSums(is.na(loc.out)) > 0, ])
......@@ -634,14 +619,12 @@ shinyServer(function(input, output, session) {
# Merge will create NA's where a realtime is missing.
# Also, NA's may be already present in the dataset'.
# Interpolate (linear) them with na.interpolate
if(locPos) {
if(locPos)
s.cols = c('y', 'pos.x', 'pos.y')
loc.out[, (s.cols) := lapply(.SD, na.interpolation), by = id, .SDcols = s.cols]
}
else {
else
s.cols = c('y')
loc.out[, (s.cols) := lapply(.SD, na.interpolation), by = id, .SDcols = s.cols]
}
loc.out[, (s.cols) := lapply(.SD, na.interpolation), by = id, .SDcols = s.cols]
# !!! Current issue with interpolation:
......
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