### project_tab.R
### Project reactiveVals ####
inputs[["default_config_dir_std"]] <-
reactiveVal(create_default_config()) # each time check to create default conf
inputs[["config_dir_std"]] <- reactiveVal(os_conf_subdir)
inputs[["project_folder_std"]] <- reactiveVal()
inputs[["project_folder"]] <- reactiveVal()
inputs[["project_loaded"]] <- reactiveVal(F)
inputs[["pr_folder"]] <- reactiveVal()
inputs[["pr_folder_std"]] <- reactiveVal(.my_actual_wd)
inputs[["pr_name"]] <- reactiveVal()
inputs[["pr_name_std"]] <- reactiveVal()
inputs[["pr_path"]] <- reactiveVal(.my_actual_wd)
inputs[['av_vcf_out_dir']] <- reactiveVal()
inputs[['thr_vcf_in_dir']] <- reactiveVal()
inputs[['thr_out_dir']] <- reactiveVal()
inputs[['dp_out_dir']] <- reactiveVal()
inputs[['va_out_dir']] <- reactiveVal()
inputs[['inf_out_dir']] <- reactiveVal()
### End project reactiveVals ####
### Project observes ####
observeEvent(input[["pr_name"]], {
pr_name <- input[["pr_name"]]
pr_name_ <- inputs[["pr_name"]]
pr_folder_std_ <- inputs[["pr_folder_std"]]
pr_name_std_ <- inputs[["pr_name_std"]]
pr_path_ <- inputs[["pr_path"]]
pr_name_(pr_name)
name <- str_replace_all(pr_name,
pattern = "[^A-Za-z0-9\\-+_]+",
replacement = "_")
pr_name_std_(name)
if (str_length(pr_name_std_()) > 0)
pr_path_(file.path(pr_folder_std_(),
pr_name_std_(),
""))
else
pr_path_(file.path(pr_folder_std_(), pr_name_std_()))
})
## Original.
## observeEvent(input[["pr_name"]], {
## inputs[["pr_name"]](input[["pr_name"]])
##
## name <- str_replace_all(input[["pr_name"]],
## pattern = "[^A-Za-z0-9\\-+_]+",
## replacement = "_")
## inputs[["pr_name_std"]](name)
##
## if (str_length(inputs[["pr_name_std"]]()) > 0)
## inputs[["pr_path"]](file.path(inputs[["pr_folder_std"]](),
## inputs[["pr_name_std"]](),
## ""))
## else # MA: Something is fishy here: incorrect indentation...
## inputs[["pr_path"]](file.path(inputs[["pr_folder_std"]](),
## inputs[["pr_name_std"]]()))
## })
observeEvent(input[["pr_folder"]],{
inputs[["pr_folder"]](input[["pr_folder"]])
inputs[["pr_folder_std"]](normalizePath(
parseDirPath(roots = roots_dir,
inputs[["pr_folder"]]()),
mustWork = F
)
)
if (str_length(inputs[["pr_name_std"]]()) > 0)
inputs[["pr_path"]](file.path(inputs[["pr_folder_std"]](), inputs[["pr_name_std"]](), ""))
else
inputs[["pr_path"]](file.path(inputs[["pr_folder_std"]](), inputs[["pr_name_std"]]()))
updateActionButton(session,
'pr_folder',
label = normalizePath(set_dir_ui("pr_folder"), mustWork = F))
})
observeEvent(inputs[["pr_path"]](), {
inputs[["project_loaded"]](F)
hideTab(inputId = "main_tabset", target = "SC metadata")
hideTab(inputId = "main_tabset", target = "Annotations")
hideTab(inputId = "main_tabset", target = "Filters")
hideTab(inputId = "main_tabset", target = "SC sampling depths")
hideTab(inputId = "main_tabset", target = "Variants")
hideTab(inputId = "main_tabset", target = "Inference")
hide(id = "pr_path_div")
if (!is.null(inputs[["pr_path"]]()))
if (length(inputs[["pr_path"]]()) > 0) {
shinyjs::show(id="pr_path_div")
if (dir.exists(file.path(inputs[["pr_path"]](),os_conf_subdir))) {
## if (!load_project(inputs[["pr_path"]](), config_dir="config")) {
## warning()
## }
## else {
path <- inputs[["pr_path"]]()
inputs[["pr_folder_std"]](dirname(path))
inputs[["pr_name"]](basename(path))
inputs[["pr_name_std"]](basename(path))
inputs[["project_folder_std"]](path)
project_folder <- list( "path"="", "root"="")
project_folder$path[[1]]<-""
project_folder$path <-
c(project_folder$path,
as.list(path_split(path_rel(inputs[["project_folder_std"]](),
start = roots_dir[[".."]]))[[1]]))
project_folder$root=".."
inputs[["project_folder"]](project_folder)
dir <- out_subfolder_compute(inputs[['project_folder']](),'vcf_out')
inputs[['av_vcf_out_dir']](dir)
inputs[['thr_vcf_in_dir']](inputs[['av_vcf_out_dir']]())
dir <- out_subfolder_compute(inputs[['project_folder']](),'filtered_vcf')
inputs[['thr_out_dir']](dir)
dir <- out_subfolder_compute(inputs[['project_folder']](),'sam_out')
inputs[['dp_out_dir']](dir)
dir <- out_subfolder_compute(inputs[['project_folder']](), 'filtered_var')
inputs[['va_out_dir']](dir)
updateActionButton(session,"pr_folder", label=inputs[["pr_folder_std"]]())
updateTextInput(session,"pr_name", value=inputs[["pr_name_std"]]())
updateActionButton(session,"pr_next", label="load project")
## }
} else
updateActionButton(session,"pr_next", label="create project")
}
})
observeEvent(inputs[["project_loaded"]](), {
if (!is.null(inputs[["project_loaded"]]()))
if (inputs[["project_loaded"]]())
hide(id = "pr_next")
else
shinyjs::show(id = "pr_next")
})
observeEvent(input[["pr_next"]], {
warning_wd <- F
if(length(inputs[["pr_path"]]()) == 0)
warning_wd <-T
else {
if (dir.exists(inputs[["pr_path"]]())) {
if (normalizePath(inputs[["pr_path"]]()) == .my_actual_wd) {
## pattume non aspetta per la risposta
## shinyalert(
## paste("You experiment will be you current working folder,", getwd(), ". Create expriment?"), type = "warning",
## immediate=F)
## warning_wd <- input$shinyalert
print(warning_wd)
warning_wd <- F
}
} else
warning_wd <- F
}
if (!warning_wd) {
dir.create(inputs[["pr_path"]](), showWarnings = F)
if (dir.exists(inputs[["pr_path"]]())) {
inputs[["project_folder_std"]](inputs[["pr_path"]]())
if (!dir.exists(file.path(inputs[["pr_path"]](),os_conf_subdir))) {
if (!create_project(inputs[["project_folder_std"]](),
inputs[["default_config_dir_std"]]())) {
showNotification(paste(paste("impossible to create project",
inputs[["pr_path"]]())),
duration = 10,
type = "error")
} else {
inputs[["project_loaded"]](T)
showTab(inputId = "main_tabset", target = "SC metadata")
}
} else {
if (!load_project(inputs[["project_folder_std"]]())) {
showNotification(paste(paste("impossible to load project",
inputs[["pr_path"]]())),
duration = 10,
type = "error")
showNotification(paste(paste("check config files")),
duration = 10,
type = "warning")
} else {
inputs[["project_loaded"]](T)
showTab(inputId = "main_tabset", target = "SC metadata")
}
}
## Change to project folder
setwd(inputs[["project_folder_std"]]())
project_folder <- list( "path"="", "root"="")
project_folder$path[[1]]<-""
project_folder$path <-
c(project_folder$path,
as.list(path_split(path_rel(inputs[["project_folder_std"]](),
start = roots_dir[[".."]]))[[1]]))
project_folder$root=".."
inputs[["project_folder"]](project_folder)
dir <- out_subfolder_compute(inputs[['project_folder']](), 'vcf_out')
inputs[['av_vcf_out_dir']](dir)
inputs[['thr_vcf_in_dir']](inputs[['av_vcf_out_dir']]())
dir <- out_subfolder_compute(inputs[['project_folder']](), 'filtered_vcf')
inputs[['thr_out_dir']](dir)
dir <- out_subfolder_compute(inputs[['project_folder']](), 'sam_out')
inputs[['dp_out_dir']](dir)
dir <- out_subfolder_compute(inputs[['project_folder']](), 'filtered_var')
inputs[['va_out_dir']](dir)
}
}
})
### End project observes ####
shinyDirChoose(input,
"pr_folder",
roots = roots_dir,
filetypes = c('', 'txt'),
defaultRoot = "..")
updateActionButton(session,
'pr_folder',
label = .my_actual_wd)
### Project outputs ####
output[["pr_path"]] <- renderText(inputs[["pr_path"]]())
output[["pr_title_ui"]] <- renderUI({
tags$h3(paste("Project:", inputs[["pr_name"]]() ))
})
output[["pr_title_ui_h"]] <- renderUI({
x <- ""
if (str_length(inputs[["pr_name"]]()) > 0)
x <- paste("Project: ", inputs[["pr_name"]]() )
tags$b(x)
})
output[["pr_path_ui"]] <- renderUI({
tagList(br(),
tags$b("Project pathname"),
verbatimTextOutput("pr_path"),
br()
)
})
### End project outputs ####
### end of file -- project_tab.R
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.