/tests/testthat/test_generate_predictor.R

https://github.com/edunford/tidysynth · R · 236 lines · 161 code · 42 blank · 33 comment · 0 complexity · 4b555ccae983ef65e399fa829ee1fe27 MD5 · raw file

  1. context("Test generate_predictor()")
  2. #'
  3. #' NOTE: if all the grab_ functions are operating correctly, than all the plot
  4. #' functions will.
  5. #'
  6. # Generate FAKE DATA for the TESTs ----------------------------------------
  7. set.seed(123)
  8. # Treatment unit
  9. treated <-
  10. tibble::tibble(unit= "a",
  11. time= 1990:2000,
  12. outcome = runif(11,-1,1),
  13. treatment_value = c(rep(0,6),1,2,3,4,5),
  14. intervention_outcome = outcome + treatment_value,
  15. x1 = rnorm(11,0,1),
  16. x2 = rnorm(11,0,1),
  17. x3 = rnorm(11,0,1))
  18. # Control units
  19. controls <-
  20. dplyr::bind_rows(
  21. tidyr::crossing(tibble::tibble(unit=c("b","c","d","e")),
  22. tibble::tibble(time=1990:2000))) %>%
  23. dplyr::mutate(outcome = runif(44,-1,1),
  24. x1 = rnorm(44,0,1),
  25. x2 = rnorm(44,0,1),
  26. x3 = rnorm(44,0,1))
  27. dat <- dplyr::bind_rows(treated,controls) %>% tidyr::replace_na(list(treatment_value=0))
  28. # Tests -------------------------------------------------------------------
  29. test_that("Test generate_predictor() with placebos",{
  30. synth_out <- synthetic_control(data=dat,outcome = outcome,time = time,
  31. unit = unit,i_unit = "a",i_time=1995,
  32. generate_placebos = T) %>%
  33. generate_predictor(time_window = 1990:1995,
  34. x1 = mean(x1),
  35. x2 = mean(x2),
  36. x3 = mean(x3))
  37. # Correct class
  38. # expect_is(synth_out,class="synth_tbl")
  39. # Check for scenarios where there is an NA in a predictor field
  40. expect_error(dat %>%
  41. mutate(x1 = NA) %>%
  42. synthetic_control(data=.,outcome = outcome,time = time,
  43. unit = unit,i_unit = "a",i_time=1995,
  44. generate_placebos = T) %>%
  45. generate_predictor(time_window = 1990:1995,
  46. x1 = mean(x1),
  47. x2 = mean(x2),
  48. x3 = mean(x3))
  49. )
  50. # Check that overwriting a field doesn't result in redundancies.
  51. expect_equivalent(
  52. synthetic_control(data=dat,outcome = outcome,time = time,
  53. unit = unit,i_unit = "a",i_time=1995,
  54. generate_placebos = T) %>%
  55. # Create variable
  56. generate_predictor(time_window = 1990:1995,
  57. x1 = mean(x1)) %>%
  58. # Overwrite variable
  59. generate_predictor(time_window = 1990:1995,
  60. x1 = mean(x2)) %>%
  61. .$.predictors %>% .[[1]],
  62. # Compared to just creating the variable with no overwriting
  63. synthetic_control(data=dat,outcome = outcome,time = time,
  64. unit = unit,i_unit = "a",i_time=1995,
  65. generate_placebos = T) %>%
  66. generate_predictor(time_window = 1990:1995,
  67. x1 = mean(x2)) %>%
  68. .$.predictors %>% .[[1]]
  69. )
  70. # check data construct is correct for the predictors for treated unit
  71. expect_is(synth_out$.predictors[[1]],"tbl_df")
  72. expect_equal(colnames(synth_out$.predictors[[1]]),c("variable","a"))
  73. expect_equal(colnames(synth_out$.predictors[[2]]),c("variable","b","c","d","e"))
  74. # treated
  75. expect_equivalent(synth_out$.predictors[[1]],
  76. expected =
  77. dplyr::filter(dat,unit=="a",time <= 1995) %>%
  78. dplyr::summarize(x1 = mean(x1),
  79. x2 = mean(x2),
  80. x3 = mean(x3)) %>%
  81. tidyr::gather(variable,a))
  82. # controls
  83. expect_equivalent(synth_out$.predictors[[2]],
  84. expected =
  85. dplyr::filter(dat,unit!="a",time <= 1995) %>%
  86. dplyr::group_by(unit) %>%
  87. dplyr::summarize(x1 = mean(x1),
  88. x2 = mean(x2),
  89. x3 = mean(x3)) %>%
  90. tidyr::gather(variable,value,-unit) %>%
  91. tidyr::pivot_wider(names_from = unit,values_from=value))
  92. # check data construct is correct for the predictors for a placebo unit
  93. expect_is(synth_out$.predictors[[9]],"tbl_df")
  94. expect_equal(colnames(synth_out$.predictors[[9]]),c("variable","e"))
  95. expect_equal(colnames(synth_out$.predictors[[10]]),c("variable","a","b","c","d"))
  96. # treated
  97. expect_equivalent(synth_out$.predictors[[9]],
  98. expected =
  99. dplyr::filter(dat,unit=="e",time <= 1995) %>%
  100. dplyr::summarize(x1 = mean(x1),
  101. x2 = mean(x2),
  102. x3 = mean(x3)) %>%
  103. tidyr::gather(variable,e))
  104. # controls
  105. expect_equivalent(synth_out$.predictors[[10]],
  106. expected =
  107. dplyr::filter(dat,unit!="e",time <= 1995) %>%
  108. dplyr::group_by(unit) %>%
  109. dplyr::summarize(x1 = mean(x1),
  110. x2 = mean(x2),
  111. x3 = mean(x3)) %>%
  112. tidyr::gather(variable,value,-unit) %>%
  113. tidyr::pivot_wider(names_from = unit,values_from=value))
  114. })
  115. test_that("Test generate_predictor() without placebos",{
  116. synth_out <- synthetic_control(data=dat,outcome = outcome,time = time,
  117. unit = unit,i_unit = "a",i_time=1995,
  118. generate_placebos = F) %>%
  119. generate_predictor(time_window = 1990:1995,
  120. x1 = mean(x1),
  121. x2 = mean(x2),
  122. x3 = mean(x3))
  123. # Correct class
  124. # expect_is(synth_out,class="synth_tbl")
  125. # Check for scenarios where there is an NA in a predictor field
  126. expect_error(dat %>%
  127. mutate(x1 = NA) %>%
  128. synthetic_control(data=.,outcome = outcome,time = time,
  129. unit = unit,i_unit = "a",i_time=1995,
  130. generate_placebos = T) %>%
  131. generate_predictor(time_window = 1990:1995,
  132. x1 = mean(x1),
  133. x2 = mean(x2),
  134. x3 = mean(x3))
  135. )
  136. # Check that overwriting a field doesn't result in redundancies.
  137. expect_equivalent(
  138. synthetic_control(data=dat,outcome = outcome,time = time,
  139. unit = unit,i_unit = "a",i_time=1995,
  140. generate_placebos = T) %>%
  141. # Create variable
  142. generate_predictor(time_window = 1990:1995,
  143. x1 = mean(x1)) %>%
  144. # Overwrite variable
  145. generate_predictor(time_window = 1990:1995,
  146. x1 = mean(x2)) %>%
  147. .$.predictors %>% .[[1]],
  148. # Compared to just creating the variable with no overwriting
  149. synthetic_control(data=dat,outcome = outcome,time = time,
  150. unit = unit,i_unit = "a",i_time=1995,
  151. generate_placebos = T) %>%
  152. generate_predictor(time_window = 1990:1995,
  153. x1 = mean(x2)) %>%
  154. .$.predictors %>% .[[1]]
  155. )
  156. # check data construct is correct for the predictors for treated unit
  157. expect_is(synth_out$.predictors[[1]],"tbl_df")
  158. expect_equal(colnames(synth_out$.predictors[[1]]),c("variable","a"))
  159. expect_equal(colnames(synth_out$.predictors[[2]]),c("variable","b","c","d","e"))
  160. # treated
  161. expect_equivalent(synth_out$.predictors[[1]],
  162. expected =
  163. dplyr::filter(dat,unit=="a",time <= 1995) %>%
  164. dplyr::summarize(x1 = mean(x1),
  165. x2 = mean(x2),
  166. x3 = mean(x3)) %>%
  167. tidyr::gather(variable,a))
  168. # controls
  169. expect_equivalent(synth_out$.predictors[[2]],
  170. expected =
  171. dplyr::filter(dat,unit!="a",time <= 1995) %>%
  172. dplyr::group_by(unit) %>%
  173. dplyr::summarize(x1 = mean(x1),
  174. x2 = mean(x2),
  175. x3 = mean(x3)) %>%
  176. tidyr::gather(variable,value,-unit) %>%
  177. tidyr::pivot_wider(names_from = unit,values_from=value))
  178. # Check there aren't any placebo entries
  179. expect_error(synth_out$.predictors[[9]])
  180. })
  181. test_that("Test grab_predictors()",{
  182. synth_out <- synthetic_control(data=dat,outcome = outcome,time = time,
  183. unit = unit,i_unit = "a",i_time=1995,
  184. generate_placebos = T) %>%
  185. generate_predictor(time_window = 1990:1995,
  186. x1 = mean(x1),
  187. x2 = mean(x2),
  188. x3 = mean(x3))
  189. # grab should be the same as directly tapping into the data.
  190. expect_equivalent(synth_out %>% grab_predictors(),
  191. synth_out$.predictors[[1]])
  192. expect_equivalent(synth_out %>% grab_predictors(placebo=T) %>% .[5,5] %>% round(.,3),
  193. tibble::tibble(b = 0.089))
  194. })