Session work in progress - uncommitted changes

Includes modifications to:
- DESCRIPTION
- R/bf_encode.R, bf_flag.R, bf_map.R, bf_protocol.R
- README files and documentation
- New vignettes directory

This commit captures the working state at end of debugging session.

Author: EhrmannS

DESCRIPTION

@@ -40,3 +40,4 @@ Suggests:
 Depends: 
     R (>= 4.1.0)
 Config/testthat/edition: 3
+VignetteBuilder: knitr

R/bf_encode.R

@@ -12,12 +12,12 @@
 #' reg <- bf_map(protocol = "na", data = bf_tbl, registry = reg, x = y)
 #'
 #' field <- bf_encode(registry = reg)
-#' @importFrom checkmate assertClass assertCharacter assertLogical
+#' @importFrom checkmate assertClass assertList
 #' @importFrom tibble tibble
 #' @importFrom purrr map map_int
-#' @importFrom dplyr bind_rows arrange bind_cols select across
+#' @importFrom dplyr bind_rows arrange bind_cols select across mutate
 #' @importFrom stringr str_split str_split_i str_sub str_pad str_remove
-#' @importFrom tidyr separate_wider_position
+#' @importFrom tidyr separate_wider_position unite
 #' @importFrom rlang  `:=`
 #' @export
 
@@ -55,22 +55,23 @@ bf_encode <- function(registry){
         # get the decimal part of the binary value and ...
         decBits <- .toBin(x = theVals, dec = TRUE)
 
-        # 1. transform to scientific notation, then ...
+        # 1. transform to scientific notation...
         temp <- gsub("^(.{1})(.*)$", "\\1.\\2", str_remove(paste0(intBits, decBits), "^0+"))
+        temp <- ifelse(temp == "", paste0(c(".", rep(0, theFlag$wasGeneratedBy$encodeAsBinary$significand)), collapse = ""), temp)
 
-        # 2. encode as bit sequence
+        # 2. ... then encode as bit sequence
         sign <- as.integer(0 > theVals)
 
         # 3. bias exponent and encode as binary
         exponent <- .toBin(x = nchar(str_remove(intBits, "^0+"))-1 + theFlag$wasGeneratedBy$encodeAsBinary$bias)
 
         # 4. extract significand
         significand  <- map(.x = temp,
-                        .f = \(x) str_sub(str_split(string = x, pattern = "[.]", simplify = TRUE)[2], end = theFlag$wasGeneratedBy$encodeAsBinary$significand ))  |>
+                        .f = \(x) str_pad(str_sub(str_split(string = x, pattern = "[.]", simplify = TRUE)[2], end = theFlag$wasGeneratedBy$encodeAsBinary$significand), width = theFlag$wasGeneratedBy$encodeAsBinary$significand, pad = "0", side = "right"))  |>
           unlist()
 
         # 5. store as bit sequence
