# Licensed to the Apache Software Foundation (ASF) under one # or more contributor license agreements. See the NOTICE file # distributed with this work for additional information # regarding copyright ownership. The ASF licenses this file # to you under the Apache License, Version 2.0 (the # "License"); you may not use this file except in compliance # with the License. You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, # software distributed under the License is distributed on an # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY # KIND, either express or implied. See the License for the # specific language governing permissions and limitations # under the License. skip_if_not_available("dataset") skip_if_not_available("utf8proc") library(dplyr, warn.conflicts = FALSE) library(lubridate) library(stringr) library(stringi) test_that("paste, paste0, and str_c", { df <- tibble( v = c("A", "B", "C"), w = c("a", "b", "c"), x = c("d", NA_character_, "f"), y = c(NA_character_, "h", "i"), z = c(1.1, 2.2, NA) ) x <- Expression$field_ref("x") y <- Expression$field_ref("y") # no NAs in data compare_dplyr_binding( .input %>% transmute(paste(v, w)) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(paste(v, w, sep = "-")) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(paste0(v, w)) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(str_c(v, w)) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(str_c(v, w, sep = "+")) %>% collect(), df ) # NAs in data compare_dplyr_binding( .input %>% transmute(paste(x, y)) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(paste(x, y, sep = "-")) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(str_c(x, y)) %>% collect(), df ) # non-character column in dots compare_dplyr_binding( .input %>% transmute(paste0(x, y, z)) %>% collect(), df ) # literal string in dots compare_dplyr_binding( .input %>% transmute(paste(x, "foo", y)) %>% collect(), df ) # literal NA in dots compare_dplyr_binding( .input %>% transmute(paste(x, NA, y)) %>% collect(), df ) # expressions in dots compare_dplyr_binding( .input %>% transmute(paste0(x, toupper(y), as.character(z))) %>% collect(), df ) # sep is literal NA # errors in paste() (consistent with base::paste()) expect_error( nse_funcs$paste(x, y, sep = NA_character_), "Invalid separator" ) # emits null in str_c() (consistent with stringr::str_c()) compare_dplyr_binding( .input %>% transmute(str_c(x, y, sep = NA_character_)) %>% collect(), df ) # sep passed in dots to paste0 (which doesn't take a sep argument) compare_dplyr_binding( .input %>% transmute(paste0(x, y, sep = "-")) %>% collect(), df ) # known differences # arrow allows the separator to be an array expect_equal( df %>% Table$create() %>% transmute(result = paste(x, y, sep = w)) %>% collect(), df %>% transmute(result = paste(x, w, y, sep = "")) ) # expected errors # collapse argument not supported expect_error( nse_funcs$paste(x, y, collapse = ""), "collapse" ) expect_error( nse_funcs$paste0(x, y, collapse = ""), "collapse" ) expect_error( nse_funcs$str_c(x, y, collapse = ""), "collapse" ) # literal vectors of length != 1 not supported expect_error( nse_funcs$paste(x, character(0), y), "Literal vectors of length != 1 not supported in string concatenation" ) expect_error( nse_funcs$paste(x, c(",", ";"), y), "Literal vectors of length != 1 not supported in string concatenation" ) }) test_that("grepl with ignore.case = FALSE and fixed = TRUE", { df <- tibble(x = c("Foo", "bar")) compare_dplyr_binding( .input %>% filter(grepl("o", x, fixed = TRUE)) %>% collect(), df ) }) test_that("sub and gsub with ignore.case = FALSE and fixed = TRUE", { df <- tibble(x = c("Foo", "bar")) compare_dplyr_binding( .input %>% transmute(x = sub("Foo", "baz", x, fixed = TRUE)) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = gsub("o", "u", x, fixed = TRUE)) %>% collect(), df ) }) # many of the remainder of these tests require RE2 skip_if_not_available("re2") test_that("grepl", { df <- tibble(x = c("Foo", "bar")) for (fixed in c(TRUE, FALSE)) { compare_dplyr_binding( .input %>% filter(grepl("Foo", x, fixed = fixed)) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = grepl("^B.+", x, ignore.case = FALSE, fixed = fixed)) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(grepl("Foo", x, ignore.case = FALSE, fixed = fixed)) %>% collect(), df ) } }) test_that("grepl with ignore.case = TRUE and fixed = TRUE", { df <- tibble(x = c("Foo", "bar")) # base::grepl() ignores ignore.case = TRUE with a warning when fixed = TRUE, # so we can't use compare_dplyr_binding() for these tests expect_equal( df %>% Table$create() %>% filter(grepl("O", x, ignore.case = TRUE, fixed = TRUE)) %>% collect(), tibble(x = "Foo") ) expect_equal( df %>% Table$create() %>% filter(x = grepl("^B.+", x, ignore.case = TRUE, fixed = TRUE)) %>% collect(), tibble(x = character(0)) ) }) test_that("str_detect", { df <- tibble(x = c("Foo", "bar")) compare_dplyr_binding( .input %>% filter(str_detect(x, regex("^F"))) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = str_detect(x, regex("^f[A-Z]{2}", ignore_case = TRUE))) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = str_detect(x, regex("^f[A-Z]{2}", ignore_case = TRUE), negate = TRUE)) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_detect(x, fixed("o"))) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_detect(x, fixed("O"))) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_detect(x, fixed("O", ignore_case = TRUE))) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_detect(x, fixed("O", ignore_case = TRUE), negate = TRUE)) %>% collect(), df ) }) test_that("sub and gsub", { df <- tibble(x = c("Foo", "bar")) for (fixed in c(TRUE, FALSE)) { compare_dplyr_binding( .input %>% transmute(x = sub("Foo", "baz", x, fixed = fixed)) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = sub("^B.+", "baz", x, ignore.case = FALSE, fixed = fixed)) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = sub("Foo", "baz", x, ignore.case = FALSE, fixed = fixed)) %>% collect(), df ) } }) test_that("sub and gsub with ignore.case = TRUE and fixed = TRUE", { df <- tibble(x = c("Foo", "bar")) # base::sub() and base::gsub() ignore ignore.case = TRUE with a warning when # fixed = TRUE, so we can't use compare_dplyr_binding() for these tests expect_equal( df %>% Table$create() %>% transmute(x = sub("O", "u", x, ignore.case = TRUE, fixed = TRUE)) %>% collect(), tibble(x = c("Fuo", "bar")) ) expect_equal( df %>% Table$create() %>% transmute(x = gsub("o", "u", x, ignore.case = TRUE, fixed = TRUE)) %>% collect(), tibble(x = c("Fuu", "bar")) ) expect_equal( df %>% Table$create() %>% transmute(x = sub("^B.+", "baz", x, ignore.case = TRUE, fixed = TRUE)) %>% collect(), df # unchanged ) }) test_that("str_replace and str_replace_all", { df <- tibble(x = c("Foo", "bar")) compare_dplyr_binding( .input %>% transmute(x = str_replace_all(x, "^F", "baz")) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = str_replace_all(x, regex("^F"), "baz")) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(x = str_replace(x, "^F[a-z]{2}", "baz")) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = str_replace(x, regex("^f[A-Z]{2}", ignore_case = TRUE), "baz")) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = str_replace_all(x, fixed("o"), "u")) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = str_replace(x, fixed("O"), "u")) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = str_replace(x, fixed("O", ignore_case = TRUE), "u")) %>% collect(), df ) }) test_that("strsplit and str_split", { df <- tibble(x = c("Foo and bar", "baz and qux and quux")) compare_dplyr_binding( .input %>% mutate(x = strsplit(x, "and")) %>% collect(), df, # `ignore_attr = TRUE` because the vctr coming back from arrow (ListArray) # has type information in it, but it's just a bare list from R/dplyr. ignore_attr = TRUE ) compare_dplyr_binding( .input %>% mutate(x = strsplit(x, "and.*", fixed = TRUE)) %>% collect(), df, ignore_attr = TRUE ) compare_dplyr_binding( .input %>% mutate(x = strsplit(x, " +and +")) %>% collect(), df, ignore_attr = TRUE ) compare_dplyr_binding( .input %>% mutate(x = str_split(x, "and")) %>% collect(), df, ignore_attr = TRUE ) compare_dplyr_binding( .input %>% mutate(x = str_split(x, "and", n = 2)) %>% collect(), df, ignore_attr = TRUE ) compare_dplyr_binding( .input %>% mutate(x = str_split(x, fixed("and"), n = 2)) %>% collect(), df, ignore_attr = TRUE ) compare_dplyr_binding( .input %>% mutate(x = str_split(x, regex("and"), n = 2)) %>% collect(), df, ignore_attr = TRUE ) compare_dplyr_binding( .input %>% mutate(x = str_split(x, "Foo|bar", n = 2)) %>% collect(), df, ignore_attr = TRUE ) }) test_that("str_to_lower, str_to_upper, and str_to_title", { df <- tibble(x = c("foo1", " \tB a R\n", "!apACHe aRroW!")) compare_dplyr_binding( .input %>% transmute( x_lower = str_to_lower(x), x_upper = str_to_upper(x), x_title = str_to_title(x) ) %>% collect(), df ) # Error checking a single function because they all use the same code path. expect_error( nse_funcs$str_to_lower("Apache Arrow", locale = "sp"), "Providing a value for 'locale' other than the default ('en') is not supported by Arrow", fixed = TRUE ) }) test_that("arrow_*_split_whitespace functions", { # use only ASCII whitespace characters df_ascii <- tibble(x = c("Foo\nand bar", "baz\tand qux and quux")) # use only non-ASCII whitespace characters df_utf8 <- tibble(x = c("Foo\u00A0and\u2000bar", "baz\u2006and\u1680qux\u3000and\u2008quux")) df_split <- tibble(x = list(c("Foo", "and", "bar"), c("baz", "and", "qux", "and", "quux"))) # use default option values expect_equal( df_ascii %>% Table$create() %>% mutate(x = arrow_ascii_split_whitespace(x)) %>% collect(), df_split, ignore_attr = TRUE ) expect_equal( df_utf8 %>% Table$create() %>% mutate(x = arrow_utf8_split_whitespace(x)) %>% collect(), df_split, ignore_attr = TRUE ) # specify non-default option values expect_equal( df_ascii %>% Table$create() %>% mutate( x = arrow_ascii_split_whitespace(x, options = list(max_splits = 1, reverse = TRUE)) ) %>% collect(), tibble(x = list(c("Foo\nand", "bar"), c("baz\tand qux and", "quux"))), ignore_attr = TRUE ) expect_equal( df_utf8 %>% Table$create() %>% mutate( x = arrow_utf8_split_whitespace(x, options = list(max_splits = 1, reverse = TRUE)) ) %>% collect(), tibble(x = list(c("Foo\u00A0and", "bar"), c("baz\u2006and\u1680qux\u3000and", "quux"))), ignore_attr = TRUE ) }) test_that("errors and warnings in string splitting", { # These conditions generate an error, but abandon_ship() catches the error, # issues a warning, and pulls the data into R (if computing on InMemoryDataset) # Elsewhere we test that abandon_ship() works, # so here we can just call the functions directly x <- Expression$field_ref("x") expect_error( nse_funcs$str_split(x, fixed("and", ignore_case = TRUE)), "Case-insensitive string splitting not supported by Arrow" ) expect_error( nse_funcs$str_split(x, coll("and.?")), "Pattern modifier `coll()` not supported by Arrow", fixed = TRUE ) expect_error( nse_funcs$str_split(x, boundary(type = "word")), "Pattern modifier `boundary()` not supported by Arrow", fixed = TRUE ) expect_error( nse_funcs$str_split(x, "and", n = 0), "Splitting strings into zero parts not supported by Arrow" ) # This condition generates a warning expect_warning( nse_funcs$str_split(x, fixed("and"), simplify = TRUE), "Argument 'simplify = TRUE' will be ignored" ) }) test_that("errors and warnings in string detection and replacement", { x <- Expression$field_ref("x") expect_error( nse_funcs$str_detect(x, boundary(type = "character")), "Pattern modifier `boundary()` not supported by Arrow", fixed = TRUE ) expect_error( nse_funcs$str_replace_all(x, coll("o", locale = "en"), "รณ"), "Pattern modifier `coll()` not supported by Arrow", fixed = TRUE ) # This condition generates a warning expect_warning( nse_funcs$str_replace_all(x, regex("o", multiline = TRUE), "u"), "Ignoring pattern modifier argument not supported in Arrow: \"multiline\"" ) }) test_that("backreferences in pattern in string detection", { skip("RE2 does not support backreferences in pattern (https://github.com/google/re2/issues/101)") df <- tibble(x = c("Foo", "bar")) compare_dplyr_binding( .input %>% filter(str_detect(x, regex("F([aeiou])\\1"))) %>% collect(), df ) }) test_that("backreferences (substitutions) in string replacement", { df <- tibble(x = c("Foo", "bar")) compare_dplyr_binding( .input %>% transmute(desc = sub( "(?:https?|ftp)://([^/\r\n]+)(/[^\r\n]*)?", "path `\\2` on server `\\1`", url )) %>% collect(), tibble(url = "https://arrow.apache.org/docs/r/") ) compare_dplyr_binding( .input %>% transmute(x = str_replace(x, "^(\\w)o(.*)", "\\1\\2p")) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = str_replace(x, regex("^(\\w)o(.*)", ignore_case = TRUE), "\\1\\2p")) %>% collect(), df ) compare_dplyr_binding( .input %>% transmute(x = str_replace(x, regex("^(\\w)o(.*)", ignore_case = TRUE), "\\1\\2p")) %>% collect(), df ) }) test_that("edge cases in string detection and replacement", { # in case-insensitive fixed match/replace, test that "\\E" in the search # string and backslashes in the replacement string are interpreted literally. # this test does not use compare_dplyr_binding() because base::sub() and # base::grepl() do not support ignore.case = TRUE when fixed = TRUE. expect_equal( tibble(x = c("\\Q\\e\\D")) %>% Table$create() %>% filter(grepl("\\E", x, ignore.case = TRUE, fixed = TRUE)) %>% collect(), tibble(x = c("\\Q\\e\\D")) ) expect_equal( tibble(x = c("\\Q\\e\\D")) %>% Table$create() %>% transmute(x = sub("\\E", "\\L", x, ignore.case = TRUE, fixed = TRUE)) %>% collect(), tibble(x = c("\\Q\\L\\D")) ) # test that a user's "(?i)" prefix does not break the "(?i)" prefix that's # added in case-insensitive regex match/replace compare_dplyr_binding( .input %>% filter(grepl("(?i)^[abc]{3}$", x, ignore.case = TRUE, fixed = FALSE)) %>% collect(), tibble(x = c("ABC")) ) compare_dplyr_binding( .input %>% transmute(x = sub("(?i)^[abc]{3}$", "123", x, ignore.case = TRUE, fixed = FALSE)) %>% collect(), tibble(x = c("ABC")) ) }) test_that("strptime", { # base::strptime() defaults to local timezone # but arrow's strptime defaults to UTC. # So that tests are consistent, set the local timezone to UTC # TODO: consider reevaluating this workaround after ARROW-12980 withr::local_timezone("UTC") t_string <- tibble(x = c("2018-10-07 19:04:05", NA)) t_stamp <- tibble(x = c(lubridate::ymd_hms("2018-10-07 19:04:05"), NA)) expect_equal( t_string %>% Table$create() %>% mutate( x = strptime(x) ) %>% collect(), t_stamp, ignore_attr = "tzone" ) expect_equal( t_string %>% Table$create() %>% mutate( x = strptime(x, format = "%Y-%m-%d %H:%M:%S") ) %>% collect(), t_stamp, ignore_attr = "tzone" ) expect_equal( t_string %>% Table$create() %>% mutate( x = strptime(x, format = "%Y-%m-%d %H:%M:%S", unit = "ns") ) %>% collect(), t_stamp, ignore_attr = "tzone" ) expect_equal( t_string %>% Table$create() %>% mutate( x = strptime(x, format = "%Y-%m-%d %H:%M:%S", unit = "s") ) %>% collect(), t_stamp, ignore_attr = "tzone" ) tstring <- tibble(x = c("08-05-2008", NA)) tstamp <- strptime(c("08-05-2008", NA), format = "%m-%d-%Y") expect_equal( tstring %>% Table$create() %>% mutate( x = strptime(x, format = "%m-%d-%Y") ) %>% pull(), # R's strptime returns POSIXlt (list type) as.POSIXct(tstamp), ignore_attr = "tzone" ) }) test_that("errors in strptime", { # Error when tz is passed x <- Expression$field_ref("x") expect_error( nse_funcs$strptime(x, tz = "PDT"), "Time zone argument not supported by Arrow" ) }) test_that("strftime", { skip_on_os("windows") # https://issues.apache.org/jira/browse/ARROW-13168 times <- tibble( datetime = c(lubridate::ymd_hms("2018-10-07 19:04:05", tz = "Etc/GMT+6"), NA), date = c(as.Date("2021-01-01"), NA) ) formats <- "%a %A %w %d %b %B %m %y %Y %H %I %p %M %z %Z %j %U %W %x %X %% %G %V %u" formats_date <- "%a %A %w %d %b %B %m %y %Y %H %I %p %M %j %U %W %x %X %% %G %V %u" compare_dplyr_binding( .input %>% mutate(x = strftime(datetime, format = formats)) %>% collect(), times ) compare_dplyr_binding( .input %>% mutate(x = strftime(date, format = formats_date)) %>% collect(), times ) compare_dplyr_binding( .input %>% mutate(x = strftime(datetime, format = formats, tz = "Pacific/Marquesas")) %>% collect(), times ) compare_dplyr_binding( .input %>% mutate(x = strftime(datetime, format = formats, tz = "EST", usetz = TRUE)) %>% collect(), times ) withr::with_timezone( "Pacific/Marquesas", { compare_dplyr_binding( .input %>% mutate( x = strftime(datetime, format = formats, tz = "EST"), x_date = strftime(date, format = formats_date, tz = "EST") ) %>% collect(), times ) compare_dplyr_binding( .input %>% mutate( x = strftime(datetime, format = formats), x_date = strftime(date, format = formats_date) ) %>% collect(), times ) } ) # This check is due to differences in the way %c currently works in Arrow and R's strftime. # We can revisit after https://github.com/HowardHinnant/date/issues/704 is resolved. expect_error( times %>% Table$create() %>% mutate(x = strftime(datetime, format = "%c")) %>% collect(), "%c flag is not supported in non-C locales." ) # Output precision of %S depends on the input timestamp precision. # Timestamps with second precision are represented as integers while # milliseconds, microsecond and nanoseconds are represented as fixed floating # point numbers with 3, 6 and 9 decimal places respectively. compare_dplyr_binding( .input %>% mutate(x = strftime(datetime, format = "%S")) %>% transmute(as.double(substr(x, 1, 2))) %>% collect(), times, tolerance = 1e-6 ) }) test_that("format_ISO8601", { skip_on_os("windows") # https://issues.apache.org/jira/browse/ARROW-13168 times <- tibble(x = c(lubridate::ymd_hms("2018-10-07 19:04:05", tz = "Etc/GMT+6"), NA)) compare_dplyr_binding( .input %>% mutate(x = format_ISO8601(x, precision = "ymd", usetz = FALSE)) %>% collect(), times ) if (getRversion() < "3.5") { # before 3.5, times$x will have no timezone attribute, so Arrow faithfully # errors that there is no timezone to format: expect_error( times %>% Table$create() %>% mutate(x = format_ISO8601(x, precision = "ymd", usetz = TRUE)) %>% collect(), "Timezone not present, cannot convert to string with timezone: %Y-%m-%d%z" ) # See comment regarding %S flag in strftime tests expect_error( times %>% Table$create() %>% mutate(x = format_ISO8601(x, precision = "ymdhms", usetz = TRUE)) %>% mutate(x = gsub("\\.0*", "", x)) %>% collect(), "Timezone not present, cannot convert to string with timezone: %Y-%m-%dT%H:%M:%S%z" ) } else { compare_dplyr_binding( .input %>% mutate(x = format_ISO8601(x, precision = "ymd", usetz = TRUE)) %>% collect(), times ) # See comment regarding %S flag in strftime tests compare_dplyr_binding( .input %>% mutate(x = format_ISO8601(x, precision = "ymdhms", usetz = TRUE)) %>% mutate(x = gsub("\\.0*", "", x)) %>% collect(), times ) } # See comment regarding %S flag in strftime tests compare_dplyr_binding( .input %>% mutate(x = format_ISO8601(x, precision = "ymdhms", usetz = FALSE)) %>% mutate(x = gsub("\\.0*", "", x)) %>% collect(), times ) }) test_that("arrow_find_substring and arrow_find_substring_regex", { df <- tibble(x = c("Foo and Bar", "baz and qux and quux")) expect_equal( df %>% Table$create() %>% mutate(x = arrow_find_substring(x, options = list(pattern = "b"))) %>% collect(), tibble(x = c(-1, 0)) ) expect_equal( df %>% Table$create() %>% mutate(x = arrow_find_substring( x, options = list(pattern = "b", ignore_case = TRUE) )) %>% collect(), tibble(x = c(8, 0)) ) expect_equal( df %>% Table$create() %>% mutate(x = arrow_find_substring_regex( x, options = list(pattern = "^[fb]") )) %>% collect(), tibble(x = c(-1, 0)) ) expect_equal( df %>% Table$create() %>% mutate(x = arrow_find_substring_regex( x, options = list(pattern = "[AEIOU]", ignore_case = TRUE) )) %>% collect(), tibble(x = c(1, 1)) ) }) test_that("stri_reverse and arrow_ascii_reverse functions", { df_ascii <- tibble(x = c("Foo\nand bar", "baz\tand qux and quux")) df_utf8 <- tibble(x = c("Foo\u00A0\u0061nd\u00A0bar", "\u0062az\u00A0and\u00A0qux\u3000and\u00A0quux")) compare_dplyr_binding( .input %>% mutate(x = stri_reverse(x)) %>% collect(), df_utf8 ) compare_dplyr_binding( .input %>% mutate(x = stri_reverse(x)) %>% collect(), df_ascii ) expect_equal( df_ascii %>% Table$create() %>% mutate(x = arrow_ascii_reverse(x)) %>% collect(), tibble(x = c("rab dna\nooF", "xuuq dna xuq dna\tzab")) ) expect_error( df_utf8 %>% Table$create() %>% mutate(x = arrow_ascii_reverse(x)) %>% collect(), "Invalid: Non-ASCII sequence in input" ) }) test_that("str_like", { df <- tibble(x = c("Foo and bar", "baz and qux and quux")) # TODO: After new version of stringr with str_like has been released, update all # these tests to use compare_dplyr_binding # No match - entire string expect_equal( df %>% Table$create() %>% mutate(x = str_like(x, "baz")) %>% collect(), tibble(x = c(FALSE, FALSE)) ) # Match - entire string expect_equal( df %>% Table$create() %>% mutate(x = str_like(x, "Foo and bar")) %>% collect(), tibble(x = c(TRUE, FALSE)) ) # Wildcard expect_equal( df %>% Table$create() %>% mutate(x = str_like(x, "f%", ignore_case = TRUE)) %>% collect(), tibble(x = c(TRUE, FALSE)) ) # Ignore case expect_equal( df %>% Table$create() %>% mutate(x = str_like(x, "f%", ignore_case = FALSE)) %>% collect(), tibble(x = c(FALSE, FALSE)) ) # Single character expect_equal( df %>% Table$create() %>% mutate(x = str_like(x, "_a%")) %>% collect(), tibble(x = c(FALSE, TRUE)) ) # This will give an error until a new version of stringr with str_like has been released skip_if_not(packageVersion("stringr") > "1.4.0") compare_dplyr_binding( .input %>% mutate(x = str_like(x, "%baz%")) %>% collect(), df ) }) test_that("str_pad", { df <- tibble(x = c("Foo and bar", "baz and qux and quux")) compare_dplyr_binding( .input %>% mutate(x = str_pad(x, width = 31)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(x = str_pad(x, width = 30, side = "right")) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(x = str_pad(x, width = 31, side = "left", pad = "+")) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(x = str_pad(x, width = 10, side = "left", pad = "+")) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(x = str_pad(x, width = 31, side = "both")) %>% collect(), df ) }) test_that("substr", { df <- tibble(x = "Apache Arrow") compare_dplyr_binding( .input %>% mutate(y = substr(x, 1, 6)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = substr(x, 0, 6)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = substr(x, -1, 6)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = substr(x, 6, 1)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = substr(x, -1, -2)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = substr(x, 9, 6)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = substr(x, 1, 6)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = substr(x, 8, 12)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = substr(x, -5, -1)) %>% collect(), df ) expect_error( nse_funcs$substr("Apache Arrow", c(1, 2), 3), "`start` must be length 1 - other lengths are not supported in Arrow" ) expect_error( nse_funcs$substr("Apache Arrow", 1, c(2, 3)), "`stop` must be length 1 - other lengths are not supported in Arrow" ) }) test_that("substring", { # nse_funcs$substring just calls nse_funcs$substr, tested extensively above df <- tibble(x = "Apache Arrow") compare_dplyr_binding( .input %>% mutate(y = substring(x, 1, 6)) %>% collect(), df ) }) test_that("str_sub", { df <- tibble(x = "Apache Arrow") compare_dplyr_binding( .input %>% mutate(y = str_sub(x, 1, 6)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = str_sub(x, 0, 6)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = str_sub(x, -1, 6)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = str_sub(x, 6, 1)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = str_sub(x, -1, -2)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = str_sub(x, -1, 3)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = str_sub(x, 9, 6)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = str_sub(x, 1, 6)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = str_sub(x, 8, 12)) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(y = str_sub(x, -5, -1)) %>% collect(), df ) expect_error( nse_funcs$str_sub("Apache Arrow", c(1, 2), 3), "`start` must be length 1 - other lengths are not supported in Arrow" ) expect_error( nse_funcs$str_sub("Apache Arrow", 1, c(2, 3)), "`end` must be length 1 - other lengths are not supported in Arrow" ) }) test_that("str_starts, str_ends, startsWith, endsWith", { df <- tibble(x = c("Foo", "bar", "baz", "qux")) compare_dplyr_binding( .input %>% filter(str_starts(x, "b.*")) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_starts(x, "b.*", negate = TRUE)) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_starts(x, fixed("b.*"))) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_starts(x, fixed("b"))) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_ends(x, "r")) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_ends(x, "r", negate = TRUE)) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_ends(x, fixed("r$"))) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(str_ends(x, fixed("r"))) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(startsWith(x, "b")) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(endsWith(x, "r")) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(startsWith(x, "b.*")) %>% collect(), df ) compare_dplyr_binding( .input %>% filter(endsWith(x, "r$")) %>% collect(), df ) }) test_that("str_count", { df <- tibble( cities = c("Kolkata", "Dar es Salaam", "Tel Aviv", "San Antonio", "Cluj Napoca", "Bern", "Bogota"), dots = c("a.", "...", ".a.a", "a..a.", "ab...", "dse....", ".f..d..") ) compare_dplyr_binding( .input %>% mutate(a_count = str_count(cities, pattern = "a")) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(p_count = str_count(cities, pattern = "d")) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(p_count = str_count(cities, pattern = regex("d", ignore_case = TRUE) )) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(e_count = str_count(cities, pattern = "u")) %>% collect(), df ) # nse_funcs$str_count() is not vectorised over pattern compare_dplyr_binding( .input %>% mutate(let_count = str_count(cities, pattern = c("a", "b", "e", "g", "p", "n", "s"))) %>% collect(), df, warning = TRUE ) compare_dplyr_binding( .input %>% mutate(dots_count = str_count(dots, ".")) %>% collect(), df ) compare_dplyr_binding( .input %>% mutate(dots_count = str_count(dots, fixed("."))) %>% collect(), df ) })