inst/tinytest/test_relop_extend.R

test_relop_extend <- function() {

  dL <- build_frame(
    "subjectID", "surveyCategory"     , "assessmentTotal", "one" |
      1          , "withdrawal behavior", 5                , 1     |
      1          , "positive re-framing", 2                , 1     |
      2          , "withdrawal behavior", 3                , 1     |
      2          , "positive re-framing", 4                , 1     |
      2          , "other"              , 0                , 1    )

 scale <- 0.237
 rquery_pipeline <- local_td(dL) %.>%
   extend_nse(.,
              probability %:=%
                exp(assessmentTotal * scale)/
                sum(exp(assessmentTotal * scale)),
              count %:=% n(),
              rank %:=% rank(),
              orderby = c("assessmentTotal", "surveyCategory"),
              reverse = c("assessmentTotal"),
              partitionby = 'subjectID')  %.>%
   orderby(., c("subjectID", "probability"))
 res <- ex_data_table(rquery_pipeline, tables = list(dL = dL))
 # cat(draw_frame(res, formatC_options = list(digits = 7)))
 res$probability <- round(res$probability, 4)
 expect <- wrapr::build_frame(
    "subjectID"  , "surveyCategory"     , "assessmentTotal", "one"   , "probability", "count" , "rank"   |
       1   , "positive re-framing",        2         ,        1, 0.3293779    ,        2,        2 |
       1   , "withdrawal behavior",        5         ,        1, 0.6706221    ,        2,        1 |
       2   , "other"              ,        0         ,        1, 0.1780446    ,        3,        3 |
       2   , "withdrawal behavior",        3         ,        1, 0.3625035    ,        3,        2 |
       2   , "positive re-framing",        4         ,        1, 0.4594519    ,        3,        1 )
 expect$probability <- round(expect$probability, 4)
 expect_true(wrapr::check_equiv_frames(expect, res))

 invisible(NULL)
}

test_relop_extend()

Try the rqdatatable package in your browser

Any scripts or data that you put into this service are public.

rqdatatable documentation built on Aug. 21, 2023, 9:10 a.m.