-        theBits <- paste0(sign, exponent, significand )
+        theBits <- paste0(sign, exponent, significand)
 
       } else {
         theBits <- intBits

R/bf_flag.R

@@ -35,6 +35,7 @@ bf_flag <- function(registry, flag = NULL) {
   } else {
     pcl <- get(protocol)
   }
+  pcl$test <- paste0(deparse(pcl$test), collapse = "")
   pcl <- .validateProtocol(pcl)
 
   # get NA value

R/bf_map.R

@@ -50,7 +50,8 @@
 #'     \item \code{integer} (x, ...): encode the integer values as bit-sequence
 #'           (\emph{signed integer}).
 #'     \item \code{numeric} (x, ...): encode the numeric value as floating-point
-#'           bit-sequence (with an adapted precision) (\emph{floating-point}).
+#'           bit-sequence (see \code{\link{.makeEncoding}} for details on the
+#'           ... argument) (\emph{floating-point}).
 #'   }
 #'
 #' @section Notes: The console output of various classes (such as tibble) shows
@@ -87,7 +88,7 @@
 #' reg <- bf_map(protocol = "matches", data = bf_tbl, registry = reg,
 #'               x = commodity, set = c("soybean", "honey"))
 #' reg <- bf_map(protocol = "grepl", data = bf_tbl, registry = reg,
-#'               x = year, pattern = "*r")
+#'               x = year, pattern = ".*r")
 #'
 #' # enumeration encoding
 #' reg <- bf_map(protocol = "category", data = bf_tbl, registry = reg,
@@ -144,6 +145,7 @@ bf_map <- function(protocol, data, registry, ..., name = NULL, pos = NULL,
                    na.val = NULL){
 
   assertCharacter(x = protocol, len = 1, any.missing = FALSE)
+  if(grepl(x = protocol, pattern = "_")) stop("protocol name ('", protocol, "'), must not contain '_' symbols.")
   assertClass(x = registry, classes = "registry")
   assertCharacter(x = name, len = 1, any.missing = FALSE, null.ok = TRUE)
   assertIntegerish(x = pos, lower = 1, min.len = 1, unique = TRUE, null.ok = TRUE)
@@ -154,10 +156,18 @@ bf_map <- function(protocol, data, registry, ..., name = NULL, pos = NULL,
   # load protocol ----
   if(protocol %in% names(bf_pcl)){
     pcl <- bf_pcl[[protocol]]
+    # internal protocols already have string tests, convert to function for execution
+    if (is.character(pcl$test)) {
+      pcl$test <- eval(parse(text = pcl$test))
+    }
   } else {
     pcl <- get(protocol)
+    pcl <- .validateProtocol(pcl)
+    # custom protocols need string->function conversion
+    if (is.character(pcl$test)) {
+      pcl$test <- eval(parse(text = pcl$test))
+    }
   }
-  pcl <- .validateProtocol(pcl)
 
   # load potentially missing packages ----
   if(!is.null(pcl$requires)){

R/bf_protocol.R

@@ -5,8 +5,8 @@
 #'   the operation in this protocol. It will be parsed with
 #'   \code{\link[glue]{glue}} and used in the bitfield legend, so can include
 #'   the test arguments as enbraced expressions.
-#' @param test [`function(...)`][function]\cr the function used to compute the bit
-#'   flag.
+#' @param test [`function(...)`][character]\cr the function used to compute the bit
+#'   flag (expressed as character string).
 #' @param example [`list(.)`][list]\cr named list that contains all arguments in
 #'   \code{test} as name with values of the correct type.
 #' @param type [`character(1)`][character]\cr the encoding type according to
@@ -32,11 +32,11 @@
 #' @examples
 #' newFlag <- bf_protocol(name = "na",
 #'                        description = "{x} contains NA-values{result}.",
-#'                        test = function(x) is.na(x = x),
+#'                        test = "function(x) is.na(x = x)",
 #'                        example = list(x = bf_tbl$commodity),
 #'                        type = "bool")
-#' @importFrom checkmate assertCharacter assertFunction assertChoice
-#'   assertIntegerish
+#' @importFrom checkmate assertCharacter assertFunction assertList assertChoice
+#'   assertIntegerish assertClass
 #' @importFrom rlang exec
 #' @importFrom dplyr case_match case_when
 #' @importFrom utils bibentry
@@ -48,7 +48,7 @@ bf_protocol <- function(name, description, test, example, type, bits = NULL,
 
   assertCharacter(x = name, len = 1, any.missing = FALSE)
   assertCharacter(x = description, len = 1, any.missing = FALSE)
-  assertFunction(x = test)
+  assertCharacter(x = test, len = 1, any.missing = FALSE)
   assertList(x = example)
   assertChoice(x = type, choices = c("bool", "enum", "int", "float"))
   assertIntegerish(x = bits, len = 1, null.ok = TRUE)
@@ -58,6 +58,8 @@ bf_protocol <- function(name, description, test, example, type, bits = NULL,
     version <- "1.0.0"
   }
 
+  test <- eval(parse(text = test))
+
   # determine number of bits, if not given ----
   if (is.null(bits)) {
 
@@ -94,7 +96,7 @@ bf_protocol <- function(name, description, test, example, type, bits = NULL,
               encoding_type = type,
               bits = bits, # when the test is general and could result in any number of bits, use NA here
               requires = requiredPkgs,
-              test = paste0(deparse(test), collapse = ""),
+              test = test,
               data = example,
               reference = reference)
 

README.Rmd

@@ -90,7 +90,7 @@ bf_tbl |>
   knitr::kable()
 ```
 
-The decoded information is also available in the package environment for programmatic access:
+The decoded information is also available in the global environment for programmatic access:
 
 ```{r}
 # access values manually
@@ -107,7 +107,7 @@ bf_tbl$yield
 
 - **[Best Practices](articles/best-practices.html)**: Guidelines for effective bitfield design, protocol selection, and common pitfalls
 - **[Community Contributions](articles/community-contributions.html)**: How to contribute protocols to the community standards repository
-- **[Applications and Citations](articles/applications.html)**: Papers and projects using the bitfield package
+- **[Applications](articles/applications.html)**: Examples and use cases using the bitfield package
 
 ## Getting Help
 

README.md

@@ -171,8 +171,8 @@ bf_tbl$yield
   effective bitfield design, protocol selection, and common pitfalls
 - **[Community Contributions](articles/community-contributions.html)**:
   How to contribute protocols to the community standards repository
-- **[Applications and Citations](articles/applications.html)**: Papers
-  and projects using the bitfield package
+- **[Applications](articles/applications.html)**: Examples and use cases
+  using the bitfield package
 
 ## Getting Help
 

man/bf_map.Rd

@@ -0,0 +1,6 @@
+## ----include = FALSE----------------------------------------------------------
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+