inst/ShinyApp/0SAS_Pecc_ini.R

# ### What data are available with <<-
# #  explo_headerevaled: give utility of each columns (id, DV, MDV...) might not be given
# #  explo
# #  explo_dec
# #  explo_NA
# #  explo_path
# #  explo_sep
# #  subPathPrevious
# #  dossier()
# #  manua function
# #  project_file path of the project
# #  datasets_df list of datasets
#
#
# # Opening actions ---------------------------------------------------------
#
#
# # project <- readRDS("C:/Users/thiba/OneDrive/Documents/testpecc3")

create_pecc_shiny_project <- function(pathtemp = ''){

  path <- pathtemp %>%
    # path <- "\"file:///D:/these/Pecc_test\"" %>%
    gsub(pattern = "(file:///)|(\")", replacement = "") %>%
    gsub(pattern = "\\\\",replacement =  "/")


  projectfile <- list()



  testroot <- str_split(path,pattern =   "/")[[1]]
  projectfile$root <- paste0(testroot[- length(testroot)], collapse = .Platform$file.sep)



  projectfile$path <- path


  # table containing all dataset metadata
  projectfile$datasets <- tibble( n = numeric(), Path = character(),	File = character(),	  commentary =  character(),x = character(), id = character(), 	x_label = character(), y = character(), y_label = character(),
                                  filter = character(), sep = character(), na = character(), dec = character())


  projectfile$exploPplot <-  tibble(Name = character(), preloadeddataset = character(),
                                    FilterexploX = character(), exploY= character(),
                                    Col= character(), Wrap = character(), exploGrid = character(),
                                    exploID = character(),exploPoint= character(),
                                    exploLine= character(), exploStand= character(),
                                    exploXlog= character(), exploYlog = character(),
                                    exploMedian = character(),exploNA = character(),
                                    exploLOQ = character(),scaleExplo = character(),
                                    titleExplo = character(),subtitleExplo = character(),
                                    xlabsExplo = character(),ylabsExplo = character(),
                                    captionExplo = character(),sizeTextExplo= character(),
                                    secondFilter= character(), allbackground= character(),
                                    addlineExplo= character(), all_bkgrdalpha= character())

  projectfile$models <-  list()

  projectfile
}

explo <<- data.frame()
explo_expr <<- character()
explo_headerevaled <<- tibble()
project_file <<- "none"
datasets_df <<- tibble()
project <<- create_pecc_shiny_project('')
#
output$mb_state <- renderRHandsontable({rhandsontable(tibble(Cmt = character(), t0 = character()),
                                                      width = 200, height = 200, rowHeaders = NULL)})

output$mb_paramater <-  renderRHandsontable( {rhandsontable(table_param(),
                                                            width = 200, height = 200, rowHeaders = NULL)})

output$mb_matrix <-  renderRHandsontable( {rhandsontable(tibble(),
                                                            width = 500, height = 200)})

output$mb_event <-  renderRHandsontable( {rhandsontable(table_input(var = "aze") %>% slice(0),
                                                         width = 500, height = 200, rowHeaders = NULL)})

output$mb_display2 <-  renderRHandsontable( {rhandsontable(table_display(possiblevalues = NA_character_) %>% slice(0),
                                                        width = 500, height = 200, rowHeaders = NULL)})

output$mb_output <-  renderRHandsontable( {rhandsontable(
  tibble(output = factor(),
         YTYPE = NA_integer_, err_add = "0.1", err_prop = "0.3", export = T, rm = F),
                                                           width = 500, height = 200, rowHeaders = NULL)})

# if(exists("dossier")){
#   print("iaijuzezaoipeuzapoeiz")
#   if(typeof(dossier) != "closure"){
#     print("iaijuzezaoipeuzapoeiz")
#     rm(dossier)
# }
# }
# Rhandsontable


output$table_forest <- renderRHandsontable({

levels <- c("itself", "cat_fold", "cat_log_fold","cont_linear",  "cont_ref", "IIV_lognormal")
  datainput <- tibble(label = "Uncertainty", parameter = "Cl", value = 3.65, RSE = 20, on = "Cl", method = factor("itself", levels = levels)) %>%
    bind_rows(

  tibble(label = "6_400", parameter = "DOSE", value = 2, RSE = 10, on = "Cl", method = factor("cat_fold", levels = levels)),
  tibble(label = "Age 50", parameter = "Age", value = 0.1, RSE = 10, on = "Cl", method = factor("cont_ref", levels = levels), cont_indiv = 60, cont_ref = 80),
      tibble(label = "IIV", parameter = "IIV", value = 0.1, RSE = 10, on = "Cl", method = factor("IIV_lognormal", levels = levels))

    )

  rhandsontable(datainput %>% mutate(use = T, delete = F), rowHeaders = NULL)

})




# When the app open, load library models from config files (for PeccaReverse section)
updateSelectInput(session, "modelLibInput" , choices = read.csv(file.path(find.package("peccary"), "Librairies_model", "library_peccary.csv" ), header = T, sep = ";")[[1]])

# When the app open, Peccary directrly propose the previous opened project to faciliate the loading
pathprev <- file.path(find.package("peccary"),  "previous_project_opened.txt")
prevpro <- read.table(pathprev,sep = ";", header = T) %>%
  filter(id == as.list(Sys.info())$user)

if(nrow(prevpro) > 0){
  prevpro %>%
    arrange(desc(date)) %>%
    slice(1) %>%
    pull(projectpath) -> lastprevpro
  updateSelectInput(session, inputId =  "recentprojectfile", choices = prevpro$projectpath, selected = lastprevpro)
}


# if(!exists("dossier")) dossier <<- "noYet"

# shinyjs::hide(id = "mb_model_cov")
# shinyjs::hide(id = "helperModel")


# Import function indiv Pred ----------------------------------------------

pathIndivPred <-  file.path(find.package("peccary"), "Add_function", "indiv_plots")

# initialise
add_function <- "Default"

