tests/testthat/test-other_functions.R

In common: Solutions for Common Problems in Base R

# String Functions --------------------------------------------------------


test_that("string1: Spaces function works as expected", {


  res <- spaces(25)

  expect_equal(nchar(res), 25)

})


test_that("string2: Symbol function works as expected.", {

  res <- symbol("reg")


  res
  expect_equal(res, "\U00AE")
})


test_that("string3: Symbol superscripts and subscripts work as expected.", {


  tst <- "here^[1] is"

  res <- symbol(tst)

  res
  expect_equal(res, "here\U00B9 is")


  tst <- "here[1] is"

  res <- symbol(tst)

  res
  expect_equal(res, "here\U2081 is")


  tst <- "here[13] is^[12] & reg trade"

  res <- symbol(tst)

  res
  expect_equal(1, 1)


  res <- symbol("rarr larr barr uarr darr harr lArr uArr rArr dArr hArr")

  res

  expect_equal(1, 1)


  res <- symbol("2H[2] + O[1] barr 2H[3]O")

  res

  expect_equal(1, 1)

})


# Other Functions ---------------------------------------------------------



test_that("other1: v() function works", {

  res <- v(a, b, c)


  expect_equal(res, c("a", "b", "c"))

  res1 <- v( c * d, a, b)

  res1

  expect_equal(res1, c("c * d", "a", "b"))


  res2 <- v(c & d, a, b)

  res2

  expect_equal(res2, c("c & d", "a", "b"))

})

test_that("other2: roundup() function works as expected.", {

  x <- seq(0.5,9.5,by=1)

  res <- roundup(x, 0)

  res



  expect_equal(res, c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10))


  vct0 <- c(-2.5, -1.5, -.5, 1.5, 2.5)
  vct1 <- c(8.75, 8.85, 8.95, 9.05, 9.15, 9.25)

  res0 <- roundup(vct0)

  sasres0 <- c(-3, -2, -1, 2,3)
  expect_equal(all(res0 == sasres0), TRUE)

  rres0 <- round(vct0)
  expect_equal(all(res0 == rres0), FALSE)

  res1 <- roundup(vct1, 1)

  sasres1 <- c(8.8, 8.9, 9.0, 9.1, 9.2, 9.3)
  expect_equal(all(res1 == sasres1), TRUE)

  rres1 <- round(vct1)
  expect_equal(all(res1 == rres1), FALSE)

  vct3 <- c(-2.5, -1.5, NA, 1.5, 2.5)
  rres2 <- roundup(vct3)

  expect_equal(is.na(rres2[3]), TRUE)
  expect_equal(rres2[4], 2)

  expect_error(roundup("1"))
  expect_error(roundup(NULL))


})


test_that("other3: find.names() works as expected.", {

  res <- find.names(mtcars)

  res

  expect_equal(length(res), 11)

  res <- find.names(mtcars, "d*")

  res

  expect_equal(length(res), 2)

  res <- find.names(mtcars, c("c*", "d*"))

  res

  expect_equal(length(res), 4)

  res <- find.names(mtcars, c("c*", "d*"), exclude = "disp")

  res

  expect_equal(length(res), 3)


  res <- find.names(mtcars, c("c*", "d*"), exclude = "Disp")

  res

  expect_equal(length(res), 3)


  res <- find.names(mtcars, c("c*", "d*"), exclude = "Disp", ignore.case = FALSE)

  res

  expect_equal(length(res), 4)

  res <- find.names(mtcars, c("c*", "d*"),  start = 3, end = 10)

  res

  expect_equal(length(res), 2)

  nms <- names(mtcars)
  res <- find.names(nms, c("c*", "d*"),  start = 3, end = 10)

  res

  expect_equal(length(res), 2)


})


test_that("other4: Test that copy.attributes parameter checks work.", {

  lst <- list()
  df <- data.frame()

  expect_error(copy.attributes(NULL, mtcars))
  expect_error(copy.attributes(mtcars, NULL))
  expect_error(copy.attributes(df, mtcars))
  expect_error(copy.attributes(mtcars, df))
  expect_error(copy.attributes(lst, mtcars))
  expect_error(copy.attributes(mtcars, lst))

})


