Dev

DESCRIPTION

@@ -2,12 +2,28 @@ Package: kwb.code
 Title: Analyse Your R Code!
 Version: 0.3.0
 Authors@R: c(
-    person("Hauke", "Sonnenberg", , "hauke.sonnenberg@kompetenz-wasser.de", role = c("aut", "cre"),
-           comment = c(ORCID = "0000-0001-9134-2871")),
-    person("Michael", "Rustler", , "michael.rustler@kompetenz-wasser.de", role = "ctb",
-           comment = "0000-0003-0647-7726"),
-    person("FAKIN", role = "fnd"),
-    person("Kompetenzzentrum Wasser Berlin gGmbH (KWB)", role = "cph")
+    person(
+        given = "Hauke", 
+        family = "Sonnenberg", 
+        email = "hauke.sonnenberg@kompetenz-wasser.de", 
+        role = c("aut", "cre"),
+        comment = c(ORCID = "0000-0001-9134-2871")
+    ),
+    person(
+        given = "Michael", 
+        family = "Rustler", 
+        email = "michael.rustler@kompetenz-wasser.de", 
+        role = "ctb",
+        comment = "0000-0003-0647-7726"
+    ),
+    person(
+        given = "FAKIN", 
+        role = "fnd"
+    ),
+    person(
+        given = "Kompetenzzentrum Wasser Berlin gGmbH (KWB)", 
+        role = "cph"
+    )
   )
 Description: This package allows you to parse your R scripts and to
     calculate some staticstics on your code.
@@ -18,6 +34,7 @@ Imports:
     dplyr,
     kwb.file,
     kwb.utils,
+    magrittr,
     stringr
 Suggests: 
     covr,
@@ -33,4 +50,4 @@ ByteCompile: true
 Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

NAMESPACE

@@ -1,38 +1,54 @@
 # Generated by roxygen2: do not edit by hand
 
+export("%>%")
 export(analyse)
 export(arg_names)
+export(find_function_name_duplicates)
 export(find_string_constants)
 export(find_weaknesses_in_scripts)
 export(get_elements_by_type)
 export(get_full_function_info)
+export(get_function_assignments)
 export(get_names_of_used_packages)
 export(get_package_function_usage)
 export(get_package_usage_per_script)
 export(get_string_constants_in_scripts)
+export(normalise_expression)
 export(parse_scripts)
 export(to_full_script_info)
 export(walk_tree)
-importFrom(dplyr,bind_rows)
+importFrom(kwb.utils,backspace)
 importFrom(kwb.utils,catAndRun)
 importFrom(kwb.utils,catIf)
+importFrom(kwb.utils,checkForMissingColumns)
+importFrom(kwb.utils,collapsed)
 importFrom(kwb.utils,commaCollapsed)
 importFrom(kwb.utils,createDirectory)
+importFrom(kwb.utils,defaultIfNULL)
+importFrom(kwb.utils,excludeNULL)
 importFrom(kwb.utils,extractSubstring)
-importFrom(kwb.utils,hsQuoteChr)
+importFrom(kwb.utils,getAttribute)
+importFrom(kwb.utils,hsOpenWindowsExplorer)
+importFrom(kwb.utils,isTryError)
+importFrom(kwb.utils,left)
 importFrom(kwb.utils,matchesCriteria)
 importFrom(kwb.utils,moveColumnsToFront)
 importFrom(kwb.utils,multiSubstitute)
 importFrom(kwb.utils,noFactorDataFrame)
+importFrom(kwb.utils,pairwise)
 importFrom(kwb.utils,printIf)
 importFrom(kwb.utils,rbindAll)
 importFrom(kwb.utils,removeAttributes)
+importFrom(kwb.utils,removeColumns)
 importFrom(kwb.utils,removeEmptyColumns)
 importFrom(kwb.utils,renameColumns)
 importFrom(kwb.utils,resetRowNames)
 importFrom(kwb.utils,safeRowBindAll)
 importFrom(kwb.utils,selectColumns)
 importFrom(kwb.utils,selectElements)
+importFrom(kwb.utils,shorten)
+importFrom(kwb.utils,stopFormatted)
+importFrom(kwb.utils,stringList)
+importFrom(magrittr,"%>%")
 importFrom(stats,aggregate)
-importFrom(stats,setNames)
 importFrom(stringr,str_extract_all)

NEWS.md

@@ -1,3 +1,7 @@
+# Latest Changes
+
+* Add normalise_expression()
+
 # [kwb.code 0.3.0](https://github.com/KWB-R/kwb.code/releases/tag/v0.3.0) <small>2023-07-15</small>
 
 * repair GitHub Actions

R/analyse.R

@@ -17,22 +17,65 @@
 #' str(result, 3)
 analyse <- function(x, path = "")
 {
-  info <- type_info(x)
-
-  # result <- list(
-  #   self = info_to_text(info)
-  # )
-
-  result <- info
+  result <- type_info(x)
+  result[["fulltype"]] <- info_to_text(result)
   result[["path"]] <- path
-  result[["fulltype"]] <- info_to_text(info)
 
   if (is.recursive(x)) {
-
     result[["children"]] <- lapply(seq_along(x), function(i) {
-      analyse(x[[i]], path = paste(path, i, sep = "/"))
+      analyse(x[[i]], path = paste0(path, "/", i))
     })
   }
 
   result  
 }