# for loop to add every function
for(a in list.files(pathIndivPred)){
# read file
temp <- readLines(file.path(pathIndivPred, a)) %>%
    gsub(pattern = "#.+", replacement = "")
# take the first declared function
newfunction <- try(temp[grep(".+<- *function\\(", temp)] %>%
  gsub(pattern = " *<-.+", replacement = ""))

if(class(newfunction) != "try-error"){

  if(gsub(".R$","",a) == newfunction) add_function <- c(add_function, newfunction )
}

}

updateSelectInput(session = session, inputId = "whichFunctionPred", choices = add_function)

# previous pro modification
observeEvent(input$recentprojectfile,{

  updateTextInput(session,"Project_file", value = isolate(input$recentprojectfile))

})



observeEvent(input$getpathProject,{
 test <-  file.choose()
updateTextInput(session, 'Project_file_create', value = test)
})

observeEvent(input$getpathDataset,{
  test <-  file.choose()
  updateTextInput(session, 'path_dataset_manual', value = test)
})


observeEvent(input$getpathProjectexisting,{
  print('la')
  test <-  file.choose()
  updateTextInput(session, 'Project_file', value = test)
})




# Project Creation --------------------------------------------------------
# Goal: create a folder with some subfolder, inclunding one containing every stored metadata (dataset pathways, plots, model....)
observeEvent(input$Project_create,{

  cat('Start creation project\n')
  pathtemp<- 'C:/Users/thiba/OneDrive/Documents/peccary_test'
  pathtemp <- isolate(input$Project_file_create)

  # Take the path
  path <- pathtemp %>%
    # path <- "\"file:///D:/these/Pecc_test\"" %>%
    gsub(pattern = "(file:///)|(\")", replacement = "") %>%
    gsub(pattern = "\\\\",replacement =  "/")



  projectfile <- create_pecc_shiny_project(pathtemp)



  # testroot <- str_split(path,pattern =   "/")[[1]]
  # projectfile$root <- paste0(testroot[- length(testroot)], collapse = .Platform$file.sep)
  #
  #
  #
  # projectfile$path <- path
  #
  #
  # # table containing all dataset metadata
  # projectfile$datasets <- tibble( n = numeric(), Path = character(),	File = character(),	  commentary =  character(),x = character(), id = character(), 	x_label = character(), y = character(), y_label = character(),
  #                                 filter = character(), sep = character(), na = character(), dec = character())
  #
  #
  # projectfile$exploPplot <-  tibble(Name = character(), preloadeddataset = character(),
  #                                   FilterexploX = character(), exploY= character(),
  #                                   Col= character(), Wrap = character(), exploGrid = character(),
  #                                   exploID = character(),exploPoint= character(),
  #                                   exploLine= character(), exploStand= character(),
  #                                   exploXlog= character(), exploYlog = character(),
  #                                   exploMedian = character(),exploNA = character(),
  #                                   exploLOQ = character(),scaleExplo = character(),
  #                                   titleExplo = character(),subtitleExplo = character(),
  #                                   xlabsExplo = character(),ylabsExplo = character(),
  #                                   captionExplo = character(),sizeTextExplo= character(),
  #                                   secondFilter= character(), allbackground= character(),
  #                                   addlineExplo= character(), all_bkgrdalpha= character())
  #
  # projectfile$models <-  list()



  updateTextInput(session, inputId = "path_models", value = file.path(path, "0_pecc_project/models.txt"))

  # ## download plots
  # output$datasets <- renderRHandsontable({
  #
  #
  #   datasets_df <- read.table(file.path(path, "/0_pecc_project/datasets.txt"), header = T, sep = ";", stringsAsFactors = F)
  #
  #   rhandsontable(datasets_df, rowHeaders = NULL)
  #
  # })

  create_pecc_shiny_project <- function(pathtemp = ''){

path <- pathtemp %>%
  # path <- "\"file:///D:/these/Pecc_test\"" %>%
  gsub(pattern = "(file:///)|(\")", replacement = "") %>%
  gsub(pattern = "\\\\",replacement =  "/")


projectfile <- list()



testroot <- str_split(path,pattern =   "/")[[1]]
projectfile$root <- paste0(testroot[- length(testroot)], collapse = .Platform$file.sep)



projectfile$path <- path


# table containing all dataset metadata
projectfile$datasets <- tibble( n = numeric(), Path = character(),	File = character(),	  commentary =  character(),x = character(), id = character(), 	x_label = character(), y = character(), y_label = character(),
                                filter = character(), sep = character(), na = character(), dec = character())


projectfile$exploPplot <-  tibble(Name = character(), preloadeddataset = character(),
                                  FilterexploX = character(), exploY= character(),
                                  Col= character(), Wrap = character(), exploGrid = character(),
                                  exploID = character(),exploPoint= character(),
                                  exploLine= character(), exploStand= character(),
                                  exploXlog= character(), exploYlog = character(),
                                  exploMedian = character(),exploNA = character(),
                                  exploLOQ = character(),scaleExplo = character(),
                                  titleExplo = character(),subtitleExplo = character(),
                                  xlabsExplo = character(),ylabsExplo = character(),
                                  captionExplo = character(),sizeTextExplo= character(),
                                  secondFilter= character(), allbackground= character(),
                                  addlineExplo= character(), all_bkgrdalpha= character())

projectfile$models <-  list()

projectfile
}

  # Addition 02/12/2020 : store into
  pathprev <- file.path(find.package("peccary"),  "previous_project_opened.txt")
  prevpro <- read.table(pathprev,sep = ";", header = T)

  prevpro$id <- as.character(prevpro$id) # if empty
  prevpro$projectpath <- as.character(prevpro$projectpath) # if empty
  prevpro$date <- as.character(prevpro$date)


  prevpro <- prevpro %>%
    filter(!(id == as.list(Sys.info())$user & projectpath == path)) %>%
    add_row(id = as.list(Sys.info())$user, projectpath = path,  date = as.character(Sys.time()))

  write.table(prevpro, file = pathprev, quote = F, sep = ";", row.names = F)
  updateSelectInput(session, inputId =  "recentprojectfile", choices = prevpro$projectpath, selected = input$Project_file_create)



  saveRDS(projectfile, path)

  output$messages <- renderMenu({

    dropdownMenu(type = "tasks", .list =   list(taskItem(text = paste0("Project ",gsub(".+/", "", path) ," created & loaded"), value = 100)))
  })


  project <<- projectfile
  showNotification("Project created", type = "message", duration = 3, closeButton = T)

  cat('End creation project\n')
})
#
#
# # project load ------------------------------------------------------------
#
observeEvent(input$Project_load,{


  cat("Load Project")
  project_file <<- isolate(input$Project_file) %>%
    gsub(pattern = "file:///", replacement = "")

  ###

  project <<- readRDS(project_file)

print(project$models)
  datasets_df <- project$datasets

  # Reload list of datasets
  output$datasets <- renderRHandsontable({

    rhandsontable(project$datasets, rowHeaders = NULL)

  })




  if(nrow(datasets_df) > 0 ){
    if("default" %in% names(datasets_df)){


      default <- datasets_df %>%
        filter(default == T) %>%
        pull(n)
      #
      #       datasets_df %>%
      #         select(-default)
    }


    if(length(default) == 0)  default <- 1


    # And put all available in the list of available data
    selectedd <- unique(paste0(datasets_df$n[datasets_df$n == default],":", datasets_df$File[datasets_df$n == default]))

    # make sure all file exists (if some has been removed)
    temp_dataset <- datasets_df %>%
      mutate(test = map2_lgl(Path, File, function(Path, File){

        if(length(grep(":/", Path)) == 0){
          file_temp <- file.path(project_file, Path, File)
        }else{
          file_temp <- file.path(Path, File)
        }

        file.exists(file_temp)

      })) %>%
      filter(test == TRUE)

    updateSelectInput(session, inputId = "preloadeddataset", choices = c("Use external", unique(paste0(datasets_df$n,":", datasets_df$File))), selected = selectedd) # what if several with same name..
  }
  print('That is done !')
  # updateSelectInput(session, inputId = "reportDatasetInfo", choices = c(unique(paste0(datasets_df$n,":", datasets_df$File))))
  # updateTextInput(session, inputId = "path_models", value = file.path(project_file, "0_pecc_project/models.txt"))


  # Put the dataset in preload

 if(!is.null(names(project$models))) updateSelectInput(session, 'names_model', choices = names(project$models), selected = names(project$models)[[1]])

  ####

  if(dir.exists(file.path(project_file, "0_pecc_project"))) {

    # print('here')

    # Addition 02/12/2020 : store into
    pathprev <- file.path(find.package("peccary"),  "previous_project_opened.txt")
    prevpro <- read.table(pathprev,sep = ";", header = T)

    prevpro$id <- as.character(prevpro$id) # if empty
    prevpro$projectpath <- as.character(prevpro$projectpath) # if empty
    prevpro$date <-  as.character(prevpro$date)



    prevpro <- prevpro %>%
      filter(!(id == as.list(Sys.info())$user & projectpath == input$Project_file)) %>%
      add_row(id = as.list(Sys.info())$user, projectpath = input$Project_file, date =  as.character(Sys.time()))

    write.table(prevpro, file = pathprev, quote = F, sep = ";", row.names = F)



    updateSelectInput(session, inputId =  "recentprojectfile", choices = prevpro$projectpath, selected = input$Project_file)

    # print('here')


    dataset_file <- read.table(file.path(project_file, "/0_pecc_project/datasets.txt"), header = T, stringsAsFactors = F)

    # read.table("file:///D:/these/Pecc_test/0_pecc_project/datasets.txt", header = T) %>%
    #   names
    ## setPat run

    updateTextInput(session, inputId = "path2", value = file.path(project_file, "3_Models", "1_Models"))


    # print(dataset_file)
    if(nrow(dataset_file) > 0 ){
      if("default" %in% names(dataset_file)){


        default <- dataset_file %>%
          filter(default == T) %>%
          pull(n)

        dataset_file %>%
          select(-default)
      }else{
        default <- 1
      }


      # print("test here2")
      updateNumericInput(session, inputId = "dataset_default", value = default)
      # print("test here3")


      datasets_df <<- dataset_file %>%
        mutate(n = as.integer(n),
               x = as.character(x),
               x_label = as.character(x_label),
               y = as.character(y),
               y_label = as.character(y_label),
               commentary = as.character(commentary),
               filter = as.character(filter),
               sep = as.character(sep),
               na = as.character(na),
               dec = as.character(dec))

      # print("test here4")
      # download dataset item
      # if(nrow(datasets_df) > 0){
      # output$datasets <- renderRHandsontable({
      #
      #
      #
      #   rhandsontable(datasets_df, rowHeaders = NULL)
      #
      # })}

      # print("test here4")
      ## update preloadeddataset

      selectedd <- unique(paste0(datasets_df$n[datasets_df$n == default],":", datasets_df$File[datasets_df$n == default]))

      # make sure all file exists (if some has been removed)
      temp_dataset <- datasets_df %>%
        mutate(test = map2_lgl(Path, File, function(Path, File){

          if(length(grep(":/", Path)) == 0){
            file_temp <- file.path(project_file, Path, File)
          }else{
            file_temp <- file.path(Path, File)
          }

          file.exists(file_temp)

        })) %>%
        filter(test == TRUE)

      updateSelectInput(session, inputId = "preloadeddataset", choices = c("Use external", unique(paste0(datasets_df$n,":", datasets_df$File))), selected = selectedd) # what if several with same name..
      updateSelectInput(session, inputId = "reportDatasetInfo", choices = c(unique(paste0(datasets_df$n,":", datasets_df$File))))
      updateTextInput(session, inputId = "path_models", value = file.path(project_file, "0_pecc_project/models.txt"))
    }else{

      ### what happen if we have a project without dataset?
      ### for the moment there are no modification
      try( updateTextInput(session, inputId = "path_models", value = file.path(project_file, "0_pecc_project/models.txt"))
      )
    }
    # print("test there")

    ## say okay
    output$messages <- renderMenu({

      dropdownMenu(type = "tasks", .list =   list(taskItem(text = paste0("Project ",gsub(".+/", "", isolate(input$Project_file)) ," loaded"), value = 100)))
    })

    # load exploplot
    try({
      read.table(stringsAsFactors = F, file.path(project_file, "0_pecc_project", "exploPlot.txt"), header = T) %>%
        as_tibble %>%
        mutate(output = paste0(gsub(":.+", "", preloadeddataset), ": ", Name)) %>%
        pull(output) -> choicesPlot

      updateSelectInput(session, "reportPlotExploSelect", choices = choicesPlot)
    })
    # load report
    try({
      temppath <- file.path(project_file, "0_pecc_project", "reports.rds")

      rapports <- try(readRDS(temppath)[[1]])
      if(class(rapports) != "try-error"){

        selected <- NA
        if(length(rapports) > 0) selected <- rapports[[1]]
        updateSelectInput(session, "reportVersion", choices = rapports, selected = rapports[[1]])
      }
    })
    # List model
    try({
      models <-  try(read.table(file.path(project_file, "0_pecc_project","models.txt" ), stringsAsFactors = F) %>% pull(name))


      if(class(models) !="try-error"){
        updateSelectInput(session, inputId = "reportModelEq", choices = c(models[order(models)]))
        updateSelectInput(session, inputId = "reportModelSimul", choices = c(models[order(models)]))
      }
    })

    # List data explo
    try({
      temppath <- file.path(project_file, "0_pecc_project", "dataExplo.rds")

      rapports <- try(readRDS(temppath))
      if(class(rapports) != "try-error"){

        rapports %>%
          mutate(output = paste0(gsub(":.+", "", preloadeddataset), ": ", dataexplonewVersion)) %>%
          pull(output) -> rapports

        rapports <- map(rapports, ~ paste0(.x, c("_table1", "_count"))) %>% reduce(c)
        rapports <- rapports[order(rapports)]
        updateSelectInput(session, "reportDataExploSelect", choices = rapports, selected = NA)
      }
    })
  }else{

    # showNotification("Error: project does not exist", type = "error", closeButton = T, duration = 4 )

  } # end if dir exist
  print('Project load done')
})
#
#
#

