allow to adjust filtering on clusters, or not

Author: EhrmannS

DESCRIPTION

@@ -1,70 +1,70 @@
-Package: tabshiftr
-Title: Reshape Disorganised Messy Data
-Version: 0.5.1
-Authors@R: 
-    c(person(given = "Steffen",
-             family = "Ehrmann",
-             role = c("aut", "cre"),
-             email = "[email protected]",
-             comment = c(ORCID = "0000-0002-2958-0796")),
-      person(given = "Tsvetelina",
-             family = "Tomova",
-             role = "ctb",
-             email = "[email protected]"),
-      person(given = "Carsten",
-             family = "Meyer",
-             role = "aut",
-             email = "[email protected]",
-             comment = c(ORCID = "0000-0003-3927-5856")),
-      person(given = "Abdualmaged",
-             family = "Alhemiary",
-             role = "ctb"),
-      person(given = "Amelie",
-             family = "Haas",
-             role = "ctb"),
-      person(given = "Annika",
-             family = "Ertel",
-             role = "ctb"),
-      person(given = "Arne",
-             family = "Rümmler",
-             role = "ctb",
-             email = "[email protected]",
-             comment = c(ORCID = "0000-0001-8637-9071")),
-      person(given = "Caroline",
-             family = "Busse",
-             role = "ctb"))
-Description: Helps the user to build and register schema descriptions of 
-    disorganised (messy) tables. Disorganised tables are tables that are 
-    not in a topologically coherent form, where packages such as 'tidyr' could 
-    be used for reshaping. The schema description documents the arrangement of 
-    input tables and is used to reshape them into a standardised (tidy) output 
-    format.
-URL: https://luckinet.github.io/tabshiftr/, https://github.com/luckinet/tabshiftr
-BugReports: https://github.com/luckinet/tabshiftr/issues
-Depends:
-    R (>= 2.10)
-Language: en-gb
-License: GPL-3
-Encoding: UTF-8
-LazyData: true
-Imports: 
-    checkmate,
-    rlang,
-    tibble,
-    dplyr,
-    tidyr,
-    magrittr,
-    tidyselect,
-    testthat,
-    crayon,
-    methods,
-    purrr,
-    stringr,
-    lubridate
-RoxygenNote: 7.3.2
-Suggests: 
-    knitr,
-    rmarkdown,
-    bookdown,
-    readr
-VignetteBuilder: knitr
+Package: tabshiftr
+Title: Reshape Disorganised Messy Data
+Version: 0.5.1
+Authors@R: 
+    c(person(given = "Steffen",
+             family = "Ehrmann",
+             role = c("aut", "cre"),
+             email = "[email protected]",
+             comment = c(ORCID = "0000-0002-2958-0796")),
+      person(given = "Tsvetelina",
+             family = "Tomova",
+             role = "ctb",
+             email = "[email protected]"),
+      person(given = "Carsten",
+             family = "Meyer",
+             role = "aut",
+             email = "[email protected]",
+             comment = c(ORCID = "0000-0003-3927-5856")),
+      person(given = "Abdualmaged",
+             family = "Alhemiary",
+             role = "ctb"),
+      person(given = "Amelie",
+             family = "Haas",
+             role = "ctb"),
+      person(given = "Annika",
+             family = "Ertel",
+             role = "ctb"),
+      person(given = "Arne",
+             family = "Rümmler",
+             role = "ctb",
+             email = "[email protected]",
+             comment = c(ORCID = "0000-0001-8637-9071")),
+      person(given = "Caroline",
+             family = "Busse",
+             role = "ctb"))
+Description: Helps the user to build and register schema descriptions of 
+    disorganised (messy) tables. Disorganised tables are tables that are 
+    not in a topologically coherent form, where packages such as 'tidyr' could 
+    be used for reshaping. The schema description documents the arrangement of 
+    input tables and is used to reshape them into a standardised (tidy) output 
+    format.
+URL: https://luckinet.github.io/tabshiftr/, https://github.com/luckinet/tabshiftr
+BugReports: https://github.com/luckinet/tabshiftr/issues
+Depends:
+    R (>= 3.5)
+Language: en-gb
+License: GPL-3
+Encoding: UTF-8
+LazyData: true
+Imports: 
+    checkmate,
+    rlang,
+    tibble,
+    dplyr,
+    tidyr,
+    magrittr,
+    tidyselect,
+    testthat,
+    crayon,
+    methods,
+    purrr,
+    stringr,
+    lubridate
+RoxygenNote: 7.3.2
+Suggests: 
+    knitr,
+    rmarkdown,
+    bookdown,
+    readr
+VignetteBuilder: knitr

