shiny_data_selector <- function(module_id, data_env = getDefaultDataRepository()){
fband <- list(
'Delta' = c(0.5, 3),
'Theta' = c(4, 7),
'Alpha' = c(8, 13),
'Mu' = c(7.5, 12.5),
'Beta' = c(16, 31),
'Low Gamma' = c(32, 74),
'High Gamma' = c(75, 150)
)
ns <- shiny::NS(module_id)
header <- function(){
tags$li(
actionLink(ns('data_select'), 'Select Data', icon = shiny_icons$tasks,
role = 'button', class = 'nav-item nav-link')
)
}
control <- function(){
NULL
}
server <- function(input, output, session, global_reactives, clear_cache = NULL){
# Vars
group <- 'main_app2'
local_data <- reactiveValues(
has_subject = FALSE,
check_result = list(),
load_mesh = !isFALSE(last_entry('load_mesh', TRUE, save = FALSE, group = group)),
# Prevent mis-clicking
# If "import" button is clicked multiple times, data will be reloaded multiple times.
# prevent will be set to false only when modal expanded
prevent_dblclick = TRUE
)
local_env <- dipsaus::fastmap2()
##### Show modal when 'data_select' is clicked
open_modal <- function(){
shinyjs::addClass(selector = 'body', class = "rave-noscroll")
local_env$is_open <- TRUE
shiny::showModal(
shiny::modalDialog(
title = 'Data Selection', size = 'l', easyClose = FALSE, fade = FALSE,
footer = tagList(
actionButton(ns('dismiss'), 'Cancel'),
dipsaus::actionButtonStyled(ns('import'), 'Load Data', type = 'primary', icon = shiny_icons$angle_right)
),
# Style to make this modal bigger
tags$style('.modal-lg { min-width: 80vw; }'),
data_modal()
)
)
}
dismiss_modal <- function(){
shinyjs::removeClass(selector = 'body', class = "rave-noscroll")
removeModal()
local_env$is_open <- FALSE
}
observeEvent(input$data_select, {
open_modal()
})
observeEvent(input$dismiss, {
dismiss_modal()
})
##### Modal layout
data_modal <- function(){
# Gather data
projects <- get_projects()
local_data$modal_refresh <- Sys.time()
local_data$prevent_dblclick <- FALSE
last_project <- last_entry('project_name', default = NULL, group = group)
if(length(projects) == 0){
return(p(strong('No valid project detected. Make sure there is at least one project folder in your data directory!')))
}
# Return UI
fluidRow(
# Responsive columns
# Input - data selection panel
div(
class = 'col-sm-12 col-md-5',
# Step 1: Select project and subject
div(
class = 'rave-grid-inputs margin-top-20 no-border-inputs',
div(
class = 'rave-grid-inputs-legend',
'Project/Subject'
),
div(
style="flex-basis: 50%;",
selectInput(ns('project_name'), 'Project', choices = projects, selected = last_project),
checkboxInput(ns('group_module'), 'Load for group analysis'),
),
div(
style="flex-basis: 50%;",
uiOutput(ns('ui_subject'))
)
),
# Step 2: select subset of data
uiOutput(ns('ui_step2'))
),
# Show Results
div(
class = 'col-sm-12 col-md-7',
uiOutput(ns('ui_preview'))
)
)
}
##### Reactives: dynamic inputs #####
output$ui_subject <- renderUI({
projects <- get_projects()
project <- input$project_name
local_data$modal_refresh
local_data$modal_refresh1 <- Sys.time()
if(length(project) == 1 && project %in% projects){
# Get subject
subjects <- get_subjects(project)
if(length(subjects) == 0){
return(p(strong('No valid subject in this project')))
}
last_subject <- last_entry('subject_code', default = NULL, group = group)
if(length(last_subject) != 1 || !last_subject %in% subjects){
last_subject <- subjects[1]
}
return(
selectInput(ns('subject_code'), 'Subject', choices = subjects, selected = last_subject)
)
}else{
return(NULL)
}
})
observe({
# Get project and subject first
project <- input$project_name
subject <- input$subject_code
if(is.null(project) || is.blank(project) || is.null(subject) || is.blank(subject)){
local_data$has_subject <- FALSE
local_data$check_result <- NULL
return()
}
# Check validity of subject
tryCatch({
check_result <- check_subjects2(project_name = project, subject_code = subject)
# We need channel_dir, meta_dir, notch_filter, wavelet, meta_electrode, meta_epoch, meta_frequency
# if reference == T, we need meta_reference
must_true <- c('channel_dir', 'meta_dir', 'notch_filter', 'wavelet',
'meta_electrode', 'meta_epoch', 'meta_frequency')
if(all(unlist(check_result$check[must_true]))){
local_data$has_subject <- TRUE
local_data$check_result <- check_result
}else{
local_data$has_subject <- FALSE
local_data$check_result <- check_result
}
}, error = function(e){
local_data$has_subject <- FALSE
local_data$check_result <- NULL
})
})
# step 2: subset data
output$ui_step2 <- renderUI({
local_data$modal_refresh1
validate(need(local_data$has_subject && is.list(local_data$check_result), message = ''))
check_result <- local_data$check_result
# Epoch files
last_epoch <- last_entry('epoch_name', NULL, group = group)
if(length(last_epoch) !=1 || !last_epoch %in% check_result$epochs){
last_epoch <- NULL
}
# reference files
last_reference <- last_entry('reference_name', NULL, group = group)
if(length(last_reference) !=1 || !last_reference %in% check_result$references){
last_entry('reference_name', 'default', group = group, save = TRUE)
last_reference <- 'default'
}
# epoch_range
last_time_range <- last_entry('time_range', NULL, group = group)
if(length(last_time_range)!=2){
last_time_range <- c(1,2)
}
last_time_range[1] <- max(last_time_range[1], 0)
last_time_range[2] <- max(last_time_range[2], 0)
# Electrodes
last_electrodes <- last_entry('electrodes', '', group = group)
if(!isTRUE(check_result$log$preprocess$subject_code == last_entry('subject_code', '', group = group))){
last_electrodes <- dipsaus::deparse_svec(check_result$log$preprocess$channels)
}
# Frequencies
freqs <- utils::tail(check_result$log$preprocess$wavelet_log, 1)[[1]][['frequencies']]
# Return
tagList(
div(
##### Epoch UI #####
id = ns('epoch-chunk'),
class = 'rave-grid-inputs margin-top-20 no-border-inputs',
tooltip = ' ',
flow = 'right',
`tooltip-image` = TRUE,
div(
class = 'tooltip-content',
style = 'background-image:url("Dipterix-0.0.1/images/data_selectior_epoch.gif")',
p(
"`Epoch table` defines experiment onset and trial condition types. Usually these files are stored in [subject]/rave/meta/epoch_[names].csv. `Pre` means seconds before onset. `Post` is the seconds after onset."
)
),
div(
class = 'rave-grid-inputs-legend',
'Epoch Selection'
),
div(
style="flex-basis: 50%;",
selectInput(ns('epoch'), 'Epoch Table', choices = check_result$epochs, selected = last_epoch)
),
div(
style="flex-basis: 25%;",
numericInput(ns('epoch_pre'), 'Pre', min = 0, value = last_time_range[1], step = 0.1)
),
div(
style="flex-basis: 25%;",
numericInput(ns('epoch_post'), 'Post', min = 0, value = last_time_range[2], step = 0.1)
),
div(
style="flex-basis: 100%;",
tags$small(textOutput(ns('epoch_txt')), style = 'color:#a1a1a1;')
)
),
# div(
# ####### Frequency UI ######
# id = ns('frequency-chunk'),
# class = 'rave-grid-inputs margin-top-20 no-border-inputs',
# tooltip = ' ',
# flow = 'right',
# div(
# class = 'tooltip-content',
# style = 'width: 17em; max-width: 300px; text-align: left; padding: 0 1em;',
# p(h4('Presets:'), br(),
# HTML(paste(sapply(seq_along(fband), function(ii){
# nm = names(fband)[[ii]]
# b = fband[[ii]]
# sprintf('%s wave: %.1f - %.1f', nm, b[1], b[2])
# }), collapse = '<br />')))
# ),
# div(
# class = 'rave-grid-inputs-legend',
# 'Frequency'
# ),
# div(
# style="flex-basis: 60%;",
# sliderInput(ns('frequencies'), 'Frequency Range', min = max(min(freqs)-1, 0), ticks = F,
# max = max(freqs)+1, value = range(freqs), step = 0.1, round = TRUE, post = 'Hz')
# ),
# div(
# style="flex-basis: 40%;",
# tags$label('Presets'),
# p(
# tags$label(
# class = 'label label-default bg-red', style = 'display: inline-block;',
# tags$a('Delta', style = 'color:white!important', class = 'action-button',
# id = ns('freq_preset_1'), href = '#')
# ),
# tags$label(
# class = 'label label-default bg-orange', style = 'display: inline-block;',
# tags$a('Theta', style = 'color:white!important', class = 'action-button',
# id = ns('freq_preset_2'), href = '#')
# ),
# tags$label(
# class = 'label label-default bg-yellow', style = 'display: inline-block;',
# tags$a('Alpha', style = 'color:white!important', class = 'action-button',
# id = ns('freq_preset_3'), href = '#')
# ),
# tags$label(
# class = 'label label-default bg-green', style = 'display: inline-block;',
# tags$a('Beta', style = 'color:white!important', class = 'action-button',
# id = ns('freq_preset_5'), href = '#')
# ),
# tags$label(
# class = 'label label-default bg-blue', style = 'display: inline-block;',
# tags$a('Low Gamma', style = 'color:white!important', class = 'action-button',
# id = ns('freq_preset_6'), href = '#')
# ),
# tags$label(
# class = 'label label-default bg-purple', style = 'display: inline-block;',
# tags$a('High Gamma', style = 'color:white!important', class = 'action-button',
# id = ns('freq_preset_7'), href = '#')
# )
# )
# ),
# div(
# style="flex-basis: 100%;",
# tags$small(textOutput(ns('frequency_txt')), style = 'color:#a1a1a1;')
# )
# ),
div(
##### Electrodes UI ####
id = ns('electrode-chunk'),
class = 'rave-grid-inputs margin-top-20 no-border-inputs',
tooltip = '',
flow = 'right',
`tooltip-image` = TRUE,
div(
class = 'rave-grid-inputs-legend',
'Electrode & Reference'
),
div(
style="flex-basis: 100%;",
selectInput(ns('reference'), 'Reference Table', choices = check_result$references, selected = last_reference)
),
div(
style="flex-basis: 50%;",
textInput(ns('electrodes'), 'Electrodes', placeholder = 'Example: 1-4,6', value = last_electrodes)
),
div(
style="flex-basis: 50%;",
fileInput(ns('mask'), 'or Mask File')
),
div(
style="flex-basis: 100%;",
tags$small(textOutput(ns('electrode_txt')), style = 'color:#a1a1a1;')
),
div(
style="flex-basis: 100%;",
uiOutput(ns('ui_mask'))
)
),
div(
#### Load Estimation ####
class = 'rave-grid-inputs margin-top-20',
div(
class = 'rave-grid-inputs-legend',
'Load Estimation'
),
div(
style="flex-basis: 100%;",
uiOutput(ns('ui_summary'))
)
)
)
})
lapply(1:7, function(ii){
observeEvent(input[[paste0('freq_preset_', ii)]], {
updateSliderInput(session = session, inputId = 'frequencies', value = fband[[ii]])
})
})
observe({
local_data$mask <- mask_file <- input$mask
check_result <- isolate(local_data$check_result)
tryCatch({
mask_tbl <- utils::read.csv(mask_file$datapath, header = TRUE)
if(!is.integer(mask_tbl[,1])){
# the first column is not electrode, add the column "Electrode" to table
mask_tbl$Electrode <- seq_len(nrow(mask_tbl))
nms <- names(mask_tbl); nms <- nms[nms != 'Electrode']
mask_tbl <- mask_tbl[,c('Electrode', nms)]
}
mask_tbl <- mask_tbl[mask_tbl$Electrode %in% check_result$log$preprocess$channels, ]
if(nrow(mask_tbl) == 0 || ncol(mask_tbl) <= 1){
local_data$mask_table <- NULL
}else{
local_data$mask_table <- mask_tbl
}
}, error = function(e){
if(length(mask_file$datapath) == 1){
showNotification(p('Cannot parse mask file'), type = 'error')
}
local_data$mask_table <- NULL
})
})
output$frequency_txt <- renderText({
validate(need(local_data$has_subject && is.list(local_data$check_result), message = ''))
check_result <- local_data$check_result
w <- check_result$log$preprocess$wavelet_log
freqs <- w[[length(w)]]$frequencies
# f = input$frequencies
n_tf <- length(freqs)
# freqs = freqs[freqs %within% f]
n_f <- length(freqs)
if(n_f){
sprintf('%d out of %d frequencies selected, actual range: %.0fHz - %.0fHz', n_f, n_tf, min(freqs), max(freqs))
}else{
sprintf('Warning: No frequency selected, total number of frequencies: %d', n_tf)
}
})
output$electrode_txt <- renderText({
validate(need(local_data$has_subject && is.list(local_data$check_result), message = ''))
txt <- input$electrodes
check_result <- local_data$check_result
if(is.null(check_result)){
return('')
}
# try to load reference table
es <- dipsaus::parse_svec(txt)
sel <- es %in% check_result$log$preprocess$channels
ref <- input$reference
if(length(ref) == 1 && ref %in% check_result$references){
# load reference
project <- isolate(input$project_name)
subject <- isolate(input$subject_code)
ref_tbl <- load_meta('references', project_name = project, subject_code = subject, meta_name = ref)
sel <- sel & (es %in% ref_tbl$Electrode[ref_tbl$Reference != ''])
}
es <- es[sel]
ne <- length(es)
txt <- dipsaus::deparse_svec(es)
if(ne){
if(isTRUE(input$group_module)){
sprintf('For group analysis, only *one* electrode is required to be loaded')
} else {
sprintf('%d electrodes selected (%s)', ne, txt)
}
}else{
'No electrode selected'
}
})
output$ui_mask <- renderUI({
validate(need(!is.null(local_data$mask_table), message = ''))
mask_table <- local_data$mask_table
vars <- c('[NONE..]', names(mask_table))
# Only three selection is allowed
div(
actionLink(ns('toggle_filter'), 'Show/Hide Filters', onclick=sprintf('$("#%s").toggle();', ns('mask_filters'))),
div(
id = ns('mask_filters'), style = 'display:none;',
tagList(lapply(seq_len(3), function(ii){
div(
class = 'rave-grid-inputs no-border',
div(
style="flex-basis: 25%;",
local({
if(ii > 1){
selectInput(ns(paste0('filter_lgt_' , ii)), paste0('Filter ', ii), choices = c('AND', 'OR'), selected = 'OR')
}else{
tags$label('Filter 1')
}
})
),
div(
style="flex-basis: 25%;",
selectInput(ns(paste0('filter_col_', ii)), 'Key', choices = vars, selected = vars[1])
),
div(
style="flex-basis: 25%;",
selectInput(ns(paste0('filter_op_', ii)), 'Operator',
choices = c('=', '>', '<', '>=', '<=', 'IN', 'NOT IN', 'BETWEEN'),
selected = 'NOT IN')
),
div(
style="flex-basis: 25%;",
textInput(ns(paste0('filter_val_', ii)), 'Value', value = '')
)
)
}))
)
)
})
observe({
# filters
mask_table <- local_data$mask_table
if(is.null(mask_table)){
return()
}
res <- as.integer(mask_table[,1])
txt <- dipsaus::deparse_svec(res)
try({
sel <- rep(TRUE, length(res))
for(ii in 1:3){
lgt <- input[[paste0('filter_lgt_', ii)]]
var <- input[[paste0('filter_col_' , ii)]]
op <- input[[paste0('filter_op_' , ii)]]
val <- input[[paste0('filter_val_' , ii)]]
if(var %in% names(mask_table)){
x <- mask_table[[var]]
if(is.numeric(x)){
val <- suppressWarnings({
r <- unlist(stringr::str_split(val, '[^0-9\\.]+'))
r <- r[!is.blank(r)]
r <- as.numeric(r)
r
})
if(any(is.na(val))){ next }
}else{
val <- unlist(stringr::str_split(val, '[,\\ ]+'))
}
subsel <- switch (op,
'=' = { x == val[1] },
'>' = { x > val[1] },
'>=' = { x >= val[1] },
'<' = { x < val[1] },
'<=' = { x <= val[1] },
'IN' = { x %in% val },
'NOT IN' = { !x %in% val },
'BETWEEN' = { x %within% val }
)
if(ii == 1){
sel <- subsel
}else{
fun <- (c(`&`, `|`)[c('AND', 'OR') %in% lgt])
if(!length(fun)){
fun <- `|`
}
sel <- fun[[1]](sel, subsel)
}
}
}
res <- res[sel]
txt <- dipsaus::deparse_svec(res)
last_electrodes <- last_entry('electrodes', txt, group = group, save = TRUE)
}, silent = TRUE)
updateTextInput(session = session, inputId = 'electrodes', value = txt)
})
output$epoch_txt <- renderText({
project <- input$project_name
subject <- input$subject_code
epoch <- input$epoch
time_range <- c(input$epoch_pre, input$epoch_post)
fn <- function(...){return('')}
tryCatch({
epoch_table <- load_meta(meta_type = 'epoch', meta_name = epoch, project_name = project, subject_code = subject)
n_trials <- nrow(epoch_table)
n_cond <- length(unique(epoch_table$Condition))
n_t <- (time_range[2] + time_range[1])
s <- sprintf('%d trials, %d unique condition types, %.1f seconds',
n_trials, n_cond, n_t)
return(s)
}, error = fn, warning = fn)
})
##### Dynamic previews #####
output$ui_preview <- renderUI({
check_result <- local_data$check_result
if(!local_data$has_subject){
# Show error message
if(is.null(check_result)){
return(p(
style = 'color:#a1a1a1',
'No subject or some errors occur during checking subject. Please report bug if you are sure that the subject exists.'
))
}else{
# Subject exists, but some procedure needs to be done before importing
must_true <- list(
'channel_dir' = 'No data folder found (preprocess)',
'meta_dir' = 'No meta directory found',
'notch_filter' = 'Needs Notch filter (preprocess)',
'wavelet' = 'Needs wavelet transformation (preprocess)',
'meta_electrode' = 'Meta data has no electrode information (electrodes.csv)',
'meta_epoch' = 'Meta data has no epoch information',
'meta_frequency' = 'Meta data has no frequency information (wavelet?)'
)
r <- check_result$check[names(must_true)]
r <- must_true[!unlist(r)]
return(div(p('This subject failed the data check.'), tags$ul(
tagList(lapply(r, tags$li))
)))
}
}else{
# Subject should be valid, detect and preview
# How many trials
fluidRow(
column(
12,
div(
class = 'rave-grid-inputs margin-top-20',
style = 'padding: 5px 0px 5px 5px;',
div(
class = 'rave-grid-inputs-legend',
'3D Viewer'
),
div(
style="display: block;width: 100%;flex-basis: 100%;",
div(
style = 'position: absolute; z-index:100; ',
checkboxInput(ns('load_mesh'), 'Load Mesh', value = isolate(local_data$load_mesh))
),
threeBrain::threejsBrainOutput(ns('three_viewer'), height = '600px')
# threejsOutput(ns('three_viewer'), height = '500px')
)
)
)
)
}
})
observe({
load_mesh <- input$load_mesh
if(length(load_mesh) && is.logical(load_mesh)){
local_data$load_mesh <- load_mesh
last_entry('load_mesh', !isFALSE(load_mesh), save = TRUE, group = group)
}
})
output$ui_summary <- renderUI({
validate(need(local_data$has_subject, message = ''))
check_result <- local_data$check_result
project <- input$project_name
subject <- input$subject_code
# check if subject exists
sub_dir <- file.path(rave_options('data_dir'), project, subject, 'rave')
if(!dir.exists(sub_dir)){
return(p(
'File path not found:', br(), sub_dir
))
}
# Trial
epoch <- input$epoch
# Check epoch file
msg <- check_epoch(sprintf('%s/%s', project, subject), epoch_name = epoch)
if(!isTRUE(msg)){
msg <- msg$message
sub <- as_subject(sprintf('%s/%s', project, subject), strict = FALSE)
blocks <- sub$preprocess_info('blocks')
blocks <- c(rep(blocks[1], 4), blocks[-1])
examp <- data.frame(
Block = blocks,
Time = c('5.12', '10.4', '...', rep('', length(blocks) - 3)),
Trial = seq_along(blocks),
Condition = c('cond1', 'cond2', '...', rep('', length(blocks) - 3))
)
examp <- utils::capture.output({print(examp)})
time_range <- ''
time_points <- load_meta('time_points', project, subject)
if(is.data.frame(time_points)){
time_range <- lapply(split(time_points, time_points$Block), function(s){
rg <- range(s$Time)
tags$li(
sprintf('Block %s, Time range: %.2f ~ %.2f seconds', unique(s$Block), rg[1], rg[2])
)
})
time_range <- tags$ul(tagList(time_range))
}
return(p(
'Warning: block numbers do not match exactly, verify that this is OK (for instance, it is OK if a leading zero is missing).',
br(), 'To continue loading data anyway, click the "Load Data" button ', br(),
strong(msg), br(), 'Here is an example of epoch file:', br(),
tags$pre(
paste(examp, collapse = '\n')
),br(),
'* Note: Time is relative to the start of the block. Trial is sequential across Blocks. Non-sequential trial numbers are OK, but they must be unique.',
time_range
))
}
epoch_table <- load_meta(meta_type = 'epoch', meta_name = epoch, project_name = project, subject_code = subject)
n_trials <- nrow(epoch_table)
# Frequency
w <- check_result$log$preprocess$wavelet_log
w <- w[[length(w)]]
freqs <- w$frequencies#[w$frequencies %within% input$frequencies]
n_freqs <- length(freqs)
# Time Points
time_range <- c(input$epoch_pre, input$epoch_post)
total_time <- sum(time_range)
n_time_wave <- w$target_srate * total_time + 1
n_time_volt <- check_result$log$preprocess$srate * total_time + 1
# Electrodes
elec <- input$electrodes
elec <- dipsaus::parse_svec(elec)
elec <- elec[elec %in% check_result$log$preprocess$channels]
n_electrodes <- length(elec)
# usage
s_volt <- prod(n_trials, n_time_volt, n_electrodes) * 8.25 * 3
s_power <- prod(n_trials, n_freqs, n_time_wave, n_electrodes) * 8.25 * 3
# # SUMA brain?
# suma_dir = get_dir(subject_code = subject, project_name = project)$suma_dir
# spec_file = file.path(suma_dir, rave_options('suma_spec_file'))
# brain_size = 0
# if(file.exists(spec_file)){
# spec_parsed = suma_spec_parse(subject = project %&% '/' %&% subject)
# sv = unique(unlist(spec_parsed)['SurfaceVolume'])
# if(length(sv)){
# sv = paste0(sv[1], '.brik')
# }
# if(!is.null(find_path(sv))){
# sv = find_path(sv)
# }else{
# sv = unlist(stringr::str_split(sv, '/'))
# sv = file.path(suma_dir, sv[length(sv)])
# }
#
# if(!is.null(sv) && file.exists(sv)){
# brain_size = file.info(sv)$size
# }
# }
drive_speed <- rave_options('drive_speed')
if(length(drive_speed) >= 2){
drive_speed <- as.numeric(drive_speed[2])
}else{
drive_speed <- NA
}
n_trials <- as.integer(n_trials)
n_time_volt <- as.integer(n_time_volt)
n_electrodes <- as.integer(n_electrodes)
n_time_wave <- as.integer(n_time_wave)
p(
strong('Voltage: '), sprintf('%d Trials x %d Timepoints x %d Electrodes (%s)',
n_trials, n_time_volt, n_electrodes, dipsaus::to_ram_size(s_volt)), br(),
strong('Power/Phase: '), sprintf('%d Trials x %d Frequencies x %d Timepoints x %d Electrodes (%s each)',
n_trials, n_freqs, n_time_wave, n_electrodes, dipsaus::to_ram_size(s_power)), br(),
# strong('Brain: '), ifelse(brain_size > 0,
# sprintf('surface volume, %s', dipsaus::to_ram_size(brain_size)),
# 'no surface volume file found'), br(),
strong('Estimated Resource Required: '), sprintf('%s (memory)',
dipsaus::to_ram_size(max(s_volt, s_power))), br(),
strong('Estimated Loading time: '), sprintf(
'Power (%.0f sec), Phase (%.0f sec), Voltage(%.0f sec)',
s_power / drive_speed / 1000^2 * 2,
s_power / drive_speed / 1000^2 * 2,
s_volt / drive_speed / 1000^2 * 2
)
)
})
# Local environment to store temporary SUMA brain
# brain_env = new.env()
# output$three_viewer <- renderThreejs({
# validate(need(local_data$has_subject, message = ''))
# project = input$project_name
# subject = input$subject_code
# subject_id = sprintf('%s/%s', project, subject)
# ref = input$reference
# elec = input$electrodes
# load_mesh = input$load_mesh
#
#
# brain = brain_env[[subject_id]]
# if(is.null(brain)){
# s = Subject$new(project_name = project, subject_code = subject, reference = ref, strict = FALSE)
# brain = RaveBrain$new(subject = s)
# brain_env[[subject_id]] = brain
# }
#
# if(load_mesh && brain$mesh_count == 0){
# brain$import_spec(nearest_face = F)
# }
#
#
# brain = brain$copy()
# elec = dipsaus::parse_svec(elec)
# s = brain$.__enclos_env__$private$subject
# valid_e = s$filter_valid_electrodes(elec)
# invalid_e = s$filter_all_electrodes(elec)
# invalid_e = invalid_e[!invalid_e %in% valid_e]
#
# lapply(s$electrodes$Electrode, function(ii){
# if(ii %in% valid_e){
# brain$set_electrode_value(which = ii, value = -1)
# }else if (ii %in% invalid_e){
# brain$set_electrode_value(which = ii, value = 1)
# }
# })
#
# brain$view(control_gui = F, width = '100%', height = '500px', center = T, show_mesh = load_mesh)
# })
proxy <- threeBrain::brain_proxy('three_viewer')
output$three_viewer <- threeBrain::renderBrain({
project <- input$project_name
subject <- input$subject_code
subject_id <- sprintf('%s/%s', project, subject)
ref <- input$reference
elec <- dipsaus::parse_svec(input$electrodes)
load_mesh <- input$load_mesh
# Check whether subject exists
dirs <- get_dir(subject_id = subject_id)
validate(
need(local_data$has_subject, message = ''),
need(dir.exists(dirs$subject_dir), message = 'Subject does not exist!')
)
subject <- as_subject(subject_id, reference = ref, strict = FALSE)
brain <- rave_brain2( subject = subject, surfaces = 'pial',
compute_template = FALSE,
usetemplateifmissing = FALSE )
if( is.null(brain) ){
return(NULL)
}
valid_e <- subject$filter_valid_electrodes(elec)
invalid_e <- subject$filter_all_electrodes(elec)
invalid_e <- invalid_e[!invalid_e %in% valid_e]
f <- factor(c('Loading', 'Bad', 'Not Loaded'), levels = c('Loading', 'Bad', 'Not Loaded'))
tbl <- subject$electrodes
tbl$Value <- f[3]
tbl$Value[tbl$Electrode %in% valid_e] <- f[1]
tbl$Value[tbl$Electrode %in% invalid_e] <- f[2]
is_template <- FALSE
if(length(brain$template_object)){
brain <- brain$template_object
is_template <- TRUE
}
brain$set_electrode_values(table_or_path = tbl[, c('Electrode', 'Value')])
if(is_template){
for(e in brain$electrodes$objects){
e$name <- paste(stringr::str_replace(e$name, '^[^,]*, ', ''), '(template brain)')
}
}
for(e in valid_e){
if( !is.null(brain$electrodes$objects[[e]]) ){
brain$electrodes$objects[[e]]$custom_info <- paste('Reference Group:', tbl$Group[tbl$Electrode == e])
}
}
for(e in invalid_e){
if( !is.null(brain$electrodes$objects[[e]]) ){
brain$electrodes$objects[[e]]$custom_info <- paste('Reference Group:', tbl$Group[tbl$Electrode == e], '(electrode not used)')
}
}
zoom <- shiny::isolate({
proxy$main_camera$zoom
})
theme <- get_rave_theme()$themes[[1]]
background <- ifelse(theme == 'dark', '#1E1E1E', '#FFFFFF')
brain$plot(control_panel = FALSE, side_canvas = FALSE,
default_colormap = 'Value', volumes = FALSE,
surfaces = load_mesh, start_zoom = zoom,
timestamp = FALSE, background = background,
palettes = list(Value = c('navyblue', 'red', '#e2e2e2')))
})
observeEvent(input$import, {
check_result <- local_data$check_result
if(local_data$prevent_dblclick){
return()
}
if(!local_data$has_subject || is.null(check_result)){
showNotification(p('Invalid subject. Please make sure you have run preprocess and generate epoch files.'), type = 'error', id = ns('data_import'))
return()
}
subject_code <- input$subject_code
project_name <- input$project_name
epoch <- input$epoch
epoch_range <- c(input$epoch_pre, input$epoch_post)
reference <- input$reference
subject_id <- paste0(project_name , '/' , subject_code)
electrodes <- dipsaus::parse_svec(input$electrodes)
tmp_subject <- Subject$new(project_name = project_name, subject_code = subject_code, reference = reference, strict = FALSE)
electrodes <- tmp_subject$filter_valid_electrodes(electrodes)
if(length(electrodes) == 0){
showNotification('You must select at least one electrode', type = 'error', id = ns('data_import'))
return(NULL)
}
frequencies <- tmp_subject$frequencies$Frequency #input$frequencies
freqs <- tmp_subject$frequencies$Frequency %within% frequencies
if(!sum(freqs)){
showNotification('No frequency found in your selected frequency band', type = 'error', id = ns('data_import'))
return(NULL)
}
if(sum(epoch_range) == 0){
showNotification('Please select valid time range', type = 'error', id = ns('data_import'))
return(NULL)
}
# register
last_entry('project_name', project_name, save = TRUE, group = group)
last_entry('subject_code', subject_code, save = TRUE, group = group)
last_entry('electrodes', dipsaus::deparse_svec(electrodes), save = TRUE, group = group)
last_entry('epoch_name', epoch, save = TRUE, group = group)
last_entry('time_range', epoch_range, save = TRUE, group = group)
last_entry('reference_name', reference, save = TRUE, group = group)
clear_cache(levels = 1)
if(isTRUE(input$group_module)){
electrodes <- electrodes[1]
}
gc()
rave_prepare(
subject = subject_id,
electrodes = electrodes,
epoch = epoch,
time_range = epoch_range,
frequency_range = frequencies,
reference = reference,
attach = FALSE,
data_types = NULL
)
# refresh UIs
global_reactives$force_refresh_all <- Sys.time()
global_reactives$has_data <- Sys.time()
shinyjs::removeClass(selector = 'body', class = "rave-noscroll")
removeModal()
# Remove
local_data$prevent_dblclick <- TRUE
catgl('Subject loaded, trigger module to refresh...')
})
##### End of server #####
# onload, check if data has been loaded into datarepo
data_loaded <- rlang::env_has(
data_env,
nms = c(
".private",
"data_check",
"module_tools",
"preload_info",
"subject"
),
inherit = FALSE
)
if(all(data_loaded)){
global_reactives$force_refresh_all <- Sys.time()
global_reactives$has_data <- Sys.time()
} else {
open_modal()
}
}
launch <- function(){
shinyjs::click(ns('data_select'))
}
return(list(
header = header,
control = control,
server = server,
launch = launch
))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.