ZeligChoice/0000755000176200001440000000000013116100671012433 5ustar liggesusersZeligChoice/inst/0000755000176200001440000000000013055636670013427 5ustar liggesusersZeligChoice/inst/JSON/0000755000176200001440000000000013055636670014200 5ustar liggesusersZeligChoice/inst/JSON/zelig5choicemodels.json0000644000176200001440000000463313104610121020631 0ustar liggesusers{ "zelig5choicemodels": { "blogit": { "name": ["blogit"], "description": ["Bivariate Logit Regression for Dichotomous Dependent Variables"], "outcome": { "modelingType": [""] }, "explanatory": { "modelingType": ["continuous", "discrete", "nominal", "ordinal", "binary"] }, "vignette.url": ["http://docs.zeligproject.org/articles/zeligchoice_blogit.html"], "wrapper": ["blogit"], "tree": ["Zelig-blogit", "Zelig-bbinchoice"] }, "bprobit": { "name": ["bprobit"], "description": ["Bivariate Probit Regression for Dichotomous Dependent Variables"], "outcome": { "modelingType": [""] }, "explanatory": { "modelingType": ["continuous", "discrete", "nominal", "ordinal", "binary"] }, "vignette.url": ["http://docs.zeligproject.org/articles/zeligchoice_bprobit.html"], "wrapper": ["bprobit"], "tree": ["Zelig-bprobit", "Zelig-bbinchoice"] }, "mlogit": { "name": ["mlogit"], "description": ["Multinomial Logistic Regression for Dependent Variables with Unordered Categorical Values"], "outcome": { "modelingType": [""] }, "explanatory": { "modelingType": ["continuous", "discrete", "nominal", "ordinal", "binary"] }, "vignette.url": ["http://docs.zeligproject.org/articles/zeligchoice_mlogit.html"], "wrapper": ["mlogit"], "tree": ["Zelig-mlogit"] }, "ologit": { "name": ["ologit"], "description": ["Ordinal Logit Regression for Ordered Categorical Dependent Variables"], "outcome": { "modelingType": [""] }, "explanatory": { "modelingType": ["continuous", "discrete", "nominal", "ordinal", "binary"] }, "vignette.url": ["http://docs.zeligproject.org/articles/zeligchoice_ologit.html"], "wrapper": ["ologit"], "tree": ["Zelig-ologit", "Zelig-obinchoice"] }, "oprobit": { "name": ["oprobit"], "description": ["Ordinal Probit Regression for Ordered Categorical Dependent Variables"], "outcome": { "modelingType": [""] }, "explanatory": { "modelingType": ["continuous", "discrete", "nominal", "ordinal", "binary"] }, "vignette.url": ["http://docs.zeligproject.org/articles/zeligchoice_oprobit.html"], "wrapper": ["oprobit"], "tree": ["Zelig-oprobit", "Zelig-obinchoice"] } } } ZeligChoice/tests/0000755000176200001440000000000013055636670013614 5ustar liggesusersZeligChoice/tests/testthat.R0000755000176200001440000000014013055636670015575 0ustar liggesuserslibrary(testthat) library(Zelig) library(ZeligChoice) set.seed("123") test_check("ZeligChoice")ZeligChoice/tests/testthat/0000755000176200001440000000000013116100671015435 5ustar liggesusersZeligChoice/tests/testthat/test-mlogit.R0000644000176200001440000000157113107103435020035 0ustar liggesusers# REQUIRE TEST mlogit example -------------------------------------------------- test_that('REQUIRE TEST mlogit example', { data(mexico) z.out <- zelig(as.factor(vote88) ~ pristr + othcok + othsocok, model = "mlogit", data = mexico) x.out <- setx(z.out) expect_error(s.out <- sim(z.out, x.out), NA) }) # REQUIRE TEST mlogit getters -------------------------------------------------- test_that('REQUIRE TEST mlogit from_zelig_model', { data(mexico) z.out1 <- zelig(as.factor(vote88) ~ pristr + othcok + othsocok, model = "mlogit", data = mexico, cite = F) expect_equal(length(coef(z.out1)), 8) expect_equal(class(from_zelig_model(z.out1))[[1]], "vglm") expect_equal(length(z.out1$get_pvalue()[[1]]), 8) expect_equal(length(z.out1$get_se()[[1]]), 8) expect_false(any(z.out1$get_pvalue()[[1]] == z.out1$get_se()[[1]])) })ZeligChoice/tests/testthat/test-oprobit.R0000755000176200001440000000012213055636670020230 0ustar liggesusersz <- zoprobit$new() test <- z$mcunit(minx=0, maxx=2, plot=FALSE) expect_true(test)ZeligChoice/tests/testthat/test-ologit.R0000755000176200001440000000145413055636670020060 0ustar liggesusers#### Ordered Logistic Regression Tests #### # REQUIRE TEST Monte Carlo ologit ---------------------------------------------- test_that('REQUIRE TEST Monte Carlo ologit', { z <- zologit$new() test <- z$mcunit(minx = 0, maxx = 2, plot = FALSE) expect_true(test) }) # REQUIRE TEST ologit doc example ---------------------------------------------- test_that('REQUIRE TEST ologit doc example', { data(sanction) sanction$ncost <- factor(sanction$ncost, ordered = TRUE, levels = c("net gain", "little effect", "modest loss", "major loss")) z.out <- zelig(ncost ~ mil + coop, model = "ologit", data = sanction) x.out <- setx(z.out) s.out <- sim(z.out, x = x.out) expect_equal(names(s.out$sim.out[[1]]), c('ev', 'pv')) }) ZeligChoice/NAMESPACE0000644000176200001440000000105313067525733013670 0ustar liggesusersimport(methods, Zelig, jsonlite, dplyr) importFrom("MASS", "polr", "mvrnorm") importFrom("VGAM", "vglm", "binom2.or", "binom2.rho", "constraints", "constraints.vlm") importFrom("stats", "runif", "rlogis", "plogis") importFrom("Formula", "as.Formula") importClassesFrom("VGAM", "vglm") importMethodsFrom("VGAM", "coef", "fitted", "predict", "vcov") exportPattern("^[[:alpha:]]+") exportClasses( "Zelig-bbinchoice", "Zelig-blogit", "Zelig-bprobit", "Zelig-mlogit", "Zelig-obinchoice", "Zelig-ologit", "Zelig-oprobit" )ZeligChoice/demo/0000755000176200001440000000000013055636670013376 5ustar liggesusersZeligChoice/demo/00Index0000644000176200001440000000042013055636670014524 0ustar liggesusersdemo-blogit example of bivariate logit model demo-bprobit example of bivariate probit model demo-mlogit example of multinomial logit regression model demo-ologit example of ordered logit regression model demo-oprobit example of ordered probit regression model ZeligChoice/demo/demo-ologit.R0000644000176200001440000000235113055636670015741 0ustar liggesuserslibrary(VGAM) # Zelig 4 code: library(Zelig4) library(ZeligChoice4) data(sanction) sanction$ncost <- factor(sanction$ncost, ordered = TRUE, levels = c("net gain", "little effect", "modest loss", "major loss")) z.out <- Zelig4::zelig(ncost ~ mil + coop, model = "ologit", data = sanction) summary(z.out) x.out <- Zelig4::setx(z.out, fn = NULL) set.seed(42) s.out <- Zelig4::sim(z.out, x = x.out, num = 100) summary(s.out) # Zelig 5 code: data(sanction) z5 <- zologit$new() z5 z5$zelig(ncost ~ mil + coop, data = sanction) z5 z5$setx(coop = 1:3) z5$setx() z.out <- z5$zelig.out$z.out[[1]] set.seed(42) z5$sim(num = 100) z5$sim.out z5$summarize() z5$cite() z5 <- zologit$new() z5 z5$zelig(ncost ~ mil + coop, data = sanction, by = "export") z5 z5$setx() z.out <- z5$zelig.out$z.out[[1]] set.seed(42) z5$sim(num = 100) z5$sim.out z5$summarize() z5$cite() fit <- MASS::polr(formula = as.factor(ncost) ~ mil + coop, data = sanction, method = "logistic", Hess = TRUE) summary(fit) fit2 <- MASS::polr(formula = ncost ~ mil + coop, data = sanction, method = "logistic", Hess = TRUE) summary(fit2) # z5$zelig(list(import ~ coop + cost + target, export ~ coop + cost + target), data = sanction) ZeligChoice/demo/demo-mlogit.R0000644000176200001440000000152313055636670015737 0ustar liggesuserslibrary(VGAM) # Zelig 4 code: library(Zelig4) library(ZeligChoice4) data(mexico) z.out1 <- Zelig4::zelig(as.factor(vote88) ~ pristr + othcok + othsocok, model = "mlogit", data = mexico) summary(z.out1) x.weak <- Zelig4::setx(z.out1, pristr = 1) x.strong <- Zelig4::setx(z.out1, pristr = 3) x.out <- Zelig4::setx(z.out1) set.seed(42) s.out1 <- Zelig4::sim(z.out1, x = x.out) summary(s.out1) v <- VGAM::vglm(formula = as.factor(vote88) ~ pristr + othcok + othsocok, data = mexico, family = "multinomial") # Zelig 5 code: data(mexico) z5 <- zmlogit$new() z5 z5$zelig(as.factor(vote88) ~ pristr + othcok + othsocok, data = mexico) z5 z5$setx() set.seed(42) z5$sim(num = 1000) z5$sim.out z5$summarize() z5$cite() # z5$zelig(list(import ~ coop + cost + target, export ~ coop + cost + target), data = sanction) ZeligChoice/demo/demo-blogit.R0000755000176200001440000000111113055636670015720 0ustar liggesusers# Zelig 4 code: # library(Zelig4) library(ZeligChoice) data(sanction) z.out1 <- zelig(cbind(import, export) ~ coop + cost + target, model = "blogit", data = sanction) summary(z.out1) x.low <- setx(z.out1, cost = 1) set.seed(42) s.out1 <- sim(z.out1, x.low, num=100) summary(s.out1) # Zelig 5 code: data(sanction) z5 <- zblogit$new() z5$zelig(cbind(import, export) ~ coop + cost + target, data = sanction) z.out2 <- zelig(cbind(import, export) ~ coop + cost + target, model = "blogit", data = sanction) z5 z5$setx(cost = 1) z5 set.seed(42) z5$sim(num = 100) z5$cite() ZeligChoice/demo/demo-oprobit.R0000644000176200001440000000144713055636670016127 0ustar liggesuserslibrary(VGAM) ## Results don't match: Zelig 4 seems to be using the logit inverse link in the probit model # Zelig 4 code: library(Zelig4) library(ZeligChoice4) data(sanction) sanction$ncost <- factor(sanction$ncost, ordered = TRUE, levels = c("net gain", "little effect", "modest loss", "major loss")) z.out <- Zelig4::zelig(ncost ~ mil + coop, model = "oprobit", data = sanction) summary(z.out) x.out <- Zelig4::setx(z.out, fn = NULL) set.seed(42) s.out <- Zelig4::sim(z.out, x = x.out, num = 5) summary(s.out) # Zelig 5 code: data(sanction) z5 <- zoprobit$new() z5 z5$zelig(ncost ~ mil + coop, data = sanction) z5 z5$setrange(sanction = 1) z5 z5$sim(num = 100) z5 z5$setx() set.seed(42) z5$sim(num = 5) z5$sim.out z5$summarize() z5$cite() ZeligChoice/demo/demo-bprobit.R0000644000176200001440000000113613055636670016105 0ustar liggesuserslibrary(VGAM) # Zelig 4 code: library(Zelig) library(ZeligChoice) data(sanction) z.out1 <- zelig(cbind(import, export) ~ coop + cost + target, model = "bprobit", data = sanction) summary(z.out1) x.low <- setx(z.out1, cost = 1) set.seed(42) s.out1 <- sim(z.out1, x = x.low) summary(s.out1) # Zelig 5 code: data(sanction) z5 <- zbprobit$new() z5$zelig(cbind(import, export) ~ coop + cost + target, data = sanction) z5 z5$setx(cost = 1) set.seed(42) z5$sim(num = 1000) z5$summarize() z5$cite() # z5$zelig(list(import ~ coop + cost + target, export ~ coop + cost + target), data = sanction) ZeligChoice/NEWS.md0000644000176200001440000000154113115273173013541 0ustar liggesusersZeligChoice version 0.9-6 =============================== - Test added to assess Zelig 5.1-2's getters with `mlogit` estimated models. - Allow users to pass `weights` to estimation models. Zelig/#250 ZeligChoice version 0.9-5 =============================== - Minor changes for compatibility with Zelig 5.1-0. ZeligChoice version 0.9-4 =============================== - Requires Zelig version 5.0-16, resolving plotting regression. - Solved deep assignment issue that returned a series of warnings on build. #Zelig/172 - Additional unit tests. ZeligChoice version 0.9-3 =============================== - README dynamically generated example. - Solve bug where `model-mlogit` wouldn't create simulations due to a missing reference level. #15 ZeligChoice version 0.9-2 =============================== - Resolves compatability issue with Zelig 5.0-14. ZeligChoice/data/0000755000176200001440000000000013055636670013363 5ustar liggesusersZeligChoice/data/coalition.tab0000755000176200001440000001640513055636670016045 0ustar liggesusers"duration" "ciep12" "invest" "fract" "polar" "numst2" "crisis" "1" 0.5 1 1 656 11 0 24 "2" 3 1 1 656 11 1 10 "3" 7 1 1 656 11 1 24 "4" 20 1 1 656 11 1 7 "5" 6 1 1 656 11 1 7 "6" 7 1 1 634 6 1 45 "7" 2 1 1 599 3 1 51 "8" 17 1 1 599 3 1 4 "9" 27 1 1 599 3 1 6 "10" 49 0 1 620 2 1 10 "11" 4 1 1 592 1 0 23 "12" 29 1 1 592 1 1 2 "13" 49 0 1 628 5 1 29 "14" 6 1 1 719 11 1 65 "15" 23 1 1 719 11 1 38 "16" 41 0 1 757 18 1 132 "17" 10 1 1 775 24 1 73 "18" 12 1 1 775 24 1 61 "19" 2 1 1 762 24 0 65 "20" 33 1 1 762 24 1 0 "21" 1 1 1 762 24 0 0 "22" 16 1 1 735 17 1 46 "23" 2 1 1 753 17 1 9 "24" 9 1 1 850 17 1 106 "25" 3 1 1 850 17 1 7 "26" 5 1 1 850 17 1 39 "27" 5 1 1 850 17 1 18 "28" 6 1 1 850 17 1 6 "29" 45 0 1 868 15 1 87 "30" 23 1 1 857 9 1 46 "31" 41 1 0 648 1 0 0 "32" 7 1 0 648 1 1 0 "33" 49 0 0 428 0 1 0 "34" 46 1 0 536 0 1 0 "35" 9 1 0 650 0 0 4 "36" 51 0 0 349 0 1 0 "37" 10 1 0 648 0 0 0 "38" 32 1 0 622 0 0 5 "39" 28 1 0 614 0 0 0 "40" 3 1 0 614 0 0 0 "41" 53 0 0 571 0 1 1 "42" 17 1 0 648 0 0 0 "43" 59 0 0 583 0 1 62 "44" 9 1 0 602 0 0 0 "45" 52 0 0 582 0 1 0 "46" 3 1 0 582 0 1 0 "47" 23 1 0 777 12 0 14 "48" 33 1 0 719 6 0 40 "49" 1 1 0 749 5 0 36 "50" 30 1 0 749 5 0 1 "51" 5 1 0 740 5 0 0 "52" 16 1 0 725 5 0 3 "53" 27 1 0 725 5 0 3 "54" 33 1 0 735 3 1 12 "55" 9 1 0 735 3 1 2 "56" 22 1 0 722 6 0 2 "57" 25 1 0 722 6 0 0 "58" 25 1 0 715 6 0 3 "59" 14 1 0 748 11 0 26 "60" 44 0 0 764 9 1 8 "61" 12 1 0 746 10 0 14 "62" 14 1 0 746 10 0 2 "63" 13 1 0 855 26 0 14 "64" 24 1 0 815 25 0 15 "65" 18 1 0 811 26 0 0 "66" 13 1 0 811 26 0 0 "67" 29 1 0 791 21 0 28 "68" 8 1 0 817 21 0 48 "69" 16 1 0 817 24 0 7 "70" 43 0 0 802 18 0 14 "71" 28 1 0 791 25 1 20 "72" 19 1 0 780 19 0 7 "73" 10 1 0 780 19 0 16 "74" 2 1 0 780 19 1 0 "75" 21 1 0 791 22 1 183 "76" 4 1 0 791 22 0 12 "77" 5 1 0 788 22 1 148 "78" 16 1 0 788 22 1 6 "79" 15 1 0 788 22 1 14 "80" 1 1 0 788 22 0 5 "81" 2 1 0 788 22 0 0 "82" 2 1 0 788 22 0 0 "83" 3 1 0 795 25 1 0 "84" 30 1 0 795 25 0 40 "85" 8 1 0 795 25 0 16 "86" 20 1 0 803 24 1 44 "87" 19 1 0 803 24 1 1 "88" 21 1 0 799 21 1 43 "89" 24 1 0 799 21 1 21 "90" 8 1 0 821 27 1 0 "91" 7 1 0 821 27 1 9 "92" 5 1 0 818 28 0 0 "93" 33 1 0 818 28 1 47 "94" 10 1 0 812 21 1 0 "95" 7 1 0 812 21 0 12 "96" 9 1 0 812 21 1 4 "97" 13 1 0 812 21 1 13 "98" 32 1 0 808 21 1 69 "99" 11 1 0 808 21 1 16 "100" 3 1 0 808 21 0 1 "101" 47 0 0 805 22 1 25 "102" 5 1 1 788 28 1 11 "103" 1 1 1 788 31 0 18 "104" 3 1 1 788 31 1 2 "105" 5 1 1 788 31 1 5 "106" 1 1 1 788 31 1 0 "107" 8 1 1 788 31 1 5 "108" 1 1 1 788 31 1 7 "109" 0.5 1 1 788 31 1 9 "110" 13 1 1 788 31 1 4 "111" 3 1 1 788 31 1 23 "112" 5 1 1 788 31 0 3 "113" 0.5 1 1 788 31 0 8 "114" 7 1 1 788 31 1 8 "115" 4 1 1 788 31 1 10 "116" 5 1 1 842 27 0 41 "117" 1 1 1 842 27 0 13 "118" 10 1 1 842 27 0 8 "119" 4 1 1 842 27 0 16 "120" 11 1 1 842 27 1 38 "121" 7 1 1 842 27 1 7 "122" 0.5 1 1 842 27 0 14 "123" 11 1 1 842 27 1 4 "124" 16 1 1 839 38 0 8 "125" 4 1 1 839 38 0 22 "126" 0.5 1 1 839 38 0 18 "127" 0.5 1 1 839 38 0 10 "128" 5 1 1 839 38 1 7 "129" 0.5 1 1 839 38 1 28 "130" 4 1 1 839 38 1 0 "131" 33 1 0 722 19 1 117 "132" 40 0 0 712 17 1 11 "133" 34 1 0 709 14 1 77 "134" 28 1 0 712 15 1 0 "135" 11 1 0 712 15 0 19 "136" 5 1 0 687 14 0 0 "137" 43 0 0 710 17 1 1 "138" 5 1 0 699 15 1 0 "139" 43 0 0 699 15 1 0 "140" 37 0 0 718 15 1 0 "141" 8 1 0 718 15 1 62 "142" 36 1 0 740 17 1 30 "143" 46 0 0 704 18 1 58 "144" 13 1 0 761 23 1 65 "145" 2 1 0 761 23 0 3 "146" 39 0 0 736 18 1 67 "147" 48 0 0 754 17 1 28 "148" 40 1 1 724 0 0 0 "149" 35 1 1 692 0 0 0 "150" 34 1 1 671 0 1 13 "151" 27 1 1 636 3 1 0 "152" 28 1 1 636 3 1 0 "153" 42 1 1 645 0 0 0 "154" 19 1 1 620 0 1 0 "155" 32 1 1 620 0 1 2 "156" 44 1 1 593 0 1 0 "157" 52 0 1 612 0 1 0 "158" 29 1 1 580 0 1 0 "159" 18 1 1 580 0 1 6 "160" 7 1 1 582 0 0 0 "161" 8 1 1 609 0 0 19 "162" 48 1 1 608 0 1 20 "163" 11 1 1 802 11 1 71 "164" 3 1 1 802 11 1 0 "165" 12 1 1 802 11 1 4 "166" 18 1 1 802 11 1 28 "167" 4 1 1 802 11 1 0 "168" 6 1 1 834 18 1 7 "169" 16 1 1 834 18 1 0 "170" 13 1 1 797 16 1 44 "171" 17 1 1 814 18 1 274 "172" 18 1 1 814 18 1 10 "173" 10 1 1 814 18 1 8 "174" 17 1 1 789 5 1 70 "175" 21 1 1 789 5 1 0 "176" 8 1 1 789 5 1 19 "177" 8 1 1 721 5 1 31 "178" 41 0 1 721 5 1 0 "179" 1 1 1 702 8 1 68 "180" 5 1 1 702 8 1 53 "181" 26 1 1 702 8 1 0 "182" 4 1 1 771 11 0 183 "183" 44 0 1 771 11 1 0 "184" 25 1 1 680 5 0 36 "185" 9 1 1 680 5 0 35 "186" 25 1 1 741 6 1 52 "187" 2 1 1 652 36 1 7 "188" 14 1 1 652 36 1 15 "189" 3 1 1 652 36 1 1 "190" 23 1 1 652 36 1 10 "191" 0.5 1 1 718 36 0 17 "192" 5 1 1 718 36 0 20 "193" 0.5 1 1 718 36 0 13 "194" 16 1 1 718 36 1 11 "195" 22 1 1 718 36 1 14 "196" 13 1 1 718 36 0 13 "197" 7 1 1 710 32 0 12 "198" 12 1 1 710 32 0 20 "199" 4 1 1 710 32 0 30 "200" 19 1 1 710 32 0 7 "201" 15 1 1 710 32 1 19 "202" 5 1 1 733 32 0 36 "203" 7 1 1 733 32 1 29 "204" 18 1 1 733 32 1 26 "205" 27 1 1 733 32 1 33 "206" 5 1 1 717 37 0 19 "207" 7 1 1 717 37 1 23 "208" 6 1 1 717 37 0 31 "209" 3 1 1 717 37 1 48 "210" 7 1 1 717 37 1 31 "211" 10 1 1 717 37 1 0 "212" 0.5 1 1 717 37 0 33 "213" 12 1 1 719 37 1 121 "214" 8 1 1 719 37 1 25 "215" 7 1 1 719 37 1 12 "216" 14 1 1 719 37 0 51 "217" 3 1 1 719 37 0 36 "218" 18 1 1 683 43 0 90 "219" 11 1 1 683 43 0 55 "220" 0.5 1 1 683 43 0 47 "221" 8 1 1 710 38 0 126 "222" 6 1 1 710 38 1 15 "223" 7 1 1 710 38 1 22 "224" 13 1 1 710 38 1 33 "225" 3 1 1 710 38 1 16 "226" 5 1 1 710 38 1 17 "227" 45 1 1 751 39 1 98 "228" 30 1 0 786 8 1 30 "229" 15 1 0 786 8 1 50 "230" 46 0 0 785 6 1 69 "231" 26 1 0 754 5 1 12 "232" 3 1 0 754 5 1 12 "233" 48 0 0 759 3 1 63 "234" 19 1 0 778 8 1 70 "235" 18 1 0 778 8 1 46 "236" 3 1 0 778 8 0 39 "237" 49 0 0 825 16 1 49 "238" 13 1 0 844 15 1 69 "239" 4 1 0 844 15 0 23 "240" 46 0 0 844 9 1 163 "241" 41 0 0 730 3 1 270 "242" 8 1 0 767 5 1 108 "243" 3 1 0 767 5 0 17 "244" 43 0 0 751 5 1 57 "245" 47 0 0 685 7 1 0 "246" 25 1 0 626 0 1 0 "247" 23 1 0 626 0 1 2 "248" 15 1 0 677 2 1 0 "249" 33 1 0 677 2 1 7 "250" 47 0 0 666 1 1 0 "251" 23 1 0 689 1 0 0 "252" 1 1 0 689 1 0 4 "253" 25 1 0 689 1 0 4 "254" 47 0 0 715 1 1 1 "255" 18 1 0 680 0 1 0 "256" 19 1 0 680 0 0 11 "257" 12 1 0 680 0 0 11 "258" 27 1 0 758 13 0 4 "259" 20 1 0 758 13 0 3 "260" 41 0 0 663 1 0 0 "261" 8 1 0 663 1 0 5 "262" 19 1 0 687 5 0 2 "263" 28 1 0 687 5 1 0 "264" 7 1 0 676 5 0 0 "265" 3 1 0 709 16 1 0 "266" 17 1 0 709 16 0 9 "267" 6 1 0 709 16 1 46 "268" 9 1 0 762 19 1 7 "269" 2 1 0 763 16 1 0 "270" 23 1 0 763 16 1 36 "271" 3 1 0 763 16 1 35 "272" 24 1 0 701 18 1 47 "273" 3 1 0 701 18 1 9 "274" 17 1 0 761 15 0 30 "275" 22 1 1 644 13 0 3 "276" 22 1 1 644 13 0 28 "277" 43 0 1 575 5 1 35 "278" 14 1 0 648 7 1 0 "279" 23 1 0 648 7 1 5 "280" 36 1 0 673 3 0 0 "281" 12 1 0 673 3 1 1 "282" 48 0 0 677 2 1 0 "283" 13 1 0 686 3 1 0 "284" 7 1 0 686 3 0 4 "285" 28 1 0 684 2 0 0 "286" 48 0 0 679 2 0 0 "287" 48 0 0 692 3 0 0 "288" 12 1 0 653 1 1 0 "289" 11 1 0 653 1 1 18 "290" 36 0 0 698 5 0 0 "291" 36 0 0 702 5 0 0 "292" 24 1 0 710 5 1 18 "293" 12 1 0 710 5 0 8 "294" 19 1 0 713 6 1 1 "295" 16 1 0 713 6 0 14 "296" 37 0 0 681 6 0 18 "297" 5 1 0 705 5 0 19 "298" 55 0 0 511 0 1 21 "299" 20 1 0 518 0 1 0 "300" 41 1 0 513 0 1 1 "301" 2 1 0 513 0 1 1 "302" 19 1 0 508 0 1 1 "303" 33 1 0 508 0 1 1 "304" 48 1 0 497 0 1 0 "305" 12 1 0 497 0 1 5 "306" 16 1 0 514 0 1 0 "307" 51 0 0 506 0 1 0 "308" 44 1 0 518 0 1 0 "309" 7 1 0 556 3 0 4 "310" 18 1 0 556 2 1 0 "311" 7 1 0 556 2 1 0 "312" 30 1 0 556 2 0 0 "313" 50 0 0 536 1 1 0 "314" 49 0 0 522 1 1 6 ZeligChoice/data/sanction.tab0000755000176200001440000000531113055636670015674 0ustar liggesusers"mil" "coop" "target" "import" "export" "cost" "num" "ncost" "1" 1 4 3 1 1 4 15 "major loss" "2" 0 2 3 0 1 3 4 "modest loss" "3" 0 1 3 1 0 2 1 "little effect" "4" 1 1 3 1 1 2 1 "little effect" "5" 0 1 3 1 1 2 1 "little effect" "6" 0 1 3 0 1 2 1 "little effect" "7" 1 2 2 0 1 2 3 "little effect" "8" 0 1 3 0 0 2 3 "little effect" "9" 0 2 1 0 0 1 2 "net gain" "10" 1 2 3 1 1 2 1 "little effect" "11" 1 1 2 0 0 1 1 "net gain" "12" 0 1 2 1 1 2 1 "little effect" "13" 0 3 1 1 1 2 8 "little effect" "14" 0 3 3 1 1 4 7 "major loss" "15" 0 3 2 1 1 3 21 "modest loss" "16" 0 1 2 0 0 1 1 "net gain" "17" 0 4 2 1 1 2 7 "little effect" "18" 0 3 3 0 0 2 4 "little effect" "19" 0 1 1 0 0 1 1 "net gain" "20" 0 3 3 1 0 3 120 "modest loss" "21" 0 4 3 0 0 2 7 "little effect" "22" 0 1 2 0 0 1 1 "net gain" "23" 0 1 2 1 1 4 1 "major loss" "24" 0 1 2 0 0 1 1 "net gain" "25" 0 1 1 0 0 1 1 "net gain" "26" 0 3 2 1 1 2 32 "little effect" "27" 0 1 2 1 0 2 1 "little effect" "28" 0 1 2 1 0 2 1 "little effect" "29" 0 1 2 0 0 1 1 "net gain" "30" 0 4 2 1 1 3 150 "modest loss" "31" 0 1 2 0 0 1 1 "net gain" "32" 0 1 2 0 0 1 1 "net gain" "33" 0 1 1 0 0 1 1 "net gain" "34" 0 1 2 0 1 1 5 "net gain" "35" 0 2 1 1 1 2 2 "little effect" "36" 0 3 3 0 1 1 10 "net gain" "37" 0 1 2 0 0 1 1 "net gain" "38" 0 1 1 0 0 1 1 "net gain" "39" 0 1 2 0 0 1 1 "net gain" "40" 0 2 3 0 1 2 2 "little effect" "41" 0 2 2 0 1 2 1 "little effect" "42" 0 2 3 0 0 2 2 "little effect" "43" 0 1 3 1 0 2 1 "little effect" "44" 0 2 3 0 1 2 1 "little effect" "45" 0 1 1 1 1 1 1 "net gain" "46" 0 1 2 0 1 1 1 "net gain" "47" 0 1 3 0 1 2 1 "little effect" "48" 0 2 1 1 0 1 1 "net gain" "49" 0 1 3 0 0 1 1 "net gain" "50" 0 1 2 0 0 1 1 "net gain" "51" 0 1 2 0 1 2 1 "little effect" "52" 0 1 3 0 1 2 1 "little effect" "53" 0 1 1 0 1 1 1 "net gain" "54" 0 1 1 0 0 1 2 "net gain" "55" 0 1 2 0 0 1 1 "net gain" "56" 0 1 2 0 1 2 1 "little effect" "57" 0 2 2 0 1 2 3 "little effect" "58" 0 2 3 0 1 2 2 "little effect" "59" 0 2 3 0 1 2 2 "little effect" "60" 0 3 2 1 1 3 9 "modest loss" "61" 1 3 2 0 0 1 7 "net gain" "62" 0 1 3 1 1 3 1 "modest loss" "63" 0 3 1 1 1 3 10 "modest loss" "64" 0 2 2 0 0 1 2 "net gain" "65" 0 3 3 1 1 2 8 "little effect" "66" 0 2 1 0 0 1 2 "net gain" "67" 0 3 3 0 1 3 13 "modest loss" "68" 0 1 2 0 1 2 1 "little effect" "69" 0 1 2 1 0 2 1 "little effect" "70" 0 3 1 1 1 2 4 "little effect" "71" 0 2 3 0 1 3 1 "modest loss" "72" 0 2 2 0 0 1 8 "net gain" "73" 1 3 1 1 1 2 14 "little effect" "74" 0 2 1 0 0 1 2 "net gain" "75" 0 1 3 0 1 2 1 "little effect" "76" 0 4 3 1 0 2 13 "little effect" "77" 0 1 2 0 0 1 1 "net gain" "78" 1 3 1 1 1 2 10 "little effect" ZeligChoice/R/0000755000176200001440000000000013115273173012643 5ustar liggesusersZeligChoice/R/create-json.R0000644000176200001440000000242513055636670015213 0ustar liggesusers#' @include model-bbinchoice.R #' @include model-blogit.R #' @include model-bprobit.R #' @include model-ologit.R #' @include model-oprobit.R #' @include model-mlogit.R #library(jsonlite) createJSONzeligchoice <- function(){ z5blogit <- zblogit$new() z5blogit$toJSON() z5bprobit <- zbprobit$new() z5bprobit$toJSON() z5mlogit <- zmlogit$new() z5mlogit$toJSON() z5ologit <- zologit$new() z5ologit$toJSON() z5oprobit <- zoprobit$new() z5oprobit$toJSON() zeligchoicemodels <- list(zelig5choicemodels = list("blogit" = z5blogit$ljson, "bprobit" = z5bprobit$ljson, "mlogit" = z5mlogit$ljson, "ologit" = z5ologit$ljson, "oprobit" = z5oprobit$ljson)) # cat(jsonlite::toJSON(zeligchoicemodels, pretty = TRUE), # file = file.path("inst/JSON", "zelig5choicemodels.json")) cat(toJSON(zeligchoicemodels, pretty = TRUE), file = file.path("zelig5choicemodels.json")) file.rename(from = file.path("zelig5choicemodels.json"), to = file.path("inst", "JSON", "zelig5choicemodels.json")) file.remove(file.path("zelig5choicemodels.json")) return(TRUE) }ZeligChoice/R/model-obinchoice.R0000644000176200001440000000755113115273173016176 0ustar liggesusers#' Ordered Choice object for inheritance across models in ZeligChoice #' #' @import methods #' @export Zelig-obinchoice #' @exportClass Zelig-obinchoice zobinchoice <- setRefClass("Zelig-obinchoice", contains = "Zelig", field = list(method = "character", linkinv = "function" )) zobinchoice$methods( initialize = function() { callSuper() .self$fn <- quote(MASS::polr) .self$authors <- "Matthew Owen, Olivia Lau, Kosuke Imai, Gary King" .self$year <- 2011 .self$category <- "multinomial" } ) zobinchoice$methods( zelig = function(formula, data, ..., weights = NULL, by = NULL, bootstrap = FALSE) { .self$zelig.call <- match.call(expand.dots = TRUE) .self$model.call <- match.call(expand.dots = TRUE) .self$model.call$method <- .self$method .self$model.call$Hess <- TRUE localformula <- update(formula, as.factor(.) ~ .) if (!is.null(weights)) message('Note: Zelig weight results may differ from those in MASS::polr.') callSuper(formula = localformula, data = data, ..., weights = weights, by = by, bootstrap = bootstrap) #rse<-plyr::llply(.self$zelig.out$z.out, (function(x) vcovHC(x,type="HC0"))) #.self$test.statistics<- list(robust.se = rse) } ) zobinchoice$methods( param = function(z.out, method="mvn") { coef <- coef(z.out) zeta <- z.out$zeta theta <- zeta[1] for (k in 2:length(zeta)) theta[k] <- log(zeta[k] - zeta[k - 1]) simalpha <- list(coef = coef, zeta = zeta, lev = z.out$lev) if(identical(method, "mvn")){ localsimparam <- mvrnorm(.self$num, c(coef, theta), vcov(z.out)) return(list(simparam = localsimparam, simalpha = simalpha)) }else if(identical(method, "point")){ return(list(simparam =t(as.matrix(c(coef, theta))), simalpha = simalpha)) } } ) zobinchoice$methods( # From ZeligChoice 4 qi = function(simparam, mm) { # startup work simulations <- simparam$simparam coef <- simparam$simalpha$coef zeta <- simparam$simalpha$zeta lev <- simparam$simalpha$lev # simulations on coefficients sim.coef <- simulations[, 1:length(coef), drop = FALSE] # remove (Intercept), make sure matrix is numeric mat <- as.numeric(as.matrix(mm)[, -1]) # compute eta eta <- t(mat %*% t(sim.coef)) # simulations on zeta, and define theta sim.zeta <- sim.theta <- simulations[, (length(coef) + 1):ncol(simulations), drop = FALSE] sim.zeta[, -1] <- exp(sim.theta[, -1]) sim.zeta <- t(apply(sim.zeta, 1, cumsum)) ##----- Expected value k <- length(zeta) + 1 # remove (Intercept), make sure matrix is numeric mat <- as.numeric(as.matrix(mm)[, -1]) eta <- t(mat %*% t(sim.coef)) rows <- as.matrix(mm) Ipv <- cuts <- tmp0 <- array(0, dim = c(.self$num, k, nrow(rows)), dimnames = list(1:.self$num, lev, rownames(rows))) for (i in 1:.self$num) { cuts[i, , ] <- t(.self$linkinv(eta[i, ], sim.zeta[i, ])) } tmp0[, 2:k, ] <- cuts[, 2:k - 1, ] # 2:k-1 => 1, 2, 3, 4, ..., k-1 ev <- cuts - tmp0 dimnames(ev) <- list(1:.self$num, lev, rownames(mm)) # remove unnecessary dimensions ev <- ev[, , 1] colnames(ev) <- lev ##----- Predicted value pv <- matrix(NA, nrow = .self$num, ncol = nrow(as.matrix(mm))) tmp <- matrix(runif(length(cuts[, 1, ]), 0, 1), nrow = .self$num, ncol = nrow(mm)) for (j in 1:k) Ipv[, j, ] <- as.integer(tmp > cuts[, j, ]) for (j in 1:nrow(mm)) pv[, j] <- 1 + rowSums(Ipv[, , j, drop = FALSE]) factors <- factor(pv, labels = lev[1:length(lev) %in% sort(unique(pv))], ordered = TRUE) return(list(ev = ev, pv = pv)) } ) ZeligChoice/R/model-bprobit.R0000644000176200001440000000223513104610121015511 0ustar liggesusers#' Bivariate Probit Regression for Two Dichotomous Dependent Variables #' #' Vignette: \url{http://docs.zeligproject.org/articles/zeligchoice_bprobit.html} #' @import methods #' @export Zelig-bprobit #' @exportClass Zelig-bprobit #' #' @include model-bbinchoice.R zbprobit <- setRefClass("Zelig-bprobit", contains = "Zelig-bbinchoice") zbprobit$methods( initialize = function() { callSuper() .self$name <- "bprobit" .self$description <- "Bivariate Probit Regression for Dichotomous Dependent Variables" .self$family <- quote(binom2.rho(zero = 3)) .self$linkinv <- binom2.rho()@linkinv .self$wrapper <- "bprobit" .self$vignette.url <- "http://docs.zeligproject.org/articles/zeligchoice_bprobit.html" } ) zbprobit$methods( mcfun = function(x, b0=0, b1=1, b2=1, b3=0.5, ..., sim=TRUE){ n.sim = length(x) pi1 <- pnorm(b0 + b1 * x) pi2 <- pnorm(b2 + b3 * x) if(sim){ y1 <- rbinom(n=n.sim, size=1, prob=pi1) y2 <- rbinom(n=n.sim, size=1, prob=pi2) return(as.data.frame(y1, y2, x)) }else{ y1.hat <- pi1 y2.hat <- pi2 return(as.data.frame(y1.hat, y2.hat, x)) } } )ZeligChoice/R/model-oprobit.R0000644000176200001440000000324613104610121015531 0ustar liggesusers#' Ordinal Probit Regression for Ordered Categorical Dependent Variables #' #' Vignette: \url{http://docs.zeligproject.org/articles/zeligchoice_oprobit.html} #' @import methods #' @export Zelig-ologit #' @exportClass Zelig-ologit #' #' @include model-obinchoice.R zoprobit <- setRefClass("Zelig-oprobit", contains = "Zelig-obinchoice") zoprobit$methods( initialize = function() { callSuper() .self$name <- "oprobit" .self$packageauthors <- "William N. Venables, and Brian D. Ripley" .self$description <- "Ordinal Probit Regression for Ordered Categorical Dependent Variables" .self$method <- "probit" .self$linkinv <- function(eta, zeta) { tmp1 <- matrix(1, nrow = length(eta), ncol = length(zeta) + 1) tmp1[, 1:length(zeta)] <- pnorm(zeta - eta) return(tmp1) } .self$wrapper <- "oprobit" .self$vignette.url <- "http://docs.zeligproject.org/articles/zeligchoice_oprobit.html" } ) zoprobit$methods( mcfun = function(x, b0=0, b1=1, ..., sim=TRUE){ mu <- b0 + b1 * x n.sim = length(x) y.star <- rnorm(n = n.sim, mean = mu, sd = 1) # latent continuous y t <- c(0,1,2) # vector of cutpoints dividing latent space into ordered outcomes if(sim){ y.obs <- rep(1, n.sim) for(i in 1:length(t)){ y.obs <- y.obs + as.numeric(y.star > t[i]) # observed ordered outcome } return(as.factor(y.obs)) }else{ y.obs.hat <- rep(1, n.sim) for(i in 1:length(t)){ y.obs.hat <- y.obs.hat + pnorm(q = t[i], mean = mu , sd = 1, lower.tail = FALSE) # expectation of observed ordered outcome } return(y.obs.hat) } } ) ZeligChoice/R/model-bbinchoice.R0000644000176200001440000001221113115273173016146 0ustar liggesusers#' Bivariate Binary Choice object for inheritance across models in ZeligChoice #' #' @import methods #' @export Zelig-bbinchoice #' @exportClass Zelig-bbinchoice zbbinchoice <- setRefClass("Zelig-bbinchoice", contains = "Zelig", field = list(family = "ANY", linkinv = "function" )) zbbinchoice$methods( initialize = function() { callSuper() .self$fn <- quote(VGAM::vglm) .self$authors <- "Kosuke Imai, Gary King, Olivia Lau" .self$packageauthors <- "Thomas W. Yee" .self$year <- 2007 .self$category <- "dichotomous" } ) zbbinchoice$methods( zelig = function(formula, data, ..., weights = NULL, by = NULL, bootstrap = FALSE) { .self$zelig.call <- match.call(expand.dots = TRUE) .self$model.call <- match.call(expand.dots = TRUE) .self$model.call$family <- .self$family if (!is.null(weights)) message('Note: Zelig weight results may differ from those in VGAM::vglm.') callSuper(formula = formula, data = data, ..., weights = weights, by = by, bootstrap = bootstrap) } ) zbbinchoice$methods( param = function(z.out, method="mvn") { if(identical(method,"mvn")){ return(mvrnorm(.self$num, coef(z.out), vcov(z.out))) } else if(identical(method,"point")){ return(t(as.matrix(coef(z.out)))) } else { stop("param called with method argument of undefined type.") } } ) zbbinchoice$methods( # From Zelig 4 qi = function(simparam, mm) { .pp <- function(object, constr, all.coef, x) { xm <- list() xm <- rep(list(NULL), 3) sim.eta <- NULL for (i in 1:length(constr)) for (j in 1:3) if (sum(constr[[i]][j,]) == 1) xm[[j]] <- c(xm[[j]], x[,names(constr)[i]]) sim.eta <- cbind( all.coef[[1]] %*% as.matrix( xm[[1]] ), all.coef[[2]] %*% as.matrix( xm[[2]] ), all.coef[[3]] %*% as.matrix( xm[[3]] ) ) # compute inverse (theta) ev <- .self$linkinv(sim.eta) # assign correct column names colnames(ev) <- c("Pr(Y1=0, Y2=0)", "Pr(Y1=0, Y2=1)", "Pr(Y1=1, Y2=0)", "Pr(Y1=1, Y2=1)" ) return(ev) } .pr <- function(ev) { mpr <- cbind(ev[, 3] + ev[, 4], ev[, 2] + ev[, 4]) index <- matrix(NA, ncol=2, nrow=nrow(mpr)) index[, 1] <- rbinom(n=nrow(ev), size=1, prob=mpr[, 1]) index[, 2] <- rbinom(n=nrow(ev), size=1, prob=mpr[, 2]) pr <- matrix(NA, nrow=nrow(ev), ncol=4) pr[, 1] <- as.integer(index[, 1] == 0 & index[, 2] == 0) pr[, 2] <- as.integer(index[, 1] == 0 & index[, 2] == 1) pr[, 3] <- as.integer(index[, 1] == 1 & index[, 2] == 0) pr[, 4] <- as.integer(index[, 1] == 1 & index[, 2] == 1) colnames(pr) <- c("(Y1=0, Y2=0)", "(Y1=0, Y2=1)", "(Y1=1, Y2=0)", "(Y1=1, Y2=1)") return(pr) } .make.match.table <- function(index, cols=NULL) { pr <- matrix(0, nrow=nrow(index), ncol=4) # assigns values by the rule: # pr[j,1] = 1 iff index[j,1] == 0 && index[j,2] == 0 # pr[j,2] = 1 iff index[j,1] == 0 && index[j,2] == 1 # pr[j,3] = 1 iff index[j,1] == 1 && index[j,2] == 0 # pr[j,4] = 1 iff index[j,1] == 1 && index[j,2] == 1 # NOTE: only one column can be true at a time, so as a result # we can do a much more elegant one liner, that I'll code # later. In this current form, I don't think this actually # explains what is going on. pr[, 1] <- as.integer(index[, 1] == 0 & index[, 2] == 0) pr[, 2] <- as.integer(index[, 1] == 0 & index[, 2] == 1) pr[, 3] <- as.integer(index[, 1] == 1 & index[, 2] == 0) pr[, 4] <- as.integer(index[, 1] == 1 & index[, 2] == 1) # assign column names colnames(pr) <- if (is.character(cols) && length(cols)==4) cols else c("(Y1=0, Y2=0)", "(Y1=0, Y2=1)", "(Y1=1, Y2=0)", "(Y1=1, Y2=1)") return(pr) } all.coef <- NULL coefs <- simparam cm <- constraints(.self$zelig.out$z.out[[1]]) v <- vector("list", 3) for (i in 1:length(cm)) { if (ncol(cm[[i]]) == 1){ for (j in 1:3) if (sum(cm[[i]][j, ]) == 1) v[[j]] <- c(v[[j]], names(cm)[i]) } else { for (j in 1:3) if (sum(cm[[i]][j,]) == 1) v[[j]] <- c(v[[j]], paste(names(cm)[i], ":", j, sep="")) } } for(i in 1:3) all.coef[[i]] <- coefs[ , unlist(v[i]) ] col.names <- c("Pr(Y1=0, Y2=0)", "Pr(Y1=0, Y2=1)", "Pr(Y1=1, Y2=0)", "Pr(Y1=1, Y2=1)" ) ev <- .pp(.self$zelig.out$z.out[[1]], cm, all.coef, as.matrix(mm)) pv <- .pr(ev) levels(pv) <- c(0, 1) # return(list("Predicted Probabilities: Pr(Y1=k|X)" = ev, # "Predicted Values: Y=k|X" = pv)) return(list(ev = ev, pv = pv)) } ) # zbinchoice$methods( # show = function() { # lapply(.self$zelig.out, function(x) print(VGAM::summary(x))) # } # ) ZeligChoice/R/model-ologit.R0000644000176200001440000000325713115273173015370 0ustar liggesusers#' Ordinal Logistic Regression for Ordered Categorical Dependent Variables #' #' Vignette: \url{http://docs.zeligproject.org/articles/zeligchoice_ologit.html} #' @import methods #' @export Zelig-ologit #' @exportClass Zelig-ologit #' #' @include model-obinchoice.R zologit <- setRefClass("Zelig-ologit", contains = "Zelig-obinchoice") zologit$methods( initialize = function() { callSuper() .self$name <- "ologit" .self$packageauthors <- "William N. Venables, and Brian D. Ripley" .self$description <- "Ordinal Logit Regression for Ordered Categorical Dependent Variables" .self$method <- "logistic" .self$linkinv <- function(eta, zeta) { tmp1 <- matrix(1, nrow = length(eta), ncol = length(zeta) + 1) tmp1[, 1:length(zeta)] <- exp(zeta - eta) / (1 + exp(zeta - eta)) return(tmp1) } .self$wrapper <- "ologit" .self$vignette.url <- "http://docs.zeligproject.org/articles/zeligchoice_ologit.html" } ) zologit$methods( mcfun = function(x, b0 = 0, b1 = 1, ..., sim = TRUE){ mu <- b0 + b1 * x n.sim = length(x) y.star <- rlogis(n = n.sim, location = mu, scale = 1) # latent continuous y t <- c(0,1,2) # vector of cutpoints dividing latent space into ordered outcomes if(sim){ y.obs <- rep(1, n.sim) for(i in 1:length(t)){ y.obs <- y.obs + as.numeric(y.star > t[i]) # observed ordered outcome } return(as.factor(y.obs)) }else{ y.obs.hat <- rep(1, n.sim) for(i in 1:length(t)){ y.obs.hat <- y.obs.hat + plogis(q = t[i], location = mu , scale = 1, lower.tail = FALSE) # expectation of observed ordered outcome } return(y.obs.hat) } } ) ZeligChoice/R/model-mlogit.R0000644000176200001440000001377013104610121015351 0ustar liggesusers#' Multinomial Logistic Regression for Dependent Variables with Unordered Categorical Values #' #' Vignette: \url{http://docs.zeligproject.org/articles/zeligchoice_mlogit.html} #' @import methods #' @export Zelig-bprobit #' @exportClass Zelig-bprobit zmlogit <- setRefClass("Zelig-mlogit", contains = "Zelig", field = list(family = "ANY", linkinv = "function" )) zmlogit$methods( initialize = function() { callSuper() .self$name <- "mlogit" .self$description <- "Multinomial Logistic Regression for Dependent Variables with Unordered Categorical Values" .self$fn <- quote(VGAM::vglm) .self$authors <- "Matthew Owen, Olivia Lau, Kosuke Imai, Gary King" .self$packageauthors <- "Thomas W. Yee" .self$year <- 2007 .self$category <- "multinomial" .self$family <- "multinomial" .self$wrapper <- "mlogit" .self$vignette.url <- "http://docs.zeligproject.org/articles/zeligchoice_mlogit.html" } ) zmlogit$methods( zelig = function(formula, data, ..., weights = NULL, by = NULL, bootstrap = FALSE) { .self$zelig.call <- match.call(expand.dots = TRUE) .self$model.call <- match.call(expand.dots = TRUE) .self$model.call$family <- .self$family callSuper(formula = formula, data = data, ..., weights = NULL, by = by, bootstrap = bootstrap) } ) zmlogit$methods( param = function(z.out, method="mvn") { if(identical(method,"mvn")){ return(mvrnorm(.self$num, coef(z.out), vcov(z.out))) } else if(identical(method,"point")){ return(t(as.matrix(coef(z.out)))) } else { stop("param called with method argument of undefined type.") } } ) zmlogit$methods( # From ZeligChoice 4 qi = function(simparam, mm) { fitted <- .self$zelig.out$z.out[[1]] # get constraints from fitted model constraints <- fitted@constraints coef <- simparam ndim <- ncol(fitted@y) - 1 all.coef <- NULL v <- construct.v(constraints, ndim) # put all indexed lists in the appropriate section for (i in 1:ndim) all.coef <- c(all.coef, list(coef[, v[[i]]])) # cnames <- ynames <- if (is.null(colnames(fitted@y))) {1:(ndim + 1)} else colnames(fitted@y) if (is.null(colnames(fitted@y))) { cnames <- 1:(ndim + 1) } else cnames <- colnames(fitted@y) ynames <- cnames cnames <- paste("Pr(Y=", cnames, ")", sep = "") ev <- ev.mlogit(fitted, constraints, all.coef, mm, ndim, cnames) pv <- pv.mlogit(fitted, ev) #, ynames) return(list(ev = ev, pv = pv)) } ) #' Split Names of Vectors into N-vectors #' This function is used to organize how variables are spread #' across the list of formulas #' @usage construct.v(constraints, ndim) #' @param constraints a constraints object #' @param ndim an integer specifying the number of dimensions #' @return a list of character-vectors construct.v <- function(constraints, ndim) { v <- rep(list(NULL), ndim) names <- names(constraints) for (i in 1:length(constraints)) { cm <- constraints[[i]] for (j in 1:ndim) { if (sum(cm[j, ]) == 1) { v[[j]] <- if (ncol(cm) == 1) c(v[[j]], names[i]) else c(v[[j]], paste(names[i], ':', j, sep="")) } } } return(v) } #' Simulate Expected Value for Multinomial Logit #' @usage ev.mlogit(fitted, constraints, all.coef, x, ndim, cnames) #' @param fitted a fitted model object #' @param constraints a constraints object #' @param all.coef all the coeficients #' @param x a setx object #' @param ndim an integer specifying the number of dimensions #' @param cnames a character-vector specifying the names of the columns #' @return a matrix of simulated values ev.mlogit <- function (fitted, constraints, all.coef, x, ndim, cnames) { if (is.null(x)) return(NA) linkinv <- fitted@family@linkinv xm <- rep(list(NULL), ndim) sim.eta <- NULL x <- as.matrix(x) for (i in 1:length(constraints)) { for (j in 1:ndim) if (sum(constraints[[i]][j,] ) == 1) xm[[j]] <- c(xm[[j]], x[, names(constraints)[i]]) } for (i in 1:ndim) sim.eta <- cbind(sim.eta, all.coef[[i]] %*% as.matrix(xm[[i]])) ev <- linkinv(sim.eta, extra = fitted@extra) colnames(ev) <- cnames return(ev) } #' Simulate Predicted Values #' @usage pv.mlogit(fitted, ev) #' @param fitted a fitted model object #' @param ev the simulated expected values #' @return a vector of simulated values pv.mlogit <- function (fitted, ev){ #, ynames) { if (all(is.na(ev))) return(NA) # initialize predicted values and a matrix pv <- NULL Ipv <- sim.cut <- matrix(NA, nrow = nrow(ev), ncol(ev)) k <- ncol(ev) colnames(Ipv) <- colnames(sim.cut) <- colnames(ev) sim.cut[, 1] <- ev[, 1] for (j in 2:k) sim.cut[, j] <- sim.cut[ , j - 1] + ev[, j] tmp <- runif(nrow(ev), min = 0, max = 1) for (j in 1:k) Ipv[, j] <- tmp > sim.cut[, j] for (j in 1:nrow(Ipv)) pv[j] <- 1 + sum(Ipv[j, ]) pv <- factor(pv, ordered = FALSE) pv.matrix <- matrix(pv, nrow = dim(ev)[1]) levels(pv.matrix) <- levels(pv) return(pv.matrix) } zmlogit$methods( mcfun = function(x, b0=-0.5, b1=0.5, b2=-1, b3=1, ..., sim=TRUE){ mu1 <- b0 + b1 * x mu2 <- b2 + b3 * x if(sim){ n.sim = length(x) y.star.1 <- exp( rlogis(n = n.sim, location = mu1, scale = 1) ) # latent continuous y y.star.2 <- exp( rlogis(n = n.sim, location = mu2, scale = 1) ) # latent continuous y pi1 <- y.star.1/(1 + y.star.1 + y.star.2) pi2 <- y.star.2/(1 + y.star.1 + y.star.2) pi3 <- 1 - pi1 - pi2 y.draw <- runif(n=n.sim) y.obs <- 1 + as.numeric(y.draw>pi1) + as.numeric(y.draw>(pi1 + pi2)) return(as.factor(y.obs)) }else{ pi1.hat <- exp(mu1)/(1 + exp(mu1) + exp(mu2)) pi2.hat <- exp(mu2)/(1 + exp(mu1) + exp(mu2)) pi3.hat <- 1 - pi1.hat - pi2.hat y.obs.hat <- pi1.hat*1 + pi2.hat*2 + pi3.hat*3 # This is the expectation the MC test will check, although it is not substantively meaningful for factor dep. var. return(y.obs.hat) } } ) ZeligChoice/R/model-blogit.R0000644000176200001440000000223513104610121015330 0ustar liggesusers#' Bivariate Logistic Regression for Two Dichotomous Dependent Variables #' #' Vignette: \url{http://docs.zeligproject.org/articles/zeligchoice_blogit.html} #' @import methods #' @export Zelig-blogit #' @exportClass Zelig-blogit #' #' @include model-bbinchoice.R zblogit <- setRefClass("Zelig-blogit", contains = "Zelig-bbinchoice") zblogit$methods( initialize = function() { callSuper() .self$name <- "blogit" .self$description <- "Bivariate Logit Regression for Dichotomous Dependent Variables" .self$family <- quote(binom2.or(zero = 3)) .self$linkinv <- binom2.or()@linkinv .self$wrapper <- "blogit" .self$vignette.url <- "http://docs.zeligproject.org/articles/zeligchoice_blogit.html" } ) zblogit$methods( mcfun = function(x, b0=0, b1=1, b2=1, b3=0.5, ..., sim=TRUE){ n.sim = length(x) pi1 <- 1/(1 + exp(b0 + b1 * x)) pi2 <- 1/(1 + exp(b2 + b3 * x)) if(sim){ y1 <- rbinom(n=n.sim, size=1, prob=pi1) y2 <- rbinom(n=n.sim, size=1, prob=pi2) return(as.data.frame(y1, y2, x)) }else{ y1.hat <- pi1 y2.hat <- pi2 return(as.data.frame(y1.hat, y2.hat, x)) } } )ZeligChoice/MD50000644000176200001440000000375213116100671012752 0ustar liggesusersf8bb0b7b780d5f5ec2953c629f8795e5 *DESCRIPTION f692b762adcbee68f1a35e850de75eb8 *NAMESPACE e64144e43fa2617e23005ffddba90cf4 *NEWS.md d2c074767923db20198a3844dcbb58f1 *R/create-json.R d9b2783702afd531aa0747650dda0884 *R/model-bbinchoice.R ce21e34cc591a2c0d1e1ddc8d523de35 *R/model-blogit.R 49342bd27a805e11bac6ce0265847fb0 *R/model-bprobit.R 3642b5ba772dd4300f60073789fe8cb3 *R/model-mlogit.R f805cf64c22189e613f0e1f81ea40bb7 *R/model-obinchoice.R 3a17d0ec6f159dcc527e0bc568d357a2 *R/model-ologit.R be209e0b0519d12875e40225448be9e7 *R/model-oprobit.R 0933d5594c16b1c6e51d27fa4d82efb1 *data/coalition.tab d9d6edeebc11b21f6f26ce2dd6db3352 *data/sanction.tab a1c355fda6c37fa1dbc5a5cb32a718e6 *demo/00Index 070cdf9de6d3a4ea33fb2553260b3dc7 *demo/demo-blogit.R fdbaa08f66bc4b23f02b6668c39bbef6 *demo/demo-bprobit.R 137a4b9e6d40afddc6bfb3bfbbed9953 *demo/demo-mlogit.R 94f3ea473599ba6c9572d682d3ae0ffb *demo/demo-ologit.R e3e9ae3e4e890bf0770a340dbbbe1379 *demo/demo-oprobit.R 9b56524740a74f40986424685b899f4a *inst/JSON/zelig5choicemodels.json 6152355c61c471afe99457ead97b8aaf *man/Zelig-bbinchoice-class.Rd 6fd039304e6a5f932c7da457f68e7114 *man/Zelig-blogit-class.Rd ff81a597ccd1a4c575e857fa7dc05d9b *man/Zelig-bprobit-class.Rd 3a7f04bb9e9b137c5ee9d15d7503eb51 *man/Zelig-mlogit-class.Rd 563c3cac6df5c503225375ffb981fed5 *man/Zelig-obinchoice-class.Rd aa81d7167a88039cf024013a88461bce *man/Zelig-ologit-class.Rd 196e7ba712897f10f02303dea07e5634 *man/Zelig-oprobit-class.Rd 3b01d1373c2b9f311a70f150f8a3e7cf *man/coalition.Rd 7dacee6dd559c77c4bca0415690fb4b3 *man/construct.v.Rd 575cc55096d53792a66814fd69ecb31a *man/createJSONzeligchoice.Rd ec6443ee11736e8d959b4233bb476c92 *man/ev.mlogit.Rd 8d44a01b87dd6b7c012bc775ddfb58b6 *man/pv.mlogit.Rd 685e8fe4738e2aad2ad73d7f2388570b *man/sanction.Rd eb1b000459ba2709b8007c0cb9fd9274 *tests/testthat.R 1127751289432698fb8c087bc0ebdfd3 *tests/testthat/test-mlogit.R c6082c7f29e4b51ab4158e9fdb759f07 *tests/testthat/test-ologit.R 524dd413c622bf5c114757b3f05f1843 *tests/testthat/test-oprobit.R ZeligChoice/DESCRIPTION0000644000176200001440000000240713116100671014144 0ustar liggesusersPackage: ZeligChoice License: GPL (>= 3) Title: Zelig Choice Models Authors@R: c( person("Christine.", "Choirat", role = "aut"), person("Christopher", "Gandrud", email = "zelig.zee@gmail.com", role = c("aut", "cre")), person("James", "Honaker", role = "aut"), person("Kosuke", "Imai", role = "aut"), person("Gary", "King", role = "aut"), person("Olivia", "Lau", role = "aut") ) Description: Add-on package for Zelig 5. Enables the use of a variety of logit and probit regressions. URL: https://cran.r-project.org/package=ZeligChoice BugReports: https://github.com/IQSS/Zelig/issues Version: 0.9-6 Date: 2017-06-07 Imports: dplyr, Formula, jsonlite, MASS, methods, VGAM, Zelig (>= 5.1-1), Suggests: testthat, knitr, zeligverse Collate: 'model-mlogit.R' 'model-obinchoice.R' 'model-oprobit.R' 'model-ologit.R' 'model-bbinchoice.R' 'model-bprobit.R' 'model-blogit.R' 'create-json.R' RoxygenNote: 6.0.1 NeedsCompilation: no Packaged: 2017-06-07 15:07:31 UTC; cgandrud Author: Christine. Choirat [aut], Christopher Gandrud [aut, cre], James Honaker [aut], Kosuke Imai [aut], Gary King [aut], Olivia Lau [aut] Maintainer: Christopher Gandrud Repository: CRAN Date/Publication: 2017-06-07 22:44:09 UTC ZeligChoice/man/0000755000176200001440000000000013055636670013225 5ustar liggesusersZeligChoice/man/Zelig-bbinchoice-class.Rd0000644000176200001440000000106213055636670017753 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-bbinchoice.R \docType{class} \name{Zelig-bbinchoice-class} \alias{Zelig-bbinchoice-class} \alias{zbbinchoice} \title{Bivariate Binary Choice object for inheritance across models in ZeligChoice} \description{ Bivariate Binary Choice object for inheritance across models in ZeligChoice } \section{Methods}{ \describe{ \item{\code{zelig(formula, data, model = NULL, ..., weights = NULL, by, bootstrap = FALSE)}}{The zelig function estimates a variety of statistical models} }} ZeligChoice/man/pv.mlogit.Rd0000644000176200001440000000056013055636670015434 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-mlogit.R \name{pv.mlogit} \alias{pv.mlogit} \title{Simulate Predicted Values} \usage{ pv.mlogit(fitted, ev) } \arguments{ \item{fitted}{a fitted model object} \item{ev}{the simulated expected values} } \value{ a vector of simulated values } \description{ Simulate Predicted Values } ZeligChoice/man/sanction.Rd0000644000176200001440000000134013055636670015330 0ustar liggesusers\name{sanction} \alias{sanction} \title{Multilateral Economic Sanctions} \description{ Data on bilateral sanctions behavior for selected years during the general period 1939-1983. This data contains errors that have since been corrected. Please contact Lisa Martin before using this data for publication. } \usage{data(sanction)} \format{A table containing 8 variables ("mil", "coop", "target", "import", "export", "cost", "num", and "ncost") and 78 observations. For full variable description, see Martin, 1992. } \source{Martin, 1992} \references{ Martin, Lisa (1992). \emph{Coercive Cooperation: Explaining Multilateral Economic Sanctions}, Princeton: Princeton University Press. } \keyword{datasets} ZeligChoice/man/Zelig-obinchoice-class.Rd0000644000176200001440000000104013055636670017764 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-obinchoice.R \docType{class} \name{Zelig-obinchoice-class} \alias{Zelig-obinchoice-class} \alias{zobinchoice} \title{Ordered Choice object for inheritance across models in ZeligChoice} \description{ Ordered Choice object for inheritance across models in ZeligChoice } \section{Methods}{ \describe{ \item{\code{zelig(formula, data, model = NULL, ..., weights = NULL, by, bootstrap = FALSE)}}{The zelig function estimates a variety of statistical models} }} ZeligChoice/man/coalition.Rd0000644000176200001440000000212413055636670015474 0ustar liggesusers\name{coalition} \alias{coalition} \title{Coalition Dissolution in Parliamentary Democracies} \description{ This data set contains survival data on government coalitions in parliamentary democracies (Belgium, Canada, Denmark, Finland, France, Iceland, Ireland, Israel, Italy, Netherlands, Norway, Portugal, Spain, Sweden, and the United Kingdom) for the period 1945-1987. For parsimony, country indicator variables are omitted in the sample data. } \usage{data(coalition)} \format{ A table containing 7 variables ("duration", "ciep12", "invest", "fract", "polar", "numst2", "crisis") and 314 observations. For variable descriptions, please refer to King, Alt, Burns and Laver (1990). } \source{ICPSR} \references{ King, Gary, James E. Alt, Nancy Elizabeth Burns and Michael Laver (1990). ``A Unified Model of Cabinet Dissolution in Parliamentary Democracies,'' \emph{American Journal of Political Science}, vol. 34, no. 3, pp. 846-870. Gary King, James E. Alt, Nancy Burns, and Michael Laver. ICPSR Publication Related Archive, 1115. } \keyword{datasets} ZeligChoice/man/ev.mlogit.Rd0000644000176200001440000000117713055636670015426 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-mlogit.R \name{ev.mlogit} \alias{ev.mlogit} \title{Simulate Expected Value for Multinomial Logit} \usage{ ev.mlogit(fitted, constraints, all.coef, x, ndim, cnames) } \arguments{ \item{fitted}{a fitted model object} \item{constraints}{a constraints object} \item{all.coef}{all the coeficients} \item{x}{a setx object} \item{ndim}{an integer specifying the number of dimensions} \item{cnames}{a character-vector specifying the names of the columns} } \value{ a matrix of simulated values } \description{ Simulate Expected Value for Multinomial Logit } ZeligChoice/man/Zelig-bprobit-class.Rd0000644000176200001440000000054213104610121017303 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-bprobit.R \docType{class} \name{Zelig-bprobit-class} \alias{Zelig-bprobit-class} \alias{zbprobit} \title{Bivariate Probit Regression for Two Dichotomous Dependent Variables} \description{ Vignette: \url{http://docs.zeligproject.org/articles/zeligchoice_bprobit.html} } ZeligChoice/man/Zelig-blogit-class.Rd0000644000176200001440000000053713104610121017126 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-blogit.R \docType{class} \name{Zelig-blogit-class} \alias{Zelig-blogit-class} \alias{zblogit} \title{Bivariate Logistic Regression for Two Dichotomous Dependent Variables} \description{ Vignette: \url{http://docs.zeligproject.org/articles/zeligchoice_blogit.html} } ZeligChoice/man/Zelig-oprobit-class.Rd0000644000176200001440000000054413104610121017322 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-oprobit.R \docType{class} \name{Zelig-oprobit-class} \alias{Zelig-oprobit-class} \alias{zoprobit} \title{Ordinal Probit Regression for Ordered Categorical Dependent Variables} \description{ Vignette: \url{http://docs.zeligproject.org/articles/zeligchoice_oprobit.html} } ZeligChoice/man/Zelig-ologit-class.Rd0000644000176200001440000000054113104610121017136 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-ologit.R \docType{class} \name{Zelig-ologit-class} \alias{Zelig-ologit-class} \alias{zologit} \title{Ordinal Logistic Regression for Ordered Categorical Dependent Variables} \description{ Vignette: \url{http://docs.zeligproject.org/articles/zeligchoice_ologit.html} } ZeligChoice/man/createJSONzeligchoice.Rd0000644000176200001440000000067713055636670017671 0ustar liggesusers\name{createJSONzeligchoice} \alias{createJSONzeligchoice} \title{Utility function for constructing JSON file that encodes the hierarchy of available statistical models in ZeligChoice} \usage{ createJSONzeligchoice() } \value{ Returns TRUE on successful completion of json file } \description{ Utility function for construction a JSON file that encodes the hierarchy of available statistical models. } \author{ Christine Choirat, Vito D'Orazio }ZeligChoice/man/Zelig-mlogit-class.Rd0000644000176200001440000000106213104610121017133 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-mlogit.R \docType{class} \name{Zelig-mlogit-class} \alias{Zelig-mlogit-class} \alias{zmlogit} \title{Multinomial Logistic Regression for Dependent Variables with Unordered Categorical Values} \description{ Vignette: \url{http://docs.zeligproject.org/articles/zeligchoice_mlogit.html} } \section{Methods}{ \describe{ \item{\code{zelig(formula, data, model = NULL, ..., weights = NULL, by, bootstrap = FALSE)}}{The zelig function estimates a variety of statistical models} }} ZeligChoice/man/construct.v.Rd0000644000176200001440000000113113055636670016000 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/model-mlogit.R \name{construct.v} \alias{construct.v} \title{Split Names of Vectors into N-vectors This function is used to organize how variables are spread across the list of formulas} \usage{ construct.v(constraints, ndim) } \arguments{ \item{constraints}{a constraints object} \item{ndim}{an integer specifying the number of dimensions} } \value{ a list of character-vectors } \description{ Split Names of Vectors into N-vectors This function is used to organize how variables are spread across the list of formulas }