# # Find datasets -----------------------------------------------------------
#
observeEvent(input$load_data_folders,{

  # print("over here ! ")
  previous <- try(hot_to_r(isolate(input$datasets)) )

  # print(previous)

  if(class(previous) != "try-error"){

    previous <- previous %>%
      mutate(n = as.integer(n),
             x = as.character(x),
             x_label = as.character(x_label),
             y = as.character(y),
             y_label = as.character(y_label),
             commentary = as.character(commentary),
             filter = as.character(filter),
             sep = as.character(sep),
             na = as.character(na),
             dec = as.character(dec))


  }else{

    previous <- tibble(File = "", n = 0L)
  }

  # print("there")
  all_files_scanned <-   tibble(Path = c("1_Data/1_as_received", "1_Data/2_manually_modified", "1_Data/3_final")) %>%
    mutate(File = map(Path, ~  list.files(file.path(project_file, .x)))) %>%
    unnest(File)



  if(nrow(all_files_scanned) > 0 ){
    all_files_scanned <- all_files_scanned %>%
      filter(!(File %in% unique(previous$File))) %>%
      rownames_to_column("n") %>%
      mutate(n = as.integer(n) + if_else(nrow(previous) == 0, 0L, max(previous$n))) %>%
      mutate(x = " ") %>%
      mutate(x_label= " ") %>%
      mutate(y = " ") %>%
      mutate(y_label= " ") %>%
      mutate(commentary = " ") %>%
      mutate(sep = ";") %>%
      mutate(dec = ".") %>%
      mutate(na = ".") %>%
      mutate(id = " ") %>%
      mutate(commentary = " ")

  }

  # print(all_files_scanned)

  if(previous$File[[1]] == ""){

    bindrowsss <- all_files_scanned

  }else{


    bindrowsss <- try( bind_rows(previous, all_files_scanned))

  }


  if(class(bindrowsss) != "try-error"){

    if(nrow(bindrowsss)>0)output$datasets <- renderRHandsontable( rhandsontable(bindrowsss, rowHeaders = NULL))
  }




})


