inst/shinyapp/project_tab.R

### 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
BIMIB-DISCo/LACEinterface documentation built on Feb. 20, 2022, 2:20 p.m.