tests/testthat/test-dsarray.R

In libr: Libraries, Data Dictionaries, and a Data Step for R

context("Datastep Array Tests")

base_path <- "c:\\packages\\libr\\tests\\testthat\\data"

base_path <- "./data"

DEV <- FALSE


test_that("dsarray() function works", {


  dsa <- dsarray("one", "two", "three", "four")

  expect_equal(length(dsa), 4)
  expect_equal(length(names(dsa)), 4)
  expect_equal("dsarray" %in% class(dsa), TRUE)
  expect_equal(as.character(dsa), c("one", "two", "three", "four"))
  expect_equal(names(dsa), c("one", "two", "three", "four"))

})




test_that("dsarray function works with character index.", {



  d1 <- datastep(mtcars, arrays = list(dsa = dsarray("vs", "am", "gear")), {

    temp <- dsa["am"]

  })

  expect_equal("temp" %in% names(d1), TRUE)
  expect_equal(d1[["temp"]], mtcars[["am"]])

})




test_that("dsarray function works with numeric index.", {



  d1 <- datastep(mtcars, arrays = list(dsa = dsarray("vs", "am", "gear")), {

    temp <- dsa[2]

  })

  expect_equal("temp" %in% names(d1), TRUE)
  expect_equal(d1[["temp"]], mtcars[["am"]])

})


test_that("dsarray function works with factors.", {

  dat <- mtcars
  dat$cat <- factor("A")

  d1 <- datastep(dat, arrays = list(dsa = dsarray("vs", "am", "gear", "cat")), {

    temp <- dsa[4]
    temp2 <- dsa["cat"]

  })

  expect_equal("temp" %in% names(d1), TRUE)
  expect_equal(d1[["temp"]], as.character(dat[["cat"]]))

  expect_equal("temp2" %in% names(d1), TRUE)
  expect_equal(d1[["temp2"]], as.character(dat[["cat"]]))

})


test_that("dsarray function works with no index.", {



  d1 <- datastep(mtcars, {

    temp <- sum(dsa[])
    temp2 <- mean(dsa[])

  }, arrays = list(dsa = dsarray("vs", "am", "gear")))

  expect_equal("temp" %in% names(d1), TRUE)
  expect_equal("temp2" %in% names(d1), TRUE)
  expect_equal(d1[["temp"]], mtcars[["vs"]] + mtcars[["am"]] + mtcars[["gear"]])

})


test_that("dsarray dynamic assignment works as expected.", {

  if (DEV) {

    d1 <- datastep(mtcars, {
  
      temp <- !dsa[1]
  
      for (nm in dsa) {
  
       assign(nm, dsa[nm] + 2)
      }
  
  
    }, arrays = list(dsa = dsarray("vs", "am", "gear")))
  
    d1
  
    expect_equal("temp" %in% names(d1), TRUE)
    expect_equal(d1[["vs"]], mtcars[["vs"]] + 2)
    expect_equal(d1[["am"]], mtcars[["am"]] + 2)
    expect_equal(d1[["gear"]], mtcars[["gear"]] + 2)
  
  } else 
    expect_equal(TRUE, TRUE)

})


test_that("length.dsarray works as expected.", {

  dsa <- dsarray("vs", "am", "gear")

  expect_equal(length(dsa), 3)



})

test_that("names.dsarray works as expected.", {

  dsa <- dsarray("vs", "am", "gear")

  as.character(dsa)

  expect_equal(names(dsa), c("vs", "am", "gear"))



})

test_that("dsarray dynamic assignment to new variables works as expected.", {


  if (DEV) {

    d1 <- datastep(mtcars, arrays = list(dsa = dsarray("vs", "am", "gear"),
                                         dsa1 = c("vs1", "am1", "gear1")),
                   steps = {
  
  
      for (i in seq_along(dsa)) {
  
        assign(dsa1[i], dsa[i] * 2)
      }
  
  
    })
  
    d1
  
    expect_equal("vs1" %in% names(d1), TRUE)
    expect_equal(d1[["vs1"]], mtcars[["vs"]] * 2)
    expect_equal(d1[["am1"]], mtcars[["am"]] * 2)
    expect_equal(d1[["gear1"]], mtcars[["gear"]] * 2)
    
  } else {
    expect_equal(TRUE, TRUE) 
  }
})