test_that("other5: copy.attributes works as expected.", {

  dat1 <- mtcars[1:10, c("mpg", "cyl", "disp")]
  dat2 <- mtcars[1:10, c("mpg", "cyl", "disp")]


  labels(dat1) <- list(mpg = "Fork1",
                       cyl = "Fork2")

  labels(dat2) <- list(disp = "fork3")

  attr(dat1$cyl, "format") <- "myfmt"
  attr(dat2$disp, "format") <- "myfmt2"
  attr(dat2$cyl, "description") <- "mydesc"

  res <- copy.attributes(dat1, dat2)

  attributes(res$mpg)
  attributes(res$cyl)
  attributes(res$disp)


  expect_equal(attributes(res$mpg)$label, "Fork1")
  expect_equal(attributes(res$cyl)$label, "Fork2")
  expect_equal(attributes(res$cyl)$format, "myfmt")
  expect_equal(attributes(res$cyl)$description, "mydesc")
  expect_equal(attributes(res$disp)$label, "fork3")
  expect_equal(attributes(res$disp)$format, "myfmt2")


})


test_that("other6: copy.attributes() works with factor", {

  dat1 <- data.frame(col1 = c(1, 2, 3),
                     col2 = c("A", "B", "C"), stringsAsFactors = TRUE)

  dat2 <- data.frame(col1 = c(1, 2, 3, 4),
                     col2 = c("A", "B", "C", "D"), stringsAsFactors = TRUE)

  labels(dat1) <- list(col1 = "Column 1",
                       col2 = "Column 2")

  res <- copy.attributes(dat1, dat2)

  res

  expect_equal(nrow(res), 4)
  expect_equal(ncol(res), 2)
  expect_equal(attr(res$col1, "label"), "Column 1")
  expect_equal(attr(res$col2, "label"), "Column 2")
  expect_equal("factor" %in% class(res$col2), TRUE)
  expect_equal(attr(res$col2, "levels"), c("A", "B", "C", "D"))

})

test_that("other7: v() function names work as expected.", {

  res <- v(fork, bork, spork = A, hammy = c(1, 2, 3), other = c("A", "B", "C"))

  res

  expect_equal(length(res), 5)
  expect_equal(res[[1]], "fork")
  expect_equal(res[[2]], "bork")
  expect_equal(res[[3]], "A")
  expect_equal(names(res), c("", "", "spork", "hammy", "other"))


})

test_that("other8: roundup() function works on dataframes.", {

  res <- roundup(mtcars)

  res

  expect_equal(res$mpg[3], 23)

  res <- roundup(mtcars, 1)

  res

  expect_equal(res$wt[3], 2.3)



  res <- roundup(iris)

  res

  expect_equal(res$Sepal.Width[1], 4)


})

test_that("other9: changedv() function works as expected.", {

  v1 <- c(1, 1, 1, 2, 2, 3, 3, 3, 1, 1)

  res <- changedv(v1)

  res

  expect_equal(res, c(TRUE, FALSE, FALSE, TRUE, FALSE,
                      TRUE, FALSE, FALSE, TRUE, FALSE))

  res2 <- duplicated(v1)

  expect_equal(all(res != res2), FALSE)

})


test_that("other10: compint() works as expected.", {

  v1 <- c(1, 1, 2, NA, 3,  3, NA)
  v2 <- c(1, 2, 2, NA, NA, 3, 1)


  res <- compint(v1, v2)

  res

  expect_equal(res, c(TRUE, FALSE, TRUE, TRUE, FALSE, TRUE, FALSE))
})


test_that("other11: changedv() reversed works as expected.", {

  v1 <- c(1, 1, 1, 2, 2, 3, 3, 3, 1, 1)

  res <- changedv(v1, reverse = TRUE)

  res

  expect_equal(res, c(F, F, TRUE, FALSE, T,
                      F, FALSE, TRUE, FALSE, T))


})

test_that("other12: changedv() with NA works as expected.", {

  v1 <- c(1, 1, 1, 2, 2, 3, NA, 3, 1, 1)

  res <- changedv(v1)

  res

  expect_equal(res, c(TRUE, FALSE, FALSE, TRUE, FALSE,
                      TRUE, TRUE, TRUE, TRUE, FALSE))



})


