Move functions from main.R to scripts per function

R/filter_scripts.R

@@ -0,0 +1,10 @@
+# filter_scripts ---------------------------------------------------------------
+#' @importFrom kwb.utils matchesCriteria removeEmptyColumns
+filter_scripts <- function(scriptInfo, fun.min = 5, epf.min = 10)
+{
+  criteria <- c(paste("fun >=", fun.min), paste("epf >=", epf.min))
+
+  scriptInfo <- scriptInfo[kwb.utils::matchesCriteria(scriptInfo, criteria), ]
+
+  kwb.utils::removeEmptyColumns(scriptInfo)
+}

R/get_full_function_info.R

@@ -0,0 +1,39 @@
+# get_full_function_info -------------------------------------------------------
+
+#' Get information on function definitions in parsed R scripts
+#'
+#' @param trees list of R script parse trees as provided by
+#'   \code{\link{parse_scripts}}
+#' @importFrom kwb.utils moveColumnsToFront rbindAll
+#' @export
+#' @seealso \code{\link{parse_scripts}}
+get_full_function_info <- function(trees)
+{
+  function_info <- trees %>%
+    lapply(function(tree) {
+      tree %>%
+        get_functions() %>%
+        lapply(FUN = get_function_info) %>%
+        kwb.utils::rbindAll()
+    }) %>%
+    kwb.utils::rbindAll(nameColumn = "script")
+
+  merge(
+    x = function_info, 
+    y = multi_defined_functions(function_info), 
+    by = "functionName"
+  ) %>%
+    kwb.utils::moveColumnsToFront(c("script", "functionName", "n.def"))
+}
+
+# multi_defined_functions ------------------------------------------------------
+multi_defined_functions <- function(functionInfo)
+{
+  count <- stats::aggregate(
+    n.def ~ functionName,
+    cbind(n.def = seq_len(nrow(functionInfo)), functionInfo),
+    length
+  )
+
+  count[order(count$n, decreasing = TRUE), ]
+}

R/merge_function_info.R

@@ -0,0 +1,12 @@
+# merge_function_info ----------------------------------------------------------
+merge_function_info <- function(scriptInfo, functionInfo)
+{
+  funExpressions <- expressions_per_function(functionInfo)
+
+  merge(
+    scriptInfo,
+    funExpressions[, c("script", "epf")],
+    by = "script",
+    all.x = TRUE
+  )
+}

R/main.R → R/parse_scripts.R

@@ -1,4 +1,5 @@
 # parse_scripts ----------------------------------------------------------------
+
 #' Parse all given R scripts into a tree structure
 #'
 #' @param root root directory to which the relative paths given in
@@ -56,76 +57,11 @@ parse_scripts <- function
     content <- catAndRun(
       paste("Reading", file), dbg = dbg, readLines(file, warn = FALSE)
     )
-
+    
     expressions <- try(parse(text = content))
 
     structure(expressions, n.lines = length(content))
   })
-
+  
   stats::setNames(trees, scripts)
 }
-
-# get_full_function_info -------------------------------------------------------
-#'
-#' Get information on function definitions in parsed R scripts
-#'
-#' @param trees list of R script parse trees as provided by
-#'   \code{\link{parse_scripts}}
-#'
-#' @importFrom kwb.utils rbindAll
-#' @importFrom kwb.utils moveColumnsToFront
-#'
-#' @export
-#'
-#' @seealso \code{\link{parse_scripts}}
-get_full_function_info <- function(trees)
-{
-  infos <- lapply(trees, function(tree) {
-    rbindAll(lapply(get_functions(tree), get_function_info))
-  })
-
-  functionInfo <- rbindAll(infos, nameColumn = "script")
-
-  count <- multi_defined_functions(functionInfo)
-
-  functionInfo <- merge(functionInfo, count, by = "functionName")
-
-  moveColumnsToFront(functionInfo, c("script", "functionName", "n.def"))
-}
-
-# multi_defined_functions ------------------------------------------------------
-multi_defined_functions <- function(functionInfo)
-{
-  count <- aggregate(
-    n.def ~ functionName,
-    cbind(n.def = seq_len(nrow(functionInfo)), functionInfo),
-    length
-  )
-
-  count[order(count$n, decreasing = TRUE), ]
-}
-
-# merge_function_info ----------------------------------------------------------
-merge_function_info <- function(scriptInfo, functionInfo)
-{
-  funExpressions <- expressions_per_function(functionInfo)
-
-  merge(
-    scriptInfo,
-    funExpressions[, c("script", "epf")],
-    by = "script",
-    all.x = TRUE
-  )
-}
-
-# filter_scripts ---------------------------------------------------------------
-#' @importFrom kwb.utils matchesCriteria
-#' @importFrom kwb.utils removeEmptyColumns
-filter_scripts <- function(scriptInfo, fun.min = 5, epf.min = 10)
-{
-  criteria <- c(paste("fun >=", fun.min), paste("epf >=", epf.min))
-
-  scriptInfo <- scriptInfo[matchesCriteria(scriptInfo, criteria), ]
-
-  removeEmptyColumns(scriptInfo)
-}

inst/extdata/cleanCodeBasics.R

@@ -2,11 +2,7 @@
 config <- list(checks = list(
   seq_1_n = list(
     check = function(x) {
-      if (!is.call(x)) return(FALSE)
-      #str(as.list(x))
-      #substr(deparse(x)[1L], 1L, 2L) == "1:"
-      identical(x[[1]], as.name(":")) &&
-        identical(x[[2]], 1) &&
+      kwb.code:::is_colon_seq_1_to_any(x) &&
         (is.name(x[[3]]) || is.call(x[[3]]))
     },
     report = function(x) {
@@ -66,11 +62,13 @@ config <- list(checks = list(
 if (FALSE)
 {
   #files <- dir_r_files("R")
-  files <- dir_r_files("~/github-repos/K/kwb.misa")
+  files <- dir_r_files("C:/development/github-repos/K/kwb.misa")
   files <- dir_r_files("~/R-Development/RScripts")
 
   cat("\n     ")
 
+  files <- files[1]
+
   # Apply the configuration for all files
   for (i in seq_along(files)) {
     file <- files[i]