# guess sep  --------------------------------------------------------------

observeEvent(input$path_dataset_manual, {
  try({
  newpath <- input$path_dataset_manual
  print("Start path dataset manuel")
  print(newpath)
  # newpath <- "file:///D:/Peccary/Exemple_demo/DATA/Simeoni.txt"
  # newpath <- "file:///D:/Peccary/Exemple_demo/DATA/Theoph.txt"
newpath <- gsub("file:///", "", newpath) %>%
    gsub(pattern = "\\\\",  replacement = "/") %>%
    gsub(pattern = "\"",  replacement = "")


  tibble(totry = c(" ", ",", ";", ".")) %>%
    mutate(test = map_dbl(totry, function(x){

      test <- try(length(read.table(newpath, header = T, sep = x,  nrows = 1)), silent = T)
      if(class(test) == "try-error") test <- 0
      test
    })) %>%
    arrange(desc(test)) %>%
    slice(1) %>% pull(totry) -> sep

 updateSelectInput(session, inputId = "sepExplo", selected =  sep)
  }, silent = T)
})

# add temporar dataset ----------------------------------------------------

observeEvent(input$addDataset,{

print('Start add dataset')
  # print("################ Trying to add a dataset #################")
  previous <- try(hot_to_r(isolate(input$datasets)) )

  # print("Previous table:")
  # print(previous)

  newpath <- isolate(input$path_dataset_manual)

  # print("New dataset")
  # print(newpath)
  # print(file.exists(newpath))
  # newpath <- "\"file:///D:/Peccary/Exemple_demo/DATA/Simeoni.txt\""

  # newpath <- "\"D:\\Peccary\\Exemple_demo\\DATA\\Theoph.txt\""
  newpath <- gsub("file:///", "", newpath) %>%
    gsub(pattern = "\\\\",  replacement = "/") %>%
    gsub(pattern = "\"",  replacement = "")

  # print("New dataset after epuration")
  # print(newpath)
  # print(file.exists(newpath))

  # print("Split with /")
  newpathsplit <- str_split(newpath, "/")[[1]]


  sep <- isolate(input$sepExplo)
  # print("Sep")
  # print(sep)

  # print("Try read headerr")
  if(grepl("\\.xlsx?$", newpath)){

    require("readxl")
    headerr <- names(readxl::read_excel(newpath))

  }else{
# print("not a readx!")
    headerr <- names(read.table(newpath, sep = sep,header = T, nrows =  1))
    # print(headerr)
  }



  timehead <- c(headerr[grep("(time)|(^x$)", tolower(headerr))], "")[[1]]
  obshead <- c(headerr[grep("(^obs)|(^dv)|(^y$)|(^conc)", tolower(headerr))], "")[[1]]

  # print("Create the new line")
  new <- tibble(n = 1L,
                Path =  invoke(file.path, newpathsplit[-length(newpathsplit)]),
                File =  newpathsplit[length(newpathsplit)],
                commentary = "",
                x = timehead,
                y = obshead,
                x_label = "",
                y_label = "",
                filter = "",
                sep = isolate(input$sepExplo),
                na = isolate(input$nastringExplo),
                dec = isolate(input$decExplo),
                default = F,
                monolix_header = "",
                id = "")


  if(class(previous) != "try-error" & !is.null(previous)){
    # print("a2")
    previous <- previous %>%
      mutate(n = as.integer(n),
             x = as.character(x),
             x_label = as.character(x_label),
             y = as.character(y),
             y_label = as.character(y_label),
             commentary = as.character(commentary),
             filter = as.character(filter),
             sep = as.character(sep),
             na = as.character(na),
             dec = as.character(dec))

  if(nrow(previous) >0)  new$n <- max(previous$n) + 1L


    bindrowsss <- try( bind_rows(previous, new))

    output$datasets <- renderRHandsontable( rhandsontable( bindrowsss, rowHeaders = NULL))
    # print('checkl project dataset')
    # print(bindrowsss)
    project$datasets <<-   bindrowsss

    choicess <- unique(paste0(bindrowsss$n,":", bindrowsss$File))

    updateSelectInput(session, inputId = "preloadeddataset", choices = choicess) # what if several with same name..

  }else{

    output$datasets <- renderRHandsontable( rhandsontable( new, rowHeaders = NULL))
    project$datasets <<-   new
    choicess <- unique(paste0(new$n,":", new$File))

    selectedd <- choicess[[1]]

    updateSelectInput(session, inputId = "preloadeddataset", choices = c("Use external",choicess), selected = selectedd) # what if several with same name..


  }


  # print('checkl project dataset')
  # print(  project$datasets)
  # print(  hot_to_r(isolate(input$datasets)))

})


