Added examples and tests.

development/R/pkgs/phuse/DESCRIPTION

@@ -1,15 +1,17 @@
-Package: phuse
-Type: Package
-Title: PhUSE R Package
-Version: 0.1.0
-Author: Hanming Tu
-Maintainer: The package maintainer Hanming Tu <[email protected]>
-Description: This package contains the common and initial functions
-  for downloading and executing R scripts in the PhUSE github 
-  (https://github.com/phuse-org/phuse-scripts).
-    More functions might be added over the time. 
-Depends: R (>= 3.0.1)
-License: MIT
-Encoding: UTF-8
-LazyData: true
-RoxygenNote: 6.0.1
+Package: phuse
+Type: Package
+Title: PhUSE R Package
+Version: 0.1.0
+Author: Hanming Tu
+Maintainer: The package maintainer Hanming Tu <[email protected]>
+Description: Make it easy to download and execute scripts stored in github phuse-scripts
+  repository (https://github.com/phuse-org/phuse-scripts). Some common and initial 
+  functions help with script meta data and demonstrate the concept of downloading 
+  and executing R scripts. More functions might be added over the time. 
+Depends: R (>= 3.0.1)
+License: MIT + file LICENSE
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 6.0.1
+Suggests: testthat
+Imports: yaml, shiny

development/R/pkgs/phuse/LICENSE

@@ -0,0 +1,27 @@
+The phuse package as a whole is distributed under MIT.
+
+Bootstrap License
+----------------------------------------------------------------------
+The MIT License (MIT)
+
+Copyright (c) 2011-2014 Twitter, Inc
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
+
+

development/R/pkgs/phuse/NAMESPACE

@@ -4,9 +4,12 @@ export(create_dir)
 export(download_script)
 export(download_script_files)
 export(init_cfg)
+export(list2df)
 export(merge_lists)
+export(run_example)
 export(test_init)
 importFrom(utils,download.file)
 importFrom(utils,install.packages)
 importFrom(utils,installed.packages)
+importFrom(utils,str)
 importFrom(yaml,yaml.load_file)

development/R/pkgs/phuse/R/download_script.R

@@ -1,50 +1,50 @@
-#' Download files defined in script metadata
-#' @description download scripts, data or any file defined in the script metadata.
-#' @param cfg a list containing script metadata
-#' @param wkDir work directory where the files will be downloaded to
-#' @param source_lib whether to source the library defined for the scrpt in the metadata
-#' @return target directory name
-#' @export
-#' @author Hanming Tu
-#' @name download_script
-#
-# Function Name: download_script
-# ---------------------------------------------------------------------------
-# Purpose: download all the files defined in the script metadata file
-# HISTORY   MM/DD/YYYY (developer) - explanation
-#   03/10/2017 (htu) - initial creation
-#   04/25/2017 (htu) - imported to the R package
-download_script <- function(
-    cfg
-  , wkDir = "workdir"
-  , source_lib = TRUE
-) {
-  prg <- "download_script"
-  curWorkDir <- getwd()
-  if (is.null(cfg[["files"]])) { stop(paste(prg, ": Could not find input files.")) }
-  if (is.null(cfg[["dirs"]]))  { stop(paste(prg, ": Could not find dir names.")) }
-  f <- cfg$files;   d <- cfg$dirs
-
-  # create the local target workdir
-  ymd_dir <- format(Sys.time(), "%Y/%m/%d/%H%M%S")
-  tgtDir <- paste(curWorkDir,wkDir, ymd_dir, sep = '/')
-  create.dir(tgtDir)
-  # download files for running the script
-  cat(paste("Downloading files to ", tgtDir, "..."))
-  if ("files" %in% names(cfg) && "dirs" %in% names(cfg) ) {
-    if (is.null(d[["baseDir"]]) && is.null(d[["scriptDir"]])) {
-      download_script_files(f, tgtDir)
-    } else if (is.null(d[["baseDir"]])) {
-      download_script_files(f, tgtDir, scriptDir = d$scriptDir)
-    } else if (is.null(d[["scriptDir"]])) {
-      download_script_files(f, tgtDir, baseDir = d$baseDir)
-    } else {
-      download_script_files(f, tgtDir, baseDir = d$baseDir, scriptDir = d$scriptDir)
-    }
-  }
-  if (source_lib) {
-    if ("lib_file" %in% names(f)) { source(paste(tgtDir, f$lib_file, sep = '/')) }
-  }
-  return(tgtDir);
-}
-
+#' Download files defined in script metadata
+#' @description download scripts, data or any file defined in the script metadata.
+#' @param cfg a list containing script metadata
+#' @param wkDir work directory where the files will be downloaded to
+#' @param source_lib whether to source the library defined for the scrpt in the metadata
+#' @return target directory name
+#' @export
+#' @author Hanming Tu
+#' @name download_script
+#
+# Function Name: download_script
+# ---------------------------------------------------------------------------
+# Purpose: download all the files defined in the script metadata file
+# HISTORY   MM/DD/YYYY (developer) - explanation
+#   03/10/2017 (htu) - initial creation
+#   04/25/2017 (htu) - imported to the R package
+download_script <- function(
+    cfg
+  , wkDir = "workdir"
+  , source_lib = TRUE
+) {
+  prg <- "download_script"
+  curWorkDir <- getwd()
+  if (is.null(cfg[["files"]])) { stop(paste(prg, ": Could not find input files.")) }
+  if (is.null(cfg[["dirs"]]))  { stop(paste(prg, ": Could not find dir names.")) }
+  f <- cfg$files;   d <- cfg$dirs
+
+  # create the local target workdir
+  ymd_dir <- format(Sys.time(), "%Y/%m/%d/%H%M%S")
+  tgtDir <- paste(curWorkDir,wkDir, ymd_dir, sep = '/')
+  dir.create(tgtDir)
+  # download files for running the script
+  cat(paste("Downloading files to ", tgtDir, "..."))
+  if ("files" %in% names(cfg) && "dirs" %in% names(cfg) ) {
+    if (is.null(d[["baseDir"]]) && is.null(d[["scriptDir"]])) {
+      download_script_files(f, tgtDir)
+    } else if (is.null(d[["baseDir"]])) {
+      download_script_files(f, tgtDir, scriptDir = d$scriptDir)
+    } else if (is.null(d[["scriptDir"]])) {
+      download_script_files(f, tgtDir, baseDir = d$baseDir)
+    } else {
+      download_script_files(f, tgtDir, baseDir = d$baseDir, scriptDir = d$scriptDir)
+    }
+  }
+  if (source_lib) {
+    if ("lib_file" %in% names(f)) { source(paste(tgtDir, f$lib_file, sep = '/')) }
+  }
+  return(tgtDir);
+}
+

development/R/pkgs/phuse/R/init_cfg.R

@@ -5,13 +5,15 @@
 #' @return a list containing the merged configuration
 #' @name init_cfg
 #' @export
+#' @importFrom yaml yaml.load_file
 #' @author Hanming Tu
 # Function Name: init_cfg
 # ---------------------------------------------------------------------------
 # HISTORY   MM/DD/YYYY (developer) - explanation
 #  03/10/2017 (htu) - initial creation
 #  04/25/2017 (htu) - added required packages
 #
+# library('yaml')
 init_cfg <- function(cfg) {
   curWorkDir <- getwd()
   yml_file <- cfg$files$yml_file;

development/R/pkgs/phuse/R/list2df.R

@@ -0,0 +1,70 @@
+#' Convert list to data frame
+#' @description convert list to a data frame with the following structure:
+#'   variable, level, type, value
+#' @param a the 1st list
+#' @return data frame
+#' @name list2df
+#' @export
+#' @author Hanming Tu
+# Function Name: list2df
+# ---------------------------------------------------------------------------
+# HISTORY   MM/DD/YYYY (developer) - explanation
+#  08/29/2017 (htu) - initial creation
+#
+list2df <- function(a) {
+  # r <- setNames(data.frame(matrix(ncol = 4), nrow=0), c("varname", "level", "type","value"))
+  var <- list(); lvl <- list(); typ <- list(); val <- list()
+  i <- 0
+  for (k1 in names(a)) {
+    if (!is.list(a[[k1]])) {
+      i <- i + 1
+      var[i]  <- k1; lvl[i]  <- 1; typ[i] <- typeof(a[[k1]]); val[i] <- a[[k1]]
+      next();
+    }
+    for (k2 in names(a[[k1]])) {
+      if (!is.list(a[[k1]][[k2]])) {
+        i <- i + 1
+        var[i] <- k2; lvl[i] <- 2; typ[i] <- typeof(a[[k1]][[k2]]); val[i] <- a[[k1]][[k2]]
+        next();
+      }
+      for (k3 in names(a[[k1]][[k2]])) {
+        if (!is.list(a[[k1]][[k2]][[k3]])) {
+          i <- i + 1
+          var[i] <- k3; lvl[i] <- 3
+          typ[i] <- typeof(a[[k1]][[k2]][[k3]])
+          val[i] <- a[[k1]][[k2]][[k3]]
+          next();
+        }
+        for (k4 in names(a[[k1]][[k2]][[k3]])) {
+          if (!is.list(a[[k1]][[k2]][[k3]][[k4]])) {
+            i <- i + 1
+            var[i] <- k4; lvl[i] <- 4
+            typ[i] <- typeof(a[[k1]][[k2]][[k3]][[k4]])
+            val[i] <- a[[k1]][[k2]][[k3]][[k4]]
+            next();
+          }
+          for (k5 in names(a[[k1]][[k2]][[k3]][[k4]])) {
+            i <- i + 1
+            var[i] <- k5; lvl[i] <- 5
+            typ[i] <- typeof(a[[k1]][[k2]][[k3]][[k4]][[k5]])
+            val[i] <- a[[k1]][[k2]][[k3]][[k4]][[k5]]
+            next();
+          }
+        }
+      }
+    }
+  }
+  n <- i
+  r <- setNames(data.frame(matrix(ncol=4, nrow=length(var))), c("varname", "level", "type","value"))
+  for (i in 1:length(var)) {
+    r$varname[i] <- var[i]
+    r$level[i] <- lvl[i]
+    if (is.null(typ[i]) || typ[i] == 'NULL') { r$type[i] <- 'character'} else { r$type[i] <- typ[i] }
+    if (is.null(val[i]) || val[i] == 'NULL') { r$value[i] <- ''} else { r$value[i] <- val[i] }
+  }
+  # r <- data.frame("varname"= var, "level" = lvl, "type" = typ, "value" = val)
+  # r <- mapply(data.frame, "varname"=var, "level"=lvl, "type"=typ, "value"=val, SIMPLIFY = FALSE)
+  # r <- do.call(rbind, Map(data.frame, "varname"=var, "level"=lvl, "type"=typ, "value"=val))
+
+  return(r)
+}

development/R/pkgs/phuse/R/merge_lists.R

@@ -17,23 +17,27 @@
 merge_lists <- function(a, b) {
   for (k1 in names(a)) {
     if (!is.list(a[[k1]])) {
-      if (k1 %in% names(b) && b[[k1]] != '') {a[[k1]] <- b[[k1]]}
+      if (k1 %in% names(b) && !(is.null(b[[k1]]) || b[[k1]] == '') ) {a[[k1]] <- b[[k1]]}
       next();
     }
     for (k2 in names(a[[k1]])) {
       if (!is.list(a[[k1]][[k2]])) {
-        if (k2 %in% names(b[[k1]]) && b[[k1]][[k2]] != '') {a[[k1]][[k2]] <- b[[k1]][[k2]]}
+        if ((k2 %in% names(b[[k1]])) && !(is.null(b[[k1]][[k2]]) || b[[k1]][[k2]] == '') ) {
+          a[[k1]][[k2]] <- b[[k1]][[k2]]
+        }
         next();
       }
       for (k3 in names(a[[k1]][[k2]])) {
         if (!is.list(a[[k1]][[k2]][[k3]])) {
-          if (k3 %in% names(b[[k1]][[k2]]) && b[[k1]][[k2]][[k3]] != '') {
+          if ((k3 %in% names(b[[k1]][[k2]])) && !(is.null(b[[k1]][[k2]][[k3]]) ||
+              b[[k1]][[k2]][[k3]] == '') ){
             a[[k1]][[k2]][[k3]] <- b[[k1]][[k2]][[k3]]
           }
           next();
         }
         for (k4 in names(a[[k1]][[k2]][[k3]])) {
-          if (k4 %in% names(b[[k1]][[k2]][[k3]]) && b[[k1]][[k2]][[k3]][[k4]] != '') {
+          if ((k4 %in% names(b[[k1]][[k2]][[k3]])) && !(
+            is.null(b[[k1]][[k2]][[k3]][[k4]]) || b[[k1]][[k2]][[k3]][[k4]] == '') ) {
             a[[k1]][[k2]][[k3]][[k4]] <- b[[k1]][[k2]][[k3]][[k4]]
           }
         }

development/R/pkgs/phuse/R/run_example.R

@@ -0,0 +1,40 @@
+#' Run example
+#' @description run examples stored in the example folder.
+#' @param example Example name
+#' @param port Port number
+#' @param launch.browser define the browser- shiny.launch.browser
+#' @param host define the host or ip address
+#' @param display.mode modes are auto, normal or showcase
+#' @name run_example
+#' @export
+#' @author Hanming Tu
+# Function Name: run_example
+# ---------------------------------------------------------------------------
+# HISTORY   MM/DD/YYYY (developer) - explanation
+#  08/28/2017 (htu) - initial creation
+#
+run_example <- function (example = NA, port = NULL,
+    launch.browser = getOption("shiny.launch.browser",interactive()),
+    host = getOption("shiny.host", "127.0.0.1"),
+    display.mode = c("auto", "normal", "showcase")
+)
+{
+  examplesDir <- system.file("examples", package = "phuse")
+  dir <- shiny:::resolve(examplesDir, example)
+  if (is.null(dir)) {
+    if (is.na(example)) {
+      errFun <- message
+      errMsg <- ""
+    }
+    else {
+      errFun <- stop
+      errMsg <- paste("Example", example, "does not exist. ")
+    }
+    errFun(errMsg, "Valid examples are \"", paste(list.files(examplesDir),
+                                                  collapse = "\", \""), "\"")
+  }
+  else {
+    shiny::runApp(dir, port = port, host = host, launch.browser = launch.browser,
+           display.mode = display.mode)
+  }
+}

development/R/pkgs/phuse/R/test_init.R

@@ -4,6 +4,7 @@
 #' @export
 #' @importFrom utils install.packages
 #' @importFrom utils installed.packages
+#' @importFrom utils str
 #' @importFrom yaml yaml.load_file
 #
 # You can learn more about package authoring with RStudio at:
@@ -18,7 +19,7 @@
 #   03/02/2017 (htu) - initial creation
 #
 # 1. load the source code
-
+# library('yaml')
 test_init <- function() {
   rm(list=ls())
   p <- c('yaml')

development/R/pkgs/phuse/examples/01_merge/DESCRIPTION

@@ -0,0 +1,7 @@
+Title: Merge List
+Author: Hanming Tu
+AuthorUrl: http://www.rstudio.com/
+License: MIT
+DisplayMode: Showcase
+Tags: getting-started
+Type: Shiny

development/R/pkgs/phuse/examples/01_merge/Readme.md

@@ -0,0 +1,5 @@
+This example demonstrates a core feature of Shiny: **reactivity**. In the `server` function, a reactive called `datasetInput` is declared. 
+
+Notice that the reactive expression depends on the input expression `input$dataset`, and that it's used by two output expressions: `output$summary` and `output$view`. Try changing the dataset (using *Choose a dataset*) while looking at the reactive and then at the outputs; you will see first the reactive and then its dependencies flash. 
+
+Notice also that the reactive expression doesn't just update whenever anything changes--only the inputs it depends on will trigger an update. Change the "Caption" field and notice how only the `output$caption` expression is re-evaluated; the reactive and its dependents are left alone.