Logistic Example

John Mount

2023-08-19

We can work an example similar to the rquery example using a data.table back-end.

library("rqdatatable")
# data example
dL <- wrapr::build_frame(
   "subjectID", "surveyCategory"     , "assessmentTotal" |
   1          , "withdrawal behavior", 5                 |
   1          , "positive re-framing", 2                 |
   2          , "withdrawal behavior", 3                 |
   2          , "positive re-framing", 4                 )
scale <- 0.237

# example rquery pipeline
rquery_pipeline <- local_td(dL) %.>%
  extend_nse(.,
             one = 1) %.>%
  extend_nse(.,
             probability =
               exp(assessmentTotal * scale)/
               sum(exp(assessmentTotal * scale)),
             count = sum(one),
             partitionby = 'subjectID') %.>%
  extend_nse(.,
             rank = cumsum(one),
             partitionby = 'subjectID',
             orderby = c('probability', 'surveyCategory')) %.>%
  extend_nse(.,
             isdiagnosis = rank == count,
             diagnosis = surveyCategory) %.>%
  select_rows_nse(., 
                  isdiagnosis == TRUE) %.>%
  select_columns(., 
                 c('subjectID', 'diagnosis', 'probability')) %.>%
  orderby(., 'subjectID')

Show expanded form of query tree.

cat(format(rquery_pipeline))
mk_td("dL", c(
  "subjectID",
  "surveyCategory",
  "assessmentTotal")) %.>%
 extend(.,
  one := 1) %.>%
 extend(.,
  probability := exp(assessmentTotal * 0.237) / sum(exp(assessmentTotal * 0.237)),
  count := sum(one),
  partitionby = c('subjectID'),
  orderby = c(),
  reverse = c()) %.>%
 extend(.,
  rank := cumsum(one),
  partitionby = c('subjectID'),
  orderby = c('probability', 'surveyCategory'),
  reverse = c()) %.>%
 extend(.,
  isdiagnosis := rank == count,
  diagnosis := surveyCategory) %.>%
 select_rows(.,
   isdiagnosis == TRUE) %.>%
 select_columns(., 
    c('subjectID', 'diagnosis', 'probability')) %.>%
 order_rows(.,
  c('subjectID'),
  reverse = c(),
  limit = NULL)

Execute the calculation.

ex_data_table(rquery_pipeline)
##   subjectID           diagnosis probability
## 1         1 withdrawal behavior   0.6706221
## 2         2 positive re-framing   0.5589742