test_that("other13: changed() function with df works as expected.", {

  v1 <- c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3)
  v2 <- c(1, 1, 1, 2, 2, 3, 3, 3, 1, 1)

  df <- data.frame(v1, v2)

  res <- changed(df)

  res

  expect_equal(res$v1.changed, c(TRUE, FALSE, FALSE, FALSE, FALSE,
                         TRUE, FALSE, FALSE, FALSE, FALSE))

  expect_equal(res$v2.changed, c(TRUE, FALSE, FALSE, TRUE, FALSE,
                         TRUE, FALSE, FALSE, TRUE, FALSE))

})


test_that("other14: collapsedf() function works as expected.", {

  v1 <- c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3)
  v2 <- c(1, 1, 1, 2, 2, 2, 3, 3, 1, 1)
  v3 <- c(1, 1, 2, 2, 2, 2, 2, 2, 2, 2)

  v1 <- changedv(v1)
  v2 <- changedv(v2)
  v3 <- changedv(v3)

  df <- data.frame(v1, v2, v3)

  res <- collapsedf(df)


  expect_equal(res, c(T, F, T, T, F, T, T, F, T, F))
})

test_that("other15: changed() function with simplify works as expected.", {

  v1 <- c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3)
  v2 <- c(1, 1, 1, 2, 2, 2, 3, 3, 1, 1)
  v3 <- c(1, 1, 2, 2, 2, 2, 2, 2, 2, 2)

  df <- data.frame(v1, v2, v3)

  res <- changed(df, simplify = TRUE)

  res

  expect_equal(res, c(T, F, T, T, F, T, T, F, T, F))

})

test_that("other16: changed() function with df character works as expected.", {

  v1 <- c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3)
  v2 <- c("A", "A", "A", "B", "B", "C", "C", "C", "A", "A")

  df <- data.frame(v1, v2)

  res <- changed(df)

  res

  expect_equal(res$v1.changed, c(TRUE, FALSE, FALSE, FALSE, FALSE,
                                 TRUE, FALSE, FALSE, FALSE, FALSE))

  expect_equal(res$v2.changed, c(TRUE, FALSE, FALSE, TRUE, FALSE,
                                 TRUE, FALSE, FALSE, TRUE, FALSE))

})


test_that("other17: changed() function with simplify works as expected.", {

  v1 <- c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3)
  v2 <- c("A", "A", "A", "B", "B", "C", "C", "C", "A", "A")
  v3 <- c(1.1, 1.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1)

  df <- data.frame(v1, v2, v3)

  res <- changed(df, simplify = TRUE)

  res

  expect_equal(res, c(T, F, T, T, F, T, F, F, T, F))

})


test_that("other18: changed() function with reverse works as expected.", {

  v1 <- c(1, 1, 1, 1, 1, 3, 3, 3, 3, 3)
  v2 <- c("A", "A", "A", "B", "B", "C", "C", "C", "A", "A")
  v3 <- c(as.Date("2023-01-01"), as.Date("2023-01-01"),
          as.Date("2023-01-02"), as.Date("2023-01-02"), as.Date("2023-01-02"),
          as.Date("2023-01-02"), as.Date("2023-01-02"), as.Date("2023-01-02"),
          as.Date("2023-01-02"), as.Date("2023-01-02"))

  df <- data.frame(v1, v2, v3)

  res <- changed(df$v2, reverse = TRUE)

  res

  expect_equal(res, c(F, F, T, F, T, F, F, T, F, T))

  res <- changed(df, reverse = TRUE)

  res

  expect_equal(res$v1.changed[1], FALSE)
  expect_equal(res$v1.changed[10], TRUE)
  expect_equal(res$v3.changed[1], FALSE)
  expect_equal(res$v3.changed[2], TRUE)
  expect_equal(res$v3.changed[10], TRUE)

  res1 <- changed(df, reverse = TRUE, simplify = TRUE)

  expect_equal(res1, c(F, T, T, F, T, F, F, T, F, T))

})