tests/testthat/test-util_parse_redcap_rule.R

In dataquieR: Data Quality in Epidemiological Research

test_that("util_parse_redcap_rule works", {
  skip_if_not_installed(c("withr"))
  skip_if_not_installed(c("qmrparser"))
  skip_if_not_installed(c("callr"))
  # TODO: also consider the results of the function, not only, that it does not report syntax errors
  expect_message(util_parse_redcap_rule("(12)", debug = 1))
  expect_message(util_parse_redcap_rule("12", debug = 1))
  expect_warning(util_parse_redcap_rule("xxxsin(12)", debug = 1))
  expect_message(util_parse_redcap_rule("sum(12)", debug = 1))
  expect_message(util_parse_redcap_rule("(12 + 1)", debug = 1))
  expect_message(util_parse_redcap_rule("(12 + 1 * 2)", debug = 1))
  expect_message(util_parse_redcap_rule("(12 + 1) * 2", debug = 1))
  expect_message(util_parse_redcap_rule("12 + 1 * 2", debug = 1))
  expect_message(util_parse_redcap_rule("12 + (1 * 2)", debug = 1))
  expect_message(util_parse_redcap_rule("(12 + (1 * 2))", debug = 1))
  expect_message(util_parse_redcap_rule("(12 + (1 * 2)) > 1", debug = 1))
  expect_message(util_parse_redcap_rule("((12 + (1 * 2)) > 1)", debug = 1))
  expect_message(util_parse_redcap_rule("12 + (1 * 2) > 1", debug = 1))
  expect_message(util_parse_redcap_rule("(12 + (1 * 2) > 1)", debug = 1))
  expect_silent(util_parse_redcap_rule("12 + (1 * 2) > 1"))
  expect_silent(util_parse_redcap_rule("12 + (1 * 2) > 1 and true"))
  expect_silent(util_parse_redcap_rule("12 + (1 * 2) > 1 and [speed] > 1"))
  expect_silent(util_parse_redcap_rule("(12 + (1 * 2) > 1) and ([speed] > 1)"))
  expect_silent(util_parse_redcap_rule("(1 * 2) > 1 and true"))
  expect_message(util_parse_redcap_rule("(1 * 2) > 1 and 2 > 1", debug = 1))
  expect_silent(util_parse_redcap_rule(rule = '[speed] > 5 and [dist] > 42 or 1 = "2"'))
  expect_silent(util_parse_redcap_rule(rule = '[speed] > 5 or [dist] > 42 and 1 = "2"'))
  expect_error(util_parse_redcap_rule(rule = '[speed] > 5', entry_pred = "non existing"))
  expect_silent(util_parse_redcap_rule(rule = '([speed] > 5)'))
  expect_silent(util_parse_redcap_rule(rule = '[speed]', entry_pred = "term_expression"))
  expect_silent(util_parse_redcap_rule(rule = '[speed] > 5 and [dist] > 42'))
  expect_silent(util_parse_redcap_rule(rule = '[speed] > 5'))
  expect_silent(util_parse_redcap_rule(rule = '[speed] > 5', entry_pred = "term_expression"))
  expect_silent(util_parse_redcap_rule(rule = '[speed] > 5 or 2 > 1', entry_pred = "term_expression"))
  expect_silent(util_parse_redcap_rule(rule = '[speed] > 5 and 12 > 5'))
  expect_silent(util_parse_redcap_rule(rule = '[speed]'))
  expect_silent(util_parse_redcap_rule(rule = '12'))
  expect_silent(util_parse_redcap_rule(rule = '([speed] > 5) and (1 = 2)'))
  expect_silent(util_parse_redcap_rule(rule = '5*5'))
  expect_silent (util_parse_redcap_rule(rule = 'prod(5*5)'))
  expect_silent(util_parse_redcap_rule(rule = 'prod(5*5) < 1'))
  expect_silent(util_parse_redcap_rule(rule = 'prod(5*5) < 1 and true'))
  expect_silent(util_parse_redcap_rule(rule = 'prod(5*5) < 1 and true or false'))
  expect_silent(util_parse_redcap_rule(rule = 'prod(5*5) < 1 and (true or false)'))
  expect_silent(util_parse_redcap_rule(rule = '(prod(5*5) < 1 and (true) or false)'))
  expect_silent(util_parse_redcap_rule(rule = '(prod(5*5) < 1 and true) or false'))
  expect_silent(util_parse_redcap_rule(rule = '(prod(5*5) < (1) and true) or false'))
  expect_silent(util_parse_redcap_rule(rule = '1 + 3 * 3'))
  expect_silent(util_parse_redcap_rule(rule = '1 + 3 * 3 and false'))
  expect_silent(util_parse_redcap_rule("[a] = 12 or [b] = 13"))
  expect_silent(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] <> "" and datediff([con_consentdt],[sda_osd1dt],"d",true) < 0'))
  expect_silent(cars[eval(util_parse_redcap_rule(rule = '[speed] > 5 and [dist] > 42 or 1 = "2"'), cars, util_get_redcap_rule_env()), ])
  expect_silent(util_parse_redcap_rule('datediff([con_consentdt],[sda_osd1dt],"d",true) < 0'))
  expect_silent(util_parse_redcap_rule('datediff([con_consentdt],[sda_osd1dt],"d",true)'))
  expect_message(util_parse_redcap_rule('datediff([con_consentdt],[sda_osd1dt],"d",true)', debug = TRUE))
  expect_message(util_parse_redcap_rule('datediff([con_consentdt],[sda_osd1dt],"d",true)', debug = TRUE, entry_pred = "function_expression"))
  expect_message(util_parse_redcap_rule('[con_consentdt],[sda_osd1dt],"d",true', debug = TRUE, entry_pred = "arg_part"))
  expect_message(util_parse_redcap_rule('[con_consentdt]', debug = TRUE, entry_pred = "term_expression"))
  expect_message(util_parse_redcap_rule('[con_consentdt]', debug = TRUE, entry_pred = "arg"))
  expect_message(util_parse_redcap_rule('[con_consentdt]', debug = TRUE, entry_pred = "symbol_expression"))
  expect_error(eval(util_parse_redcap_rule('datediff([con_consentdt],[sda_osd1dt],"d",true)', debug = TRUE, entry_pred = "function_expression"), cars, util_get_redcap_rule_env()))
  expect_error(eval(util_parse_redcap_rule('datediff([con_consentdt],[sda_osd1dt],"d",true)', entry_pred = "function_expression"), cars, util_get_redcap_rule_env()))
  expect_warning(expect_error(eval(util_parse_redcap_rule('datediff([con_consentdt],[sda_osd1dt],"d", "Y-M-D",true)', entry_pred = "function_expression"), cars, util_get_redcap_rule_env())))
  x <- data.frame(con_consentdt = c(as.POSIXct("2020-01-01"), as.POSIXct("2020-10-20")), sda_osd1dt = c(as.POSIXct("2020-01-20"), as.POSIXct("2020-10-01")))
  expect_silent(eval(util_parse_redcap_rule('datediff([con_consentdt],[sda_osd1dt],"d", "Y-M-D",true)', entry_pred = "function_expression"), x, util_get_redcap_rule_env()))
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] <> "" and datediff([con_consentdt],[sda_osd1dt],"d", "Y-M-D",true)'), x, util_get_redcap_rule_env()))
  x <- cars
  expect_error(eval(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] <> "" and datediff([con_consentdt],[sda_osd1dt],"d", "Y-M-D",true)'), x, util_get_redcap_rule_env()))
  x <- data.frame(con_consentdt = c(as.POSIXct("2020-01-01"), as.POSIXct("2020-10-20")), sda_osd1dt = c(as.POSIXct("2020-01-20"), as.POSIXct("2020-10-01")))
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] <> "" and datediff([con_consentdt],[sda_osd1dt],"d", "Y-M-D",true) < 10'), x, util_get_redcap_rule_env()))
  expect_silent(eval(util_parse_redcap_rule('datediff([con_consentdt],[sda_osd1dt],"d", "Y-M-D",true) < 10'), x, util_get_redcap_rule_env()))
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] <> ""'), x, util_get_redcap_rule_env()))
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] == ""'), x, util_get_redcap_rule_env()))
  x$sda_osd1dt <- NA
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] == ""'), x, util_get_redcap_rule_env()))
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] == "" and [sda_osd1dt] == ""'), x, util_get_redcap_rule_env()))
  x$sda_osd1dt[1] <- as.POSIXct("2020-01-01")
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] == "" and [sda_osd1dt] == ""'), x, util_get_redcap_rule_env()))
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] == "" or [sda_osd1dt] == ""'), x, util_get_redcap_rule_env()))
  expect_silent(expect_error(eval(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] <> "" and datediff([con_consentdt],[sda_osd1dt],"d", "Y-M-D",true) < 10'), x, util_get_redcap_rule_env())))
  x <- data.frame(con_consentdt = c(as.POSIXct("2020-01-01"), as.POSIXct("2020-10-20")), sda_osd1dt = c(as.POSIXct("2020-01-20"), as.POSIXct("2020-10-01")))
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] <> "today" and datediff([con_consentdt],[sda_osd1dt],"d", "Y-M-D",true) < 10'), x, util_get_redcap_rule_env()))
  x$sda_osd1dt[1] <- Sys.Date()
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] <> "today" and datediff([con_consentdt],[sda_osd1dt],"d", "Y-M-D",true) < 10'), x, util_get_redcap_rule_env()))
  expect_silent(eval(util_parse_redcap_rule('[con_consentdt] <> "" and [sda_osd1dt] = "today" and datediff([con_consentdt],[sda_osd1dt],"d", "Y-M-D",true) < 10'), x, util_get_redcap_rule_env()))
  expect_silent(lapply(lapply(setNames(nm = c("(12) > 0 and [speed] > 12", "4+4*5+6")), util_parse_redcap_rule, debug = 0), eval, cars, util_get_redcap_rule_env()))
  expect_equal(
    util_eval_rule(util_parse_redcap_rule("12 * ([speed] + not(not(true or false)))", debug = 0), ds1 = cars, use_value_labels = FALSE),
    with(cars, 12 * (speed + !(!(TRUE || FALSE))))
    )
  expect_equal(
    util_eval_rule(util_parse_redcap_rule("if([speed] > 5, 1, 0)", debug = 0), ds1 = cars, use_value_labels = FALSE),
    with(cars, ifelse(speed > 5, 1, 0))
  )

  x <- tibble::tribble( ~ con_consentdt, ~ cont_inddt, ~ sda_osd1dt,
    as.POSIXct("2020-01-01"), as.POSIXct("2020-01-20"), as.POSIXct("2020-01-20"),
    as.POSIXct("2020-10-20"), as.POSIXct("2020-10-20 15:00:00"), as.POSIXct("2020-10-20 17:00:00")
  )

  expect_equal(
    util_eval_rule(util_parse_redcap_rule("successive_dates([con_consentdt], [cont_inddt], [sda_osd1dt])", debug = 0),
                   ds1 = x, use_value_labels = FALSE),
    with(x, con_consentdt <= cont_inddt & cont_inddt <= sda_osd1dt)
  )

  expect_equal(
    util_eval_rule(util_parse_redcap_rule("strictly_successive_dates([con_consentdt], [cont_inddt], [sda_osd1dt])", debug = 0),
                   ds1 = x, use_value_labels = FALSE),
    with(x, con_consentdt < cont_inddt & cont_inddt < sda_osd1dt)
  )

})