test_that("for loop and data type check works as expected.", {

  if (DEV) {
    d1 <- datastep(mtcars,
                   arrays = list(dsa = dsarray("vs", "am", "gear", "fork")),
                   calculate = {
  
      fork <- "my value"
  
  
    }, drop = "nm",
      steps =
  
      {
      rownum <- n.
  
      for (nm in dsa) {
        if (class(dsa[nm]) == "character")
            assign(nm, paste(dsa[nm], n.))
        else
            assign(nm, dsa[nm] + n.)
      }
  
  
    })
  
    d1
  
    expect_equal("fork" %in% names(d1), TRUE)
    expect_equal("rownum" %in% names(d1), TRUE)

  } else {
    expect_equal(TRUE, TRUE) 
  }
})


test_that("System test of datastep array.", {

  dfin <- read.table(header = TRUE, text = '
   C1 C2 C3 C4 C5 C6 C7
   12 R11 D21 201901 09 D89 Real
   21 R23 D77 201901 21 D77 Fetched
   33 R43 D87 201901 31 D87 Real
   33 R43 D87 201901 31 D87 Fetched
   57 R12 D87 201901 12 D87 Fetched')


  dfout <- datastep(dfin,
                    arrays = list(dsa = dsarray(names(dfin[1:6]))),
                    drop = c("nm"),
                    {


                      # After the first row
                      if (n. > 1) {

                        # Loop through column array
                        for (nm in dsa) {

                          # If any of the first 6 columns don't match
                          # or C7 is equal to Real, keep the row
                          #print(paste0("DSA", n., ":", dsa[nm]))
                          #print(paste0("data", n., ":", data[[n. - 1, nm]]))
                          if (as.character(data[[n., nm]]) != as.character(data[[n. - 1, nm]]) ||
                              C7 == "Real") {
                            delete <- FALSE
                            break
                          } else {

                            delete <- TRUE

                          }

                        }

                      } else {

                        # Keep first row by default
                        delete <- FALSE
                      }

                    })

  # See results of datastep
  dfout
  #   C1  C2  C3     C4 C5  C6      C7 delete
  # 1 12 R11 D21 201901  9 D89    Real  FALSE
  # 2 21 R23 D77 201901 21 D77 Fetched  FALSE
  # 3 33 R43 D87 201901 31 D87    Real  FALSE
  # 4 33 R43 D87 201901 31 D87 Fetched   TRUE
  # 5 57 R12 D87 201901 12 D87 Fetched  FALSE

  #print(dfout)

  expect_equal(nrow(dfout), 5)

  # Filter out rows flagged for deletion
  res <- dfout[dfout$delete == FALSE, names(dfout)[1:7]]
  #print(res)
  res
  #   C1  C2  C3     C4 C5  C6      C7
  # 1 12 R11 D21 201901  9 D89    Real
  # 2 21 R23 D77 201901 21 D77 Fetched
  # 3 33 R43 D87 201901 31 D87    Real
  # 5 57 R12 D87 201901 12 D87 Fetched

  expect_equal(nrow(res), 4)
})


test_that("System test of datastep array.", {

  df <- read.table(header = TRUE, text = '
      C1    C2
       3    A1
       2    A2
       1    A3
  ')


  dt <- datastep(df,
                 arrays = list(arr1 = dsarray("C1", "C2")),
                 {

                    D1 <- arr1["C1"]
                    D2 <- arr1["C2"]

                 })
  #print(dt)
  expect_equal(dt$D1, c(3, 2, 1))
  #print(dt$D2)
  expect_equal(dt$D2, c("A1", "A2", "A3"))

})