revise

R/bf_decode.R

@@ -25,30 +25,32 @@ bf_decode <- function(x, registry, positions = NULL, sep = NULL){
   assertCharacter(x = sep, len = 1, null.ok = TRUE)
 
   # get the bits ...
-  theBits <- bind_rows(map(seq_along(registry@flags), function(ix){
+  theBits <- map(.x = seq_along(registry@flags), .f = function(ix){
     tibble(pos = registry@flags[[ix]]$position,
            name = names(registry@flags)[ix],
            flags = length(registry@flags[[ix]]$values),
            bits = length(registry@flags[[ix]]$position),
            desc = paste0(registry@flags[[ix]]$description, collapse = " | "))
-  }))
-  theBits <- arrange(theBits, pos)
+  }) |>
+    bind_rows() |>
+    arrange(pos)
 
   # ... and the positions where they should be split
-  tempTab <- theBits
-  tempTab <- group_by(theBits, name)
-  tempTab <- summarise(tempTab,
-                       split = max(pos),
-                       pos = if_else(n() == 1, as.character(split), paste0(min(pos), ":", max(pos))),
-                       flags = max(flags),
-                       bits = max(bits),
-                       desc = first(desc))
-  tempTab <- arrange(tempTab, split)
+  tempTab <- theBits |>
+    group_by(name) |>
+    summarise(split = max(pos),
+              pos = if_else(n() == 1, as.character(split), paste0(min(pos), ":", max(pos))),
+              flags = max(flags),
+              bits = max(bits),
+              desc = first(desc)) |>
+    arrange(split)
 
   # process bits
-  out <- rowwise(tibble(bf_int = x))
-  out <- mutate(out, bit = .bit(x = bf_int, encoding = registry@width), to = "int")
-  out <- separate(out, col = bit, into = paste0("b", tempTab$split), sep = tempTab$split)
+  out <- .toBin(x = x) |>
+    separate(col = bit, into = paste0("b", tempTab$split), sep = tempTab$split)
+
+    # rowwise(tibble(bf_int = x)) |>
+    # mutate(bit = .toBin(x = bf_int)) |> # fix here
 
   if(!is.null(sep)){
     out <- unite(out, col = "bf_binary", paste0("b", tempTab$split), sep = sep)
@@ -62,7 +64,7 @@ bf_decode <- function(x, registry, positions = NULL, sep = NULL){
   lut <- mutate(lut, flags = row_number()-1)
   lut <- ungroup(lut)
   lut <- rowwise(lut)
-  lut <- mutate(lut, flag = .makeFlag(x = flags, len = bits, rev = TRUE))
+  # lut <- mutate(lut, flag = .makeFlag(x = flags, len = bits, rev = TRUE))
   lut <- ungroup(lut)
   lut <- select(lut, bits = pos, name, flag, desc)
 

R/bf_encode.R

@@ -22,7 +22,7 @@ bf_encode <- function(registry){
     tibble(pos = registry@flags[[ix]]$position,
            name = names(registry@flags)[ix])
   }))
-  theFlags <- arrange(theBits, pos)
+  theFlags <- arrange(theFlags, pos)
 
   # ... and write into the registry
   for(i in seq_along(theFlags$name)){
@@ -41,12 +41,12 @@ bf_encode <- function(registry){
 
       # get the integer part of the binary value
       # .intToBin(x = theVals, len = theFlag$encoding$significand)
-      intBits <- .intToBin(x = theVals)
+      intBits <- .toBin(x = theVals)
 
       if(!is.integer(theVals)){
         # if(theFlag$encoding$exponent != 0L){
         # optionally get the decimal part of the binary value and ...
-        decBits <- .decToBin(x = theVals, len = 23)
+        decBits <- .toBin(x = theVals, len = 23, dec = TRUE)
 
         # transform to scientific notation, then ...
         temp <- paste0(intBits, decBits)
@@ -55,7 +55,7 @@ bf_encode <- function(registry){
 
         # encode as bit sequence
         sign <- as.integer(0 > theVals)
-        exponent <- .intToBin(x = nchar(intBits)-1 + 127, len = 8)# replace this with the correct dynamic bias
+        exponent <- .toBin(x = nchar(intBits)-1 + 127, len = 8)# replace this with the correct dynamic bias
         mantissa <- map(.x = temp, .f = \(x) str_split(string = x, pattern = "[.]", simplify = TRUE)[2]) |>
           unlist()
 
@@ -74,13 +74,13 @@ bf_encode <- function(registry){
   }
 
   # build the integer representation
-  out <- map(1:dim(theBitfield)[1], function(ix){ #this should be an integer
+  out <- map(1:dim(theBitfield)[1], function(ix){
 
-    temp <- paste0(theBitfield[ix, ], collapse = "")
+    temp <- paste0(theBitfield[ix, ], collapse = "") implement it so that it splits this up into chunks of 32 bits, if it's longer
     int <- rev(str_split(temp, "")[[1]])
     sum(+(int == "1") * 2^(seq(int)-1))
 
-  })
+  }) |> unlist()
 
   return(out)
 

R/toBin.R

@@ -0,0 +1,88 @@
+#' Make a bit flag from an integer
+#'
+#' @param x [`numeric(1)`][numeric]\cr the numeric value for which to derive the
+#'   binary value.
+#' @param len [`integerish(1)`][integer]\cr the number of bits used to capture
+#'   the value.
+#' @param dec [`logical(1)`][logical]\cr whether to transform the decimal part
+#'   to bits, or the integer part.
+#' @details Additional details...
+#'
+#' @examples
+#' # example code
+#'
+#' @importFrom checkmate assertIntegerish assertNumeric
+#' @importFrom stringr str_pad
+#' @export
+
+.toBin <- function(x, len = NULL, dec = FALSE){
+
+  # ensure that 'len' is enough to capture the value
+
+  if(dec){
+    x <- as.numeric(paste0(0, ".", str_split(x, "[.]", simplify = T)[,2]))
+
+    temp <- map(.x = x, .f = function(ix){
+      val <- ix
+      bin <- NULL
+      i <- 0
+      while(val > 0 & i < len){
+        val <- val * 2
+        bin <- c(bin, val %/% 1)
+        val <- val - val %/% 1
+        i <-  i + 1
+      }
+      bin <- paste0(bin, collapse = "")
+
+      return(bin)
+    }) |> unlist()
+  } else {
+    x <- as.integer(x)
+
+    temp <- map(.x = x, .f = function(ix){
+      val <- ix
+      bin <- NULL
+      i <- 1
+      if(val == 0){
+        bin <- "0"
+      } else {
+        while(val > 0){
+
+          bin[i] <- val %% 2
+          val <- val %/% 2
+          i <- i + 1
+
+        }
+      }
+      bin <- rev(bin)
+      bin <- paste0(bin, collapse = "")
+
+
+      return(bin)
+    }) |> unlist()
+
+    # fill with 0s
+    if(!is.null(len)){
+      temp <- temp[1:len]
+      temp[is.na(temp)] <- 0
+    }
+  }
+
+  return(temp)
+}
+
+
+# good explanation
+# https://www.cs.cornell.edu/~tomf/notes/cps104/floating
+#
+# calculator
+# https://float.exposed/0x3e458b82
+#
+# https://en.wikipedia.org/wiki/Minifloat
+# https://en.wikipedia.org/wiki/Bfloat16_floating-point_format
+# https://www.youtube.com/watch?v=D-9SQMWo6kI
+#
+# https://youtu.be/D-9SQMWo6kI?t=35 -> explanation of the data model of a bitfield, I should write this into a short description to explain how this function works
+#
+# for use-case
+# https://en.wikipedia.org/wiki/Decimal_degrees