# quicklooksave -----------------------------------------------------------


observeEvent(input$quicklooksave,{




  # print("here")
  temp <- hot_to_r(isolate(input$datasets)) %>%
    mutate(x = if_else(n == isolate(input$quicklookn), isolate(input$quicklookx), x)) %>%
    mutate(x_label= if_else(n == isolate(input$quicklookn), isolate(input$quicklookxlabel), x_label)) %>%
    mutate(y = if_else(n == isolate(input$quicklookn), isolate(input$quicklooky), y)) %>%
    mutate(y_label= if_else(n == isolate(input$quicklookn), isolate(input$quicklookylabel), y_label)) %>%
    mutate(commentary = if_else(n == isolate(input$quicklookn), isolate(input$quicklookcomment), commentary)) %>%
    mutate(sep = if_else(n == isolate(input$quicklookn), isolate(input$quicklooksep), sep)) %>%
    mutate(dec = if_else(n == isolate(input$quicklookn), isolate(input$quicklookdec), dec)) %>%
    mutate(na = if_else(n == isolate(input$quicklookn), isolate(input$quicklookna), na))


  # monolix header

  test <-  tribble(~Name, ~Col,
                   "ID", isolate(input$IDheader),
                   "time", isolate(input$IDheader2),
                   "OBS", isolate(input$OBSheader),
                   "AMT", isolate(input$AMTheader),
                   "RATE", isolate(input$RATEheader),
                   "EVID", isolate(input$EVIDheader),
                   "MDV", isolate(input$MDVheader),
                   "YTYPE", isolate(input$YTYPEheader),
                   "cov.cat", isolate(input$COVCATheader),
                   "cov.cont", isolate(input$COVCONTheader),
                   "ADM", isolate(input$ADMheader)

  )


  express <- test %>%
    filter(Col != "") %>%
    mutate(end = paste0(Col, " = \"",Name, "\"")) %>%
    pull(end) %>%
    paste0(collapse = ", ") %>%
    {paste0("c(", ., ")")}


  if(express == "c()") express <- ""

  if("monolix_header" %in% names(temp) ){

    # print("here")
    temp <- temp %>%
      mutate(monolix_header =   if_else(n == isolate(input$quicklookn),  express, as.character(monolix_header)))

  }else{

    # print("plot")
    # print(expr(c(!!!map(hot_to_r(isolate(input$defineheader)) %>% map_dfr(~ as.character(.x)), ~.x))) %>% deparse)

    temp <- temp %>%
      mutate(monolix_header =   if_else(n == isolate(input$quicklookn),  express, ""))


  }
  # # print("here")
  # mutate(id = if_else(n == isolate(input$quicklookn), isolate(input$quicklookna), id))

  # explo_header
    # hot_to_r(isolate(input$datasets))


  # explo_header <<- expr(c(!!!map(hot_to_r(isolate(input$defineheader)) %>% map_dfr(~ as.character(.x)), ~.x))) %>% deparse(width.cutoff = 500)

  output$datasets <- renderRHandsontable( rhandsontable( temp, rowHeaders = NULL))
  datasets_df <- temp

  showNotification("Do not forget to save the whole table !", type = "message", duration = 3, closeButton = T)

})


