test-multilevel.R
In matchMulti: Optimal Multilevel Matching using a Network Algorithm

# library(matchMulti)
# library(Hmisc)
# library( testthat )

context("general testing")


data(catholic_schools)
# Trim data to speed up example
catholic_schools <- catholic_schools[catholic_schools$female_mean >.45 &
 catholic_schools$female_mean < .60,]






#match on a single covariate 
student.cov <- c('minority')


match.simple <- matchMulti(catholic_schools, treatment = 'sector', 
                           school.id = 'school', match.students = FALSE, 
                           student.vars = student.cov, verbose=TRUE, tol=.01)

#Check balance after matching - this checks both student and school balance
bM <- balanceMulti(match.simple, student.cov = student.cov)

expect_true( is.list( bM ) )
expect_true( !is.null( bM$students ) )



#match on several covariates
student.cov <- c('minority','female','ses')

# Check balance student balance before matching
bT <- balanceTable(catholic_schools[c(student.cov,'sector')],  treatment = 'sector')
bT
expect_equal( dim(bT), c(3,3) )


#Match schools but not students within schools
match.simple <- matchMulti(catholic_schools, treatment = 'sector',
                           school.id = 'school', match.students = FALSE)




# Does school.fb work?
catholic_schools = dplyr::mutate( catholic_schools,
                                  size_cut = cut( size, 2 ),
                                  discrm_cut = cut( discrm, 2 ),
                                  acad_cut = cut( acad, 3 ) )

#table( catholic_schools$discrm_cut, catholic_schools$size_cut, catholic_schools$acad_cut )

match.simple2 <- matchMulti(catholic_schools, treatment = 'sector',
                            school.id = 'school', match.students = FALSE,
                            school.fb = list( c( "size_cut" ), c( "discrm_cut", "acad_cut" ) ) )






data <- catholic_schools
treatment = 'sector'
school.id = 'school'
match.students = FALSE
student.vars = NULL
school.caliper = NULL
school.fb = NULL
verbose = FALSE
keep.target = NULL
student.penalty.qtile = 0.05
min.keep.pctg = 0.8
school.penalty = NULL
save.first.stage = TRUE
tol = 1e-3


### Match on component pieces ####

student.matches <- matchStudents(data, treatment, school.id, match.students, 
                                 student.vars,  school.caliper, verbose, student.penalty.qtile, 
                                 min.keep.pctg)

school.match <- matchSchools(student.matches$schools.matrix, data, treatment, school.id, 
                             school.fb, school.penalty, verbose, tol = tol) 


dmat <- student.matches$schools.matrix
students <- catholic_schools
treatment = 'sector'
school.id = 'school'
school.fb = NULL
verbose = FALSE 
tol	<- 1e-3
penalty <- NULL

out.match <- assembleMatch(student.matches$student.matches, school.match, school.id, treatment)

expect_true( !is.null( out.match ) )
expect_true( is.data.frame( out.match ) )





#### Check sensitivity ####

head( match.simple2$matched )

sens <- matchMultisens(match.simple2, out.name = "mathach", schl_id_name = "school", treat.name = "sector", Gamma=1.5)

expect_true( sens$pval > 0 )