Merge pull request #35 from r-world-devs/dev

Release v0.3.0

.Rbuildignore

@@ -11,4 +11,4 @@ README.Rmd
 ^pkgdown$
 cran-comments.md
 .Rprofile
-
+meta_data.yaml

.gitignore

@@ -5,3 +5,5 @@
 inst/doc
 docs
 .Rprofile
+*.Rcheck
+*.tar.gz

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: cohortBuilder
 Type: Package
 Title: Data Source Agnostic Filtering Tools
-Version: 0.2.0
+Version: 0.3.0
 Authors@R: 
     c(person('Krystian', 'Igras', 
              email = '[email protected]', 
@@ -30,6 +30,7 @@ Imports:
 KeepSource: true
 RoxygenNote: 7.2.3
 Suggests: 
+    queryBuilder,
     testthat (>= 3.0.0),
     shiny,
     knitr,

NAMESPACE

@@ -14,6 +14,8 @@ S3method(.post_binding,default)
 S3method(.post_filtering,default)
 S3method(.pre_filtering,default)
 S3method(.pre_filtering,tblist)
+S3method(.print_filter,default)
+S3method(.print_filter,query)
 S3method(.repro_code_tweak,tblist)
 S3method(.run_binding,default)
 S3method(.run_binding,tblist)
@@ -27,12 +29,14 @@ S3method(cb_filter.date_range,tblist)
 S3method(cb_filter.discrete,tblist)
 S3method(cb_filter.discrete_text,tblist)
 S3method(cb_filter.multi_discrete,tblist)
+S3method(cb_filter.query,tblist)
 S3method(cb_filter.range,tblist)
 S3method(filter,character)
 S3method(filter,date_range)
 S3method(filter,discrete)
 S3method(filter,discrete_text)
 S3method(filter,multi_discrete)
+S3method(filter,query)
 S3method(filter,range)
 S3method(rm_filter,Cohort)
 S3method(rm_filter,Source)
@@ -55,6 +59,7 @@ export(.init_step)
 export(.post_binding)
 export(.post_filtering)
 export(.pre_filtering)
+export(.print_filter)
 export(.repro_code_tweak)
 export(.run_binding)
 export(Source)
@@ -70,6 +75,7 @@ export(cb_filter.date_range)
 export(cb_filter.discrete)
 export(cb_filter.discrete_text)
 export(cb_filter.multi_discrete)
+export(cb_filter.query)
 export(cb_filter.range)
 export(code)
 export(cohort)

NEWS.md

@@ -1,3 +1,8 @@
+# cohortBuilder 0.3.0
+
+* Add new filter of type `"query"` that allows to configure complex filtering rules with `queryBuilder` package.
+* Add filter-focused `.print_filter` method responsible for printing filter values when calling `sum_up` on cohort.
+
 # cohortBuilder 0.2.0
 
 * Changed the way reproducible code is returned. Now more flexibility is allowed with using e.g. `.repro_code_tweak` method.

R/bind_keys.R

@@ -63,22 +63,22 @@ primary_keys <- function(...) {
 #'
 #' In order to understand binding keys concept we need to describe the following functions:
 #' \itemize{
-#'   \item{\link{data_key}}{ Defines which table column should be used to describe relation.}
-#'   \item{bind_key}{ Defines what relation occur between datasets.}
-#'   \item{bind_keys}{ If needed, allows to define more than one relation.}
+#'   \item{\link{data_key} - Defines which table column should be used to describe relation.}
+#'   \item{\code{bind_key} - Defines what relation occur between datasets.}
+#'   \item{\code{bind_keys} - If needed, allows to define more than one relation.}
 #' }
 #'
 #' - `data_key` - requires to provide two parameters:
 #' \itemize{
-#'   \item{dataset}{ Name of the dataset existing in Source.}
-#'   \item{key}{ Single character string or vector storing column names that are keys, which should be used to describe relation.}
+#'   \item{\code{dataset} - Name of the dataset existing in Source.}
+#'   \item{\code{key} - Single character string or vector storing column names that are keys, which should be used to describe relation.}
 #' }
 #' For example `data_key('books', 'author_id')`.
 #'
 #' - `bind_key` - requires to provide two obligatory parameters
 #' \itemize{
-#'   \item{update}{ Data key describing which table should be updated.}
-#'   \item{...}{ \strong{Triggering data keys}. One or more data keys describing on which dataset(s) the one in `update` is dependent.}
+#'   \item{\code{update} - Data key describing which table should be updated.}
+#'   \item{\code{...} - \strong{Triggering data keys}. One or more data keys describing on which dataset(s) the one in `update` is dependent.}
 #' }
 #' The output of `bind_key` function is named \strong{binding key}.
 #' `bind_key` offers two extra parameters `post` and `activate`.
@@ -97,8 +97,8 @@ primary_keys <- function(...) {
 #'
 #' You may achieve more flexibility with two parameters:
 #' \itemize{
-#'   \item{activate}{}
-#'   \item{post}{}
+#'   \item{\code{activate}}
+#'   \item{\code{post}}
 #' }
 #'
 #' \strong{Active tables and `activate` parameter}

R/cohort_methods.R

@@ -338,6 +338,7 @@ Cohort <- R6::R6Class(
       for (step_state in state) {
         for (filter_state in step_state$filters) {
           if (filter_state$type == "date_range") {
+            filter_state$range <- na_fix(filter_state$range)
             filter_state$range <- as.Date(filter_state$range)
           }
           add_filter(
@@ -870,14 +871,14 @@ cohort <- function(source, ..., run_flow = FALSE,
 #' The list of methods designed for managing the Cohort configuration and state.
 #'
 #' \itemize{
-#'    \item{\link{add_source}}{ Add source to Cohort object.}
-#'    \item{\link{update_source}}{ Update Cohort object source.}
-#'    \item{\link{add_step}}{ Add step to Cohort object.}
-#'    \item{\link{rm_step}}{ Remove step from Cohort object.}
-#'    \item{\link{add_filter}}{ Add filter to Cohort step.}
-#'    \item{\link{rm_filter}}{ Remove filter from Cohort step.}
-#'    \item{\link{update_filter}}{ Update filter configuration.}
-#'    \item{\link{run}}{ Run data filtering.}
+#'    \item{\link{add_source} - Add source to Cohort object.}
+#'    \item{\link{update_source} - Update Cohort object source.}
+#'    \item{\link{add_step} - Add step to Cohort object.}
+#'    \item{\link{rm_step} - Remove step from Cohort object.}
+#'    \item{\link{add_filter} - Add filter to Cohort step.}
+#'    \item{\link{rm_filter} - Remove filter from Cohort step.}
+#'    \item{\link{update_filter} - Update filter configuration.}
+#'    \item{\link{run} - Run data filtering.}
 #' }
 #'
 #' @return The object of class `Cohort` having the modified configuration dependent on the used method.
@@ -1063,15 +1064,15 @@ run <- function(x, min_step_id, step_id) {
 #' The list of methods designed for getting Cohort-related details.
 #'
 #' \itemize{
-#'    \item{\link{plot_data}}{ Plot filter related Cohort data.}
-#'    \item{\link{stat}}{ Get Cohort related statistics.}
-#'    \item{\link{code}}{ Return reproducible data filtering code.}
-#'    \item{\link{get_data}}{ Get step related data.}
-#'    \item{\link{sum_up}}{ Sum up Cohort state.}
-#'    \item{\link{get_state}}{ Save Cohort state.}
-#'    \item{\link{restore}}{ Restore Cohort state.}
-#'    \item{\link{attrition}}{ Show attrition plot.}
-#'    \item{\link{description}}{ Show Source or filter related description.}
+#'    \item{\link{plot_data} - Plot filter related Cohort data.}
+#'    \item{\link{stat} - Get Cohort related statistics.}
+#'    \item{\link{code} - Return reproducible data filtering code.}
+#'    \item{\link{get_data} - Get step related data.}
+#'    \item{\link{sum_up} - Sum up Cohort state.}
+#'    \item{\link{get_state} - Save Cohort state.}
+#'    \item{\link{restore} - Restore Cohort state.}
+#'    \item{\link{attrition} - Show attrition plot.}
+#'    \item{\link{description} - Show Source or filter related description.}
 #' }
 #'
 #' @return Various type outputs dependent on the selected method.

R/data.R

@@ -6,32 +6,32 @@
 #'
 #' \strong{books} - books on store
 #' \describe{
-#'   \item{isbn}{book ISBN number}
-#'   \item{title}{book title}
-#'   \item{genre}{comma separated book genre}
-#'   \item{publisher}{name of book publisher}
-#'   \item{author}{name of book author}
-#'   \item{copies}{total number of book copies on store}
+#'   \item{\code{isbn}}{book ISBN number}
+#'   \item{\code{title}}{book title}
+#'   \item{\code{genre}}{comma separated book genre}
+#'   \item{\code{publisher}}{name of book publisher}
+#'   \item{\code{author}}{name of book author}
+#'   \item{\code{copies}}{total number of book copies on store}
 #' }
 #' \strong{borrowers} - registered library members
 #' \describe{
-#'   \item{id}{member unique id}
-#'   \item{registered}{date the member joined library}
-#'   \item{address}{member address}
-#'   \item{name}{full member name}
-#'   \item{phone_number}{member phone number}
-#'   \item{program}{membership program type (standard, premium or vip)}
+#'   \item{\code{id}}{member unique id}
+#'   \item{\code{registered}}{date the member joined library}
+#'   \item{\code{address}}{member address}
+#'   \item{\code{name}}{full member name}
+#'   \item{\code{phone_number}}{member phone number}
+#'   \item{\code{program}}{membership program type (standard, premium or vip)}
 #' }
 #' \strong{issues} - borrowed books events
 #' \describe{
-#'   \item{id}{unique event id}
-#'   \item{borrower_id}{id of the member that borrowed the book}
-#'   \item{isbn}{is of the borrowed book}
-#'   \item{date}{date of borrow event}
+#'   \item{\code{id}}{unique event id}
+#'   \item{\code{borrower_id}}{id of the member that borrowed the book}
+#'   \item{\code{isbn}}{is of the borrowed book}
+#'   \item{\code{date}}{date of borrow event}
 #' }
 #' \strong{returns} - returned books events
 #' \describe{
-#'   \item{id}{event id equal to borrow issue id}
-#'   \item{date}{date of return event}
+#'   \item{\code{id}}{event id equal to borrow issue id}
+#'   \item{\code{date}}{date of return event}
 #' }
 "librarian"

R/filter.R

@@ -109,7 +109,17 @@ new_filter <- function(filter_type, source_type, input_param = "value", extra_pa
   utils::file.edit(file)
 }
 
-print_filter <- function(filter, data_objects) {
+#' Method for printing filter details
+#'
+#' @param filter The defined filter object.
+#' @param data_objects List of data objects for the underlying filtering step.
+#' @export
+.print_filter <- function(filter, data_objects) {
+  UseMethod(".print_filter", filter)
+}
+
+#' @export
+.print_filter.default <- function(filter, data_objects) {
   meta <- filter$get_params()
   params <- meta[setdiff(names(meta), static_params)]
   cat(glue::glue("-> Filter ID: {filter$id}"), sep = "\n")
@@ -321,3 +331,44 @@ filter.multi_discrete <- function(type, id, name, ..., description = NULL,
 cb_filter.multi_discrete <- function(source, ...) {
   UseMethod("cb_filter.multi_discrete", source)
 }
+
+#' @rdname filter-types
+#' @export
+filter.query <- function(type, id, name, ..., active = getOption("cb_active_filter", default = TRUE)) {
+  args <- append(
+    environment() %>% as.list() %>% purrr::keep(~ !is.symbol(.x)),
+    list(...)
+  )
+
+  .as_constructor(
+    function(source) {
+      do.call(
+        cb_filter.query,
+        append(list(source = source), args)
+      )
+    }
+  )
+}
+
+#' @rdname filter-source-types
+#' @export
+cb_filter.query <- function(source, ...) {
+  UseMethod("cb_filter.query", source)
+}
+
+#' @export
+.print_filter.query <- function(filter, data_objects) {
+  meta <- filter$get_params()
+  params <- meta[setdiff(names(meta), static_params)]
+  cat(glue::glue("-> Filter ID: {filter$id}"), sep = "\n")
+  cat(glue::glue("   Filter Type: {filter$type}"), sep = "\n")
+  cat("   Filter Parameters:", sep = "\n")
+  for (param_name in names(params)) {
+    if (param_name == "value") {
+      cat(glue::glue("     {param_name}: {deparse(queryBuilder::queryToExpr(params[[param_name]]))}"), sep = "\n")
+    } else {
+      cat(glue::glue("     {param_name}: {paste(params[[param_name]], collapse = ', ')}"), sep = "\n")
+    }
+  }
+}
+

R/hooks.R

@@ -9,18 +9,18 @@
 #'
 #' Each `hook` is a function of two obligatory parameters:
 #' \itemize{
-#'   \item{public}{ Cohort object.}
-#'   \item{private}{ Private environment of Cohort object.}
+#'   \item{\code{public} - Cohort object.}
+#'   \item{\code{private} - Private environment of Cohort object.}
 #' }
 #'
 #' When Cohort method, for which hook is defined, allow to pass custom parameters,
 #' the ones should be also available in hook definition (with some exclusions, see below).
 #'
 #' For example `Cohort$remove_step` has three parameters:
 #' \itemize{
-#'   \item{step_id}{}
-#'   \item{run_flow}{}
-#'   \item{hook}{}
+#'   \item{\code{step_id}}
+#'   \item{\code{run_flow}}
+#'   \item{\code{hook}}
 #' }
 #' By the implementation, the parameters that we should skip are `run_flow` and `hook`,
 #' so the hook should have three parameters `public`, `private` and `step_id`.
@@ -40,7 +40,13 @@
 #' }
 #'
 #' 'Pre' hooks are defined with 'pre_<method_name>_hook' and 'Post' ones as 'post_<method_name>_hook'.
-#' As a result calling `add_hook("pre_remove_step_hook", function(public, private, step_id) {...})`
+#' As a result calling:
+#' \preformatted{
+#' add_hook(
+#'   "pre_remove_step_hook",
+#'   function(public, private, step_id) {...}
+#' )
+#' }
 #' will result with specifying a new pre-hook for `remove_step` method.
 #'
 #' You may add as many hooks as you want.

R/source_methods.R

@@ -237,23 +237,23 @@ set_source <- function(dtconn, ..., primary_keys = NULL, binding_keys = NULL,
 #' In order to make new source type layer functioning, the following list of methods
 #' should be defined:
 #' \itemize{
-#'   \item{.init_source}{ Defines how to extract data object from source.
+#'   \item{\code{.init_source} - Defines how to extract data object from source.
 #'   Each filtering step assumes to be operating on resulting data object
 #'   (further named data_object) and returns object of the same type and structure.}
-#'   \item{.collect_data}{ Defines how to collect data (into R memory) from `data_object`.}
-#'   \item{.get_stats}{ Defines what `data_object` statistics should be
+#'   \item{\code{.collect_data} - Defines how to collect data (into R memory) from `data_object`.}
+#'   \item{\code{.get_stats} - Defines what `data_object` statistics should be
 #'   calculated and how. When provided the stats can be extracted using \link{stat}.}
-#'   \item{.pre_filtering}{ (optional) Defines what operation on `data_object` should be
+#'   \item{\code{.pre_filtering} - (optional) Defines what operation on `data_object` should be
 #'   performed before applying filtering in the step.}
-#'   \item{.post_filtering}{ (optional) Defines what operation on `data_object` should be
+#'   \item{\code{.post_filtering} - (optional) Defines what operation on `data_object` should be
 #'   performed after applying filtering in the step (before running binding).}
-#'   \item{.post_binding}{ (optional) Defines what operation on `data_object` should be
+#'   \item{\code{.post_binding} - (optional) Defines what operation on `data_object` should be
 #'   performed after applying binding in the step.}
-#'   \item{.run_binding}{ (optional) Defines how to handle post filtering data binding.
+#'   \item{\code{.run_binding} - (optional) Defines how to handle post filtering data binding.
 #'   See more about binding keys at \link{binding-keys}.}
-#'   \item{.get_attrition_count and .get_attrition_label}{ Methods defining how to
+#'   \item{\code{.get_attrition_count and .get_attrition_label} - Methods defining how to
 #'   get statistics and labels for attrition plot.}
-#'   \item{.repro_code_tweak}{ (optional) Default method passed as a `modifier`
+#'   \item{\code{.repro_code_tweak} - (optional) Default method passed as a `modifier`
 #'   argument of \link{code} function. Aims to modify reproducible code into the final format.}
 #' }
 #' Except from the above methods, you may extend the existing or new source with providing
@@ -335,11 +335,11 @@ NULL
 #' The list of methods designed for managing the Source configuration and state.
 #'
 #' \itemize{
-#'    \item{\link{add_step}}{ Add step to Source object.}
-#'    \item{\link{rm_step}}{ Remove step from Source object.}
-#'    \item{\link{add_filter}}{ Add filter to Source step.}
-#'    \item{\link{rm_filter}}{ Remove filter from Source step.}
-#'    \item{\link{update_filter}}{ Update filter configuration.}
+#'    \item{\link{add_step} - Add step to Source object.}
+#'    \item{\link{rm_step} - Remove step from Source object.}
+#'    \item{\link{add_filter} - Add filter to Source step.}
+#'    \item{\link{rm_filter} - Remove filter from Source step.}
+#'    \item{\link{update_filter} - Update filter configuration.}
 #' }
 #'
 #' @name managing-source