renamed bycol to byrow; fixed that gen.named.(vector|list) can be used as a inner expression of other gen.-functions

Author: patrickroocks

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: listcompr
 Version: 0.2.5
-Date: 2021-05-08
+Date: 2021-05-17
 Title: List Comprehension for R
 Author: Patrick Roocks <[email protected]>
 Maintainer: Patrick Roocks <[email protected]>

NEWS.md

@@ -1,6 +1,7 @@
 # listcompr 0.2.5
 
-* added `bycol` parameter to `gen.(named).(data.frame|matrix)` which applies the Cartesian product by column to the expression (WIP: documentation)
+* added `byrow` parameter to `gen.(named).(data.frame|matrix)` which applies the Cartesian product by column to the expression
+* fixed that `gen.named.(vector|list)` can be used as a inner expression of other `gen.`-functions
 
 # listcompr 0.2.4
 

R/eval.r

@@ -246,16 +246,16 @@ get_vars_and_conditions <- function(l, is_var, is_cond, ctx) {
 }
 
 # searches for 2-dim matrix without names/conditions, e.g. gen.matrix(i+j, i=1:3, j=1:4)
-check_2d_matrix <- function(first_row, is_by_col, vars, conds, parent_frame) {
+check_2d_matrix <- function(first_row, is_by_row, vars, conds, parent_frame) {
   if (!(    is.null(names(first_row))
          && length(first_row) == 1
          && length(vars) == 2 && length(conds) == 0)) return(NULL)
 
-  rowindex <- if (is_by_col) 2 else 1
+  rowindex <- if (is_by_row) 2 else 1
   nrow <- tryCatch(eval(vars[[rowindex]], parent_frame), error = function(e) NULL)
   if (is.null(row)) return(NULL)
 
-  colindex <- if (is_by_col) 1 else 2
+  colindex <- if (is_by_row) 1 else 2
   ncol <- tryCatch(eval(vars[[colindex]], parent_frame), error = function(e) NULL)
   if (is.null(ncol)) return(NULL)
 
@@ -285,9 +285,9 @@ fold.or <- function(lst) {
 
 # ----- Main functions (called by interface) -----
 
-OUTPUT_FORMAT <- list(LST = 1, VEC = 2, LST_EXPR = 3, VEC_EXPR = 4, DF = 5, DF_COL = 6, MTX = 7, MTX_COL = 8)
+OUTPUT_FORMAT <- list(LST = 1, VEC = 2, LST_EXPR = 3, VEC_EXPR = 4, DF = 5, DF_ROW = 6, MTX = 7, MTX_ROW = 8)
 
-gen_list_internal <- function(expr, l, output_format, name_str, parent_frame) {
+gen_list_internal <- function(expr, l, output_format, name_str_expr, parent_frame) {
 
   # * preliminary checks, find vars/conditions
 
@@ -307,9 +307,9 @@ gen_list_internal <- function(expr, l, output_format, name_str, parent_frame) {
   is_format_expr <- output_format %in% c(OUTPUT_FORMAT[["LST_EXPR"]], OUTPUT_FORMAT[["VEC_EXPR"]])
   is_format_vec  <- output_format %in% c(OUTPUT_FORMAT[["VEC"]],      OUTPUT_FORMAT[["VEC_EXPR"]])
   is_format_lst  <- output_format %in% c(OUTPUT_FORMAT[["LST"]],      OUTPUT_FORMAT[["LST_EXPR"]])
-  is_format_mtx  <- output_format %in% c(OUTPUT_FORMAT[["MTX"]],      OUTPUT_FORMAT[["MTX_COL"]])
-  is_format_df   <- output_format %in% c(OUTPUT_FORMAT[["DF"]],       OUTPUT_FORMAT[["DF_COL"]])
-  is_by_col      <- output_format %in% c(OUTPUT_FORMAT[["MTX_COL"]],  OUTPUT_FORMAT[["DF_COL"]])
+  is_format_mtx  <- output_format %in% c(OUTPUT_FORMAT[["MTX"]],      OUTPUT_FORMAT[["MTX_ROW"]])
+  is_format_df   <- output_format %in% c(OUTPUT_FORMAT[["DF"]],       OUTPUT_FORMAT[["DF_ROW"]])
+  is_by_row      <- output_format %in% c(OUTPUT_FORMAT[["MTX_ROW"]],  OUTPUT_FORMAT[["DF_ROW"]])
 
   # * Expansions
 
@@ -318,9 +318,10 @@ gen_list_internal <- function(expr, l, output_format, name_str, parent_frame) {
   expr <- res[["expr"]]
   vars <- res[["vars"]]
 
-  has_row_names <- !is.null(name_str)
+  has_row_names <- !is.null(name_str_expr)
   if (has_row_names) { # for named list/vectors/...
-    res <- expand_expr(name_str, vars, ctx)
+    if (is.symbol(name_str_expr)) name_str_expr <- eval(name_str_expr, parent_frame)
+    res <- expand_expr(name_str_expr, vars, ctx)
     name_str_expr <- res[["expr"]]
     vars          <- res[["vars"]]
   }
@@ -342,7 +343,7 @@ gen_list_internal <- function(expr, l, output_format, name_str, parent_frame) {
   }
 
   if (has_row_names) {
-    name_vec <- vapply(1:nrow(cartesian_df), function(i) eval(name_str_expr, cartesian_df[i,,drop=FALSE], parent_frame), '')
+    name_vec <- vapply(1:nrow(cartesian_df), function(i) eval(name_str_expr, cartesian_df[i,,drop=FALSE], parent_frame), "")
   }
 
   # * Apply expression and return
@@ -352,15 +353,15 @@ gen_list_internal <- function(expr, l, output_format, name_str, parent_frame) {
     } else {
       rv <- lapply(1:nrow(cartesian_df), function(i) eval(expr, cartesian_df[i,,drop=FALSE], parent_frame))
     }
-    if (!is.null(name_str)) names(rv) <- name_vec
+    if (has_row_names) names(rv) <- name_vec
     return(rv)
 
   } else if (is_format_expr) {
     rv <- if (is_format_vec) quote(c()) else quote(list())
     for (i in 1:nrow(cartesian_df)) {
       rv[[i+1]] <- eval_partial(expr, cartesian_df[i,,drop=FALSE])
     }
-    if (!is.null(name_str)) names(rv) <- c("", name_vec)
+    if (has_row_names) names(rv) <- c("", name_vec)
     return(rv)
 
   } else if (is_format_df || is_format_mtx) {
@@ -370,15 +371,15 @@ gen_list_internal <- function(expr, l, output_format, name_str, parent_frame) {
     rv_list <- lapply(1:nrow(cartesian_df), function(i) eval(expr, cartesian_df[i,,drop=FALSE], parent_frame))
     if (has_row_names) names(rv_list) <- name_vec
     rv_list_begin <- rv_list[[1]]
-    rv_list <- do.call((if (is_by_col) "cbind" else "rbind"), rv_list)
+    rv_list <- do.call((if (is_by_row) "cbind" else "rbind"), rv_list)
     if (output_format == OUTPUT_FORMAT[["DF"]]) {
       return(as.data.frame(rv_list, stringsAsFactors = FALSE))
     } else { # matrix
-      res_mtx <- if (!has_row_names) check_2d_matrix(rv_list_begin, is_by_col, vars, conds, parent_frame) else NULL
+      res_mtx <- if (!has_row_names) check_2d_matrix(rv_list_begin, is_by_row, vars, conds, parent_frame) else NULL
       if (is.null(res_mtx)) {
         return(as.matrix(rv_list))
       } else {
-        return(matrix(rv_list, nrow = res_mtx[["nrow"]], ncol = res_mtx[["ncol"]], byrow = is_by_col))
+        return(matrix(rv_list, nrow = res_mtx[["nrow"]], ncol = res_mtx[["ncol"]], byrow = is_by_row))
       }
     }
   }

R/gen-list.r

@@ -17,18 +17,21 @@
 #'    \item For \code{gen.vector} a value (i.e., a vector of length 1) is expected.
 #'    \item For \code{gen.data.frame} a (named) vector or list is expected which describes one row of the data frame.
 #'    \item For \code{gen.matrix} either a (named) vector/list (like \code{gen.data.frame}) or a scalar is expected. 
-#'          In the latter case we expect exactly two variables (inducing rows/columns) within the \code{...} arguments.
+#'          In the latter case we expect exactly two variables (inducing rows and columns where the order depends on \code{byrow}) within the \code{...} arguments.
 #'   }
 #'   Within \code{expr} it is allowed to use functions and predefined constants from the parent environment.
 #' @param ... Arbitrary many variable ranges and conditions.
 #'   For all free variables occurring in \code{expr} a range must be assigned, e.g., \code{x = 1:3, y = 1:5} for an expression \code{x + y}. 
 #'   At least one variable range is required.
 #'   The ranges may depend on each other, e.g., \code{x = 1:3, y = x:3} or a substitution like \code{x = 1:3, y = 2 * x} is allowed.
-#'   The generated values can be further restricted by conditions (like \code{x <= y}).
-#' 
+#'   The generated values can be further restricted by conditions like \code{x <= y}.
+#' @param byrow Logical. If \code{FALSE} (the default), the elements of a vector within \code{expr} are taken as columns. 
+#'   Otherwise, they are taken as rows.
+#'   
 #' @return 
 #' 
-#' The result of \code{gen.list} is a list (a vector for \code{gen.vector}) containing an entry for each combination of the free variables (i.e., the Cartesian product), where all the free variables in \code{expr} are substituted.
+#' The result of \code{gen.list} is a list (a vector for \code{gen.vector}) containing an entry for each combination of the free variables (i.e., the Cartesian product), 
+#' where all the free variables in \code{expr} are substituted.
 #' The function \code{gen.vector} returns a vector while \code{gen.list} may contain also more complex substructures (like vectors or lists).
 #' 
 #' The output of \code{gen.data.frame} is a data frame where each substituted \code{expr} entry is one row.
@@ -42,8 +45,10 @@
 #'         Each substituted \code{expr} entry is one row of the matrix.
 #'         In contrast to \code{gen.data.frame}, column names are not auto-generated, e.g., \code{gen.matrix(c(a_1, a_2), a_ = 1:2)} is an unnamed matrix.
 #'         If the \code{expr} argument has explicit names (e.g., \code{c(a_1 = a_1, a_2 = a_2)}), these column names are assigned to the resulting matrix.
-#'   \item It's a matrix where the rows/columns are induced by the first/second variable, if \code{expr} is a scalar, and no names or conditions are given.
+#'   \item It's a matrix where the rows and columns are induced by the two variables within \code{...}, if \code{expr} is a scalar, and no names or conditions are given.
+#'         If \code{byrow} is \code{FALSE}, the second variable (i.e., the inner loop) refers to the columns, otherwise it refers to the rows.
 #'         For instance, \code{gen.matrix(i + j, i = 1:3, j = 1:2)} is a matrix with 3 rows and 2 columns.
+#'         For \code{gen.matrix(i + j, i = 1:3, j = 1:2, byrow = TRUE)} we get 2 rows and 3 columns.
 #' }
 #' 
 #' All expressions and conditions are applied to each combination of the free variables separately, i.e., they are applied row-wise and not vector-wise. 
@@ -87,8 +92,9 @@
 #' For instance, \code{"var{x + 1}_{{a}}"} is transformed into \code{"var2_{a}"} for \code{x = 1}.
 #' 
 #' 
-#' @seealso \code{\link{gen.list.expr}} to generate expressions to be evaluated later, 
-#'   \code{\link{gen.named.list.expr}} to generate named structures, 
+#' @seealso
+#'   \code{\link{gen.named.list}} to generate named structures, 
+#'   \code{\link{gen.list.expr}} to generate expressions to be evaluated later, 
 #'   \code{\link{gen.logical.and}} to generate logical and/or conditions,
 #'   and \link{listcompr} for an overview of all list comprehension functions.
 #' 
@@ -135,18 +141,18 @@ gen.vector <- function(expr, ...) {
 
 #' @rdname gen.list
 #' @export
-gen.data.frame <- function(expr, ..., bycol = FALSE) {
+gen.data.frame <- function(expr, ..., byrow = FALSE) {
   l <- substitute(list(...))
   expr <- substitute(expr)
-  return(gen_list_internal(expr, l, if (bycol) OUTPUT_FORMAT[["DF_COL"]] else OUTPUT_FORMAT[["DF"]], NULL, parent.frame()))
+  return(gen_list_internal(expr, l, if (byrow) OUTPUT_FORMAT[["DF_ROW"]] else OUTPUT_FORMAT[["DF"]], NULL, parent.frame()))
 }
 
 #' @rdname gen.list
 #' @export
-gen.matrix <- function(expr, ..., bycol = FALSE) {
+gen.matrix <- function(expr, ..., byrow = FALSE) {
   l <- substitute(list(...))
   expr <- substitute(expr)
-  return(gen_list_internal(expr, l, if (bycol) OUTPUT_FORMAT[["MTX_COL"]] else OUTPUT_FORMAT[["MTX"]], NULL, parent.frame()))
+  return(gen_list_internal(expr, l, if (byrow) OUTPUT_FORMAT[["MTX_ROW"]] else OUTPUT_FORMAT[["MTX"]], NULL, parent.frame()))
 }
 
 # ----- Named Structures -----
@@ -165,6 +171,8 @@ gen.matrix <- function(expr, ..., bycol = FALSE) {
 #'   For instance, \code{"var{x + 1}_{{a}}"} is transformed into \code{"var2_{a}"} for \code{x = 1}.
 #' @param expr A base expression containing free variables which is evaluated for all combinations of variables. 
 #' @param ... Arbitrary many variable ranges and conditions.
+#' @param byrow Logical. If \code{FALSE} (the default), the elements of an \code{expr} vector are taken as columns. 
+#'   Otherwise, they are taken as rows.
 #' 
 #' @details 
 #' 
@@ -189,9 +197,14 @@ gen.matrix <- function(expr, ..., bycol = FALSE) {
 #' # matrix with named columns and rows
 #' gen.named.matrix("row{i}", gen.named.vector("col{j}", i+j, j = 1:3), i = 1:3)
 #' 
+#' # a matrix where the expression refers to the rows and not the columns
+#' gen.named.matrix("col{i}", c(row1 = i, row2 = 10 * i, row3 = 100 * i), i = 1:10,
+#'                  byrow = TRUE)
+#' 
 #' @export
 gen.named.list <- function(str, expr, ...) {
   l <- substitute(list(...))
+  str <- substitute(str)
   expr <- substitute(expr)
   return(gen_list_internal(expr, l, OUTPUT_FORMAT[["LST"]], str, parent.frame()))
 }
@@ -200,24 +213,27 @@ gen.named.list <- function(str, expr, ...) {
 #' @export
 gen.named.vector <- function(str, expr, ...) {
   l <- substitute(list(...))
+  str <- substitute(str)
   expr <- substitute(expr)
   return(gen_list_internal(expr, l, OUTPUT_FORMAT[["VEC"]], str, parent.frame()))
 }
 
 #' @rdname gen.named.list
 #' @export
-gen.named.data.frame <- function(str, expr, ..., bycol = FALSE) {
+gen.named.data.frame <- function(str, expr, ..., byrow = FALSE) {
   l <- substitute(list(...))
+  str <- substitute(str)
   expr <- substitute(expr)
-  return(gen_list_internal(expr, l, if (bycol) OUTPUT_FORMAT[["DF_COL"]] else OUTPUT_FORMAT[["DF"]], str, parent.frame()))
+  return(gen_list_internal(expr, l, if (byrow) OUTPUT_FORMAT[["DF_ROW"]] else OUTPUT_FORMAT[["DF"]], str, parent.frame()))
 }
 
 #' @rdname gen.named.list
 #' @export
-gen.named.matrix <- function(str, expr, ..., bycol = FALSE) {
+gen.named.matrix <- function(str, expr, ..., byrow = FALSE) {
   l <- substitute(list(...))
+  str <- substitute(str)
   expr <- substitute(expr)
-  return(gen_list_internal(expr, l, if (bycol) OUTPUT_FORMAT[["MTX_COL"]] else OUTPUT_FORMAT[["MTX"]], str, parent.frame()))
+  return(gen_list_internal(expr, l, if (byrow) OUTPUT_FORMAT[["MTX_ROW"]] else OUTPUT_FORMAT[["MTX"]], str, parent.frame()))
 }
 
 # ----- Expressions -----