tests/testthat/test-fdata.R

In dbosak01/fmtr: Easily Apply Formats to Data

context("fdata Tests")



test_that("fdata() function works as expected with named vector.", {
  
  res <- c(A = "Label A", B = "Label B", C = "Other", B = "Label B")
  
  fb <- data.frame(id = 100:103, 
                   catc = c("A", "B", "C", "B"), 
                   catn = c(1, 2, 3, 2)) 
  
  
  attr(fb$catc, "format") <- c(A = "Label A", B = "Label B", C = "Other")

  
  fmt_fb <- fdata(fb)
  
  
  expect_equal(all(fmt_fb$catc == res), TRUE)
  

})



test_that("fdata() function works as expected with fmt object.", {
  
  res <- c("Label A", "Label B", "Other", "Label B")
  
  fb <- data.frame(id = 100:103, 
               catc = c("A", "B", "C", "B"), 
               catn = c(1, 2, 3, 2)) 
  
  
  attr(fb$catc, "format") <- 
    value(condition(x == "A", "Label A"),
          condition(x == "B", "Label B"),
          condition(TRUE, "Other"))

  fmt_fb <- fdata(fb)
  
  expect_equal(all(fmt_fb$catc == res), TRUE)
  
})



test_that("fdata() function works as expected with vectorized function.", {
  
  res <- c("Label A", "Label B", "Other", "Label B")
  
  fb <- data.frame(id = 100:103, 
               catc = c("A", "B", "C", "B"), 
               catn = c(1, 2, 3, 2)) 
  
  attr(fb$catc, "format") <- Vectorize(function(x) {
    
    if (x == "A") 
      ret <- "Label A"
    else if (x == "B")
      ret <- "Label B"
    else 
      ret <- "Other"
    
    return(ret)
    
  })
  
  
  fmt_fb <- fdata(fb)

  
  expect_equal(all(fmt_fb$catc == res), TRUE)
  
  
})




test_that("fdata() function works as expected with list of formats.", {

  
  v1 <- c("type1", "type2", "type3", "type2", "type3", "type1")
  v2 <- list(1.258, "H", as.Date("2020-06-19"),
             "L", as.Date("2020-04-24"), 2.8865)
  
  df <- data.frame(type = v1, values = I(v2))
  df
  
  lst <- flist(type  = "row", lookup = v1,
               type1 = "%.1f",
               type2 = value(condition(x == "H", "High"),
                              condition(x == "L", "Low"),
                              condition(TRUE, "NA")),
               type3 = "%y-%m")
  
  
  attr(df$values, "format") <- lst
  df$values
  
  ret <- fdata(df)
  ret
  
  
  expect_equal(as.character(ret[1, 2]), "1.3")
  expect_equal(as.character(ret[2, 2]), "High")
  expect_equal(as.character(ret[3, 2]), "20-06")

})


test_that("fdata() function restores any labels.", {
  
  res <- c(A = "Label A", B = "Label B", C = "Other", B = "Label B")
  
  fb <- data.frame(id = 100:103, 
                   catc = c("A", "B", "C", "B"), 
                   catn = c(1, 2, 3, 2)) 
  
  attr(fb$catc, "label") <- "My Labels" 
  
  attr(fb$catc, "format") <- c(A = "Label A", B = "Label B", C = "Other")
  
  #print(is.null(attr(fb$catc, "label")))
  
  fmt_fb <- fdata(fb)
  
  # print("Here I am in the fdata() check")
  # print(fmt_fb)
  # print(fmt_fb$catc)
  # 
  # attr(fmt_fb$catn, "label") <- "My numeric label"
  # print(attr(fmt_fb$catn, "label"))
  # print(attr(fmt_fb$catc, "label"))
  
  expect_equal(attr(fmt_fb$catc, "label"), "My Labels")
  
  
})



test_that("fdata() function returns character data types.", {
  

  
  fb <- data.frame(id = 100:103, 
                   catc = c("A", "B", "C", "B"), 
                   catn = c(1, 2, 3, 2), 
                   stringsAsFactors = FALSE) 
  
  widths(fb) <- list(id = 10, catc = 10, catn = 10)
  
  expect_equal(class(fb$id), "integer")
  expect_equal(class(fb$catc), "character")
  expect_equal(class(fb$catn), "numeric")
  
  #print(is.null(attr(fb$catc, "label")))
  
  fmt_fb <- fdata(fb)

  
  expect_equal(class(fmt_fb$id), "character")
  expect_equal(class(fmt_fb$catc), "character")
  expect_equal(class(fmt_fb$catn), "character")
  
  
})

test_that("fdata() function works as expected with tibble.", {
  
  dta <- as_tibble(mtcars)
  
  dt1 <- fdata(dta)
  
  expect_equal("tbl_df" %in% class(dt1), TRUE)
  
})

test_that("fdata() parameter checks work as expected.", {
  
  expect_error(fdata("fork"))
  
  dat <- mtcars
  
  res <- fdata(dat, width = 10)
  
  expect_equal(nchar(res[1, 1]), 10)
  
})