From 6281f777d54c94f1d6e166bee654ec35d569f66b Mon Sep 17 00:00:00 2001 From: eitsupi Date: Sat, 22 Apr 2023 09:46:50 +0000 Subject: [PATCH 1/3] feat: add internal method `Series$to_fmt_char` --- R/extendr-wrappers.R | 2 ++ src/rust/src/series.rs | 9 +++++++++ tests/testthat/test-series.R | 10 +++++++++- 3 files changed, 20 insertions(+), 1 deletion(-) diff --git a/R/extendr-wrappers.R b/R/extendr-wrappers.R index f20795ac2..aa23d3d5e 100644 --- a/R/extendr-wrappers.R +++ b/R/extendr-wrappers.R @@ -941,6 +941,8 @@ Series$series_equal <- function(other, null_equal, strict) .Call(wrap__Series__s Series$get_fmt <- function(index, str_length) .Call(wrap__Series__get_fmt, self, index, str_length) +Series$to_fmt_char <- function(str_length) .Call(wrap__Series__to_fmt_char, self, str_length) + Series$compare <- function(other, op) .Call(wrap__Series__compare, self, other, op) Series$rep <- function(n, rechunk) .Call(wrap__Series__rep, self, n, rechunk) diff --git a/src/rust/src/series.rs b/src/rust/src/series.rs index 287669904..90f8adefd 100644 --- a/src/rust/src/series.rs +++ b/src/rust/src/series.rs @@ -174,6 +174,15 @@ impl Series { } } + fn to_fmt_char(&self, str_length: u32) -> Vec { + let len = self.0.len(); + let mut res = Vec::with_capacity(len); + for i in 0..len { + res.push(self.get_fmt(i.try_into().expect("usize>u32"), str_length)); + } + res + } + pub fn compare(&self, other: &Series, op: String) -> List { //try cast other to self, downcast(dc) to chunkedarray and compare with operator(op) elementwise macro_rules! comp { diff --git a/tests/testthat/test-series.R b/tests/testthat/test-series.R index 189e84456..cc067a710 100644 --- a/tests/testthat/test-series.R +++ b/tests/testthat/test-series.R @@ -485,7 +485,7 @@ test_that("Backward compatibility: to_r_vector", { expect_identical(pl$Series(1:3)$to_r_vector(), 1:3) }) -test_that("internal method get_fmt", { +test_that("internal method get_fmt and to_fmt_char", { s_1 <- pl$Series(c("foo", "bar")) expect_equal( .pr$Series$get_fmt(s_1, index = 1, str_length = 3), @@ -495,4 +495,12 @@ test_that("internal method get_fmt", { .pr$Series$get_fmt(s_1, index = 0, str_length = 100), '"foo"' ) + expect_equal( + .pr$Series$to_fmt_char(s_1, 3), + c('"fo…', '"ba…') + ) + expect_equal( + .pr$Series$to_fmt_char(s_1, 100), + c('"foo"', '"bar"') + ) }) From 27844a9c273814314db086ef5d3e4e20eef26076 Mon Sep 17 00:00:00 2001 From: eitsupi Date: Sat, 22 Apr 2023 10:33:30 +0000 Subject: [PATCH 2/3] feat: add `as.charactor.Series` --- NAMESPACE | 1 + R/s3_methods.R | 19 ++++ tests/testthat/_snaps/s3_methods.md | 136 ++++++++++++++++++++++++++++ tests/testthat/test-s3_methods.R | 26 ++++-- 4 files changed, 175 insertions(+), 7 deletions(-) create mode 100644 tests/testthat/_snaps/s3_methods.md diff --git a/NAMESPACE b/NAMESPACE index d65627397..249b27aaa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -81,6 +81,7 @@ S3method(.DollarNames,When) S3method(.DollarNames,WhenThen) S3method(.DollarNames,WhenThenThen) S3method(.DollarNames,method_environment) +S3method(as.character,Series) S3method(as.data.frame,DataFrame) S3method(as.data.frame,LazyFrame) S3method(as.list,Expr) diff --git a/R/s3_methods.R b/R/s3_methods.R index 7cf13a190..b25879deb 100644 --- a/R/s3_methods.R +++ b/R/s3_methods.R @@ -154,6 +154,25 @@ max.LazyFrame = function(x, ...) x$max() #' @noRd as.vector.Series = function(x, mode) x$to_vector() +#' @param x Series +#' @param format a logical. If `TRUE`, the Series will be formatted. +#' @param str_length an integer. If `format = TRUE`, +#' utf8 or categorical type Series will be formatted to a string of this length. +#' @examples +#' s = pl$Series(c("foo", "barbaz")) +#' as.character(s) +#' as.character(s, format = TRUE) +#' as.character(s, format = TRUE, str_length = 3) +#' @export +as.character.Series = function(x, ..., format = FALSE, str_length = 15) { + if (isTRUE(format)) { + .pr$Series$to_fmt_char(x, str_length = str_length) + } else { + x$to_vector() |> + as.character() + } +} + #' @export #' @noRd max.Series = function(x, ...) x$max() diff --git a/tests/testthat/_snaps/s3_methods.md b/tests/testthat/_snaps/s3_methods.md new file mode 100644 index 000000000..7d0a91b47 --- /dev/null +++ b/tests/testthat/_snaps/s3_methods.md @@ -0,0 +1,136 @@ +# Series as.character v=a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x, y, z + + Code + as.character(pl$Series(v)) + Output + [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" + [20] "t" "u" "v" "w" "x" "y" "z" + +--- + + Code + as.character(pl$Series(v), format = TRUE) + Output + [1] "\"a\"" "\"b\"" "\"c\"" "\"d\"" "\"e\"" "\"f\"" "\"g\"" "\"h\"" "\"i\"" + [10] "\"j\"" "\"k\"" "\"l\"" "\"m\"" "\"n\"" "\"o\"" "\"p\"" "\"q\"" "\"r\"" + [19] "\"s\"" "\"t\"" "\"u\"" "\"v\"" "\"w\"" "\"x\"" "\"y\"" "\"z\"" + +--- + + Code + as.character(pl$Series(v), format = TRUE, str_length = 2) + Output + [1] "\"a…" "\"b…" "\"c…" "\"d…" "\"e…" "\"f…" "\"g…" "\"h…" "\"i…" "\"j…" + [11] "\"k…" "\"l…" "\"m…" "\"n…" "\"o…" "\"p…" "\"q…" "\"r…" "\"s…" "\"t…" + [21] "\"u…" "\"v…" "\"w…" "\"x…" "\"y…" "\"z…" + +# Series as.character v=1, 2, 3, 4, 5, 6, 7, 8, 9, 10 + + Code + as.character(pl$Series(v)) + Output + [1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" + +--- + + Code + as.character(pl$Series(v), format = TRUE) + Output + [1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" + +--- + + Code + as.character(pl$Series(v), format = TRUE, str_length = 2) + Output + [1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" + +# Series as.character v=bar + + Code + as.character(pl$Series(v)) + Output + [1] "bar" + +--- + + Code + as.character(pl$Series(v), format = TRUE) + Output + [1] "\"bar\"" + +--- + + Code + as.character(pl$Series(v), format = TRUE, str_length = 2) + Output + [1] "\"b…" + +# Series as.character v=TRUE, FALSE + + Code + as.character(pl$Series(v)) + Output + [1] "TRUE" "FALSE" + +--- + + Code + as.character(pl$Series(v), format = TRUE) + Output + [1] "true" "false" + +--- + + Code + as.character(pl$Series(v), format = TRUE, str_length = 2) + Output + [1] "true" "false" + +# Series as.character v=1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26 + + Code + as.character(pl$Series(v)) + Output + [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" + [20] "t" "u" "v" "w" "x" "y" "z" + +--- + + Code + as.character(pl$Series(v), format = TRUE) + Output + [1] "\"a\"" "\"b\"" "\"c\"" "\"d\"" "\"e\"" "\"f\"" "\"g\"" "\"h\"" "\"i\"" + [10] "\"j\"" "\"k\"" "\"l\"" "\"m\"" "\"n\"" "\"o\"" "\"p\"" "\"q\"" "\"r\"" + [19] "\"s\"" "\"t\"" "\"u\"" "\"v\"" "\"w\"" "\"x\"" "\"y\"" "\"z\"" + +--- + + Code + as.character(pl$Series(v), format = TRUE, str_length = 2) + Output + [1] "\"a…" "\"b…" "\"c…" "\"d…" "\"e…" "\"f…" "\"g…" "\"h…" "\"i…" "\"j…" + [11] "\"k…" "\"l…" "\"m…" "\"n…" "\"o…" "\"p…" "\"q…" "\"r…" "\"s…" "\"t…" + [21] "\"u…" "\"v…" "\"w…" "\"x…" "\"y…" "\"z…" + +# Series as.character v=foooo , barrrrr + + Code + as.character(pl$Series(v)) + Output + [1] "foooo" "barrrrr" + +--- + + Code + as.character(pl$Series(v), format = TRUE) + Output + [1] "\"foooo\"" "\"barrrrr\"" + +--- + + Code + as.character(pl$Series(v), format = TRUE, str_length = 2) + Output + [1] "\"f…" "\"b…" + diff --git a/tests/testthat/test-s3_methods.R b/tests/testthat/test-s3_methods.R index 955027f1b..a1437afad 100644 --- a/tests/testthat/test-s3_methods.R +++ b/tests/testthat/test-s3_methods.R @@ -77,17 +77,29 @@ patrick::with_parameters_test_that("Series", .cases = make_cases() ) +vecs_to_test = list( + letters, + 1:10, + c("foo" = "bar"), + c(TRUE, FALSE), + as.factor(letters), + c("foooo", "barrrrr") +) + patrick::with_parameters_test_that("Series as.vector", { expect_equal(as.vector(pl$Series(v)), v, ignore_attr = TRUE) }, - v = list( - letters, - 1:10, - c("foo" = "bar"), - c(TRUE, FALSE), - as.factor(letters) - ) + v = vecs_to_test +) + +patrick::with_parameters_test_that("Series as.character", + { + expect_snapshot(as.character(pl$Series(v)), cran = TRUE) + expect_snapshot(as.character(pl$Series(v), format = TRUE), cran = TRUE) + expect_snapshot(as.character(pl$Series(v), format = TRUE, str_length = 2), cran = TRUE) + }, + v = vecs_to_test ) test_that("drop_nulls", { From 7a216a83115a8a4d39094c8997249e04013367f9 Mon Sep 17 00:00:00 2001 From: eitsupi Date: Sat, 22 Apr 2023 10:53:22 +0000 Subject: [PATCH 3/3] test: add more tests --- tests/testthat/_snaps/s3_methods.md | 21 +++++++++++++++++++++ tests/testthat/test-s3_methods.R | 2 ++ 2 files changed, 23 insertions(+) diff --git a/tests/testthat/_snaps/s3_methods.md b/tests/testthat/_snaps/s3_methods.md index 7d0a91b47..27b20ffc7 100644 --- a/tests/testthat/_snaps/s3_methods.md +++ b/tests/testthat/_snaps/s3_methods.md @@ -45,6 +45,27 @@ Output [1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" +--- + + Code + as.character(pl$Series(v)) + Output + [1] "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" + +--- + + Code + as.character(pl$Series(v), format = TRUE) + Output + [1] "1.0" "2.0" "3.0" "4.0" "5.0" "6.0" "7.0" "8.0" "9.0" "10.0" + +--- + + Code + as.character(pl$Series(v), format = TRUE, str_length = 2) + Output + [1] "1.0" "2.0" "3.0" "4.0" "5.0" "6.0" "7.0" "8.0" "9.0" "10.0" + # Series as.character v=bar Code diff --git a/tests/testthat/test-s3_methods.R b/tests/testthat/test-s3_methods.R index a1437afad..43bc9f984 100644 --- a/tests/testthat/test-s3_methods.R +++ b/tests/testthat/test-s3_methods.R @@ -80,6 +80,7 @@ patrick::with_parameters_test_that("Series", vecs_to_test = list( letters, 1:10, + as.double(1:10), c("foo" = "bar"), c(TRUE, FALSE), as.factor(letters), @@ -95,6 +96,7 @@ patrick::with_parameters_test_that("Series as.vector", patrick::with_parameters_test_that("Series as.character", { + expect_equal(as.character(pl$Series(v)), as.character(v), ignore_attr = TRUE) expect_snapshot(as.character(pl$Series(v)), cran = TRUE) expect_snapshot(as.character(pl$Series(v), format = TRUE), cran = TRUE) expect_snapshot(as.character(pl$Series(v), format = TRUE, str_length = 2), cran = TRUE)