# observEvent quicklook ---------------------------------------------------


observeEvent(input$quicklookn,{

  temp <- try(hot_to_r(isolate(input$datasets)) %>%
                filter(n == isolate(input$quicklookn)))



  ### first lines
  if(class(temp) != "try-error"){

    if(nrow(temp) >= 1){
      updateSelectInput(session, inputId =  "quicklooksep",  selected = temp$sep)
      updateSelectInput(session, inputId =  "quicklookdec",  selected = temp$dec)
      updateTextInput(session, inputId = "quicklookna", value = temp$na)
      updateTextInput(session, inputId = "quicklookx", value = temp$x)
      updateTextInput(session, inputId = "quicklookxlabel", value = temp$x_label)
      updateTextInput(session, inputId = "quicklooky", value = temp$y)
      updateTextInput(session, inputId = "quicklookylabel", value = temp$y_label)
      updateTextInput(session, inputId = "quicklookcomment", value = temp$commentary)
    }
  }else{

    updateSelectInput(session, inputId =  "quicklooksep",  selected = ";")
    updateSelectInput(session, inputId =  "quicklookdec",  selected = ".")
    updateTextInput(session, inputId = "quicklookna", value = ".")
    updateTextInput(session, inputId = "quicklookx", value = "")
    updateTextInput(session, inputId = "quicklookxlabel", value = "")
    updateTextInput(session, inputId = "quicklooky", value = "")
    updateTextInput(session, inputId = "quicklookylabel", value = "")
    updateTextInput(session, inputId = "quicklookcomment", value = "")

  }

##### monolix header

try({

  ## getting current header
  headerTable <- tibble(name = "", statut = "")
  # datasetdf <- datasets_df %>%
  #   filter(n == 13)
  datasetdf <- try( hot_to_r(isolate(input$datasets)) %>%
                      filter(n == isolate(input$quicklookn)))
  tryeval <- try(eval(parse_expr(as.character(datasetdf$monolix_header))))
  if(class(tryeval) != "try-error"){
  if(!is.na(tryeval)) headerTable <- try(tibble(name = names(tryeval), statut = tryeval))
  }

  ## getting name of columns
  if(length(grep(":/|\\\\", datasetdf$Path)) > 0 ){
    pathfile <- file.path(datasetdf$Path, datasetdf$File)
  }else{
    pathfile <- file.path(project_file,datasetdf$Path, datasetdf$File)

  }

  read.table(nrows = 0,  pathfile, sep = datasetdf$sep, header = T, dec = datasetdf$dec, na.strings = datasetdf$na, stringsAsFactors = F )  %>%
    names -> namescol




  ## let's update !

  updateSelectInput(session, "IDheader", choices = namescol, selected = c(headerTable$name[headerTable$statut == "ID"], NA)[[1]])
  updateSelectInput(session, "IDheader2", choices = namescol, selected = c(headerTable$name[headerTable$statut == "time"], NA)[[1]])
  updateSelectInput(session, "OBSheader", choices = namescol, selected = c(headerTable$name[headerTable$statut == "OBS"], NA)[[1]])
  updateSelectInput(session, "AMTheader", choices = namescol, selected = c(headerTable$name[headerTable$statut == "AMT"], NA)[[1]])
  updateSelectInput(session, "RATEheader", choices = namescol, selected = c(headerTable$name[headerTable$statut == "RATE"], NA)[[1]])
  updateSelectInput(session, "EVIDheader", choices = namescol, selected = c(headerTable$name[headerTable$statut == "EVID"], NA)[[1]])
  updateSelectInput(session, "MDVheader", choices = namescol, selected = c(headerTable$name[headerTable$statut == "MDV"], NA)[[1]])
  updateSelectInput(session, "YTYPEheader", choices = namescol, selected = c(headerTable$name[headerTable$statut == "YTYPE"], NA)[[1]])
  updateSelectInput(session, "COVCATheader", choices = namescol, selected = c(headerTable$name[headerTable$statut == "cov.cat"], NA)[[1]])
  updateSelectInput(session, "COVCONTheader", choices = namescol, selected = c(headerTable$name[headerTable$statut == "cov.cont"], NA)[[1]])
  updateSelectInput(session, "ADMheader", choices = namescol, selected = c(headerTable$name[headerTable$statut == "ADM"], NA)[[1]])

    # unique(headerTable$statut)
  # div(style="display:inline-block; width: 100px;height: 75px;", selectInput(inputId =  "IDheader2", label = "TIME", choices = c("lol","lal"), selected = "lol")),
  # div(style="display:inline-block; width: 100px;height: 75px;", selectInput(inputId = "OBSheader", label = "OBS", choices = c(""), selected = "")),
  # div(style="display:inline-block; width: 100px;height: 75px;", selectInput(inputId = "AMTheader", label = "AMT", choices = c(""), selected = "")),
  # div(style="display:inline-block; width: 100px;height: 75px;", selectInput(inputId = "AMTheader", label = "ADM", choices = c(""), selected = "")),
  # div(style="display:inline-block; width: 100px;height: 75px;", selectInput(inputId = "RATEheader", label = "RATE", choices = c(""), selected = "")),
  # div(style="display:inline-block; width: 100px;height: 75px;", selectInput(inputId = "EVIDheader", label = "EVID", choices = c(""), selected = "")),
  # div(style="display:inline-block; width: 100px;height: 75px;", selectInput(inputId = "MDVheader", label = "MDV", choices = c(""), selected = "")),
  # div(style="display:inline-block; width: 100px;height: 75px;", selectInput(inputId = "YTYPEheader", label = "YTYPE", choices = c(""), selected = "")),
  # div(style="display:inline-block; width: 100px;height: 75px;", selectInput(inputId = "COVCONTheader", label = "cov.cont", choices = c(""), selected = "")),
  # div(style="display:inline-block; width: 100px;height: 75px;", selectInput(inputId = "COVCATheader", label = "cov.cat", choices = c(""), selected = ""))

})
  #
})




