Merge pull request #96 from diyabc/refactor_app

Application refactoring to improve performance, robustness and stability (training set simulation and random forest analysis only)

Author: gdurif

R-pkg/DESCRIPTION

@@ -1,8 +1,8 @@
 Package: diyabcGUI
 Type: Package
 Title: Graphical User Interface for DYIABC-RF software
-Version: 1.0.14
-Date: 2021-03-12
+Version: 1.1.0
+Date: 2021-08-24
 Authors@R: c(
     person(
         "Ghislain", "Durif", comment="diyabcGUI main developer",
@@ -59,11 +59,14 @@ Imports:
     lubridate, 
     jsonlite, 
     magrittr, 
+    markdown, 
+    mime,
     parallel, pbapply, processx,
+    readr,
     rlang,
     shiny, 
     shinybusy (>= 0.2.2), 
-    shinydashboard, shinyFiles, 
+    shinydashboard, shinyFeedback, shinyFiles, 
     shinyhelper, shinyjs, shinyWidgets, 
     stringr, 
     tibble,

R-pkg/NAMESPACE

@@ -13,6 +13,7 @@ export(get_option)
 export(redirect_output)
 export(set_diyabcGUI_options)
 export(standalone_run_app)
+import(markdown)
 import(shiny)
 importFrom(dplyr,arrange)
 importFrom(dplyr,bind_rows)
@@ -53,16 +54,21 @@ importFrom(ggplot2,ylim)
 importFrom(jsonlite,fromJSON)
 importFrom(lubridate,now)
 importFrom(magrittr,"%>%")
+importFrom(mime,guess_type)
 importFrom(parallel,detectCores)
 importFrom(parallel,makeCluster)
 importFrom(parallel,stopCluster)
 importFrom(pbapply,pblapply)
 importFrom(processx,process)
+importFrom(readr,read_file)
 importFrom(rlang,duplicate)
+importFrom(shinyFeedback,feedbackWarning)
+importFrom(shinyFeedback,useShinyFeedback)
 importFrom(shinyWidgets,actionBttn)
 importFrom(shinyWidgets,actionGroupButtons)
 importFrom(shinyWidgets,ask_confirmation)
 importFrom(shinyWidgets,downloadBttn)
+importFrom(shinyWidgets,execute_safely)
 importFrom(shinyWidgets,progressBar)
 importFrom(shinyWidgets,radioGroupButtons)
 importFrom(shinyWidgets,show_alert)
@@ -74,7 +80,9 @@ importFrom(shinydashboard,dashboardHeader)
 importFrom(shinydashboard,dashboardPage)
 importFrom(shinydashboard,dashboardSidebar)
 importFrom(shinydashboard,menuItem)
+importFrom(shinydashboard,renderMenu)
 importFrom(shinydashboard,sidebarMenu)
+importFrom(shinydashboard,sidebarMenuOutput)
 importFrom(shinydashboard,tabItem)
 importFrom(shinydashboard,tabItems)
 importFrom(shinydashboard,updateTabItems)
@@ -85,7 +93,6 @@ importFrom(shinyjs,disabled)
 importFrom(shinyjs,enable)
 importFrom(shinyjs,hidden)
 importFrom(shinyjs,hide)
-importFrom(shinyjs,onclick)
 importFrom(shinyjs,reset)
 importFrom(shinyjs,show)
 importFrom(shinyjs,useShinyjs)
@@ -100,6 +107,7 @@ importFrom(stringr,str_pad)
 importFrom(stringr,str_replace)
 importFrom(stringr,str_replace_all)
 importFrom(stringr,str_split)
+importFrom(stringr,str_to_lower)
 importFrom(stringr,str_to_upper)
 importFrom(stringr,str_trim)
 importFrom(tibble,lst)

R-pkg/R/01_directory.R

@@ -75,3 +75,44 @@ mk_proj_dir <- function(tag = "diyabc") {
     # output
     return(tmp_dir)
 }
+
+
+#' Clean project directory
+#' @keywords internal
+#' @description Remove all files and sub-folders in a given project directory.
+#' @author Ghislain Durif
+#' @param proj_dir character string, path to project directory.
+clean_proj_dir <- function(proj_dir) {
+    # check if project directory exists
+    if(length(proj_dir) != 1 && !dir.exists(proj_dir)) {
+        stop("Input argument should be a valid path to a project directory")
+    }
+    # sub-folders
+    subdir_list <- list.dirs(proj_dir, full.names = FALSE, recursive = FALSE)
+    subdir_list <- subdir_list[subdir_list != ""]
+    if(length(subdir_list) > 0) {
+        fs::dir_delete(file.path(proj_dir, subdir_list))
+    }
+    # files
+    file_list <- list.files(proj_dir)
+    if(length(file_list) > 0) {
+        fs::file_delete(file.path(proj_dir, file_list))
+    }
+}
+
+
+#' Clean binary directory
+#' @keywords internal
+#' @author Ghislain Durif
+clean_bin_dir <- function() {
+    # bin directory
+    path <- bin_dir()
+    # existing binary file
+    existing_bin_files <- list.files(path)
+    existing_bin_files <- existing_bin_files[str_detect(existing_bin_files, 
+                                                        "diyabc|abcranger|dll")]
+    # delete diyabc/abcranger files
+    if(length(existing_bin_files) > 0) {
+        fs::file_delete(file.path(path, existing_bin_files))
+    }
+}

R-pkg/R/02_regex.R

@@ -12,6 +12,13 @@ num_regex <- function() {
     return("[0-9]+\\.?[0-9]*")
 }
 
+#' return numerical (xxEyy notation) regex
+#' @keywords internal
+#' @author Ghislain Durif
+numexp_regex <- function() {
+    return("[0-9]+\\.?[0-9]*((E|e)\\-?[0-9]+)?")
+}
+
 #' return event numerical rate regex
 #' @keywords internal
 #' @author Ghislain Durif

R-pkg/R/03_utils.R

@@ -42,21 +42,6 @@ find_bin <- function(prog = "diyabc") {
     return(bin_file)
 }
 
-#' Clean binary directory
-#' @keywords internal
-#' @author Ghislain Durif
-clean_bin_dir <- function() {
-    # bin directory
-    path <- bin_dir()
-    # existing binary file
-    existing_bin_files <- list.files(path)
-    existing_bin_files <- existing_bin_files[str_detect(existing_bin_files, 
-                                                        "diyabc|abcranger|dll")]
-    # delete diyabc/abcranger files
-    if(length(existing_bin_files) > 0) {
-        fs::file_delete(file.path(path, existing_bin_files))
-    }
-}
 
 #' Find which OS is running
 #' @keywords internal
@@ -85,6 +70,8 @@ get_os <- function() {
 #' @author Ghislain Durif
 #' @param prog string, name of the program to download, eligible name are
 #' `"diyabc-RF"` and `"abcranger"`.
+#' @return integer value, `0` if download succeeded, `1` if download failed,
+#' `-1` if latest version is already here.
 #' @importFrom fs file_chmod
 #' @importFrom jsonlite fromJSON
 #' @export
@@ -107,6 +94,7 @@ dl_latest_bin <- function(prog = "diyabc") {
         "releases/latest",
         sep = "/"
     )
+    
     # check latest release info
     release_info <- fromJSON(release_url)
 
@@ -115,94 +103,91 @@ dl_latest_bin <- function(prog = "diyabc") {
 
     # check if file in release
     if(nrow(release) < 1) {
-        stop(str_c("Issue with available files at ", release_url, ". ",
-                   "Contact DIYABC-RF support.",
-                   sep = ""))
+        stop(str_c(
+            "Issue with files available at", release_url, ".",
+            "Please contact DIYABC-RF support.",
+            sep = " "
+        ))
+    }
+    
+    # select release for current OS
+    release <- subset(release, str_detect(release$name, os_id))
+    
+    # check if release available for current OS
+    if(nrow(release) != 1) {
+        stop(str_c(
+            prog, "binary file is not available for", os_id, "OS at",
+            release_url, ".",
+            "Please contact DIYABC-RF support.",
+            sep = ""
+        ))
     }
 
     # already existing binary file
     existing_bin_files <- list.files(path)
 
     # download release
-    out <- lapply(
-        split(release, seq(nrow(release))), 
-        function(single_file) {
-            # output
-            #   check:  0 if dl is ok or latest version already here,
-            #           1 if dl failed
-            #           -1 if no binary files was available
-            check <- 1
-            bin_name <- single_file$name
-            bin_url <- single_file$browser_download_url
-            
-            # abcranger/diyabc binary files
-            if(str_detect(bin_name, str_c(prog_name(prog), "-", 
-                                          os_id, sep = ""))) {
-                if(!bin_name %in% existing_bin_files) {
-                    # avoid blacklisting
-                    Sys.sleep(2)
-                    # dl
-                    check <- download.file(
-                        bin_url, 
-                        destfile = file.path(path, bin_name),
-                        mode = "wb"
-                    )
-                } else {
-                    check <- 0
-                    warning(str_c(
-                        "The latest release", bin_name, 
-                        "was already downloaded.", sep = " "
-                    ))
-                }
-            } else {
-                check <- -1
-            }
-            return(check)
-        }
-    )
+    check <- 1
+    bin_name <- release$name
+    bin_url <- release$browser_download_url
 
-    # binary files not available at all among files in latest release
-    if(all(out == -1)) {
-        warning(str_c("No binary file available for ", prog, " on ", 
-                      os_id, ". ",
-                      "Contact DIYABC-RF support.",
-                      sep = ""))
-    }
-    
-    # no download success among files in latest release
-    if(!any(out == 0)) {
-        stop("Issue with download")
+    # check if bin file already available locally
+    if(!bin_name %in% existing_bin_files) {
+        # avoid blacklisting
+        Sys.sleep(2)
+        # dl
+        check <- download.file(
+            bin_url, 
+            destfile = file.path(path, bin_name),
+            mode = "wb"
+        )
+    } else {
+        check <- -1
+        warning(str_c(
+            "The latest release", bin_name, 
+            "was already downloaded.", sep = " "
+        ))
     }
 
     # zip extraction for diyabc on Windows
     zip_files <- list.files(path, pattern = "\\.zip$")
     if(length(zip_files) > 0) {
         latest_zip <- which.max(file.info(file.path(path, zip_files))$mtime)
-        tmp <- utils::unzip(file.path(path, zip_files[latest_zip]), exdir = path)
+        tmp <- utils::unzip(
+            file.path(path, zip_files[latest_zip]), 
+            exdir = path
+        )
         if(length(tmp) == 0) {
-            stop(str_c("Issue when unzipping ", zip_files[latest_zip]))
+            stop(str_c(
+                "Issue when unzipping", zip_files[latest_zip], sep = " "
+            ))
         }
         fs::file_delete(file.path(path, zip_files))
     }
 
     # set up rights
     bin_files <- list.files(path, pattern = prog)
     fs::file_chmod(file.path(path, bin_files), "a+rx")
+    
+    # output
+    return(check)
 }
 
 #' Download all latest diyabcGUI related binary files if missing
 #' @keywords internal
 #' @author Ghislain Durif
 #' @export
 dl_all_latest_bin <- function() {
-    dl_latest_bin("diyabc")
-    dl_latest_bin("abcranger")
+    check_diyabc <- dl_latest_bin("diyabc")
+    check_abcranger <- dl_latest_bin("abcranger")
+    return(lst(check_diyabc, check_abcranger))
 }
 
 #' Custom print
 #' @keywords internal
 #' @author Ghislain Durif
 pprint <- function(...) {
+    print(str_c("--- content of ",deparse(substitute(...))))
     # message(as.character(...))
     print(...)
 }
@@ -222,7 +207,7 @@ reset_sink <- function() {
 #' @author Ghislain Durif
 logging <- function(...) {
     if(getOption("diyabcGUI")$verbose)
-        pprint(str_c(..., sep = " ", collapse = " "))
+        print(str_c(..., sep = " ", collapse = " "))
 }
 
 #' Enable logging verbosity