tests/testthat/testComposit.R

In SMasa11/ptse: Post-Treatment Subgroup Effect

library(ptse)
library(testthat)
context("compositTests Monte Carlo")
test_that("Monte Carlo DGP ", {
  rm(list=ls())
  source('./testMCDGP.R')
  expect_warning(reporting <- runEstimateReporting())
  means <- c(0.18373344405026, 0.503588728096011, 0.332920103280546, 0.341200660811245)
  quantiles <- c(0.151011881650212, 0.121466078718648, 0.101768876764273, 0.0755059408251064,
                 0.131314679695837, 0.210103487513338, 0.167426216612191, 0.17727481758938,
                 0.213386354505734, 0.344701034201571, 0.370963970140738, 0.269195093376466,
                 0.30530663029282, 0.331569566231988, 0.364398236155947, 0.380812571117925,
                 0.541673053745326, 0.600764659608451, 0.604047526600848, 0.623744728555224,
                 0.689402068403141, 0.69925066938033)
  expect_true(all.equal(reporting$reportingV[1:(length(means)-1)],means[1:(length(means)-1)]))
  expect_true(all.equal(reporting$reportingQ,quantiles))
  CIs <- c(dDim = 8, 0.089941648444899, 0.277525239655621, 0.423377557534654,
           0.583799898657368, 0.135734160876175, 0.530106045684916, 0.207888446594825,
           0.474512875027665, 44, -1.27212715775791, -0.795180781645478,
           -0.532843393353532, 0.00721782305673639, -0.541707331087952,
           0.121445403933248, -0.424341588226735, -0.134149625895804, -0.185706454885434,
           0.0790149899169291, -0.124954860837813, 1.57415092105834, 1.03811293908277,
           0.736381146882079, 0.143794058593476, 0.804336690479626, 0.298761571093428,
           0.759194021451117, 0.488699261074563, 0.612479163896902, 0.610387078486213,
           0.866882801119289, -0.497774797988227, -1.29214317628441, -1.89302067046618,
           -1.5658840071837, -3.06898283091622, -1.52897772100035, 0.0744222447516234,
           0.394842404897424, -0.00894471485132375, 0.508733571443369, 0.0703026495230752,
           1.03616498474116, 1.90275643687005, 2.55615980293015, 2.29468047949559,
           3.83060797315207, 2.612323828491, 1.12710707446528, 0.813252648304271,
           1.25643417196177, 0.870070565362913, 1.32819868923758)
  expect_warning(estCIs <- runEstimateCI(rpt=reporting))
  #checking element
  CIs[8] <- 0
  CIs[9] <- 0
  estCIs[8] <- 0
  estCIs[9] <- 0
  expect_true(all.equal(estCIs,CIs))

  expect_warning(estCIs <- runCombined())
  #checking element
  estCIs[8] <- 0
  estCIs[9] <- 0
  expect_true(all.equal(estCIs,CIs))


  expect_warning(reporting <- runEstimateReportingNoCont())
  means <- c(0.28412370074526, 0.456096656773537, 0.376035513199443, 0.368787309866873)
  quantiles <- c(0.133133805502293, 0.183508758935592, 0.237481923328414, 0.237481923328415,
                 0.298651509640278, 0.244678345247458, 0.291455087721236, 0.205098024692722,
                 0.111544539745164, 0.0215892657571279, 0.118740961664208, 0.367017517871187,
                 0.291455087721236, 0.323838986356929, 0.331035408275971, 0.2518747671665,
                 0.266267611004586, 0.226687290449849, 0.269865821964108, 0.413794260344964,
                 0.568517331604387, 0.68006187134955)
  expect_true(all.equal(reporting$reportingV[1:(length(means)-1)],means[1:(length(means)-1)]))
  expect_true(all.equal(reporting$reportingQ,quantiles))


  expect_warning(reporting <- runEstimateReportingNoDisc())
  means <- c(0.141066395680431, 0.485616629875832, 0.33343323855367, 0.310691126361244)
  quantiles <- c(0.0421824159383632, 0.0259584098082239, 0.012979204904112,
                 0.00973440367808465, 0.0648960245205599, 0.162240061301398, 0.220646483369902,
                 0.230380887047986, 0.243360091952098, 0.259584098082238, 0.285542507890462,
                 0.107078440458923, 0.146016055171258, 0.217401682143874, 0.279052905438405,
                 0.36990733976719, 0.493209786356252, 0.519168196164476, 0.522412997390504,
                 0.681408257465875, 0.639225841527511, 0.626246636623399)
  expect_true(all.equal(reporting$reportingV[1:(length(means)-1)],means[1:(length(means)-1)]))
  expect_true(all.equal(reporting$reportingQ,quantiles))

})