fix 2

Author: Gertjan Bisschop

R/R/derived_variables.R

@@ -12,7 +12,7 @@
 
 .series_to_list <- function(x) {
   if (is.null(x)) return(NULL)
-  x$to_list()
+  as.vector(x)
 }
 
 .series_to_numeric <- function(x) {
@@ -52,13 +52,13 @@
     return(as.numeric(x[[1]]))
   }
 
-  if (is.environment(x) && !is.null(x$to_list)) {
-    vals <- x$to_list()
+  if (.is_polars_series(x)) {
+    vals <- .series_to_list(x)
     if (length(vals) == 0) {
       stop(sprintf("Parameter '%s' must contain at least one value", name), call. = FALSE)
     }
     first <- vals[[1]]
-    if (is.null(first)) {
+    if (is.null(first) || is.na(first)) {
       stop(sprintf("Parameter '%s' cannot be null", name), call. = FALSE)
     }
     return(as.numeric(first))
@@ -72,11 +72,11 @@
 }
 
 .is_polars_series <- function(x) {
-  is.environment(x) && !is.null(x$to_list)
+  inherits(x, "polars_series")
 }
 
 .to_series <- function(values) {
-  polars::pl$Series(values)
+  polars::pl$Series("", values)
 }
 
 .validate_same_length <- function(...) {
@@ -101,7 +101,7 @@
 }
 
 .is_series_like <- function(x) {
-  is.environment(x) && !is.null(x$to_list)
+  .is_polars_series(x)
 }
 
 .split_named_weighted_inputs <- function(values_by_name) {

R/README.md

@@ -51,8 +51,8 @@ Example:
 ```r
 library(polars)
 
-measured <- pl$Series(c(50.0, 100.0, 75.0))
-sg <- pl$Series(c(1.020, 1.015, 1.025))
+measured <- pl$Series("measured", c(50.0, 100.0, 75.0))
+sg <- pl$Series("sg_measured", c(1.020, 1.015, 1.025))
 
 out <- compehndly_apply(
   "normalize_specific_gravity",
@@ -61,15 +61,15 @@ out <- compehndly_apply(
   .params = list(sg_ref = 1.024)
 )
 
-out$to_list()
+as.vector(out)
 ```
 
 Bin decoding uses the same numbered pair contract as Python:
 
 ```r
-values <- pl$Series(c(-10.0, 1.25, -3.0, 4.5))
-copy_a <- pl$Series(c(10.0, 20.0, 30.0, 40.0))
-copy_b <- pl$Series(c(50.0, 60.0, 70.0, 80.0))
+values <- pl$Series("values", c(-10.0, 1.25, -3.0, 4.5))
+copy_a <- pl$Series("copy_from_1", c(10.0, 20.0, 30.0, 40.0))
+copy_b <- pl$Series("copy_from_2", c(50.0, 60.0, 70.0, 80.0))
 
 out <- compehndly_apply(
   "bin_decoding",
@@ -79,7 +79,7 @@ out <- compehndly_apply(
   .params = list(filter_value_1 = -10.0, filter_value_2 = -3.0)
 )
 
-out$to_list()
+as.vector(out)
 ```
 
 ## Run Shared Conformance Tests

R/tests/testthat/helper-conformance.R

@@ -24,3 +24,11 @@ to_numeric_with_na <- function(x) {
     numeric(1)
   )
 }
+
+test_series <- function(values) {
+  polars::pl$Series("", values)
+}
+
+series_values <- function(x) {
+  as.vector(x)
+}

R/tests/testthat/test-bin-decoding.R

@@ -3,14 +3,14 @@ test_that("bin_decoding decodes numbered pairs", {
 
   out <- compehndly_apply(
     "bin_decoding",
-    values = polars::pl$Series(c(-10, 1.25, -3, 4.5, -2)),
-    copy_from_1 = polars::pl$Series(c(10, 20, 30, 40, 50)),
-    copy_from_2 = polars::pl$Series(c(60, 70, 80, 90, 100)),
+    values = test_series(c(-10, 1.25, -3, 4.5, -2)),
+    copy_from_1 = test_series(c(10, 20, 30, 40, 50)),
+    copy_from_2 = test_series(c(60, 70, 80, 90, 100)),
     .params = list(filter_value_1 = -10, filter_value_2 = -3)
   )
 
   expect_equal(
-    to_numeric_with_na(out$to_list()),
+    to_numeric_with_na(series_values(out)),
     c(10, 1.25, 80, 4.5, -2)
   )
 })
@@ -21,7 +21,7 @@ test_that("bin_decoding requires complete contiguous unique pairs", {
   expect_error(
     compehndly_apply(
       "bin_decoding",
-      values = polars::pl$Series(c(-10)),
+      values = test_series(c(-10)),
       .params = list(filter_value_1 = -10)
     ),
     "missing copy_from_1"
@@ -30,8 +30,8 @@ test_that("bin_decoding requires complete contiguous unique pairs", {
   expect_error(
     compehndly_apply(
       "bin_decoding",
-      values = polars::pl$Series(c(-10)),
-      copy_from_2 = polars::pl$Series(c(10)),
+      values = test_series(c(-10)),
+      copy_from_2 = test_series(c(10)),
       .params = list(filter_value_2 = -10)
     ),
     "contiguous"
@@ -40,9 +40,9 @@ test_that("bin_decoding requires complete contiguous unique pairs", {
   expect_error(
     compehndly_apply(
       "bin_decoding",
-      values = polars::pl$Series(c(-10)),
-      copy_from_1 = polars::pl$Series(c(10)),
-      copy_from_2 = polars::pl$Series(c(20)),
+      values = test_series(c(-10)),
+      copy_from_1 = test_series(c(10)),
+      copy_from_2 = test_series(c(20)),
       .params = list(filter_value_1 = -10, filter_value_2 = -10)
     ),
     "unique"

R/tests/testthat/test-conformance.R

@@ -13,18 +13,18 @@ test_that("shared conformance vectors are available and runnable", {
   cases <- payload$cases
 
   for (case in cases) {
-    function_name <- case$function
+    function_name <- case[["function"]]
     params <- case$params %||% list()
     input <- case$input %||% list()
 
     invoke <- function() {
       if (!is.null(input$positional)) {
-        series <- lapply(input$positional, polars::pl$Series)
+        series <- lapply(input$positional, test_series)
         return(do.call(compehndly_apply, c(list(function_name), series, .params = list(params))))
       }
 
       if (!is.null(input$named)) {
-        named_series <- lapply(input$named, polars::pl$Series)
+        named_series <- lapply(input$named, test_series)
         return(do.call(compehndly_apply, c(list(function_name), named_series, .params = list(params))))
       }
 
@@ -40,35 +40,35 @@ test_that("shared conformance vectors are available and runnable", {
     assertions <- case$assertions %||% list()
 
     if (!is.null(assertions$expected)) {
-      got <- to_numeric_with_na(out$to_list())
+      got <- to_numeric_with_na(series_values(out))
       expected <- to_numeric_with_na(assertions$expected)
       expect_equal(got, expected, tolerance = 1e-8)
     }
 
     if (isTRUE(assertions$all_null)) {
-      expect_equal(out$null_count(), out$len())
+      expect_equal(sum(is.na(series_values(out))), length(out))
     }
 
     if (isTRUE(assertions$non_negative)) {
-      got <- as.numeric(out$to_numpy())
+      got <- as.numeric(series_values(out))
       expect_true(all(got >= 0))
     }
 
     if (isTRUE(assertions$no_nan)) {
-      got <- as.numeric(out$to_numpy())
+      got <- as.numeric(series_values(out))
       expect_false(any(is.nan(got)))
     }
 
     if (!is.null(assertions$equals_at_indices)) {
-      got <- as.numeric(out$to_numpy())
+      got <- as.numeric(series_values(out))
       for (idx_name in names(assertions$equals_at_indices)) {
         idx <- as.integer(idx_name) + 1
         expect_equal(got[[idx]], as.numeric(assertions$equals_at_indices[[idx_name]]), tolerance = 1e-8)
       }
     }
 
     if (!is.null(assertions$ranges_at_indices)) {
-      got <- as.numeric(out$to_numpy())
+      got <- as.numeric(series_values(out))
       for (idx_name in names(assertions$ranges_at_indices)) {
         idx <- as.integer(idx_name) + 1
         bounds <- assertions$ranges_at_indices[[idx_name]]
@@ -78,7 +78,7 @@ test_that("shared conformance vectors are available and runnable", {
     }
 
     if (!is.null(assertions$min_value_from_index)) {
-      got <- as.numeric(out$to_numpy())
+      got <- as.numeric(series_values(out))
       start <- as.integer(assertions$min_value_from_index$start) + 1
       min_value <- as.numeric(assertions$min_value_from_index$value)
       expect_true(all(got[start:length(got)] >= min_value))

R/tests/testthat/test-imputation.R

@@ -21,13 +21,13 @@ test_that("medium_bound_imputation follows decision table", {
   measurements <- c(-10, -3, -2, -1, 0.5, 1.5, 3)
   out <- compehndly_apply(
     "medium_bound_imputation",
-    measurement = polars::pl$Series(rep(measurements, 4)),
-    lod = polars::pl$Series(c(rep(NA_real_, 7), rep(1, 7), rep(NA_real_, 7), rep(1, 7))),
-    loq = polars::pl$Series(c(rep(NA_real_, 14), rep(2, 14)))
+    measurement = test_series(rep(measurements, 4)),
+    lod = test_series(c(rep(NA_real_, 7), rep(1, 7), rep(NA_real_, 7), rep(1, 7))),
+    loq = test_series(c(rep(NA_real_, 14), rep(2, 14)))
   )
 
   expect_equal(
-    to_numeric_with_na(out$to_list()),
+    to_numeric_with_na(series_values(out)),
     c(
       rep(NA_real_, 7),
       NA_real_, NA_real_, NA_real_, 0.5, 0.5, 1.5, 3,
@@ -43,13 +43,13 @@ test_that("lab_sensitivity_dichotomization follows decision table", {
   measurements <- c(-10, -3, -2, -1, 0.5, 1.5, 3)
   out <- compehndly_apply(
     "lab_sensitivity_dichotomization",
-    measurement = polars::pl$Series(rep(measurements, 4)),
-    lod = polars::pl$Series(c(rep(NA_real_, 7), rep(1, 7), rep(NA_real_, 7), rep(1, 7))),
-    loq = polars::pl$Series(c(rep(NA_real_, 14), rep(2, 14)))
+    measurement = test_series(rep(measurements, 4)),
+    lod = test_series(c(rep(NA_real_, 7), rep(1, 7), rep(NA_real_, 7), rep(1, 7))),
+    loq = test_series(c(rep(NA_real_, 14), rep(2, 14)))
   )
 
   expect_equal(
-    to_logical_with_na(out$to_list()),
+    to_logical_with_na(series_values(out)),
     c(
       rep(NA, 7),
       NA, NA, NA, FALSE, FALSE, TRUE, TRUE,
@@ -65,12 +65,12 @@ test_that("random_single_imputation follows null and bound decisions", {
   measurements <- c(-10, -3, -2, -1, 0.5, 1.5, 3)
   out <- compehndly_apply(
     "random_single_imputation",
-    biomarker = polars::pl$Series(rep(measurements, 4)),
-    lod = polars::pl$Series(c(rep(NA_real_, 7), rep(1, 7), rep(NA_real_, 7), rep(1, 7))),
-    loq = polars::pl$Series(c(rep(NA_real_, 14), rep(2, 14))),
+    biomarker = test_series(rep(measurements, 4)),
+    lod = test_series(c(rep(NA_real_, 7), rep(1, 7), rep(NA_real_, 7), rep(1, 7))),
+    loq = test_series(c(rep(NA_real_, 14), rep(2, 14))),
     .params = list(seed = 42)
   )
-  values <- to_numeric_with_na(out$to_list())
+  values <- to_numeric_with_na(series_values(out))
 
   expect_true(all(is.na(values[1:7])))
   expect_true(all(is.na(values[8:10])))

docs/r/usage.md

@@ -57,8 +57,8 @@ compehndly_apply(function_name, ..., .params = list())
 For example, normalize a measured value by specific gravity:
 
 ```r
-measured <- pl$Series(c(50.0, 100.0, 75.0))
-sg <- pl$Series(c(1.020, 1.015, 1.025))
+measured <- pl$Series("measured", c(50.0, 100.0, 75.0))
+sg <- pl$Series("sg_measured", c(1.020, 1.015, 1.025))
 
 out <- compehndly_apply(
   "normalize_specific_gravity",
@@ -67,15 +67,15 @@ out <- compehndly_apply(
   .params = list(sg_ref = 1.024)
 )
 
-out$to_list()
+as.vector(out)
 ```
 
 Bin decoding uses the same numbered pair contract as Python:
 
 ```r
-values <- pl$Series(c(-10.0, 1.25, -3.0, 4.5))
-copy_a <- pl$Series(c(10.0, 20.0, 30.0, 40.0))
-copy_b <- pl$Series(c(50.0, 60.0, 70.0, 80.0))
+values <- pl$Series("values", c(-10.0, 1.25, -3.0, 4.5))
+copy_a <- pl$Series("copy_from_1", c(10.0, 20.0, 30.0, 40.0))
+copy_b <- pl$Series("copy_from_2", c(50.0, 60.0, 70.0, 80.0))
 
 out <- compehndly_apply(
   "bin_decoding",
@@ -85,7 +85,7 @@ out <- compehndly_apply(
   .params = list(filter_value_1 = -10.0, filter_value_2 = -3.0)
 )
 
-out$to_list()
+as.vector(out)
 ```
 
 ## Run R Tests