Draft 'modify' - for modification existing object

Author: gdemin

NAMESPACE

@@ -3,6 +3,7 @@
 export(enumerate)
 export(lag_list)
 export(mark)
+export(modify)
 export(numerate)
 export(to_list)
 export(to_vec)

NEWS

@@ -1,3 +1,7 @@
+0.6.5 (09.04.2019)
+================
+* add for lists/data.frames modification
+
 0.6.0 (18.03.2019)
 ================
 * add iterations over multiple lists: to_vec(for(`i, j` in numerate(letters)) if(i %% 2==0) paste(i, j))

R/to_list.R

@@ -58,16 +58,16 @@ to_vec = function(expr, recursive = TRUE, use.names = FALSE){
 }
 
 
-add_assignment_to_final_loops = function(expr){
+add_assignment_to_final_loops = function(expr, result_exists = FALSE){
     if(is_loop(expr)){
         if(has_loop_inside(expr[-1])){
-            expr[-1] = as.call(lapply(as.list(expr)[-1], add_assignment_to_final_loops))
+            expr[-1] = as.call(lapply(as.list(expr)[-1], add_assignment_to_final_loops, result_exists = result_exists))
         } else {
-            expr = add_assignment_to_loop(expr)
+            expr = add_assignment_to_loop(expr, result_exists = result_exists)
         }
     } else {
         if(has_loop_inside(expr)){
-            expr = as.call(lapply(as.list(expr), add_assignment_to_final_loops))
+            expr = as.call(lapply(as.list(expr), add_assignment_to_final_loops, result_exists = result_exists))
         }
     }
     expr
@@ -127,16 +127,46 @@ has_loop_inside = function(expr){
 }
 
 
-add_assignment_to_loop = function(expr){
+add_assignment_to_loop = function(expr, result_exists = FALSE){
     last_item = length(expr)
-    expr[[last_item]] = bquote({
-
-        .__curr = {.(expr[[last_item]])}
-        if(!is.null(.__curr)){
+    if(result_exists){
+        expr[[last_item]] = bquote({
+            .__curr = {.(expr[[last_item]])}
             .___counter = .___counter + 1
-            .___res[[.___counter]] = .__curr
-        }
+            if(!is.null(.__curr)){
+                .___res[[.___counter]] = .__curr
+            }
+
+        })
+    } else {
+        expr[[last_item]] = bquote({
 
-    })
+            .__curr = {.(expr[[last_item]])}
+            if(!is.null(.__curr)){
+                .___counter = .___counter + 1
+                .___res[[.___counter]] = .__curr
+            }
+
+        })
+    }
     expr
 }
+
+#' @rdname to_list
+#' @export
+modify = function(expr, data = NULL){
+    expr = substitute(expr)
+    if(!is_loop(expr)) {
+        stop(paste("argument should be expression with 'for', 'while' or 'repeat' but we have: ", deparse(expr, width.cutoff = 500)[1]))
+    }
+    on.exit(suppressWarnings(rm(list = c(".___res", ".___counter", ".__curr"), envir = parent.frame())))
+    if(is.null(data)) data = expr[[3]]
+    eval.parent(substitute(.___res <- data))
+    expr = expand_loop_variables(expr)
+    expr = add_assignment_to_final_loops(expr, result_exists = TRUE)
+    eval.parent(quote(.___counter <- 0)) # initial list length
+    eval.parent(expr)
+    res = get(".___res", envir = parent.frame())
+    res
+
+}

man/to_list.Rd

@@ -117,3 +117,22 @@ index = seq_along(letters)
 true_res = expand.grid(paste(seq_along(letters), LETTERS), paste(index[index %% 2==0], letters[index %% 2==0]))
 true_res = paste(true_res[[2]], true_res[[1]])
 expect_identical(res, true_res)
+
+
+context("modify")
+data(iris)
+iris2 = modify(for(i in iris) if(is.numeric(i)) scale(i))
+res_iris = iris
+res_iris[,-5] = lapply(iris[,-5], scale)
+expect_equal(iris2, res_iris)
+
+iris2 = modify(for(`name, value` in mark(iris)) if(grepl("Width", name)) scale(value), data = iris)
+
+res_iris = iris
+res_iris[,c("Sepal.Width", "Petal.Width")] = lapply(iris[,c("Sepal.Width", "Petal.Width")], scale)
+expect_equal(iris2, res_iris)
+
+
+# library(data.table)
+# dt_iris = as.data.table(iris)
+# dt_iris2 = modify(for(i in dt_iris) if(is.numeric(i)) scale(i))