+
+# type_info --------------------------------------------------------------------
+type_info <- function(x, as_character = FALSE)
+{
+  shorten <- function(x) paste(substr(x, 1, 30), "...")
+
+  text <- as.character(x)
+  mode_x <- mode(x)
+  class_x <- class(x)
+
+  info <- list(
+    type = typeof(x),
+    mode = mode_x,
+    class = class_x, 
+    length = length(x),
+    text = shorten(paste0("[", seq_along(text), "]", text, collapse = "")),
+    is = is_what(x),
+    n_modes = length(mode_x),
+    n_classes = length(class_x)
+  )
+
+  if (as_character) {
+    info_to_text(info)
+  } else {
+    info
+  }
+}
+
+# info_to_text -----------------------------------------------------------------
+info_to_text <- function(info)
+{
+  collapse <- function(element) {
+    select_elements(info, element) %>% 
+      comma_collapsed()
+  }
+
+  #prefix <- "type|mode|class|length|is: "
+  prefix <- NULL
+
+  paste0(
+    prefix, 
+    paste(collapse = "|", c(
+      collapse("type"),
+      collapse("mode"),
+      collapse("class"), 
+      collapse("length"),
+      collapse("is")
+    )) 
+  )
+}

R/duplicatesToFiles.R

@@ -1,27 +1,59 @@
 # duplicatesToFiles ------------------------------------------------------------
-#' @importFrom kwb.utils catIf
-#' @importFrom kwb.utils createDirectory
-#' @importFrom kwb.utils selectColumns
-#' @importFrom kwb.utils selectElements
 duplicatesToFiles <- function
 (
-  trees, fun_duplicates, function_name, target_root = tempdir(), dbg = TRUE,
+  trees, 
+  fun_duplicates = NULL, 
+  function_name = NULL, 
+  target_root = tempdir(), 
+  dbg = TRUE,
   write.all = FALSE
-) {
-
-  selected <- selectColumns(fun_duplicates, "functionName") == function_name
+)
+{
+  if (is.null(fun_duplicates)) {
+    fun_duplicates <- get_info_on_duplicated_function_names(trees)
+  }
+
+  if (nrow(fun_duplicates) == 0L) {
+    message("No duplications given or no duplications found.")
+    return()
+  }
+
+  function_names <- select_columns(fun_duplicates, "functionName")
+
+  # Call this function for each function name if no function name is given  
+  if (is.null(function_name)) {
+
+    message("No function name given.")
+
+    lapply(unique(function_names), function(function_name) {
+      #function_name <- unique(function_names)[1L]
+      cat_and_run(
+        sprintf(
+          "Calling duplicatesToFiles(..., function_name = \"%s\")", 
+          function_name
+        ), 
+        duplicatesToFiles(trees, fun_duplicates, function_name),
+        newLine = 3L
+      )
+    })
+  }
 
-  scripts <- as.character(selectColumns(fun_duplicates[selected, ], "script"))
+  # Script files that contain a function <function_name>  
+  scripts <- fun_duplicates[function_names == function_name, ] %>%
+    selectColumns("script") %>%
+    as.character()
 
-  function_defs <- lapply(scripts, function(script) {
-    extract_function_definition(selectElements(trees, script), function_name)
+  # From each script, extract the definition of function <function_name>
+  function_defs <- lapply(stats::setNames(nm = scripts), function(script) {
+    trees %>% 
+      select_elements(script) %>%
+      extract_function_definition(function_name)
   })
-
-  names(function_defs) <- scripts
-
-  target_dir <- file.path(target_root, "clean", function_name)
-  target_dir <- createDirectory(target_dir, dbg = FALSE)
-
+
+  target_dir <- target_root %>% 
+    file.path("clean", function_name) %>% 
+    create_directory(dbg = FALSE)
+
   contents <- lapply(function_defs, function(x) deparse(x[[3L]]))
 
   # Write one file per function definition
@@ -30,36 +62,46 @@ duplicatesToFiles <- function
   }
 
   # Write one file per unique function definition
-  n_files <- writeContentsToLessFiles(
+  files <- writeContentsToLessFiles(
     contents, target_dir, function_name, dbg = dbg
   )
 
-  if (n_files != length(contents)) {
+  if (length(files) != length(contents)) {
     message("There are identical definitions for ", function_name)
   }
 
-  target_dir
+  files
 }
 
-# extract_function_definition --------------------------------------------------
-extract_function_definition <- function(tree, function_name) {
-
-  tree <- tree[sapply(tree, is_function_assignment)]
+# get_info_on_duplicated_function_names ----------------------------------------
+get_info_on_duplicated_function_names <- function(trees)
+{
+  result <- get_full_function_info(trees)
+  result[selectColumns(result, "n.def") > 1L, ]
+}
 
-  fnames <- sapply(tree, function(x) split_function_assignment(x)$functionName)
+# extract_function_definition --------------------------------------------------
+extract_function_definition <- function(tree, function_name)
+{
+  fnames <- tree[sapply(tree, is_function_assignment)] %>% 
+    sapply(function(x) split_function_assignment(x)$functionName)
 
   index <- which(fnames == function_name)
 
   n_defs <- length(index)
 
   if (n_defs == 0L) {
-    stop("No such function: '", function_name, "' defined in the given tree")
+    stop_formatted(
+      "No such function: '%s' defined in the given tree", 
+      function_name
+    )
   }
-
+  
   if (n_defs > 1L) {
-    warning(
-      "The function '", function_name, "' is defined multiple times in ",
-      "the given tree. I return the first definition!"
+    warn_formatted(
+      "The function '%s' is defined multiple times in ",
+      "the given tree. I return the first definition!",
+      function_name
     )
   }