Nothing
library(rcbalance)
if (requireNamespace("optmatch", quietly = TRUE)){
context('Building distance objects')
library(optmatch)
data(nuclearplants)
#reorder nuclearplants dataframe so treated units come first
nuclearplants <- nuclearplants[order(nuclearplants$pr, decreasing = TRUE),]
my.dist.struct <- build.dist.struct(z = nuclearplants$pr,
X = subset(nuclearplants[c('date', 't1', 't2', 'cap', 'bw', 'cum.n')]),
exact = nuclearplants$ne)
test_that('Distance has expected number of pairings', {
#sparsity via blocks
dist.nocalip <- build.dist.struct(z = nuclearplants$pr,
X = subset(nuclearplants[c('date', 't1', 't2', 'cap', 'bw', 'cum.n')]),
exact = nuclearplants$ne, calip.option = 'none')
expect_equal(length(unlist(dist.nocalip)),
count.pairings(z = nuclearplants$pr, exact = nuclearplants$ne))
#sparsity via calipers
dist.calip.only <- build.dist.struct(z = nuclearplants$pr,
X = subset(nuclearplants[c('date', 't1', 't2', 'cap', 'bw', 'cum.n')]))
prop.score <- predict(glm(pr ~ date + t1 + t2 + cap + bw + cum.n,
data = nuclearplants, family = binomial()))
calip.mat <- pmax(abs(outer(prop.score[nuclearplants$pr ==1],
prop.score[nuclearplants$pr == 0], FUN = "-")) - 0.2*sd(prop.score),0)
calip.mat[calip.mat > 0] <- Inf
expect_equal(length(unlist(dist.calip.only)), sum(is.finite(calip.mat)))
})
test_that('Constant variables are removed', {
nuclearplants$constant <- rep(1, nrow(nuclearplants))
expect_identical(my.dist.struct, build.dist.struct(z = nuclearplants$pr,
X = subset(nuclearplants[c('date', 't1', 't2', 'cap', 'bw', 'cum.n', 'constant')]),
exact = nuclearplants$ne))
})
nuclearplants$not_bw <- 1- nuclearplants$bw
nuclearplants$bw_factor <- factor(nuclearplants$bw + 2*nuclearplants$not_bw)
test_that('Factors are converted properly to dummies', {
expect_equal(
build.dist.struct(z = nuclearplants$pr, X = subset(nuclearplants[c('date', 't1', 't2', 'cap', 'bw', 'not_bw', 'cum.n')]), exact = nuclearplants$ne),
build.dist.struct(z = nuclearplants$pr,X = subset(nuclearplants[c('date', 't1', 't2', 'cap', 'bw_factor', 'cum.n')]), exact = nuclearplants$ne)
)
})
test_that('Missing values are handled properly', {
nuclearplants$t2[1:4] <- NA
nuclearplants$t2_missing <- is.na(nuclearplants$t2)
nuclearplants$t2_impute <- nuclearplants$t2
nuclearplants$t2_impute[nuclearplants$t2_missing] <- mean(nuclearplants$t2, na.rm = TRUE)
nuclearplants$bw_factor[1:4] <- NA
nuclearplants$bw_factor_na <- addNA(nuclearplants$bw_factor)
expect_equal(
build.dist.struct(z = nuclearplants$pr, X = subset(nuclearplants[c('date', 't1', 't2', 'cap', 'bw_factor', 'cum.n')]), exact = nuclearplants$ne),
build.dist.struct(z = nuclearplants$pr,X = subset(nuclearplants[c('date', 't1', 't2_impute','t2_missing', 'cap', 'bw_factor_na', 'cum.n')]), exact = nuclearplants$ne)
)
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.