-
Notifications
You must be signed in to change notification settings - Fork 57
/
TestCovBalanceSampling.R
71 lines (59 loc) · 2.15 KB
/
TestCovBalanceSampling.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
# Some R code to test whether sampling doesn't distort balance computation
library(CohortMethod)
library(dplyr)
options(andromedaTempFolder = "s:/andromedaTemp")
cohortMethodData <- loadCohortMethodData('s:/temp/cohortMethodVignette/cohortMethodData.zip')
ps <- readRDS('s:/temp/cohortMethodVignette/ps.rds')
# Matched ---------------------------------------
matchedPop <- matchOnPs(ps, caliper = 0.25, caliperScale = "standardized", maxRatio = 100)
system.time(
balance <- computeCovariateBalance(matchedPop, cohortMethodData)
)
# Computing covariate balance took 2.52 mins
# user system elapsed
# 129.90 11.81 151.20
system.time(
balance2 <- computeCovariateBalance(matchedPop, cohortMethodData, maxCohortSize = 10000)
)
# user system elapsed
# 49.89 4.90 56.78
joined <- balance %>%
select("covariateId", old = "afterMatchingStdDiff") %>%
inner_join(balance2 %>%
select("covariateId", new = "afterMatchingStdDiff"))
plot(joined$old, joined$new)
min(balance$afterMatchingStdDiff, na.rm = TRUE)
# [1] -0.03841681
min(balance2$afterMatchingStdDiff, na.rm = TRUE)
# [1] -0.05833007
max(balance$afterMatchingStdDiff, na.rm = TRUE)
# [1] 0.03778678
max(balance2$afterMatchingStdDiff, na.rm = TRUE)
# [1] 0.05928888
# Stratified ---------------------------------------
matchedPop <- stratifyByPs(ps, numberOfStrata = 5)
system.time(
balance <- computeCovariateBalance(matchedPop, cohortMethodData)
)
# Computing covariate balance took 3.17 mins
# user system elapsed
# 157.82 23.44 190.06
system.time(
balance2 <- computeCovariateBalance(matchedPop, cohortMethodData, maxCohortSize = 10000)
)
# Computing covariate balance took 59.8 secs
# user system elapsed
# 51.09 4.51 59.84
joined <- balance %>%
select(covariateId, old = afterMatchingStdDiff) %>%
inner_join(balance2 %>%
select("covariateId", new = "afterMatchingStdDiff"))
plot(joined$old, joined$new)
min(balance$afterMatchingStdDiff, na.rm = TRUE)
# [1] -0.07032446
min(balance2$afterMatchingStdDiff, na.rm = TRUE)
# [1] -0.06093756
max(balance$afterMatchingStdDiff, na.rm = TRUE)
# [1] 0.09543712
max(balance2$afterMatchingStdDiff, na.rm = TRUE)
# [1] 0.09344089