R/schema.R

@@ -228,8 +228,8 @@ setValidity(Class = "schema", function(object){
     if(length(object@filter) == 0){
       errors <- c(errors, "the slot 'filter' does not contain any entries.")
     }
-    if(!all(names(object@filter) %in% c("row", "col"))){
-      errors <- c(errors, "'names(schema$filter)' must be a permutation of set {row,col}")
+    if(!all(names(object@filter) %in% c("row", "col", "clusters"))){
+      errors <- c(errors, "'names(schema$filter)' must be a permutation of set {row,col, clusters}")
     }
     if(!is.null(object@filter$row)){
       if(!is.numeric(object@filter$row)){
@@ -241,6 +241,11 @@ setValidity(Class = "schema", function(object){
         errors <- c(errors, "'schema$filter$col' must have a numeric value.")
       }
     }
+    if(!is.null(object@filter$clusters)){
+      if(!is.logical(object@filter$clusters)){
+        errors <- c(errors, "'schema$filter$clusters' must have a logical value.")
+      }
+    }
   }
 
   if(!.hasSlot(object = object, name = "variables")){

R/setFilter.R

@@ -9,6 +9,7 @@
 #'   kept.
 #' @param invert [\code{logical(1)}]\cr whether or not to invert the specified
 #'   columns or rows.
+#' @param clusters [\code{logical(1)}]\cr whether or not to filter cluster rows.
 #' @param operator [\code{function(1)}]\cr \code{\link[base]{Logic}} operators
 #'   by which the current filter should be combined with the directly preceeding
 #'   filter; hence this argument is not used in case no other filter was defined
@@ -33,7 +34,7 @@
 #' @export
 
 setFilter <- function(schema = NULL, rows = NULL, columns = NULL, invert = FALSE,
-                      operator = NULL){
+                      clusters = TRUE, operator = NULL){
 
   # assertions ----
   assertClass(x = schema, classes = "schema", null.ok = TRUE)
@@ -46,6 +47,7 @@ setFilter <- function(schema = NULL, rows = NULL, columns = NULL, invert = FALSE
   if(rowList) assertSubset(x = names(rows), choices = c("find"))
   if(colList) assertSubset(x = names(columns), choices = c("find"))
   assertLogical(x = invert, any.missing = FALSE)
+  assertLogical(x = clusters, any.missing = FALSE)
 
   # update schema ----
   if(is.null(schema)){
@@ -76,6 +78,8 @@ setFilter <- function(schema = NULL, rows = NULL, columns = NULL, invert = FALSE
     schema@filter$col <- c(schema@filter$col, columns)
   }
 
+  schema@filter$clusters <- clusters
+
   # test for problems ----
   # reportProblems(schema = schema)
 

R/validateSchema.R

@@ -71,7 +71,7 @@ validateSchema <- function(schema = NULL, input = NULL){
     clusters$row <- .eval_find(input = input, row = clusters$row, clusters = clusters)
 
     # ignore filter rows
-    if(!is.null(filter$row)){
+    if(filter$clusters & !is.null(filter$row)){
       clusters$row <- clusters$row[clusters$row %in% filter$row]
     }
     clusters$row <- .eval_sum(input = input, groups = groups, data = clusters$row)

data/schema_default.rda

@@ -1,5 +1,5 @@
 Version: 1.0
-ProjectId: 24d10686-dec0-4212-b538-0958fbc3a23b
+ProjectId: 934225e6-a5a1-4111-86d0-eb38315d6cde
 
 RestoreWorkspace: Default
 SaveWorkspace: Default