-
Notifications
You must be signed in to change notification settings - Fork 2
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
207e5bb
commit 75f738e
Showing
14 changed files
with
794 additions
and
24 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,19 +1,17 @@ | ||
| Package: designmatch | ||
| Type: Package | ||
| Title: Construction of Optimally Matched Samples for Randomized | ||
| Experiments and Observational Studies that are Balanced and | ||
| Representative by Design | ||
| Version: 0.2.0 | ||
| Date: 2016-08-09 | ||
| Author: Jose R. Zubizarreta <[email protected]>, Cinar Kilcioglu <[email protected]> | ||
| Title: Matched Samples that are Balanced and Representative by Design | ||
| Version: 0.3.0 | ||
| Date: 2017-05-17 | ||
| Author: Jose R. Zubizarreta <[email protected]>, Cinar Kilcioglu <[email protected]>, Juan P. Vielma <[email protected]> | ||
| Maintainer: Jose R. Zubizarreta <[email protected]> | ||
| Depends: R (>= 3.2), lattice, MASS, slam, Rglpk | ||
| Suggests: gurobi, Rcplex, Rsymphony | ||
| SystemRequirements: GLPK library package (e.g., libglpk-dev on | ||
| Debian/Ubuntu) | ||
| License: GPL-2 | GPL-3 | ||
| Description: Includes functions for the construction of matched samples that are balanced and representative by design. Among others, these functions can be used for matching in observational studies with treated and control units, with cases and controls, in related settings with instrumental variables, and in discontinuity designs. Also, they can be used for the design of randomized experiments, for example, for matching before randomization. By default, 'designmatch' uses the 'GLPK' optimization solver, but its performance is greatly enhanced by the 'Gurobi' optimization solver and its associated R interface. For their installation, please follow the instructions at http://user.gurobi.com/download/gurobi-optimizer and http://www.gurobi.com/documentation/6.5/refman/r_api_overview.html. We have also included directions in the gurobi_installation file in the inst folder. | ||
| Description: Includes functions for the construction of matched samples that are balanced and representative by design. Among others, these functions can be used for matching in observational studies with treated and control units, with cases and controls, in related settings with instrumental variables, and in discontinuity designs. Also, they can be used for the design of randomized experiments, for example, for matching before randomization. By default, 'designmatch' uses the 'GLPK' optimization solver, but its performance is greatly enhanced by the 'Gurobi' optimization solver and its associated R interface. For their installation, please follow the instructions at <http://user.gurobi.com/download/gurobi-optimizer> and <http://www.gurobi.com/documentation/7.0/refman/r_api_overview.html>. We have also included directions in the gurobi_installation file in the inst folder. | ||
| NeedsCompilation: no | ||
| Packaged: 2016-08-09 18:44:53 UTC; jrz | ||
| Packaged: 2017-05-18 01:39:38 UTC; jrz | ||
| Repository: CRAN | ||
| Date/Publication: 2016-08-11 13:01:07 | ||
| Date/Publication: 2017-05-18 03:48:36 UTC |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
File renamed without changes.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,249 @@ | ||
| #! cardmatch | ||
| cardmatch = function(t_ind, mom = NULL, fine = NULL, solver = NULL) { | ||
|
|
||
| if (is.null(mom)) { | ||
| mom_covs = NULL | ||
| mom_tols = NULL | ||
| mom_targets = NULL | ||
| } else { | ||
| mom_covs = mom$covs | ||
| mom_tols = mom$tols | ||
| mom_targets = mom$targets | ||
| } | ||
| if (is.null(fine)) { | ||
| fine_covs = NULL | ||
| } else { | ||
| fine_covs = fine$covs | ||
| } | ||
|
|
||
| if (is.null(solver)) { | ||
| solver = 'glpk' | ||
| t_max = 60 * 15 | ||
| approximate = 1 | ||
| } else { | ||
| t_max = solver$t_max | ||
| approximate = solver$approximate | ||
| trace = solver$trace | ||
| round_cplex = solver$round_cplex | ||
| solver = solver$name | ||
| } | ||
|
|
||
| #! CALL ERROR HANDLING | ||
|
|
||
| #! Generate the parameters | ||
| cat(format(" Building the matching problem..."), "\n") | ||
| prmtrs = .problemparameters_cardmatch(t_ind, mom_covs, mom_tols, mom_targets, fine_covs) | ||
| n_t = prmtrs$n_t | ||
| n_c = prmtrs$n_c | ||
| n_dec_vars = prmtrs$n_dec_vars | ||
| cvec = prmtrs$cvec | ||
| Amat = prmtrs$Amat | ||
| bvec = prmtrs$bvec | ||
| sense = prmtrs$sense | ||
| vtype = prmtrs$vtype | ||
|
|
||
| #! Find matches and calculate the elapsed time | ||
| #! Gurobi | ||
| if (solver == "gurobi") { | ||
| #library(gurobi) | ||
| if (requireNamespace('gurobi', quietly=TRUE)) { | ||
| cat(format(" Gurobi optimizer is open..."), "\n") | ||
| model = list() | ||
| model$modelsense = 'max' | ||
| model$obj = cvec | ||
| model$A = Amat | ||
| model$sense = rep(NA, length(sense)) | ||
| model$sense[sense=="E"] = '=' | ||
| model$sense[sense=="L"] = '<=' | ||
| model$sense[sense=="G"] = '>=' | ||
| model$rhs = bvec | ||
| model$vtypes = vtype | ||
|
|
||
| t_lim = list(TimeLimit = t_max, OutputFlag = trace) | ||
|
|
||
| cat(format(" Finding the optimal matches..."), "\n") | ||
| ptm = proc.time() | ||
| out = gurobi::gurobi(model, t_lim) | ||
| time = (proc.time()-ptm)[3] | ||
|
|
||
| if (out$status == "INFEASIBLE") { | ||
| cat(format(" Error: problem infeasible!"), "\n") | ||
| obj_total = NA | ||
| obj_dist_mat = NA | ||
| t_id = NA | ||
| c_id = NA | ||
| group_id = NA | ||
| time = NA | ||
| } | ||
|
|
||
| if (out$status == "OPTIMAL" || out$status == "TIME_LIMIT") { | ||
| if (out$status == "OPTIMAL") { | ||
| cat(format(" Optimal matches found"), "\n") | ||
| } | ||
|
|
||
| else { | ||
| cat(format(" Time limit reached, best suboptimal solution given"), "\n") | ||
| } | ||
|
|
||
| #! Matched units indexes | ||
| t_id = (1:n_dec_vars)[t_ind==1 & out$x==1] | ||
| c_id = (1:n_dec_vars)[t_ind==0 & out$x==1] | ||
|
|
||
| #! Group (or pair) identifier | ||
| group_id = c(1:(length(t_id)), 1:(length(c_id))) | ||
|
|
||
| #! Optimal value of the objective function | ||
| obj_total = out$objval | ||
| } | ||
| } else { | ||
| stop('Required solver not installed') | ||
| } | ||
|
|
||
| } | ||
|
|
||
| #! CPLEX | ||
| else if (solver == "cplex") { | ||
| #library(Rcplex) | ||
| if (requireNamespace('Rcplex', quietly=TRUE)) { | ||
| cat(format(" CPLEX optimizer is open..."), "\n") | ||
| cat(format(" Finding the optimal matches..."), "\n") | ||
| ptm = proc.time() | ||
| out = Rcplex::Rcplex(objsense = 'max', cvec, Amat, bvec, sense = sense, vtype = vtype, n = 1, | ||
| control = list(trace = trace, round = round_cplex, tilim = t_max)) | ||
| time = (proc.time()-ptm)[3] | ||
|
|
||
| if (out$status==108) { | ||
| cat(format(" Error: time limit exceeded, no integer solution!"), "\n") | ||
| obj_total = NA | ||
| obj_dist_mat = NA | ||
| t_id = NA | ||
| c_id = NA | ||
| group_id = NA | ||
| time = NA | ||
| } else if (is.na(out$obj)) { | ||
| cat(format(" Error: problem infeasible!"), "\n") | ||
| obj_total = NA | ||
| obj_dist_mat = NA | ||
| t_id = NA | ||
| c_id = NA | ||
| group_id = NA | ||
| time = NA | ||
| } | ||
|
|
||
| if (!is.na(out$obj)) { | ||
| cat(format(" Optimal matches found"), "\n") | ||
|
|
||
| #! Matched units indexes | ||
| t_id = (1:n_dec_vars)[t_ind==1 & out$xopt==1] | ||
| c_id = (1:n_dec_vars)[t_ind==0 & out$xopt==1] | ||
|
|
||
| #! Group (or pair) identifier | ||
| group_id = c(1:(length(t_id)), 1:(length(c_id))) | ||
|
|
||
| #! Optimal value of the objective function | ||
| obj_total = out$obj | ||
|
|
||
| } | ||
| } else { | ||
| stop('Required solver not installed') | ||
| } | ||
|
|
||
| } | ||
|
|
||
| #! GLPK | ||
| else if (solver == "glpk") { | ||
| #library(Rglpk) | ||
| cat(format(" GLPK optimizer is open..."), "\n") | ||
| dir = rep(NA, length(prmtrs$sense)) | ||
| dir[prmtrs$sense=="E"] = '==' | ||
| dir[prmtrs$sense=="L"] = '<=' | ||
| dir[prmtrs$sense=="G"] = '>=' | ||
|
|
||
| cat(format(" Finding the optimal matches..."), "\n") | ||
| ptm = proc.time() | ||
| out= Rglpk_solve_LP(cvec, Amat, dir, bvec, types = vtype, max = TRUE) | ||
| time = (proc.time()-ptm)[3] | ||
|
|
||
| if (out$status!=0) { | ||
| cat(format(" Error: problem infeasible!"), "\n") | ||
| obj_total = NA | ||
| obj_dist_mat = NA | ||
| t_id = NA | ||
| c_id = NA | ||
| group_id = NA | ||
| time = NA | ||
| } | ||
|
|
||
| if (out$status==0) { | ||
| cat(format(" Optimal matches found"), "\n") | ||
|
|
||
| #! Matched units indexes | ||
| t_id = (1:n_dec_vars)[t_ind==1 & out$solution==1] | ||
| c_id = (1:n_dec_vars)[t_ind==0 & out$solution==1] | ||
|
|
||
| #! Group (or pair) identifier | ||
| group_id = c(1:(length(t_id)), 1:(length(c_id))) | ||
|
|
||
| #! Optimal value of the objective function | ||
| obj_total = out$optimum | ||
|
|
||
| } | ||
| } | ||
|
|
||
| #! Symphony | ||
| else { | ||
| #library(Rsymphony) | ||
| if (requireNamespace('Rsymphony', quietly=TRUE)) { | ||
| cat(format(" Symphony optimizer is open..."), "\n") | ||
|
|
||
| dir = rep(NA, length(prmtrs$sense)) | ||
| dir[prmtrs$sense=="E"] = '==' | ||
| dir[prmtrs$sense=="L"] = '<=' | ||
| dir[prmtrs$sense=="G"] = '>=' | ||
|
|
||
| cat(format(" Finding the optimal matches..."), "\n") | ||
| ptm = proc.time() | ||
| out= Rsymphony::Rsymphony_solve_LP(cvec, Amat, dir, bvec, types = vtype, max = TRUE, time_limit = t_max) | ||
| time = (proc.time()-ptm)[3] | ||
|
|
||
| if (out$status==228) { | ||
| cat(format(" Error: problem exceeded the time limit and no feasible solution is found!"), "\n") | ||
| obj_total = NA | ||
| obj_dist_mat = NA | ||
| t_id = NA | ||
| c_id = NA | ||
| group_id = NA | ||
| time = NA | ||
| } | ||
| else if (out$status!=0) { | ||
| cat(format(" Error: problem infeasible!"), "\n") | ||
| obj_total = NA | ||
| obj_dist_mat = NA | ||
| t_id = NA | ||
| c_id = NA | ||
| group_id = NA | ||
| time = NA | ||
| } | ||
|
|
||
| if (out$status==0) { | ||
| cat(format(" Optimal matches found"), "\n") | ||
|
|
||
| #! Matched units indexes | ||
| t_id = (1:n_dec_vars)[t_ind==1 & out$solution==1] | ||
| c_id = (1:n_dec_vars)[t_ind==0 & out$solution==1] | ||
|
|
||
| #! Group (or pair) identifier | ||
| group_id = c(1:(length(t_id)), 1:(length(c_id))) | ||
|
|
||
| #! Optimal value of the objective function | ||
| obj_total = out$objval | ||
|
|
||
| } | ||
| } else { | ||
| stop('Required solver not installed') | ||
| } | ||
|
|
||
| } | ||
| #! Output | ||
| return(list(obj_total = obj_total, t_id = t_id, c_id = c_id, group_id = group_id, time = time)) | ||
| } |
File renamed without changes.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,17 @@ | ||
| #! distmatch | ||
| distmatch = function(t_ind, dist_mat = NULL, solver = NULL) { | ||
|
|
||
| # Subset matching weight | ||
| subset_weight = 0 | ||
|
|
||
| # Total number of matched pairs | ||
| total_groups = sum(t_ind) | ||
|
|
||
| # Match | ||
| out = bmatch(t_ind = t_ind, dist_mat = dist_mat, subset_weight = subset_weight, total_groups = total_groups, solver = solver) | ||
|
|
||
| #! Output | ||
| return(list(obj_total = out$obj_total, obj_dist_mat = out$obj_dist_mat, | ||
| t_id = out$t_id, c_id = out$c_id, group_id = out$group_id, time = out$time, status = out$status)) | ||
|
|
||
| } |
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
Oops, something went wrong.