tests/testthat/test_profiles.R

In dexter: Data Management and Analysis of Tests

context('Test profile analysis')

library(dplyr)
library(DBI)
library(RSQLite)

verbAggCopy = function(pth = '../verbAggression.db')
{
  con = dbConnect(SQLite(), ":memory:")
  db = open_project(pth)
  
  sqliteCopyDatabase(db, con)
  
  dbDisconnect(db)
  return(con)
}


# to do: check for proper number of rows

test_that('profile analysis verb agg',{

  db = verbAggCopy()
  
  f = fit_enorm(db)
  p = profiles(db, f, 'behavior')
  
  expect_gt(cor(p$domain_score,p$expected_domain_score), 0.6, 
            'expected score should have a relation with observed score')
  
  expect_gt(cor(p$domain_score,p$expected_domain_score), cor(p$booklet_score,p$expected_domain_score),
            'domain should add extra information')
  
  expect_true(all(p %>% 
                    group_by(person_id) %>% 
                    summarise(sum_dif = abs(sum(expected_domain_score) - first(booklet_score))) %>%
                    ungroup() %>%
                    pull(sum_dif) < 1e-10), 
              'expected domains scores need to sum to total test score')
  
  # check inputs work with just parms
  pt = profile_tables(f, get_items(db),'situation')
  

  f = fit_enorm(db, method='Bayes')
  p = profiles(db, f, 'behavior')
  
  expect_gt(cor(p$domain_score,p$expected_domain_score), 0.6, 
            'expected score should have a relation with observed score (Bayes)')
  
  
  expect_gt(cor(p$domain_score,p$expected_domain_score), cor(p$booklet_score,p$expected_domain_score),
            'domain should add extra information (Bayes)')
  
  expect_true(all(p %>% 
                    group_by(person_id) %>% 
                    summarise(sum_dif = abs(sum(expected_domain_score) - first(booklet_score))) %>%
                    ungroup() %>%
                    pull(sum_dif) < 1e-10), 
              'expected domains scores need to sum to total test score (Bayes)')
  
  close_project(db)
})