# save dataset ------------------------------------------------------------

observeEvent(input$save_datasets,{

  print(hot_to_r(isolate(input$datasets)))
  temp <<- hot_to_r(isolate(input$datasets))


  project$datasets <-  hot_to_r(isolate(input$datasets))


  saveRDS(project, project$path)

  project <<- project
  # if(project_file != "none"){
  # temp <<- hot_to_r(isolate(input$datasets))
  #
  # if(isolate(input$dataset_default) %in% temp$n){
  #
  #
  #   temp <- temp %>%
  #     mutate(default = if_else(n == isolate(input$dataset_default), T , F))
  #
  # }
  #
  #
  #
  # write.table(temp, file = file.path(project_file, "/0_pecc_project/datasets.txt"), row.names = F)
  #
  # datasets_df <<- isolate(hot_to_r(input$datasets))
  #
  # }else{
  #
  #   showNotification("You need first to load / create a project !", type = "error", duration = 4, closeButton = T)
  # }

})

observeEvent(input$datasets,{

  datasets_df <<- hot_to_r(input$datasets)

})
#
# # Pre-loaded dataset for exploration  ---------------------------------------------------------------
#
observeEvent(input$preloadeddataset, {

  # if(exists(project))

  cat('Start Preload dataset')

  preloadeddataset <<- isolate(input$preloadeddataset) %>%
    gsub(pattern = "file:///",  replacement = "") %>%
    gsub(pattern = "\\\\",  replacement = "/") %>%
    gsub(pattern = "\"",  replacement = "")

#
updateTextInput(session, "tableExploManipulation", value = "")
#
# print(  hot_to_r(isolate(input$datasets)))
print(preloadeddataset)
  if(!preloadeddataset %in% c("Use external", ':')){

#
    # try useless because can return a 0xn df
    line <-  try(
      project$datasets  %>%
        filter(n == gsub(":.+", "", preloadeddataset))
    )




print("line")
print(line)

file <- gsub(" \\+ code$","", line$File)

      # if relative path from project
      if(file.exists(file.path(project_file, line$Path, file))){
        explo_path <<- try(file.path(project_file, line$Path, file))
      }else{
      # if absolute path
        explo_path <<- try(file.path(line$Path, file))

      }



#
print("explo_path")
print(explo_path)
print(line)


    explo_na <<- line$na
    explo_sep <<- line$sep
    explo_dec <<- line$dec

    # initialisation before if
print('line')
print(line)
    if("monolix_header" %in% names(line) ){
      if(!is.na(line$monolix_header)){
      if(gsub(" ", "",line$monolix_header) != ""){
      try(explo_header <<- as.character(line$monolix_header))
      try(explo_headerevaled <<- eval(parse_expr(explo_header)))
      }
      }
    }

    if(!exists("explo_header"))explo_header <<- "F"
    if(!exists("explo_headerevaled"))explo_headerevaled <<- "F"
# print("we try exploooo")

    if(grepl("\\.xlsx?$", explo_path)){

      require("readxl")
      explo <<- try(readxl::read_excel(explo_path))

    }else{

    explo <<- try(read.table( explo_path, header = T, na.strings = explo_na, sep = explo_sep, dec = explo_dec))

    }

    # Perfom modification if needed

    if(grepl(" \\+ code", preloadeddataset)){


    explo <<-
      try(eval(parse_expr(line$codeToEval)))

    }

# print(head(explo))
    # print(explo)

    if(class(explo) != "try-error"){

      if(!grepl("\\+ code$", line$File)){

        explo_expr <<- expr(explo <- read.table(file = !!explo_path, header = T, na.strings = !!explo_na, sep = !!explo_sep, dec = !!explo_dec))

      }else{

        explo_expr <<-   expr(explo <- {explo <- read.table(file = !!explo_path, header = T, na.strings = !!explo_na, sep = !!explo_sep, dec = !!explo_dec)
        !!!parse_exprs(line$codeToEval)})



      }



      # updateTextInput(session, "pathExplo", value = path)
      updateSelectInput(session, "exploY", choices = c("", names(explo)), selected = line$y)
      updateSelectInput(session, "exploX", choices = c("", names(explo)), selected = line$x)
      updateTextAreaInput(session, "filterrExplo", value  = line$filter)
      # updateSelectInput(session, "sepExplo",  choices = c("Space" = "", ";", ".", ","), selected = line$sep)
      # updateSelectInput(session, "decExplo", choices = c(".", ","), selected = line$dec)
      # updateTextInput(session, "nastringExplo", value  = line$na)
      updateSelectInput(session, "exploID", choices = c("", names(explo)), selected = names(explo)[c(grep("(id)|(subj)", tolower(names(explo))),1)[[1]]])

      updateSelectInput(session, "exploCol", choices = c("", names(explo)), selected = "")
      updateSelectInput(session, "exploWrap", choices = c("", names(explo)), selected = "")
      updateSelectInput(session, "exploGrid", choices = c("", names(explo)), selected = "")
      updateSelectInput(session, "exploStand", choices = c("", names(explo)), selected = "")
      updateSelectInput(session, "exploShape", choices = c("", names(explo)), selected = "")
      updateSelectInput(session, "exploLty", choices = c("", names(explo)), selected = "")
      updateSelectInput(session, "covNCA", choices = c("", names(explo)), selected = "")
      updateSelectInput(session, "groupNCA", choices = c("", names(explo)), selected = names(explo)[c(grep("(id)|(subj)", tolower(names(explo))),1)[[1]]])
         updateSelectInput(session, "blqNCA", choices = c("", names(explo)), selected =   names(explo)[c(grep("blq", tolower(names(explo))),NA)[[1]]])
      # updateSelectInput(session, "evidNCA", choices = c("", names(explo)), selected =   names(explo)[c(grep("evid", tolower(names(explo))),NA)[[1]]])

       updateSelectInput(session, "pknca_id", choices = c( names(explo)), selected = names(explo)[c(grep("(id)|(subj)", tolower(names(explo))),1)[[1]]])
      updateSelectInput(session, "pknca_cov", choices = c("", names(explo)), selected = "")
      updateSelectInput(session, "pknca_rateduration", choices = c("", names(explo)), selected = "")
      updateSelectInput(session, "pknca_dose", choices = c("", names(explo)), selected = names(explo)[c(grep("(amt)|(dose)", tolower(names(explo))),1)[[1]]])
      updateSelectInput(session, "pknca_ADM", choices = c("Single dose time 0", names(explo)), selected = names(explo)[c(grep("evid", tolower(names(explo))),1)[[1]]])

    }


  }
# #
#   # pre_loaded plots
  cat("preloadPlot\n")
#
#   path_temp <- try(file.path(project_file,"0_pecc_project/exploPlot.txt"))
#


 if(exists('project')){
  # if(class(previous) != "try-error"){
   previous <- try(project$exploPplot)

    if(nrow(previous) > 0){
    previous %>%
      filter(preloadeddataset == isolate(input$preloadeddataset)) %>%
      select(Name, Filter, Col, Wrap) %>%
      mutate(Load = F) %>%
      mutate(pdf = F) %>%
      mutate(Name = as.character(Name)) %>%
      mutate(Filter = as.character(Filter)) %>%
      mutate(Col = as.character(Col)) %>%
      mutate(Wrap = as.character(Wrap)) %>%
      select(Load, pdf, everything())-> outpuutt



    output$PlotexplorationSaved <- renderRHandsontable(rhandsontable(outpuutt,rowHeaders = NULL))
    }
 }
  cat("end preloadPlot\n")
  # }
#
#   # end function
#   # print("preloadNCA")
  # path_temp2 <- try(file.path(project_file,"0_pecc_project/NCA.txt"))

  # previous2 <- project$NCA
  #
  # if(!is.null(previous2)){
  #   # print("tesst")
  #   previous2 %>%
  #     filter(preloadeddataset == isolate(input$preloadeddataset)) %>%
  #     select(Name, Filter) %>%
  #     mutate(Load = F) %>%
  #     mutate(pdf = F) %>%
  #     mutate(Name = as.character(Name)) %>%
  #     mutate(Filter = as.character(Filter)) %>%
  #     select(Load, pdf, everything())-> outpuutt2
  #   # print(outpuutt)
  #   output$NCASaved <- renderRHandsontable(rhandsontable(outpuutt2,rowHeaders = NULL))
  # }
#   # print("hereendokays")
#
#
#   ### the dataset observation thing
#
  try(
    output$tableexplo <- DT::renderDataTable({

      # print("tableExplo")
      if(isolate(input$filterrExplo) == "" | is.na(isolate(input$filterrExplo))){

        temp <- explo
      }else{

        temp <- explo %>%
          filter_(isolate(input$filterrExplo))

      }

      if(!(isolate(input$filtertableexplo) == "" | is.na(isolate(input$filtertableexplo)))){

        temp <- temp %>%
          filter_(isolate(input$filtertableexplo))
      }

      if(!(isolate(input$tableExploManipulation) == "" | is.na(isolate(input$tableExploManipulation)))){

        code <- paste0("temp <- {temp\n", isolate(input$tableExploManipulation),"}") %>%
          gsub(pattern = "\n *%>%", replacement = "%>%")

        # print(code)
        eval(parse_expr(code))

        # eval(parse_expr(paste0("temp", test)))
        # # eval(parse_expr)
        #   test <- " %>% filter(mpg >3) %>% \n select(wt, qsec)"
      }

      if(length(isolate(input$groupbyCovExplo)) > 0){


        temp <- pecc_search_cov(temp, isolate(input$groupbyCovExplo))


      }

      updateSelectInput(session, "groupbyExplo", choices = names(temp),selected = NA)
      updateSelectInput(session, "groupbyCovExplo", choices = names(temp),selected = NA)
      updateSelectInput(session, "table1reduceBy", choices = names(temp),selected = NA)
      updateSelectInput(session, "table1x", choices = c("All", names(temp)),selected = "All")
      updateSelectInput(session, "table1y", choices = names(temp),selected = NA)
    return(temp)

    }, options = list(pageLength = 10, scrollX = TRUE))

  )


 updateSelectInput(session, 'names_model', choices = names(project$models))
#
#   # load data exploration
#
  # temppath <- project$datasets # file.path(project_file, "0_pecc_project", "dataExplo.rds")
  #
  # rapports <- try(readRDS(temppath))
  # if(class(rapports) != "try-error"){
  #
  #   rapports  %>%
  #     filter(preloadeddataset == isolate(input$preloadeddataset) ) %>%
  #     pull(dataexplonewVersion) -> rapports
  #
  #   if(length(rapports) > 0){
  #   selected <- NA
  #   if(length(rapports) > 0) selected <- rapports[[1]]
  #   updateSelectInput(session, "dataexploVersion", choices = rapports, selected = rapports[[1]])
  #   }else{
  #
  #     updateSelectInput(session, "dataexploVersion", choices = "", selected = "")
  #
  #   }
  #
  #
  # }
#
print('end preloaddataset')
})
# # #
Peccary-PMX/Peccary documentation built on Jan. 17, 2024, 9:27 p.m.