├── .gitattributes ├── .github └── workflows │ └── pkgdown.yml ├── .gitignore ├── .travis.yml ├── README.md ├── appveyor.yml ├── builitin.travis.yml └── pkg ├── .Rbuildignore ├── DESCRIPTION ├── NAMESPACE ├── R ├── AIC-mclogit.R ├── anova-mclogit.R ├── blockMatrices.R ├── formula-utils.R ├── getSummary-mblogit.R ├── getSummary-mclogit.R ├── mblogit.R ├── mclogit-dispersion.R ├── mclogit-fit.R ├── mclogit-rebase.R ├── mclogit.R ├── mmclogit-fitPQLMQL.R ├── safeInverse.R └── zzz.R ├── data ├── Transport.R └── electors.R ├── demo ├── 00Index ├── mclogit.test.R └── test-mblogit-random-nonnested.R ├── examples └── mblogit-ex.R ├── inst ├── ChangeLog ├── ChangeLog-old └── NEWS.Rd ├── man ├── Transport.Rd ├── dispersion.Rd ├── electors.Rd ├── getSummary-mclogit.Rd ├── mblogit.Rd ├── mclogit.Rd ├── mclogit.fit.Rd ├── mclogit_control.Rd ├── predict.Rd ├── rebase.Rd └── simulate.Rd ├── pkgdown └── _pkgdown.yml └── vignettes ├── approximations.Rmd ├── baseline-and-conditional-logit.Rmd ├── baseline-logit.Rmd ├── conditional-logit.Rmd ├── fitting-mclogit.Rmd ├── mclogit.bib └── random-effects.Rmd /.gitattributes: -------------------------------------------------------------------------------- 1 | * text=auto 2 | data/* binary 3 | src/* text=lf 4 | R/* text=lf 5 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master,pkgdown-test] 6 | pull_request: 7 | branches: [main, master,pkgdown-test] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | steps: 23 | - uses: actions/checkout@v3 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | working-directory: pkg 36 | 37 | - name: Copy Readme 38 | run: cp -a README.md pkg 39 | 40 | - name: Build site 41 | run: install.packages("preferably");pkgdown::build_site_github_pages(pkg = "pkg", dest_dir = "../docs", new_process = FALSE, install = FALSE) 42 | shell: Rscript {0} 43 | 44 | - name: Deploy to GitHub pages 🚀 45 | if: github.event_name != 'pull_request' 46 | uses: JamesIves/github-pages-deploy-action@v4.4.1 47 | with: 48 | clean: false 49 | branch: gh-pages 50 | folder: docs 51 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.Rcheck 2 | *.tar.gz 3 | *.zip 4 | *.Rproj 5 | *.Rproj.user 6 | *~ 7 | /exampledata.csv 8 | /mclogit, strange standard errors?.mbox 9 | /sim_clogitforMartin.R 10 | /sim_clogitforMartin.R~ 11 | /sim-clogit.log 12 | .Rproj.user 13 | /AIC-mclogit.R 14 | /binomial-family.R 15 | /bugreports/cremer-schulte/mclogit weights.mbox 16 | /bugreports/feralli/mclogit package_little (but very annoying) bug with predict after mclogit command.mbox 17 | /bugreports/feralli/RE_mclogit package_little (but very annoying) bug with predict after mclogit command.mbox 18 | /bugreports/killeen/examplecode.txt 19 | /bugreports/killeen/exampledata.txt 20 | /bugreports/killeen/killeen-new.R 21 | /bugreports/killeen/killeen.R 22 | /bugreports/killeen/residuals_output.txt 23 | /Conflicting imports in CRAN package mclogit.mbox 24 | /Dupke.R 25 | /mclogit-00check.html 26 | /Mclogit-AIC.mbox 27 | /mclogit-Ex.pdf 28 | /mclogit-random-old.R 29 | /predict-glm.R 30 | /residuals-glm.R 31 | /S.RData 32 | /testAIC.R 33 | /test-package.R 34 | /pkg.pdf 35 | electors-n.R 36 | examine-varpar.R 37 | test-anova-mclogit.R 38 | CRAN-submission-email-template.txt 39 | test-electors-mtable.R 40 | theory 41 | test-mclogit.R 42 | test-vcov.R 43 | sync-r-forge 44 | .RData 45 | .Rhistory 46 | .stfolder 47 | .stignore 48 | gitlog 49 | gitlog.out 50 | tmp.txt 51 | release.txt 52 | test-mblogit-housing.R 53 | .gitignore 54 | /mclogit.org 55 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | cache: packages 3 | sudo: false 4 | 5 | warnings_are_errors: false 6 | 7 | before_install: cd pkg 8 | 9 | notifications: 10 | email: 11 | recipients: mclogit@elff.eu 12 | on_success: always 13 | on_failure: always 14 | 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # mclogit: Multinomial Logit Models, with or without Random Effects or Overdispersion 3 | 4 | [![CRAN](http://www.r-pkg.org/badges/version/mclogit)](http://cran.rstudio.com/package=mclogit) 5 | [![Total downloads from RStudio CRAN mirror](http://cranlogs.r-pkg.org/badges/grand-total/mclogit)](http://cran.r-project.org/web/packages/mclogit/index.html) 6 | [![Current release on GitHub](http://img.shields.io/github/release/melff/mclogit.svg)](http://github.com/melff/mclogit/releases/) 7 | [![Total downloads from RStudio CRAN mirror](http://cranlogs.r-pkg.org/badges/mclogit)](http://cran.r-project.org/web/packages/mclogit/index.html) 8 | 9 | 10 | 11 | 12 | This packages provides estimators for multinomial logit models in their 13 | conditional logit and baseline logit variants, with or without random effects, 14 | with or without overdispersion. Random effects models are estimated using the 15 | PQL technique (based on a Laplace approximation) or the MQL technique (based on 16 | a Solomon-Cox approximation). Estimates should be treated with caution if the 17 | group sizes are small. 18 | 19 | 20 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | # DO NOT CHANGE the "init" and "install" sections below 2 | 3 | # Download script file from GitHub 4 | init: 5 | ps: | 6 | $ErrorActionPreference = "Stop" 7 | Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" 8 | Import-Module '..\appveyor-tool.ps1' 9 | Update-AppveyorBuild -Version "$env:APPVEYOR_REPO_TAG_NAME" 10 | 11 | install: 12 | ps: Bootstrap 13 | 14 | # Adapt as necessary starting from here 15 | 16 | before_build: 17 | - cp ../travis-tool.sh ./travis-tool.sh 18 | - cp travis-tool.sh.cmd pkg/travis-tool.sh.cmd 19 | - cd pkg 20 | - bash -c "echo '^travis-tool\.sh\.cmd$' >> .Rbuildignore" 21 | 22 | build_script: 23 | - travis-tool.sh install_deps 24 | 25 | test_script: 26 | - travis-tool.sh run_tests 27 | 28 | on_failure: 29 | - travis-tool.sh dump_logs 30 | 31 | artifacts: 32 | - path: 'pkg\*.Rcheck\**\*.log' 33 | name: Logs 34 | 35 | - path: 'pkg\*.Rcheck\**\*.out' 36 | name: Logs 37 | 38 | - path: 'pkg\*.Rcheck\**\*.fail' 39 | name: Logs 40 | 41 | - path: 'pkg\*.Rcheck\**\*.Rout' 42 | name: Logs 43 | 44 | - path: 'pkg\*_*.tar.gz' 45 | name: source 46 | 47 | - path: 'pkg\*_*.zip' 48 | name: binary 49 | 50 | version: 0.9-{build} 51 | 52 | skip_non_tags: true 53 | 54 | notifications: 55 | - provider: Email 56 | to: mclogit@elff.eu 57 | on_build_success: true 58 | on_build_failure: true 59 | 60 | deploy: 61 | provider: GitHub 62 | auth_token: 63 | secure: IYtxvmAVA0yYUgxvOxBhWo2TMyfGtqhTDnjSXh3qc4KRUGBZOrUPm4R85FFn9umV 64 | artifact: source,binary 65 | 66 | draft: true 67 | prerelease: true 68 | # on: 69 | # appveyor_repo_tag: true # deploy on tag push only 70 | 71 | -------------------------------------------------------------------------------- /builitin.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | sudo: required 3 | 4 | # Be strict when checking our package 5 | warnings_are_errors: true 6 | 7 | before_install: cd pkg 8 | 9 | 10 | -------------------------------------------------------------------------------- /pkg/.Rbuildignore: -------------------------------------------------------------------------------- 1 | examples 2 | pkgdown -------------------------------------------------------------------------------- /pkg/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: mclogit 2 | Type: Package 3 | Title: Multinomial Logit Models, with or without Random Effects or Overdispersion 4 | Version: 0.9.10 5 | Date: 2025-06-08 6 | Author: Martin Elff 7 | Maintainer: Martin Elff 8 | Description: Provides estimators for multinomial logit models in their 9 | conditional logit and baseline logit variants, with or without random effects, 10 | with or without overdispersion. 11 | Random effects models are estimated using the PQL technique (based on a Laplace approximation) 12 | or the MQL technique (based on a Solomon-Cox approximation). Estimates should be treated 13 | with caution if the group sizes are small. 14 | License: GPL-2 15 | Depends: 16 | stats, 17 | Matrix 18 | Imports: 19 | MASS, 20 | memisc, 21 | methods, 22 | nlme 23 | Suggests: 24 | nnet, 25 | ucminf, 26 | knitr, 27 | rmarkdown 28 | LazyLoad: Yes 29 | VignetteBuilder: knitr 30 | URL: http://melff.github.io/mclogit/,https://github.com/melff/mclogit/ 31 | BugReports: https://github.com/melff/mclogit/issues 32 | Encoding: UTF-8 33 | RoxygenNote: 7.3.2 34 | -------------------------------------------------------------------------------- /pkg/NAMESPACE: -------------------------------------------------------------------------------- 1 | import(stats,Matrix) 2 | importFrom(memisc,getSummary,"%nin%",Sapply) 3 | importFrom(methods,as) 4 | export( 5 | mclogit, 6 | mclogit.fit, 7 | mmclogit.fitPQLMQL, 8 | mclogit.control, 9 | mmclogit.control, 10 | getSummary.mclogit, 11 | getSummary.mmclogit, 12 | mblogit, 13 | getSummary.mblogit, 14 | getSummary.mmblogit 15 | ) 16 | S3method(print,mclogit) 17 | S3method(vcov,mclogit) 18 | S3method(deviance,mclogit) 19 | S3method(logLik,mclogit) 20 | S3method(summary,mclogit) 21 | S3method(print,summary.mclogit) 22 | S3method(fitted,mclogit) 23 | S3method(predict,mclogit) 24 | S3method(weights,mclogit) 25 | S3method(residuals,mclogit) 26 | S3method(AIC,mclogit) 27 | S3method(BIC,mclogit) 28 | S3method(nobs,mclogit) 29 | S3method(extractAIC,mclogit) 30 | S3method(anova,mclogit) 31 | S3method(update,mclogit) 32 | 33 | S3method(print,mmclogit) 34 | S3method(vcov,mmclogit) 35 | S3method(summary,mmclogit) 36 | S3method(print,summary.mmclogit) 37 | 38 | S3method(print,mblogit) 39 | S3method(summary,mblogit) 40 | S3method(print,summary.mblogit) 41 | S3method(fitted,mblogit) 42 | S3method(predict,mblogit) 43 | S3method(weights,mblogit) 44 | 45 | S3method(print,mmblogit) 46 | S3method(summary,mmblogit) 47 | S3method(print,summary.mmblogit) 48 | 49 | 50 | export(dispersion) 51 | S3method(dispersion,mclogit) 52 | 53 | S3method(getSummary,mclogit) 54 | S3method(getSummary,mblogit) 55 | 56 | S3method(getSummary,mmclogit) 57 | S3method(getSummary,mmblogit) 58 | 59 | S3method(simulate,mclogit) 60 | S3method(simulate,mblogit) 61 | 62 | S3method(simulate,mmclogit) 63 | S3method(simulate,mmblogit) 64 | 65 | S3method(predict,mmblogit) 66 | S3method(predict,mmclogit) 67 | 68 | export(rebase) 69 | S3method(rebase,mblogit) 70 | 71 | importFrom(nlme,ranef) 72 | S3method(ranef,mmclogit) 73 | 74 | importFrom(MASS,ginv) -------------------------------------------------------------------------------- /pkg/R/AIC-mclogit.R: -------------------------------------------------------------------------------- 1 | # Contributed by Nic Elliot 2 | 3 | AIC.mclogit <- function(object,...,k=2){ 4 | 5 | devNdf <- function(object) 6 | unname(unlist(object[c("deviance","N","model.df")])) 7 | 8 | if (length(list(...))) { 9 | dvs <- sapply(list(object, ...), devNdf) 10 | nobs <- dvs[2,] 11 | if(length(unique(nobs))>1) 12 | warning("models are not all fitted to the same number of observations") 13 | val <- data.frame(df=dvs[3,],AIC=dvs[1,]+k*dvs[3,]) 14 | Call <- match.call() 15 | Call$k <- NULL 16 | row.names(val) <- as.character(Call[-1L]) 17 | val 18 | } 19 | else { 20 | dvs <- devNdf(object) 21 | dvs[1]+k*dvs[3] 22 | } 23 | } 24 | 25 | BIC.mclogit <- function(object,...){ 26 | 27 | devNdf <- function(object) 28 | unname(unlist(object[c("deviance","N","model.df")])) 29 | 30 | if (length(list(...))) { 31 | dvs <- sapply(list(object, ...), devNdf) 32 | nobs <- dvs[2,] 33 | if(length(unique(nobs))>1) 34 | warning("models are not all fitted to the same number of observations") 35 | val <- data.frame(df=dvs[3,],BIC=dvs[1,]+log(dvs[2,])*dvs[3,]) 36 | Call <- match.call() 37 | Call$k <- NULL 38 | row.names(val) <- as.character(Call[-1L]) 39 | val 40 | } 41 | else { 42 | dvs <- devNdf(object) 43 | dvs[1]+log(dvs[2])*dvs[3] 44 | } 45 | } -------------------------------------------------------------------------------- /pkg/R/anova-mclogit.R: -------------------------------------------------------------------------------- 1 | anova.mclogit <- function (object, ..., dispersion = NULL, test = NULL) 2 | { 3 | dotargs <- list(...) 4 | named <- if (is.null(names(dotargs))) 5 | rep_len(FALSE, length(dotargs)) 6 | else (names(dotargs) != "") 7 | if (any(named)) 8 | warning("the following arguments to 'anova.mclogit' are invalid and dropped: ", 9 | paste(deparse(dotargs[named]), collapse = ", ")) 10 | dotargs <- dotargs[!named] 11 | is.mclogit <- vapply(dotargs, function(x) inherits(x, "mclogit") , 12 | #&!inherits(x,"mclogitRandeff"), 13 | NA) 14 | dotargs <- dotargs[is.mclogit] 15 | if (length(dotargs)) 16 | return(anova.mclogitlist(c(list(object), dotargs), dispersion = dispersion, 17 | test = test)) 18 | stop("'anova.mclogit' can only be used to compare fitted models") 19 | } 20 | 21 | anova.mclogitlist <- function (object, ..., dispersion = NULL, test = NULL) 22 | { 23 | responses <- as.character(lapply(object, function(x) { 24 | deparse(formula(x)[[2L]]) 25 | })) 26 | sameresp <- responses == responses[1L] 27 | if (!all(sameresp)) { 28 | object <- object[sameresp] 29 | warning(gettextf("models with response %s removed because response differs from model 1", 30 | sQuote(deparse(responses[!sameresp]))), domain = NA) 31 | } 32 | ns <- sapply(object, function(x) x$N) 33 | if (any(ns != ns[1L])) 34 | stop("models were not all fitted to the same size of dataset") 35 | nmodels <- length(object) 36 | if (nmodels == 1) stop("'anova.mclogit' can only be used to compare fitted models") 37 | 38 | hasRE <- sapply(object,inherits,"mmclogit") 39 | if(any(hasRE)) warning("Results are unreliable, since deviances from quasi-likelihoods are not comparable.") 40 | 41 | resdf <- as.numeric(lapply(object, function(x) x$df.residual)) 42 | resdev <- as.numeric(lapply(object, function(x) x$deviance)) 43 | table <- data.frame(resdf, resdev, c(NA, -diff(resdf)), c(NA, 44 | -diff(resdev))) 45 | variables <- lapply(object, function(x) paste(deparse(formula(x)), 46 | collapse = "\n")) 47 | dimnames(table) <- list(1L:nmodels, c("Resid. Df", "Resid. Dev", 48 | "Df", "Deviance")) 49 | title <- "Analysis of Deviance Table\n" 50 | topnote <- paste("Model ", format(1L:nmodels), ": ", variables, 51 | sep = "", collapse = "\n") 52 | if (!is.null(test)) { 53 | bigmodel <- object[[order(resdf)[1L]]] 54 | df.dispersion <- Inf 55 | table <- stat.anova(table = table, test = test, scale = 1, 56 | df.scale = df.dispersion, n = bigmodel$N) 57 | } 58 | structure(table, heading = c(title, topnote), class = c("anova", 59 | "data.frame")) 60 | } 61 | 62 | 63 | -------------------------------------------------------------------------------- /pkg/R/blockMatrices.R: -------------------------------------------------------------------------------- 1 | all_equal <- function(x) length(unique(x)) == 1 2 | 3 | blockMatrix <- function(x=list(),nrow,ncol,horizontal=TRUE){ 4 | if(!is.list(x)) x <- list(x) 5 | if(horizontal){ 6 | if(missing(nrow)) nrow <- 1 7 | if(missing(ncol)) ncol <- length(x) 8 | } 9 | else { 10 | if(missing(nrow)) nrow <- length(x) 11 | if(missing(ncol)) ncol <- 1 12 | } 13 | y <- matrix(x,nrow=nrow,ncol=ncol) 14 | ncols <- apply(y,1:2,ncol) 15 | nrows <- apply(y,1:2,nrow) 16 | ncols <- array(sapply(y,ncol),dim=dim(y)) 17 | nrows <- array(sapply(y,nrow),dim=dim(y)) 18 | nrows_equal <- apply(nrows,1,all_equal) 19 | ncols_equal <- apply(ncols,2,all_equal) 20 | if(!all(nrows_equal)) stop("Non-matching numbers of rows") 21 | if(!all(ncols_equal)) stop("Non-matching numbers of columns") 22 | structure(y,class="blockMatrix") 23 | } 24 | 25 | Ops.blockMatrix <- function(e1, e2){ 26 | if(!inherits(e1,"blockMatrix")) e1 <- blockMatrix(e1) 27 | if(!inherits(e2,"blockMatrix")) e2 <- blockMatrix(e2) 28 | stopifnot(dim(e1)==dim(e2)) 29 | d <- dim(e1) 30 | if(!(.Generic%in% c("+","-","*","=="))) 31 | stop(sQuote(.Generic)," not implemented for block matrices") 32 | res <- switch(.Generic, 33 | `+`= mapply(`+`,e1,e2,SIMPLIFY=FALSE), 34 | `-`= mapply(`-`,e1,e2,SIMPLIFY=FALSE), 35 | `*`= mapply(`*`,e1,e2,SIMPLIFY=FALSE), 36 | `==`= all(Reduce(`&`,mapply(`==`,e1,e2))) 37 | ) 38 | if(is.list(res)){ 39 | dim(res) <- d 40 | structure(res, 41 | class=class(e1)) 42 | } 43 | else res 44 | } 45 | 46 | bMatProd <- function(x,y){ 47 | if(!inherits(x,"blockMatrix")) x <- blockMatrix(x) 48 | if(!inherits(y,"blockMatrix")) y <- blockMatrix(y) 49 | dim.x <- dim(x) 50 | dim.y <- dim(y) 51 | stopifnot(dim.x[2]==dim.y[1]) 52 | m <- dim.x[1] 53 | n <- dim.y[2] 54 | q <- dim.x[2] 55 | res <- blockMatrix(nrow=m,ncol=n) 56 | for(i in 1:m) 57 | for(j in 1:n){ 58 | res[[i,j]] <- inner_p(x[i,],y[,j]) 59 | } 60 | res 61 | } 62 | 63 | bMatCrsProd <- function(x,y=NULL){ 64 | if(missing(y)) 65 | y <- x 66 | if(!inherits(x,"blockMatrix")) x <- blockMatrix(x) 67 | if(!inherits(y,"blockMatrix")) y <- blockMatrix(y) 68 | dim.x <- dim(x) 69 | dim.y <- dim(y) 70 | stopifnot(dim.x[1]==dim.y[1]) 71 | m <- dim.x[2] 72 | n <- dim.y[2] 73 | q <- dim.x[1] 74 | res <- blockMatrix(nrow=m,ncol=n) 75 | for(i in 1:m) 76 | for(j in 1:n){ 77 | res[[i,j]] <- inner_crsp(x[,i],y[,j]) 78 | } 79 | res 80 | } 81 | 82 | bMatTCrsProd <- function(x,y=NULL){ 83 | if(missing(y)) 84 | y <- x 85 | if(!inherits(x,"blockMatrix")) x <- blockMatrix(x) 86 | if(!inherits(y,"blockMatrix")) y <- blockMatrix(y) 87 | dim.x <- dim(x) 88 | dim.y <- dim(y) 89 | stopifnot(dim.x[2]==dim.y[2]) 90 | m <- dim.x[1] 91 | n <- dim.y[1] 92 | q <- dim.x[2] 93 | res <- blockMatrix(nrow=m,ncol=n) 94 | for(i in 1:m) 95 | for(j in 1:n){ 96 | res[[i,j]] <- inner_tcrsp(x[i,],y[j,]) 97 | } 98 | res 99 | } 100 | 101 | bMatTrns <- function(x){ 102 | m <- nrow(x) 103 | n <- ncol(x) 104 | res <- blockMatrix(nrow=n,ncol=m) 105 | for(i in 1:n) 106 | for(j in 1:m){ 107 | res[[i,j]] <- t(x[[j,i]]) 108 | } 109 | res 110 | } 111 | 112 | inner_p <- function(x,y){ 113 | xy <- mapply(`%*%`,x,y,SIMPLIFY=FALSE) 114 | Reduce(`+`,xy) 115 | } 116 | 117 | inner_crsp <- function(x,y){ 118 | xy <- mapply(crossprod,x,y,SIMPLIFY=FALSE) 119 | Reduce(`+`,xy) 120 | } 121 | 122 | inner_tcrsp <- function(x,y){ 123 | xy <- mapply(tcrossprod,x,y,SIMPLIFY=FALSE) 124 | Reduce(`+`,xy) 125 | } 126 | 127 | 128 | 129 | matprod1 <- function(x,y){ 130 | if(!length(x) || !length(y)) NULL 131 | else x %*% y 132 | } 133 | 134 | blockDiag <- function(x,n=length(x)){ 135 | y <- blockMatrix(nrow=n,ncol=n) 136 | i <- 1:n 137 | y[cbind(i,i)] <- x 138 | bM_fill(y) 139 | } 140 | 141 | bM_check <- function(x){ 142 | nnrow <- sapply(x,NROW) 143 | nncol <- sapply(x,NCOL) 144 | dim(nnrow) <- dim(x) 145 | dim(nncol) <- dim(x) 146 | lunq.cols <- apply(nncol,2,lunq) 147 | lunq.rows <- apply(nnrow,1,lunq) 148 | ok <- all(lunq.cols==1) && all(lunq.cols) 149 | return(ok) 150 | } 151 | 152 | bM_nrow <- function(x) sapply(x[,1],nrow) 153 | 154 | bM_ncol <- function(x) sapply(x[1,],ncol) 155 | 156 | to_bM <- function(x,nnrow,nncol){ 157 | nnrow1 <- cumsum(c(0,nnrow[-length(nnrow)])) + 1 158 | nncol1 <- cumsum(c(0,nncol[-length(nncol)])) + 1 159 | rows <- mapply(seq.int,from=nnrow1,length.out=nnrow,SIMPLIFY=FALSE) 160 | cols <- mapply(seq.int,from=nncol1,length.out=nncol,SIMPLIFY=FALSE) 161 | m <- length(nnrow) 162 | n <- length(nncol) 163 | y <- blockMatrix(nrow=m,ncol=n) 164 | for(i in 1:m) 165 | for(j in 1:n) 166 | y[i,j] <- list(Matrix(x[rows[[i]],cols[[j]]])) 167 | return(y) 168 | } 169 | 170 | bM_fill <- function(x){ 171 | nnrow <- Sapply(x,NROW) 172 | nncol <- Sapply(x,NCOL) 173 | dim(nnrow) <- dim(x) 174 | dim(nncol) <- dim(x) 175 | nnrow <- apply(nnrow,1,max) 176 | nncol <- apply(nncol,2,max) 177 | m <- nrow(x) 178 | n <- ncol(x) 179 | for(i in 1:m) 180 | for(j in 1:n){ 181 | if(is.null(x[[i,j]])){ 182 | x[[i,j]] <- Matrix(0,nnrow[i],nncol[j]) 183 | } 184 | } 185 | return(x) 186 | } 187 | 188 | solve.blockMatrix <- function(a,b,...){ 189 | nnrow.a <- bM_nrow(a) 190 | nncol.a <- bM_ncol(a) 191 | if(missing(b)){ 192 | if(!all(nnrow.a == nncol.a)) { 193 | a <- fuseMat(a) 194 | x <- solve(a) 195 | return(to_bM(x,nnrow=nnrow.a,nncol=nncol.a)) 196 | } 197 | else { 198 | x <- blk_inv.squareBlockMatrix(a) 199 | return(x) 200 | } 201 | } 202 | else { 203 | a <- fuseMat(a) 204 | nnrow.b <- bM_nrow(b) 205 | nncol.b <- bM_ncol(b) 206 | b <- fuseMat(b) 207 | x <- solve(a,b) 208 | return(to_bM(x,nnrow=nnrow.a,nncol=nncol.b)) 209 | } 210 | } 211 | 212 | format_dims <- function(x){ 213 | sprintf("<%d x %d>",nrow(x),ncol(x)) 214 | } 215 | 216 | print.blockMatrix <- function(x,quote=FALSE,...){ 217 | cat(sprintf("Block matrix with %d x %d blocks\n\n",nrow(x),ncol(x))) 218 | y <- sapply(x,format_dims) 219 | dim(y) <- dim(x) 220 | print.default(y,quote=quote,...) 221 | invisible(x) 222 | } 223 | 224 | sum_blockDiag <- function(x,n){ 225 | i <- rep(1:n,n) 226 | j <- rep(1:n,each=n) 227 | nblks <- nrow(x) %/% n 228 | offs <- rep(seq.int(from=0,to=nblks-1),each=n*n) 229 | i <- rep(i,nblks) + offs 230 | j <- rep(j,nblks) + offs 231 | y <- x[cbind(i,j)] 232 | dim(y) <- c(n*n,nblks) 233 | y <- rowSums(y) 234 | dim(y) <- c(n,n) 235 | Matrix(y) 236 | } 237 | 238 | v_bCrossprod <- function(x,d){ 239 | n <- length(x)%/%d 240 | dim(x) <- c(d,n) 241 | tcrossprod(x) 242 | } 243 | 244 | v_bQuadfm <- function(x,W){ 245 | d <- nrow(W) 246 | n <- length(x)%/%d 247 | dim(x) <- c(d,n) 248 | colSums((W%*%x)*x) 249 | } 250 | 251 | set_blockDiag <- function(x,v){ 252 | n <- ncol(v) 253 | i <- rep(1:n,n) 254 | j <- rep(1:n,each=n) 255 | nblks <- ncol(x) %/% n 256 | offs <- rep(seq.int(from=0,to=nblks-1)*n,each=n*n) 257 | i <- rep(i,nblks) + offs 258 | j <- rep(j,nblks) + offs 259 | x[cbind(i,j)] <- v 260 | return(x) 261 | } 262 | 263 | logDet_blockMatrix <- function(x){ 264 | d <- determinant(fuseMat(x),logarithm=TRUE) 265 | d$modulus 266 | } 267 | 268 | chol_blockMatrix <- function(x,resplit=TRUE){ 269 | y <- chol(fuseMat(x)) 270 | if(resplit){ 271 | nnrow <- bM_nrow(x) 272 | nncol <- bM_ncol(x) 273 | return(to_bM(y,nnrow=nnrow,nncol=nncol)) 274 | } 275 | else return(y) 276 | } 277 | 278 | kron_bM <- function(x,y){ 279 | m1 <- nrow(x) 280 | m2 <- nrow(y) 281 | n1 <- ncol(x) 282 | n2 <- ncol(y) 283 | attributes(x) <- NULL 284 | attributes(y) <- NULL 285 | lx <- length(x) 286 | ly <- length(y) 287 | x <- rep(x,each=ly) 288 | y <- rep(y,lx) 289 | xy <- mapply(`%x%`,x,y,SIMPLIFY=FALSE) 290 | blockMatrix(xy,m1*m2,n1*n2) 291 | } 292 | 293 | blk_inv.squareBlockMatrix <- function(A){ 294 | stopifnot(nrow(A)==ncol(A)) 295 | n <- nrow(A) 296 | if(n == 1) { 297 | R <- A 298 | R[[1,1]] <- solve(A[[1,1]]) 299 | return(R) 300 | } 301 | else { 302 | nnrow <- bM_nrow(A) 303 | nncol <- bM_ncol(A) 304 | stopifnot(all(nnrow==nncol)) 305 | nn <- nnrow 306 | sum_nn <- sum(nn) 307 | B <- to_bM(Diagonal(sum_nn),nn,nn) 308 | # Gauss-Jordan Phase 1 309 | for(i in seq.int(from=1,to=n-1)) { 310 | for(j in seq.int(from=i+1,to=n)){ 311 | C.ji <- A[[j,i]]%*%solve(A[[i,i]]) 312 | for(k in 1:n) { 313 | A[[j,k]] <- A[[j,k]] - C.ji%*%A[[i,k]] 314 | B[[j,k]] <- B[[j,k]] - C.ji%*%B[[i,k]] 315 | } 316 | } 317 | } 318 | # Phase 2 319 | for(i in 1:n) { 320 | A_ii <- solve(A[[i,i]]) 321 | for(j in 1:n) { 322 | A[[i,j]] <- A_ii %*% A[[i,j]] 323 | B[[i,j]] <- A_ii %*% B[[i,j]] 324 | } 325 | } 326 | # Phase 3 327 | for(i in seq.int(from=n,to=2)) { 328 | for(j in seq.int(from=1,to=i-1)){ 329 | A.ji <- A[[j,i]] 330 | for(k in 1:n) { 331 | A[[j,k]] <- A[[j,k]] - A.ji%*%A[[i,k]] 332 | B[[j,k]] <- B[[j,k]] - A.ji%*%B[[i,k]] 333 | } 334 | } 335 | } 336 | B 337 | } 338 | 339 | } -------------------------------------------------------------------------------- /pkg/R/formula-utils.R: -------------------------------------------------------------------------------- 1 | # Deparse into a single string 2 | deparse0 <- function(formula) paste(trimws(deparse(formula)),collapse=" ") 3 | 4 | # Concatenate two formulae 5 | c_formulae <- function(formula,extra){ 6 | formula.deparsed <- deparse0(formula) 7 | extra.deparsed <- sub("~","+",deparse0(extra)) 8 | as.formula(paste(formula.deparsed, 9 | extra.deparsed), 10 | env=environment(formula)) 11 | } 12 | 13 | # Check if formula 14 | is_formula <- function(x)inherits(x,"formula") 15 | 16 | # Subtitute "|" with "+" 17 | random2formula <- function(r) { 18 | formula.deparsed <- deparse0(r$formula) 19 | gf <- paste(r$groups,collapse="+") 20 | as.formula(paste(formula.deparsed, 21 | gf,sep="+"), 22 | env=environment(r$formula)) 23 | } 24 | -------------------------------------------------------------------------------- /pkg/R/getSummary-mblogit.R: -------------------------------------------------------------------------------- 1 | rbind_list <- function(x) do.call(rbind, x) 2 | 3 | getSummary.mblogit <- function(obj, 4 | alpha = .05, 5 | ...) { 6 | smry <- summary(obj) 7 | N <- obj$N 8 | coef <- smry$coefficients 9 | 10 | lower.cf <- qnorm(p = alpha / 2, mean = coef[, 1], sd = coef[, 2]) 11 | upper.cf <- qnorm(p = 1 - alpha / 2, mean = coef[, 1], sd = coef[, 2]) 12 | coef <- cbind(coef, lower.cf, upper.cf) 13 | ttl <- c("est", "se", "stat", "p", "lwr", "upr") 14 | colnames(coef) <- ttl 15 | 16 | modcat <- colnames(obj$D) 17 | basecat <- rownames(obj$D)[rownames(obj$D) %nin% modcat] 18 | 19 | eqs <- paste0(modcat, "~") 20 | 21 | rn.coef <- rownames(coef) 22 | coef.grps <- lapply(eqs, function(eq) { 23 | ii <- grep(eq, rn.coef, fixed = TRUE) 24 | coef.grp <- coef[ii, , drop = FALSE] 25 | rownames(coef.grp) <- gsub(eq, "", rownames(coef.grp), fixed = TRUE) 26 | coef.grp 27 | }) 28 | 29 | if (getOption("mblogit.show.basecat", TRUE)) { 30 | grp.titles <- paste(modcat, basecat, sep = getOption("mblogit.basecat.sep", "/")) 31 | } else { 32 | grp.titles <- modcat 33 | } 34 | 35 | names(coef.grps) <- grp.titles 36 | coef <- do.call(memisc::collect, coef.grps) 37 | 38 | VarPar <- NULL 39 | VarCov <- smry$VarCov 40 | se_VarCov <- smry$se_VarCov 41 | 42 | n.eq <- length(eqs) 43 | 44 | for (i in seq_along(VarCov)) { 45 | lv.i <- names(VarCov)[i] 46 | vc.i <- VarCov[[i]] 47 | se_vc.i <- se_VarCov[[i]] 48 | vp.i <- array(NA, c( 49 | nrow(vc.i), 50 | ncol(vc.i), 51 | 6 52 | )) 53 | vp.i[, , 1] <- vc.i 54 | vp.i[, , 2] <- se_vc.i 55 | m.i <- ncol(vc.i) %/% n.eq 56 | d <- c(n.eq, m.i) 57 | dim(vp.i) <- c(d, d, 6) 58 | vn.i <- colnames(vc.i) 59 | vn.i <- strsplit(vn.i, "~") 60 | vn.i <- unique(sapply(vn.i, "[", 2)) 61 | dn <- list(eqs, vn.i) 62 | dimnames(vp.i) <- c(dn, dn, list(ttl)) 63 | vp.i.arr <- aperm(vp.i, c(4, 2, 3, 1, 5)) 64 | 65 | # vp.i <- lapply(eqs,function(eq){ 66 | # ii <- grep(eq,dn.4,fixed=TRUE) 67 | # browser() 68 | # vp.i.grp <- vp.i[,,,ii,,drop=FALSE] 69 | # nr.i.g <- nrow(vp.i.grp) 70 | # nc.i.g <- ncol(vp.i.grp) 71 | # dn1.i.grp <- dimnames(vp.i.grp)[[1]] 72 | # dn2.i.grp <- dimnames(vp.i.grp)[[2]] 73 | # dn2.i.grp <- gsub(eq,"~",dn2.i.grp,fixed=TRUE) 74 | # dn3.i.grp <- dimnames(vp.i.grp)[[3]] 75 | # dim(vp.i.grp) <- c(nr.i.g*nc.i.g,6) 76 | # rn.i.g.1 <- rep(dn1.i.grp,nc.i.g) 77 | # rn.i.g.2 <- rep(dn2.i.grp,each=nr.i.g) 78 | # #rn.i.g <- ifelse(dn1.i.grp == dn2.i.grp,"Var","Cov") 79 | # rn.i.g <- paste0(rn.i.g.1,",",rn.i.g.2) 80 | # rownames(vp.i.grp) <- rn.i.g 81 | # colnames(vp.i.grp) <- dn3.i.grp 82 | # vp.i.grp 83 | # }) 84 | vp.i_ <- matrix(list(NULL), n.eq, n.eq) 85 | for (j in 1:n.eq) { 86 | for (k in 1:n.eq) { 87 | vp.ijk <- vp.i.arr[, , j, k, ] 88 | dim(vp.ijk) <- c(m.i^2, 6) 89 | rn.i.1 <- rep(vn.i, m.i) 90 | rn.i.2 <- rep(vn.i, each = m.i) 91 | jk.1 <- rep(1:m.i, m.i) 92 | jk.2 <- rep(1:m.i, each = m.i) 93 | rownames(vp.ijk) <- paste0("VCov(~", rn.i.1, ",", "~", rn.i.2, ")") 94 | rownames(vp.ijk)[1] <- paste0(grp.titles[j], ": ", rownames(vp.ijk)[1]) 95 | rownames(vp.ijk) <- format(rownames(vp.ijk), justify = "right") 96 | colnames(vp.ijk) <- ttl 97 | ii <- c(which(jk.1 == jk.2), which(jk.1 < jk.2)) 98 | ii <- which(jk.1 <= jk.2) 99 | vp.ijk <- vp.ijk[ii, , drop = FALSE] 100 | vp.i_[[j, k]] <- vp.ijk 101 | } 102 | } 103 | vp.i_ <- lapply(1:n.eq, function(j) do.call(rbind, vp.i_[, j])) 104 | 105 | vp.i <- list() 106 | # vp.i <- array(NA,c(dim(vp.i_[[1]]),n.eq),dimnames=c(dimnames(vp.i_[[1]]),list(grp.titles))) 107 | vp.i <- array(NA, c(dim(vp.i_[[1]]), n.eq), dimnames = c(dimnames(vp.i_[[1]]), list(NULL))) 108 | for (j in 1:n.eq) { 109 | vp.i[, , j] <- vp.i_[[j]] 110 | } 111 | VarPar <- c(VarPar, structure(list(vp.i), names = lv.i)) 112 | } 113 | 114 | 115 | phi <- smry$phi 116 | LR <- smry$null.deviance - smry$deviance 117 | df <- obj$model.df 118 | deviance <- deviance(obj) 119 | 120 | if (df > 0) { 121 | p <- pchisq(LR, df, lower.tail = FALSE) 122 | L0.pwr <- exp(-smry$null.deviance / N) 123 | LM.pwr <- exp(-smry$deviance / N) 124 | 125 | McFadden <- 1 - smry$deviance / smry$null.deviance 126 | Cox.Snell <- 1 - exp(-LR / N) 127 | Nagelkerke <- Cox.Snell / (1 - L0.pwr) 128 | } else { 129 | LR <- NA 130 | df <- NA 131 | p <- NA 132 | McFadden <- NA 133 | Cox.Snell <- NA 134 | Nagelkerke <- NA 135 | } 136 | 137 | ll <- obj$ll 138 | AIC <- AIC(obj) 139 | BIC <- AIC(obj, k = log(N)) 140 | sumstat <- c( 141 | phi = phi, 142 | LR = LR, 143 | df = df, 144 | # p = p, 145 | logLik = ll, 146 | deviance = deviance, 147 | McFadden = McFadden, 148 | Cox.Snell = Cox.Snell, 149 | Nagelkerke = Nagelkerke, 150 | AIC = AIC, 151 | BIC = BIC, 152 | N = N 153 | ) 154 | 155 | ans <- list(coef = coef) 156 | ans <- c(ans, VarPar) 157 | parameter.types <- c("coef", names(VarPar)) 158 | 159 | if(length(smry$ngrps)){ 160 | G <-as.integer(smry$ngrps) 161 | names(G) <- names(smry$ngrps) 162 | names(G) <- paste("Groups by",names(G)) 163 | G <- c(G,"Total obs."=N) 164 | 165 | sumstat <- list(sumstat,N=G) 166 | 167 | c(ans, 168 | list(sumstat=sumstat, 169 | parameter.types=parameter.types, 170 | call=obj$call, 171 | contrasts = obj$contrasts, 172 | xlevels = obj$xlevels)) 173 | } 174 | else { 175 | 176 | sumstat <- c(sumstat,N=N) 177 | c(ans, 178 | list(sumstat=sumstat, 179 | call=obj$call, 180 | contrasts = obj$contrasts, 181 | xlevels = obj$xlevels)) 182 | } 183 | 184 | } 185 | 186 | getSummary.mmblogit <- getSummary.mblogit 187 | -------------------------------------------------------------------------------- /pkg/R/getSummary-mclogit.R: -------------------------------------------------------------------------------- 1 | getSummary.mclogit <- function(obj, 2 | alpha=.05, 3 | rearrange=NULL, 4 | ...){ 5 | 6 | smry <- summary(obj) 7 | N <- obj$N 8 | coef <- smry$coefficients 9 | varPar <- smry$varPar 10 | 11 | lower.cf <- qnorm(p=alpha/2,mean=coef[,1],sd=coef[,2]) 12 | upper.cf <- qnorm(p=1-alpha/2,mean=coef[,1],sd=coef[,2]) 13 | coef <- cbind(coef,lower.cf,upper.cf) 14 | colnames(coef) <- c("est","se","stat","p","lwr","upr") 15 | if(length(rearrange)){ 16 | coef.grps <- lapply(rearrange,function(ii){ 17 | if(is.character(ii) && !all(ii %in% rownames(coef))) 18 | stop("coefficient(s) ",dQuote(unname(ii[!(ii %in% rownames(coef))]))," do not exist") 19 | structure(coef[ii,], 20 | dimnames=list(names(ii),dimnames(coef)[[2]]) 21 | ) 22 | }) 23 | grp.titles <- names(rearrange) 24 | coef.grps <- do.call(memisc::collect,coef.grps) 25 | coef <- array(NA,dim=c( 26 | dim(coef.grps)[1] + NROW(varPar), 27 | dim(coef.grps)[2], 28 | dim(coef.grps)[3] 29 | )) 30 | coef[seq(dim(coef.grps)[1]),,] <- coef.grps 31 | if(length(varPar)) 32 | coef[dim(coef.grps)[1]+seq(nrow(varPar)),,1] <- varPar 33 | dimnames(coef) <- list( 34 | c(dimnames(coef.grps)[[1]],rownames(varPar)), 35 | dimnames(coef.grps)[[2]], 36 | grp.titles 37 | ) 38 | } 39 | 40 | VarPar <- NULL 41 | VarCov <- smry$VarCov 42 | se_VarCov <- smry$se_VarCov 43 | 44 | for(i in seq_along(VarCov)){ 45 | lv.i <- names(VarCov)[i] 46 | vc.i <- VarCov[[i]] 47 | vr.i <- diag(vc.i) 48 | cv.i <- vc.i[lower.tri(vc.i)] 49 | se_vc.i <- se_VarCov[[i]] 50 | se_vr.i <- diag(se_vc.i) 51 | se_cv.i <- se_vc.i[lower.tri(se_vc.i)] 52 | nms.i <- rownames(vc.i) 53 | nms.i <- gsub("(Intercept)","1",nms.i,fixed=TRUE) 54 | vrnames.i <- paste0("Var(~",nms.i,"|",lv.i,")") 55 | cvnames.i <- t(outer(nms.i,nms.i,FUN=paste,sep=":")) 56 | cvnames.i <- cvnames.i[lower.tri(cvnames.i)] 57 | if(length(cvnames.i)) 58 | cvnames.i <- paste0("Cov(~",cvnames.i,"|",lv.i,")") 59 | vp.i <- matrix(NA,nrow=length(vr.i)+length(cv.i),ncol=6) 60 | vp.i[,1] <- c(vr.i,cv.i) 61 | vp.i[,2] <- c(se_vr.i,se_cv.i) 62 | dimnames(vp.i) <- list(c(vrnames.i,cvnames.i), 63 | c("est","se","stat","p","lwr","upr")) 64 | VarPar <- c(VarPar,structure(list(vp.i),names=lv.i)) 65 | } 66 | 67 | phi <- smry$phi 68 | LR <- smry$null.deviance - smry$deviance 69 | df <- obj$model.df 70 | deviance <- deviance(obj) 71 | 72 | 73 | if(df > 0){ 74 | p <- pchisq(LR,df,lower.tail=FALSE) 75 | L0.pwr <- exp(-smry$null.deviance/N) 76 | LM.pwr <- exp(-smry$deviance/N) 77 | 78 | McFadden <- 1- smry$deviance/smry$null.deviance 79 | Cox.Snell <- 1 - exp(-LR/N) 80 | Nagelkerke <- Cox.Snell/(1-L0.pwr) 81 | } 82 | else { 83 | LR <- NA 84 | df <- NA 85 | p <- NA 86 | McFadden <- NA 87 | Cox.Snell <- NA 88 | Nagelkerke <- NA 89 | } 90 | 91 | ll <- obj$ll 92 | AIC <- AIC(obj) 93 | BIC <- AIC(obj,k=log(N)) 94 | sumstat <- c( 95 | phi = phi, 96 | LR = LR, 97 | df = df, 98 | #p = p, 99 | logLik = ll, 100 | deviance = deviance, 101 | McFadden = McFadden, 102 | Cox.Snell = Cox.Snell, 103 | Nagelkerke = Nagelkerke, 104 | AIC = AIC, 105 | BIC = BIC, 106 | N = N 107 | ) 108 | 109 | ans <- list(coef= coef) 110 | ans <- c(ans,VarPar) 111 | parameter.types <- c("coef", names(VarPar)) 112 | 113 | if(length(smry$ngrps)){ 114 | G <-as.integer(smry$ngrps) 115 | names(G) <- names(smry$ngrps) 116 | names(G) <- paste("Groups by",names(G)) 117 | G <- c(G,"Total obs."=N) 118 | 119 | sumstat <- list(sumstat,N=G) 120 | 121 | c(ans, 122 | list(sumstat=sumstat, 123 | parameter.types=parameter.types, 124 | call=obj$call, 125 | contrasts = obj$contrasts, 126 | xlevels = obj$xlevels)) 127 | } 128 | else { 129 | 130 | sumstat <- c(sumstat,N=N) 131 | c(ans, 132 | list(sumstat=sumstat, 133 | call=obj$call, 134 | contrasts = obj$contrasts, 135 | xlevels = obj$xlevels)) 136 | } 137 | } 138 | 139 | getSummary.mmclogit <- getSummary.mclogit 140 | -------------------------------------------------------------------------------- /pkg/R/mclogit-dispersion.R: -------------------------------------------------------------------------------- 1 | mclogit.dispersion <- function(y,w,s,pi,coef,method){ 2 | N <- length(w) 3 | n <- length(unique(s)) 4 | p <- length(coef) 5 | res.df <- N - n - p 6 | if(method=="Deviance"){ 7 | Dresid <- 2*w*y*(log(y)-log(pi)) 8 | Dresid[w==0 | y== 0] <- 0 9 | D <- sum(Dresid) 10 | phi <- D/res.df 11 | } 12 | else { 13 | X2 <- sum(w*(y - pi)^2/pi) 14 | phi.pearson <- X2/(N - n - p) 15 | if(method %in% c("Afroz","Fletcher")) 16 | s.bar <- sum((y - pi)/pi)/(N - n) 17 | phi <- switch(method, 18 | Pearson = phi.pearson, 19 | Afroz = phi.pearson/(1 + s.bar), 20 | Fletcher = phi.pearson - (N - n)*s.bar/(N - n - p)) 21 | } 22 | return(phi) 23 | } 24 | 25 | update_mclogit_dispersion <- function(object,dispersion){ 26 | 27 | if(!isFALSE(dispersion)){ 28 | if(is.numeric(dispersion)) 29 | phi <- dispersion 30 | else { 31 | if(isTRUE(dispersion)) 32 | method <- "Afroz" 33 | else 34 | method <- match.arg(dispersion, 35 | c("Afroz", 36 | "Fletcher", 37 | "Pearson", 38 | "Deviance")) 39 | phi <- dispersion(object,method=method) 40 | } 41 | } 42 | else phi <- 1 43 | 44 | object$phi <- phi 45 | return(object) 46 | } 47 | 48 | dispersion <- function(object,method,...) 49 | UseMethod("dispersion") 50 | 51 | dispersion.mclogit <- function(object,method=NULL,...){ 52 | if(is.null(method)) 53 | return(object$phi) 54 | else { 55 | y <- object$y 56 | s <- object$s 57 | w <- object$weights 58 | pi <- object$fitted.values 59 | coef <- object$coefficients 60 | method <- match.arg(method,c("Afroz", 61 | "Fletcher", 62 | "Pearson", 63 | "Deviance")) 64 | phi <- mclogit.dispersion(y,w,s,pi,coef, 65 | method=method) 66 | return(phi) 67 | } 68 | } 69 | -------------------------------------------------------------------------------- /pkg/R/mclogit-fit.R: -------------------------------------------------------------------------------- 1 | mclogit.fit <- function( 2 | y, 3 | s, 4 | w, 5 | X, 6 | dispersion=FALSE, 7 | start=NULL, 8 | offset=NULL, 9 | control=mclogit.control() 10 | ){ 11 | 12 | nvar <- ncol(X) 13 | nobs <- length(y) 14 | if(!length(offset)) 15 | offset <- rep.int(0, nobs) 16 | if(length(start)){ 17 | stopifnot(length(start)==ncol(X)) 18 | eta <- c(X%*%start) + offset 19 | } 20 | else 21 | eta <- mclogitLinkInv(y,s,w) 22 | pi <- mclogitP(eta,s) 23 | dev.resids <- ifelse(y>0, 24 | 2*w*y*(log(y)-log(pi)), 25 | 0) 26 | deviance <- sum(dev.resids) 27 | if(length(start)) 28 | coef <- start 29 | else coef <- NULL 30 | converged <- FALSE 31 | for(iter in 1:control$maxit){ 32 | y.star <- eta - offset + (y-pi)/pi 33 | yP.star <- y.star - rowsum(pi*y.star,s)[s] 34 | XP <- X - as.matrix(rowsum(pi*X,s))[s,,drop=FALSE] 35 | ww <- w*pi 36 | good <- ww > 0 & is.finite(yP.star) 37 | wlsFit <- lm.wfit(x=XP[good,,drop=FALSE],y=yP.star[good],w=ww[good]) 38 | last.coef <- coef 39 | coef <- wlsFit$coefficients 40 | eta <- c(X%*%coef) + offset 41 | pi <- mclogitP(eta,s) 42 | last.deviance <- deviance 43 | dev.resids <- ifelse(y>0, 44 | 2*w*y*(log(y)-log(pi)), 45 | 0) 46 | deviance <- sum(dev.resids) 47 | ## check for divergence 48 | boundary <- FALSE 49 | if(!is.finite(deviance) || deviance > last.deviance && iter > 1){ 50 | if(is.null(last.coef)) 51 | stop("no valid set of coefficients has been found: please supply starting values", call. = FALSE) 52 | warning("step size truncated due to divergence", call. = FALSE) 53 | ii <- 1 54 | while (!is.finite(deviance) || deviance > last.deviance){ 55 | if(ii > control$maxit) 56 | stop("inner loop; cannot correct step size") 57 | ii <- ii + 1 58 | coef <- (coef + last.coef)/2 59 | eta <- c(X %*% coef) + offset 60 | pi <- mclogitP(eta,s) 61 | dev.resids <- ifelse(y>0,2*w*y*(log(y)-log(pi)),0) 62 | deviance <- sum(dev.resids) 63 | } 64 | boundary <- TRUE 65 | if (control$trace) 66 | cat("Step halved: new deviance =", deviance, "\n") 67 | } ## inner loop 68 | crit <- abs(deviance-last.deviance)/abs(0.1+deviance) 69 | if(control$trace) 70 | cat("\nIteration",iter,"- deviance =",deviance,"- criterion =",crit) 71 | if(crit < control$eps){ 72 | converged <- TRUE 73 | if(control$trace) 74 | cat("\nconverged\n") 75 | break 76 | } 77 | } 78 | if (!converged) warning("algorithm did not converge",call.=FALSE) 79 | if (boundary) warning("algorithm stopped at boundary value",call.=FALSE) 80 | eps <- 10*.Machine$double.eps 81 | if (any(pi < eps) || any(1-pi < eps)) 82 | warning("fitted probabilities numerically 0 occurred",call.=FALSE) 83 | 84 | XP <- X - as.matrix(rowsum(pi*X,s))[s,,drop=FALSE] 85 | ww <- w*pi 86 | XWX <- crossprod(XP,ww*XP) 87 | 88 | ntot <- length(y) 89 | pi0 <- mclogitP(offset,s) 90 | null.deviance <- sum(ifelse(y>0, 91 | 2*w*y*(log(y)-log(pi0)), 92 | 0)) 93 | resid.df <- length(y)-length(unique(s)) 94 | model.df <- ncol(X) 95 | resid.df <- resid.df - model.df 96 | ll <- mclogit.logLik(y,pi,w) 97 | 98 | if(!isFALSE(dispersion)){ 99 | if(isTRUE(dispersion)) 100 | odisp.method <- "Afroz" 101 | else 102 | odisp.method <- match.arg(dispersion, 103 | c("Afroz", 104 | "Fletcher", 105 | "Pearson", 106 | "Deviance")) 107 | phi <- mclogit.dispersion(y,w,s,pi,coef,method=odisp.method) 108 | } 109 | else phi <- 1 110 | 111 | 112 | return(list( 113 | coefficients = drop(coef), 114 | phi = phi, 115 | linear.predictors = eta, 116 | working.residuals = (y-pi)/pi, 117 | response.residuals = y-pi, 118 | df.residual = resid.df, 119 | model.df = model.df, 120 | fitted.values = pi, 121 | deviance=deviance, 122 | ll=ll, 123 | deviance.residuals=dev.resids, 124 | null.deviance=null.deviance, 125 | iter = iter, 126 | y = y, 127 | s = s, 128 | offset = offset, 129 | converged = converged, 130 | control=control, 131 | information.matrix=XWX 132 | )) 133 | } 134 | 135 | 136 | 137 | mclogit.control <- function( 138 | epsilon = 1e-08, 139 | maxit = 25, 140 | trace=TRUE 141 | ) { 142 | if (!is.numeric(epsilon) || epsilon <= 0) 143 | stop("value of epsilon must be > 0") 144 | if (!is.numeric(maxit) || maxit <= 0) 145 | stop("maximum number of iterations must be > 0") 146 | list(epsilon = epsilon, maxit = maxit, trace = trace) 147 | } 148 | 149 | log.Det <- function(x) determinant(x,logarithm=TRUE)$modulus 150 | 151 | mclogitP <- function(eta,s){ 152 | expeta <- exp(eta) 153 | sum.expeta <- rowsum(expeta,s) 154 | expeta/sum.expeta[s] 155 | } 156 | 157 | # mclogit.dev.resids <- function(y,p,w) 158 | # ifelse(y>0, 159 | # 2*w*y*(log(y)-log(p)), 160 | # 0) 161 | 162 | mclogit.logLik <- function(y,p,w) sum(w*y*log(p)) 163 | 164 | 165 | mclogitLinkInv <- function(y,s,w){ 166 | #n.alt <- tapply(y,s,length) 167 | #c(log(sqrt(w)*y+1/n.alt[s])-log(w)/2) 168 | n <- w*y+0.5 169 | f <- n/(rowsum(n,s)[s]) 170 | log(f) - ave(log(f),s) 171 | } 172 | 173 | -------------------------------------------------------------------------------- /pkg/R/mclogit-rebase.R: -------------------------------------------------------------------------------- 1 | 2 | get_categs <- function(object){ 3 | D <- object$D 4 | rownames(D) 5 | } 6 | 7 | get_baseline_cat <- function(object){ 8 | D <- object$D 9 | j <- which(!rownames(D)%in%colnames(D)) 10 | rownames(D)[j] 11 | } 12 | 13 | rebase_mat <- function(categs,from,to){ 14 | m <- length(categs) 15 | j <- match(from,categs) 16 | k <- match(to,categs) 17 | res <- diag(nrow=m) 18 | dimnames(res) <- list(categs,categs) 19 | res[,k] <- -1 20 | res <- res[,-j] 21 | res <- res[-k,] 22 | res 23 | } 24 | 25 | 26 | #' Change baseline category of multinomial logit or similar model 27 | #' 28 | #' `rebase` returns an model object that is equivalent to the one 29 | #' given as argument but differs in parameterization 30 | #' 31 | #' @param object a statistical model object 32 | #' @param to usually, a string; the baseline category 33 | #' @param ... other arguments, currently ignored 34 | rebase <- function(object,to,...) UseMethod("rebase") 35 | 36 | #' @rdname rebase 37 | rebase.mblogit <- function(object,to,...){ 38 | categs <- get_categs(object) 39 | m <- length(categs) 40 | from <- get_baseline_cat(object) 41 | TMat <- rebase_mat(categs,from=from,to=to) 42 | coefmat <- object$coefmat 43 | p <- ncol(coefmat) 44 | coefmat.new <- TMat%*%coefmat 45 | coefficients.new <- as.vector(coefmat.new) 46 | coefficients.new.names <- outer(rownames(coefmat.new),colnames(coefmat.new),paste,sep="~") 47 | coefficients.new.names <- as.vector(coefficients.new.names) 48 | names(coefficients.new) <- coefficients.new.names 49 | iTMat <- rebase_mat(categs,from=to,to=from) 50 | iMMat <- diag(p)%x%t(iTMat) 51 | info.matrix <- object$information.matrix 52 | info.matrix.new <- iMMat%*%info.matrix%*%t(iMMat) 53 | dimnames(info.matrix.new) <- list(coefficients.new.names, 54 | coefficients.new.names) 55 | D.new <- diag(m) 56 | dimnames(D.new) <- list(categs,categs) 57 | D.new <- D.new[,-match(to,categs)] 58 | object.new <- object 59 | object.new$coefmat <- coefmat.new 60 | object.new$coefficients <- coefficients.new 61 | object.new$information.matrix <- info.matrix.new 62 | object.new$D <- D.new 63 | object.new 64 | } 65 | -------------------------------------------------------------------------------- /pkg/R/mmclogit-fitPQLMQL.R: -------------------------------------------------------------------------------- 1 | mmclogit.fitPQLMQL <- function( 2 | y, 3 | s, 4 | w, 5 | X, 6 | Z, 7 | d, 8 | start = NULL, 9 | start.Phi = NULL, 10 | start.b = NULL, 11 | offset = NULL, 12 | method = c("PQL","MQL"), 13 | estimator = c("ML","REML"), 14 | control=mmclogit.control() 15 | ){ 16 | method <- match.arg(method) 17 | estimator <- match.arg(estimator) 18 | 19 | nvar <- ncol(X) 20 | nobs <- length(y) 21 | nsets <- length(unique(s)) 22 | nlevs <- length(Z) 23 | m <- sapply(Z,ncol)/d 24 | 25 | sqrt.w <- sqrt(w) 26 | 27 | i <- 1:nobs 28 | 29 | if(!length(offset)) 30 | offset <- rep.int(0, nobs) 31 | if(length(start)){ 32 | stopifnot(length(start)==ncol(X)) 33 | eta <- c(X%*%start) + offset 34 | if(method=="PQL"){ 35 | if(length(start.b) == nlevs){ 36 | for(k in 1:nlevs) 37 | eta <- eta + as.vector(Z[[k]]%*%start.b[[k]]) 38 | } 39 | else stop("PQL requires starting values for random effects") 40 | } 41 | } 42 | else 43 | eta <- mclogitLinkInv(y,s,w) 44 | pi <- mclogitP(eta,s) 45 | dev.resids <- ifelse(y>0, 46 | 2*w*y*(log(y)-log(pi)), 47 | 0) 48 | deviance <- sum(dev.resids) 49 | 50 | # Outer iterations: update non-linear part of the model 51 | converged <- FALSE 52 | fit <- NULL 53 | do.backup <- FALSE 54 | step.truncated <- FALSE 55 | 56 | msg <- "Random effects design matrix at index %d has fewer rows than columns (%d < %d). 57 | This will almost certainly lead to noncovergence or other numerical problems. 58 | Please reconsider your model specification." 59 | 60 | for(k in 1:nlevs){ 61 | Z.k <- Z[[k]] 62 | if(nrow(Z.k) < ncol(Z.k)) 63 | warning(sprintf(msg,k,nrow(Z.k),ncol(Z.k))) 64 | } 65 | parms <- NULL 66 | last.parms <- NULL 67 | last.deviance <- deviance 68 | prev.last.deviance <- NULL 69 | last.eta <- eta 70 | 71 | model.struct <- list(y=y, 72 | s=s, 73 | nsets=nsets, 74 | nobs=nobs, 75 | i=i, 76 | w=w, 77 | sqrt.w=sqrt.w, 78 | offset=offset, 79 | X=X, 80 | Z=Z, 81 | d=d, 82 | m=m, 83 | nlevs=nlevs) 84 | 85 | parms$coefficients <- list(fixed=start, 86 | random=start.b) 87 | parms$Phi <- start.Phi 88 | for(iter in 1:control$maxit){ 89 | 90 | W <- Matrix(0,nrow=nobs,ncol=nsets) 91 | W[cbind(i,s)] <- sqrt.w*pi 92 | W <- Diagonal(x=w*pi)-tcrossprod(W) 93 | 94 | y.star <- eta - offset + (y-pi)/pi 95 | 96 | # cat("\n") 97 | # print(head(y.star)) 98 | 99 | prev.last.parms <- last.parms 100 | last.parms <- parms 101 | 102 | aux <- list(y=y.star,W=W) 103 | 104 | parms <- PQLMQL_innerFit(parms,aux,model.struct,method,estimator,control) 105 | 106 | step.back <- FALSE 107 | if(inherits(parms,"try-error")){ 108 | if(length(prev.last.deviance) && 109 | last.deviance > prev.last.deviance && 110 | length(prev.last.parms)){ 111 | # Previous step increased the deviance, so we better step back twice 112 | warning("Numeric problems in inner iteration and previous step increased deviance, 113 | stepping back twice") 114 | parms <- prev.last.parms 115 | } 116 | else { # Previous step decreased the deviance 117 | warning("Numeric problems in inner iteration, stepping back") 118 | parms <- last.parms 119 | } 120 | step.back <- TRUE 121 | } 122 | 123 | last.fit <- fit 124 | fit <- PQLMQL_eval_parms(parms,model.struct,method,estimator) 125 | 126 | deviance <- fit$deviance 127 | if(control$trace){ 128 | cat("\nIteration",iter,"- deviance =",deviance) 129 | } 130 | 131 | if(is.finite(deviance)){ 132 | if(deviance > last.deviance && control$break.on.increase){ 133 | warning("Cannot decrease the deviance, stepping back",call.=FALSE) 134 | step.back <- TRUE 135 | parms <- last.parms 136 | fit <- last.fit 137 | deviance <- fit$deviance 138 | } 139 | if(deviance < 0 && control$break.on.negative){ 140 | warning("Negative deviance, backing up",call.=FALSE) 141 | step.back <- TRUE 142 | parms <- last.parms 143 | fit <- last.fit 144 | deviance <- fit$deviance 145 | } 146 | } 147 | else if(!is.finite(deviance)){ 148 | warning("Non-finite deviance, backing up",call.=FALSE) 149 | step.back <- TRUE 150 | parms <- last.parms 151 | fit <- last.fit 152 | deviance <- fit$deviance 153 | 154 | } 155 | 156 | eta <- fit$eta 157 | pi <- fit$pi 158 | coef <- parms$coefficients$fixed 159 | Phi <- parms$Phi 160 | # print(start) 161 | # print(coef) 162 | # print(start.Phi) 163 | # print(Phi) 164 | if(step.back) { 165 | if(control$trace) 166 | cat(" - new deviance = ",deviance) 167 | break 168 | } 169 | else { 170 | if(length(last.fit)) 171 | last.eta <- last.fit$eta 172 | crit <- sum((eta - last.eta)^2) /sum(eta^2) 173 | 174 | if(control$trace) 175 | cat(" - criterion =",crit) 176 | 177 | if(crit <= control$eps){ 178 | converged <- TRUE 179 | if(control$trace) 180 | cat("\nconverged\n") 181 | break 182 | } 183 | } 184 | } 185 | if(!converged && !step.back){ 186 | # if(control$trace) cat("\n") 187 | warning("Algorithm did not converge",call.=FALSE) 188 | } 189 | if(step.back){ 190 | # if(control$trace) cat("\n") 191 | warning("Algorithm stopped without convergence",call.=FALSE) 192 | } 193 | eps <- 10*.Machine$double.eps 194 | if (any(pi < eps) || any(1-pi < eps)){ 195 | # if(control$trace) cat("\n") 196 | warning("Fitted probabilities numerically 0 or 1 occurred",call.=FALSE) 197 | } 198 | if(deviance < 0){ 199 | # if(control$trace) cat("\n") 200 | warning("Approximate deviance is negative.\nYou might be overfitting your data or the group size is too small.",call.=FALSE) 201 | } 202 | 203 | ntot <- length(y) 204 | pi0 <- mclogitP(offset,s) 205 | null.deviance <- sum(ifelse(y>0, 206 | 2*w*y*(log(y)-log(pi0)), 207 | 0)) 208 | resid.df <- length(y) - length(unique(s)) 209 | model.df <- ncol(X) + length(parms$lambda) 210 | resid.df <- resid.df - model.df 211 | 212 | return( 213 | list( 214 | coefficients = parms$coefficients$fixed, 215 | random.effects = parms$coefficients$random, 216 | VarCov = parms$Phi, 217 | lambda = parms$lambda, 218 | linear.predictors = eta, 219 | working.residuals = (y-pi)/pi, 220 | response.residuals = y-pi, 221 | df.residual = resid.df, 222 | model.df = model.df, 223 | deviance=deviance, 224 | deviance.residuals=dev.resids, 225 | null.deviance=null.deviance, 226 | method = method, 227 | estimator = estimator, 228 | iter = iter, 229 | y = y, 230 | s = s, 231 | offset = offset, 232 | converged = converged, 233 | control=control, 234 | info.coef = parms$info.fixed, 235 | info.fixed.random = parms$info.fixed.random, 236 | info.lambda = parms$info.lambda, 237 | info.psi = parms$info.psi 238 | )) 239 | } 240 | 241 | matrank <- function(x) { 242 | qr(x)$rank 243 | } 244 | 245 | 246 | PQLMQL_innerFit <- function(parms,aux,model.struct,method,estimator,control){ 247 | 248 | m <- model.struct$m 249 | d <- model.struct$d 250 | nlevs <- model.struct$nlevs 251 | X <- model.struct$X 252 | Z <- model.struct$Z 253 | 254 | y <- aux$y 255 | W <- aux$W 256 | 257 | # Naive starting values 258 | Wy <- W%*%y 259 | WX <- W%*%X 260 | XWX <- crossprod(X,WX) 261 | XWy <- crossprod(X,Wy) 262 | yWy <- crossprod(y,Wy) 263 | 264 | alpha.start <- parms$coefficients$fixed 265 | Phi.start <- parms$Phi 266 | 267 | if(!length(alpha.start)) 268 | alpha.start <- solve(XWX,XWy) 269 | 270 | y_Xalpha <- as.vector(y - X%*%alpha.start) 271 | 272 | if(!length(Phi.start)){ 273 | Phi.start <- list() 274 | for(k in 1:nlevs){ 275 | Z.k <- Z[[k]] 276 | ZZ.k <- crossprod(Z.k) 277 | Zy_Xa.k <- crossprod(Z.k,y_Xalpha) 278 | ZZ.k <- ZZ.k + Diagonal(ncol(ZZ.k)) 279 | b.k <- solve(ZZ.k,Zy_Xa.k) 280 | m.k <- m[k] 281 | d.k <- d[k] 282 | dim(b.k) <- c(d.k,m.k) 283 | dimnames(b.k) <- NULL 284 | S.k <- tcrossprod(b.k) 285 | if(matrank(S.k) < d.k){ 286 | #warning(sprintf("Singular initial covariance matrix at level %d in inner fitting routine",k)) 287 | S.k <- diag(S.k) 288 | S.k <- diag(x=S.k,nrow=d) 289 | } 290 | Phi.start[[k]] <- S.k/(m.k-1) 291 | } 292 | } 293 | Psi.start <- lapply(Phi.start,safeInverse) 294 | Lambda.start <- lapply(Psi.start,chol) 295 | lambda.start <- unlist(lapply(Lambda.start,uvech)) 296 | 297 | WZ <- bMatProd(W,Z) 298 | ZWZ <- bMatCrsProd(WZ,Z) 299 | ZWX <- bMatCrsProd(WZ,X) 300 | ZWy <- bMatCrsProd(WZ,y) 301 | 302 | aux <- list(yWy=yWy, 303 | XWy=XWy, 304 | ZWy=ZWy, 305 | XWX=XWX, 306 | ZWX=ZWX, 307 | ZWZ=ZWZ) 308 | 309 | if(control$trace.inner) cat("\n") 310 | 311 | devfunc <- function(lambda) 312 | -2*as.vector(PQLMQL_pseudoLogLik(lambda, 313 | model.struct=model.struct, 314 | estimator=estimator, 315 | aux=aux)$logLik) 316 | gradfunc <- function(lambda) 317 | -2*as.vector(PQLMQL_pseudoLogLik(lambda, 318 | model.struct=model.struct, 319 | estimator=estimator, 320 | aux=aux, 321 | gradient=TRUE)$gradient) 322 | 323 | if(control$inner.optimizer=="nlminb"){ 324 | 325 | res.port <- nlminb(lambda.start, 326 | objective = devfunc, 327 | gradient = if(control$use.gradient == "analytic") gradfunc, 328 | control = list(trace = as.integer(control$trace.inner), 329 | iter.max=control$maxit.inner) 330 | ) 331 | if(res.port$convergence != 0){ 332 | cat("\n") 333 | warning(sprintf("Possible non-convergence of inner iterations - nlminb message: %s",res.port$message), 334 | call.=FALSE,immediate.=TRUE) 335 | } 336 | 337 | lambda <- res.port$par 338 | } 339 | else if(control$inner.optimizer=="nlm") { 340 | 341 | # 'nlminb' seems to be more stable - but this allows to check the analyticals. 342 | 343 | dev_f <- function(lambda){ 344 | res <- PQLMQL_pseudoLogLik(lambda, 345 | model.struct=model.struct, 346 | estimator=estimator, 347 | aux=aux, 348 | gradient=TRUE) 349 | structure(-2*res$logLik, 350 | gradient=if(control$use.gradient == "analytic") -2*res$gradient) 351 | } 352 | 353 | res.nlm <- nlm(f = dev_f, 354 | p = lambda.start, 355 | check.analyticals = TRUE, 356 | print.level = if(control$trace.inner) 2 else 0, 357 | iterlim = control$maxit.inner) 358 | 359 | if(res.nlm$code > 2){ 360 | nlm.messages <- c("","", 361 | paste("Last global step failed to locate a point lower than", 362 | "'estimate'. Either 'estimate' is an approximate local", 363 | "minimum of the function or 'steptol' is too small.",sep="\n"), 364 | "Iteration limit exceeded.", 365 | paste("Maximum step size 'stepmax' exceeded five consecutive", 366 | "times. Either the function is unbounded below, becomes", 367 | "asymptotic to a finite value from above in some direction", 368 | "or 'stepmax' is too small.",sep="\n")) 369 | retcode <- res.nlm$code 370 | cat("\n") 371 | warning(sprintf("Possible non-convergence of inner iterations - nlm code indicates:\n %s", 372 | nlm.messages[retcode]), 373 | call.=FALSE,immediate.=TRUE) 374 | } 375 | lambda <- res.nlm$estimate 376 | } else if(control$inner.optimizer %in% 377 | c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN")){ 378 | optim.method <- control$inner.optimizer 379 | optim.control <- list( 380 | trace = as.integer(control$trace.inner), 381 | maxit = control$maxit.inner, 382 | REPORT = switch(control$inner.optimizer, 383 | SANN = 100, 384 | `Nelder-Mead` = 100, 385 | 1), 386 | type = if(optim.method == "CG") control$CG.type, 387 | alpha = if(optim.method == "Nelder-Mead") control$NM.alpha, 388 | beta = if(optim.method == "Nelder-Mead") control$NM.beta, 389 | gamma = if(optim.method == "Nelder-Mead") control$NM.gamma, 390 | temp = if(optim.method == "SANN") control$SANN.temp, 391 | tmax = if(optim.method == "SANN") control$SANN.tmax 392 | ) 393 | res.optim <- optim(par = lambda.start, 394 | fn = devfunc, 395 | gr = if(control$use.gradient == "analytic") gradfunc, 396 | method = optim.method, 397 | control = optim.control 398 | ) 399 | if(res.optim$convergence > 0){ 400 | cat("\n") 401 | if(res.optim$convergence == 1) 402 | warning("Inner iterations did not converge", 403 | call.=FALSE,immediate.=TRUE) 404 | if(res.optim$convergence == 10) 405 | warning("Degeneracy of the Nelder-Mead simplex", 406 | call.=FALSE,immediate.=TRUE) 407 | if(length(res.optim$message)) 408 | warning(sprintf("Message from 'optim':\n%s", 409 | res.optim$message), 410 | call.=FALSE,immediate.=TRUE) 411 | } 412 | lambda <- res.optim$par 413 | } 414 | else if(control$inner.optimizer == "ucminf" && 415 | requireNamespace("ucminf", quietly = TRUE)){ 416 | ucminf.control <- list( 417 | trace = as.integer(control$trace.inner) 418 | ) 419 | for(nn in c("grtol","xtol","stepmax","maxeval","grad")) 420 | if(length(control[nn])) ucminf.control[[nn]] <- control[[nn]] 421 | res.ucminf <- ucminf::ucminf(par = lambda.start, 422 | fn = devfunc, 423 | gr = if(control$use.gradient == "analytic") gradfunc, 424 | control = ucminf.control 425 | ) 426 | if(res.ucminf$convergence > 2){ 427 | cat("\n") 428 | if(length(res.ucminf$message)) 429 | warning(sprintf("Message from 'ucminf':\n%s", 430 | res.ucminf$message), 431 | call.=FALSE,immediate.=TRUE) 432 | } 433 | else if(ucminf.control$trace > 0){ 434 | cat("\n") 435 | if(length(res.ucminf$message)) 436 | message(sprintf("Message from 'ucminf':\n%s", 437 | res.ucminf$message)) 438 | } 439 | lambda <- res.ucminf$par 440 | } 441 | else 442 | stop(sprintf("Unknown optimizer '%s'",control$inner.optimizer)) 443 | 444 | info.varPar <- PQLMQL_pseudoLogLik(lambda, 445 | model.struct=model.struct, 446 | estimator=estimator, 447 | aux=aux, 448 | info.lambda=TRUE, 449 | info.psi=TRUE)$info 450 | 451 | Lambda <- lambda2Mat(lambda,m,d) 452 | Psi <- lapply(Lambda,crossprod) 453 | iSigma <- Psi2iSigma(Psi,m) 454 | Phi <- lapply(Psi,safeInverse) 455 | 456 | ZWZiSigma <- ZWZ + iSigma 457 | if(getOption("mclogit.use_blkinv", TRUE)) { 458 | K <- blk_inv.squareBlockMatrix(ZWZiSigma) 459 | } 460 | else { 461 | K <- solve(ZWZiSigma) 462 | } 463 | 464 | 465 | log.det.iSigma <- Lambda2log.det.iSigma(Lambda,m) 466 | 467 | log.det.ZWZiSigma <- 2*sum(log(diag(chol_blockMatrix(ZWZiSigma,resplit=FALSE)))) 468 | 469 | XiVX <- XWX - fuseMat(bMatCrsProd(ZWX,bMatProd(K,ZWX))) 470 | XiVy <- XWy - fuseMat(bMatCrsProd(ZWX,bMatProd(K,ZWy))) 471 | 472 | alpha <- solve(XiVX,XiVy) 473 | alpha <- drop(as.matrix(alpha)) 474 | b <- bMatProd(K,ZWy-bMatProd(ZWX,alpha)) 475 | b[] <- lapply(b[],as.matrix) 476 | 477 | XZWiSZX <- structure(rbind(cbind(blockMatrix(XWX),bMatTrns(ZWX)), 478 | cbind(ZWX,ZWZiSigma)),class="blockMatrix") 479 | 480 | list( 481 | lambda = lambda, 482 | coefficients = list(fixed = alpha, 483 | random = b), 484 | Psi = Psi, 485 | Phi = Phi, 486 | info.fixed = as.matrix(XiVX), 487 | info.fixed.random = XZWiSZX, 488 | info.lambda = info.varPar$lambda, 489 | info.psi = info.varPar$psi, 490 | log.det.iSigma = log.det.iSigma, 491 | log.det.ZiVZ = log.det.ZWZiSigma, 492 | ZiVZ = ZWZiSigma 493 | ) 494 | } 495 | 496 | PQLMQL_eval_parms <- function(parms,model.struct,method,estimator){ 497 | 498 | nlevs <- model.struct$nlevs 499 | d <- model.struct$d 500 | s <- model.struct$s 501 | y <- model.struct$y 502 | w <- model.struct$w 503 | 504 | X <- model.struct$X 505 | Z <- model.struct$Z 506 | offset <- model.struct$offset 507 | 508 | alpha <- parms$coefficients$fixed 509 | b <- parms$coefficients$random 510 | Psi <- parms$Psi 511 | ZiVZ <- parms$ZiVZ 512 | 513 | eta <- as.vector(X%*%alpha) + offset 514 | 515 | if(method=="PQL"){ 516 | rand.ssq <- 0 517 | for(k in 1:nlevs){ 518 | eta <- eta + as.vector(Z[[k]]%*%b[[k]]) 519 | B.k <- matrix(b[[k]],nrow=d[k]) 520 | Psi.k <- Psi[[k]] 521 | rand.ssq <- rand.ssq + sum(B.k * (Psi.k%*%B.k)) 522 | } 523 | } else { 524 | b_ <- blockMatrix(b,nrow=nlevs,ncol=1) 525 | rand.ssq <- as.vector(fuseMat(bMatCrsProd(b_,bMatProd(ZiVZ,b_)))) 526 | } 527 | 528 | pi <- mclogitP(eta,s) 529 | dev.resids <- ifelse(y>0, 530 | 2*w*y*(log(y)-log(pi)), 531 | 0) 532 | 533 | deviance <- -parms$log.det.iSigma + parms$log.det.ZiVZ + sum(dev.resids) + rand.ssq 534 | 535 | list( 536 | eta = eta, 537 | pi = pi, 538 | deviance = deviance 539 | ) 540 | } 541 | 542 | PQLMQL_pseudoLogLik <- function(lambda, 543 | model.struct, 544 | estimator, 545 | aux, 546 | gradient=FALSE, 547 | info.lambda=FALSE, 548 | info.psi=FALSE 549 | ){ 550 | 551 | nlevs <- model.struct$nlevs 552 | d <- model.struct$d 553 | m <- model.struct$m 554 | 555 | yWy <- aux$yWy 556 | XWy <- aux$XWy 557 | ZWy <- aux$ZWy 558 | XWX <- aux$XWX 559 | ZWX <- aux$ZWX 560 | ZWZ <- aux$ZWZ 561 | 562 | Lambda <- lambda2Mat(lambda,m,d) 563 | Psi <- lapply(Lambda,crossprod) 564 | iSigma <- Psi2iSigma(Psi,m) 565 | 566 | H <- ZWZ + iSigma 567 | if(getOption("mclogit.use_blkinv", TRUE)) { 568 | K <- blk_inv.squareBlockMatrix(H) 569 | } 570 | else { 571 | K <- solve(H) 572 | } 573 | 574 | XiVX <- XWX - fuseMat(bMatCrsProd(ZWX,bMatProd(K,ZWX))) 575 | XiVy <- XWy - fuseMat(bMatCrsProd(ZWX,bMatProd(K,ZWy))) 576 | XiVX <- symmpart(XiVX) 577 | 578 | alpha <- solve(XiVX,XiVy) 579 | b <- bMatProd(K,ZWy-bMatProd(ZWX,alpha)) 580 | 581 | y.aXiVXa.y <- yWy - crossprod(XWy,alpha) - fuseMat(bMatCrsProd(ZWy,b)) 582 | 583 | log.det.iSigma <- Lambda2log.det.iSigma(Lambda,m) 584 | 585 | log.det.H <- 2*sum(log(diag(chol_blockMatrix(H,resplit=FALSE)))) 586 | logLik <- (log.det.iSigma - log.det.H - y.aXiVXa.y)/2 587 | if(estimator == "REML"){ 588 | log.det.XiVX <- log.Det(XiVX) 589 | logLik <- logLik - log.det.XiVX/2 590 | } 591 | res <- list( 592 | logLik=as.vector(logLik), 593 | coefficients=as.vector(alpha), 594 | random.effects=b, 595 | Psi=Psi 596 | ) 597 | 598 | if(gradient || info.lambda || info.psi){ 599 | if(estimator=="REML"){ 600 | iA <- solve(XiVX) 601 | XWZK <- bMatCrsProd(ZWX,K) 602 | iAXWZK <- bMatProd(blockMatrix(iA),XWZK) 603 | M <- bMatCrsProd(XWZK,iAXWZK) 604 | } 605 | } 606 | 607 | if(gradient){ 608 | if(estimator=="REML"){ 609 | K <- K + M 610 | } 611 | Phi <- lapply(Psi,safeInverse) 612 | S <- mapply(v_bCrossprod,b,d,SIMPLIFY=FALSE) 613 | K.kk <- diag(K) 614 | SumK.k <- mapply(sum_blockDiag,K.kk,d,SIMPLIFY=FALSE) 615 | Gr <- list() 616 | for(k in 1:nlevs) 617 | Gr[[k]] <- Lambda[[k]]%*%(m[k]*Phi[[k]] - SumK.k[[k]] - S[[k]]) 618 | res$gradient <- unlist(lapply(Gr,uvech)) 619 | } 620 | if(info.lambda || info.psi){ 621 | res$info <- list() 622 | T <- iSigma - K 623 | if(estimator=="REML"){ 624 | T <- T - M 625 | } 626 | if(info.lambda){ 627 | G.lambda <- d.psi.d.lambda(Lambda) 628 | I.lambda <- blockMatrix(list(matrix(0,0,0)),nlevs,nlevs) 629 | } 630 | if(info.psi) 631 | I.psi <- blockMatrix(list(matrix(0,0,0)),nlevs,nlevs) 632 | for(k in 1:nlevs){ 633 | T.k <- T[[k,k]] 634 | B.kk <- block_kronSum(T.k,m[k],m[k]) 635 | if(info.lambda){ 636 | G.k <- G.lambda[[k]] 637 | I.lambda[[k,k]] <- crossprod(G.k,B.kk%*%G.k) 638 | } 639 | if(info.psi){ 640 | I.psi[[k,k]] <- B.kk/2 641 | } 642 | if(k < nlevs){ 643 | for(k_ in seq(from=k+1,to=nlevs)){ 644 | T.kk_ <- T[[k,k_]] 645 | B.kk_ <- block_kronSum(T.kk_,m[k],m[k_]) 646 | if(info.lambda){ 647 | G.k_ <- G.lambda[[k_]] 648 | I.lambda[[k,k_]] <- crossprod(G.k,B.kk_%*%G.k_) 649 | I.lambda[[k_,k]] <- t(I.lambda[[k,k_]]) 650 | } 651 | if(info.psi){ 652 | I.psi[[k,k_]] <- B.kk_/2 653 | I.psi[[k_,k]] <- t(I.psi[[k,k_]]) 654 | } 655 | } 656 | } 657 | } 658 | if(info.lambda) 659 | res$info$lambda <- as.matrix(fuseMat(I.lambda)) 660 | if(info.psi) 661 | res$info$psi <- as.matrix(fuseMat(I.psi)) 662 | } 663 | return(res) 664 | } 665 | 666 | 667 | 668 | vech <- function(x) x[lower.tri(x,diag=TRUE)] 669 | setVech <- function(x,v) { 670 | ij <- lower.tri(x,diag=TRUE) 671 | x[ij] <- v 672 | x <- t(x) 673 | x[ij] <- v 674 | x 675 | } 676 | 677 | uvech <- function(x) x[upper.tri(x,diag=TRUE)] 678 | set_uvech <- function(x,v,symm=FALSE) { 679 | ij <- upper.tri(x,diag=TRUE) 680 | x[ij] <- v 681 | if(symm){ 682 | x <- t(x) 683 | x[ij] <- v 684 | } 685 | x 686 | } 687 | lambda2Mat <- function(lambda,m,d){ 688 | nlevs <- length(m) 689 | dd2 <- d*(d+1)/2 690 | lambda <- split_(lambda,dd2) 691 | D <- lapply(d,diag) 692 | Map(set_uvech,D,lambda) 693 | } 694 | 695 | Psi2iSigma <- function(Psi,m){ 696 | iSigma <- mapply(mk.iSigma.k,Psi,m,SIMPLIFY=FALSE) 697 | blockDiag(iSigma) 698 | } 699 | 700 | mk.iSigma.k <- function(Psi,m){ 701 | Diagonal(m) %x% Psi 702 | } 703 | 704 | split_ <- function(x,d){ 705 | m <- length(x) 706 | n <- length(d) 707 | i <- rep(1:n,d) 708 | split(x,i) 709 | } 710 | 711 | mmclogit.control <- function( 712 | epsilon = 1e-08, 713 | maxit = 25, 714 | trace = TRUE, 715 | trace.inner = FALSE, 716 | avoid.increase = FALSE, 717 | break.on.increase = FALSE, 718 | break.on.infinite = FALSE, 719 | break.on.negative = FALSE, 720 | inner.optimizer = "nlminb", 721 | maxit.inner = switch(inner.optimizer, 722 | SANN = 10000, 723 | `Nelder-Mead` = 500, 724 | 100), 725 | CG.type = 1, 726 | NM.alpha = 1, 727 | NM.beta = 0.5, 728 | NM.gamma = 2.0, 729 | SANN.temp = 10, 730 | SANN.tmax = 10, 731 | grtol = 1e-6, 732 | xtol = 1e-8, 733 | maxeval = 100, 734 | gradstep = c(1e-6, 1e-8), 735 | use.gradient = c("analytic","numeric")) { 736 | if (!is.numeric(epsilon) || epsilon <= 0) 737 | stop("value of epsilon must be > 0") 738 | if (!is.numeric(maxit) || maxit <= 0) 739 | stop("maximum number of iterations must be > 0") 740 | m <- match.call() 741 | 742 | use.gradient <- match.arg(use.gradient) 743 | 744 | list(epsilon = epsilon, maxit = maxit, 745 | trace = trace, trace.inner = trace.inner, 746 | avoid.increase = avoid.increase, 747 | break.on.increase = break.on.increase, 748 | break.on.infinite = break.on.infinite, 749 | break.on.negative = break.on.negative, 750 | inner.optimizer = inner.optimizer, 751 | maxit.inner = maxit.inner, 752 | CG.type = CG.type, 753 | NM.alpha = NM.alpha, 754 | NM.beta = NM.beta, 755 | NM.gamma = NM.gamma, 756 | SANN.temp = SANN.temp, 757 | SANN.tmax = SANN.tmax, 758 | grtol = grtol, 759 | xtol = xtol, 760 | maxeval = maxeval, 761 | gradstep = gradstep, 762 | use.gradient = use.gradient 763 | ) 764 | } 765 | 766 | split_bdiag1 <- function(x,n){ 767 | m0 <- ncol(x) 768 | stopifnot(nrow(x)==m0) 769 | m <- m0%/%n 770 | i <- rep(1:m,each=n) 771 | j <- rep(1:m0) 772 | j <- split(j,i) 773 | y <- list() 774 | for(k in 1:m){ 775 | j.k <- j[[k]] 776 | y[[k]] <- x[j.k,j.k] 777 | } 778 | y 779 | } 780 | 781 | split_bdiag <- function(x,d){ 782 | m <- length(d) 783 | n <- ncol(x) 784 | s <- 1:m 785 | s <- rep(s,d) 786 | j <- 1:n 787 | j <- split(j,s) 788 | y <- list() 789 | for(k in 1:m){ 790 | j.k <- j[[k]] 791 | y[[k]] <- x[j.k,j.k] 792 | } 793 | y 794 | } 795 | 796 | 797 | se_Phi <- function(Phi,info.lambda){ 798 | d <- sapply(Phi,ncol) 799 | dd2 <- d*(d+1)/2 800 | info.lambda <- split_bdiag(info.lambda,dd2) 801 | Map(se_Phi_,Phi,info.lambda) 802 | } 803 | 804 | block_kronSum <- function(A,m1,m2){ 805 | nr <- nrow(A) 806 | nc <- ncol(A) 807 | d1 <- nr%/%m1 808 | d2 <- nc%/%m2 809 | A <- as.array(A) 810 | dim(A) <- c(d1,m1,d2,m2) 811 | A <- aperm(A,c(2,4,1,3)) # dim = m1,m2,d1,d2 812 | dim(A) <- c(m1*m2,d1*d2) 813 | B <- crossprod(A) # dim = d1*d2,d1*d2 814 | dim(B) <- c(d1,d2,d1,d2) 815 | B <- aperm(B,c(1,3,2,4)) # dim = d1,d1,d2,d2 816 | dim(B) <- c(d1*d1,d2*d2) 817 | return(B) 818 | } 819 | 820 | 821 | d.psi.d.lambda <- function(Lambda) { 822 | lapply(Lambda,d.psi.d.lambda.1) 823 | } 824 | 825 | d.psi.d.lambda.1 <- function(Lambda){ 826 | d <- ncol(Lambda) 827 | d_2 <- d*(d+1)/2 828 | G <- array(0,c(d,d,d,d)) 829 | 830 | g <- rep(1:d,d*d*d) 831 | h <- rep(1:d,each=d,d*d) 832 | i <- rep(1:d,each=d*d,d) 833 | j <- rep(1:d,each=d*d*d) 834 | 835 | delta <- diag(d) 836 | 837 | G[cbind(g,h,i,j)] <- delta[cbind(g,j)]*Lambda[cbind(i,h)] + Lambda[cbind(i,g)]*delta[cbind(h,j)] 838 | 839 | dim(G) <- c(d*d,d*d) 840 | keep.lambda <- as.vector(upper.tri(Lambda,diag=TRUE)) 841 | G[,keep.lambda] 842 | } 843 | 844 | solve_ <- function(x){ 845 | res <- try(solve(x),silent=TRUE) 846 | if(inherits(res,"try-error")){ 847 | warning("Singlular matrix encountered, trying a Moore-Penrose inverse") 848 | return(ginv(x)) 849 | } else return(res) 850 | 851 | } 852 | 853 | 854 | se_Phi_ <- function(Phi,info.lambda){ 855 | d <- ncol(Phi) 856 | Psi <- solve(Phi) 857 | Lambda <- chol(Psi) 858 | G <- d.psi.d.lambda.1(Lambda) 859 | vcov.lambda <- solve_(info.lambda) 860 | vcov.psi <- G%*%tcrossprod(vcov.lambda,G) 861 | PhiPhi <- Phi%x%Phi 862 | vcov.phi <- PhiPhi%*%vcov.psi%*%PhiPhi 863 | se.phi <- sqrt(diag(vcov.phi)) 864 | matrix(se.phi,d,d,dimnames=dimnames(Phi)) 865 | } 866 | 867 | Lambda2log.det.iSigma <- function(Lambda,m){ 868 | res <- Map(Lambda2log.det.iSigma_1,Lambda,m) 869 | sum(unlist(res)) 870 | } 871 | 872 | Lambda2log.det.iSigma_1 <- function(Lambda,m){ 873 | dLambda <- diag(Lambda) 874 | if(any(dLambda < 0)){ 875 | Psi <- crossprod(Lambda) 876 | svd.Psi <- svd(Psi) 877 | dLambda <- svd.Psi$d/2 878 | } 879 | 2*m*sum(log(dLambda)) 880 | } 881 | 882 | 883 | reff <- function(object){ 884 | b <- object$random.effects 885 | Phi <- object$VarCov 886 | nlev <- length(b) 887 | B <- list() 888 | for(k in 1:nlev){ 889 | d <- ncol(Phi[[k]]) 890 | B_k <- matrix(b[[k]],nrow=d) 891 | B_k <- t(B_k) 892 | colnames(B_k) <- colnames(Phi[[k]]) 893 | B[[k]] <- B_k 894 | } 895 | B 896 | } 897 | -------------------------------------------------------------------------------- /pkg/R/safeInverse.R: -------------------------------------------------------------------------------- 1 | safeInverse <- function(x,tol=1e-7){ 2 | tryCatch(solve(x), 3 | error=function(e){ 4 | warning(e$message,call.=FALSE,immediate.=TRUE) 5 | warning("saveInverse: Using Moore-Penrose inverse",call.=FALSE,immediate.=TRUE) 6 | moore.penrose(x,tol=tol) 7 | }) 8 | } 9 | 10 | mach.eps <- .Machine$double.eps 11 | 12 | moore.penrose <- function(x,tol=mach.eps*max(dim(x))*max(abs(d))){ 13 | svd.x <- svd(x) 14 | d <- svd.x$d 15 | u <- svd.x$u 16 | v <- svd.x$v 17 | good <- abs(d) > tol 18 | id <- 1/d 19 | id[!good] <- 0 20 | v %*% diag(id,nrow=length(id)) %*% t(u) 21 | } 22 | -------------------------------------------------------------------------------- /pkg/R/zzz.R: -------------------------------------------------------------------------------- 1 | .onLoad <- function(lib,pkg){ 2 | if(requireNamespace("memisc",quietly = TRUE)){ 3 | 4 | memisc::setSummaryTemplate( 5 | mclogit = c( 6 | "Likelihood-ratio" = "($LR:f1#)", 7 | #p = "($p:#)", 8 | "Log-likelihood" = "($logLik:f1#)", 9 | Deviance = "($deviance:f1#)", 10 | AIC = "($AIC:f1#)", 11 | BIC = "($BIC:f1#)", 12 | N = "($N:d)" 13 | ), 14 | mmclogit = c( 15 | #"Likelihood-ratio" = "($LR:f1#)", 16 | #p = "($p:#)", 17 | #"Log-likelihood" = "($logLik:f1#)", 18 | Deviance = "($deviance:f1#)", 19 | #AIC = "($AIC:f1#)", 20 | #BIC = "($BIC:f1#)", 21 | N = "($N:d)" 22 | ), 23 | mblogit = c( 24 | "Log-likelihood" = "($logLik:f1#)", 25 | Deviance = "($deviance:f1#)", 26 | AIC = "($AIC:f1#)", 27 | BIC = "($BIC:f1#)", 28 | N = "($N:d)" 29 | ) 30 | ) 31 | } 32 | 33 | options(mblogit.basecat.sep="/") 34 | options(mblogit.show.basecat=TRUE) 35 | options(summary.stats.mclogit=c("Deviance","N")) 36 | options(summary.stats.mmclogit=c("Deviance","N")) 37 | } 38 | 39 | -------------------------------------------------------------------------------- /pkg/data/Transport.R: -------------------------------------------------------------------------------- 1 | Transport <- local({ 2 | 3 | set.seed(1) 4 | 5 | # Spatial positions of suburbs are 6 | # normally distributed 7 | 8 | N <- 10 9 | unit.len <- 10 10 | suburbs <- cbind(x=stats::rnorm(n=N),y=stats::rnorm(n=N)) 11 | workpop.suburb <- stats::rpois(n=N,lambda=200) 12 | 13 | 14 | # There are a couple of large firms in the area 15 | firms <- rbind( 16 | "Hollibarton"=c(-1,0), 17 | "Mikrobrainz"=c(1,1), 18 | "Whalemurd"=c(-1,1), 19 | "G. Gecko Mergers and Aquisitions"=c(1,-1), 20 | "Huddsucker Industries"=c(0,0) 21 | ) 22 | 23 | colnames(firms) <- c("x","y") 24 | 25 | # There are also some bus stations scattered in 26 | # the area ... 27 | n.bus.stations <- as.integer(N/1.3) 28 | bus.stations <- cbind( x=stats::rnorm(n=n.bus.stations), 29 | y=stats::rnorm(n=n.bus.stations)) 30 | 31 | # and some train stations 32 | 33 | n.train.stations <- as.integer(N/1.4) 34 | train.stations <- cbind(x=stats::rnorm(n=n.train.stations), 35 | y=stats::rnorm(n=n.train.stations)) 36 | 37 | # Oil is expensive these days (2020!). 38 | # Cars and car maintenance costs are high, too. 39 | car.cost <- 10 40 | bus.cost <- 4 41 | train.cost <- 3.7 42 | 43 | # Every firm has a bus station and a train station 44 | # and a parking place. 45 | # Therefore the distance of the nearest bus station 46 | # or train station, respectively, counts here. 47 | 48 | dist.car <- rep(0,N) 49 | dist.train <- sqrt( 50 | outer(suburbs[,1],train.stations[,1],"-")^2 + 51 | outer(suburbs[,2],train.stations[,2],"-")^2 52 | ) 53 | dist.train <- apply(dist.train,1,min) 54 | 55 | dist.bus <- sqrt( 56 | outer(suburbs[,1],bus.stations[,1],"-")^2 + 57 | outer(suburbs[,2],bus.stations[,2],"-")^2 58 | ) 59 | dist.bus <- apply(dist.bus,1,min) 60 | 61 | Transport <- expand.grid( 62 | transport=factor(1:3,labels=c("bus","car","train")), 63 | suburb=1:N) 64 | 65 | 66 | distance <- rep(NA,nrow(Transport)) 67 | cost <- rep(NA,nrow(Transport)) 68 | transport <- Transport$transport 69 | suburb <- Transport$suburb 70 | 71 | distance[transport=="bus"] <- dist.bus*unit.len 72 | distance[transport=="car"] <- dist.car*unit.len 73 | distance[transport=="train"] <- dist.train*unit.len 74 | 75 | cost[transport=="bus"] <- bus.cost 76 | cost[transport=="car"] <- car.cost 77 | cost[transport=="train"] <- train.cost 78 | 79 | working <- workpop.suburb[suburb] 80 | 81 | coef.true <- c(distance=-1.5,cost=-1) 82 | 83 | expeta.true <- exp(cbind(distance,cost) %*% coef.true) 84 | sumexpeta.true <- tapply(expeta.true,suburb,sum) 85 | prop.true <- expeta.true/c(sumexpeta.true[suburb]) 86 | 87 | resp <- c(sapply( 88 | split(data.frame(prop.true,working), 89 | suburb 90 | ), 91 | function(x) stats::rmultinom(n=1, 92 | size=unique(x$working), 93 | prob=x$prop.true) 94 | )) 95 | 96 | data.frame(transport,suburb,distance,cost,working,prop.true,resp) 97 | }) -------------------------------------------------------------------------------- /pkg/data/electors.R: -------------------------------------------------------------------------------- 1 | electors <- local({ 2 | 3 | set.seed(1) 4 | 5 | unit.len=.5 6 | 7 | green <- c( 8 | econ.left=.8, 9 | welfare=0, 10 | auth=-1.5 11 | ) 12 | 13 | labor <- c( 14 | econ.left=2, 15 | welfare=3, 16 | auth=0 17 | ) 18 | 19 | communist <- c( 20 | econ.left=5, 21 | welfare=2, 22 | auth=1 23 | ) 24 | 25 | conservative <- c(econ.left=-2, 26 | welfare=-2, 27 | auth=2 28 | ) 29 | 30 | liberal <- c( 31 | econ.left=-2.5, 32 | welfare=0, 33 | auth=-1.5 34 | ) 35 | 36 | right.wing.populist <- c( 37 | econ.left=0, 38 | welfare=.2, 39 | auth=4 40 | ) 41 | 42 | parties <- rbind( 43 | green, 44 | labor, 45 | communist, 46 | conservative, 47 | liberal, 48 | right.wing.populist 49 | )*unit.len 50 | 51 | 52 | working <- c( 53 | econ.left=2, 54 | welfare=5, 55 | auth=1 56 | )*unit.len 57 | 58 | new.middle <- c( 59 | econ.left=-1, 60 | welfare=1, 61 | auth=-1 62 | ) 63 | 64 | old.middle <-c( 65 | econ.left=-2.5, 66 | welfare=0, 67 | auth=2 68 | ) 69 | 70 | classes <- rbind( 71 | working, 72 | new.middle, 73 | old.middle 74 | )*unit.len 75 | 76 | T <- 25 77 | constant <- rep(1,nrow(classes)*T) 78 | 79 | util.econ <- -outer( 80 | constant*classes[,"econ.left"], 81 | parties[,"econ.left"], 82 | "-" 83 | )^2 84 | 85 | util.auth <- -outer( 86 | constant*classes[,"auth"], 87 | parties[,"auth"], 88 | "-" 89 | )^2 90 | 91 | util.welfare <- outer( 92 | constant*classes[,"welfare"], 93 | parties[,"welfare"] 94 | ) 95 | 96 | 97 | 98 | utils <- util.econ+util.auth+util.welfare 99 | 100 | rand <- matrix(stats::rnorm(n=ncol(utils)*T,sd=1),nrow=T,ncol=ncol(utils)) 101 | rand <- rand[rep(seq_len(nrow(rand)),each=nrow(classes)),] 102 | 103 | 104 | exp.eta <- exp(utils+rand) 105 | 106 | probs <- exp.eta/apply(exp.eta,1,sum) 107 | 108 | rownames(probs) <- rep(rownames(classes),T) 109 | 110 | # browser() 111 | 112 | the.sample<-c( 113 | working=500, 114 | new.middle=500, 115 | old.middle=500 116 | ) 117 | 118 | the.tab <- structure(t(sapply(rownames(probs), 119 | function(nm) stats::rmultinom( 120 | n=1, 121 | size=the.sample[nm], 122 | prob=probs[nm,] 123 | ) 124 | )), 125 | dimnames=structure(dimnames(probs),names=c("class","party")), 126 | class="table" 127 | ) 128 | 129 | electors <- within(as.data.frame(t(the.tab)),{ 130 | time <- rep(1:T,each=nrow(classes)*nrow(parties)) 131 | time <- time/T 132 | class <- factor(class, 133 | levels=c( 134 | "working", 135 | "new.middle", 136 | "old.middle" 137 | ) 138 | ) 139 | party <- factor(party, 140 | levels=c( 141 | "communist", 142 | "labor", 143 | "green", 144 | "liberal", 145 | "conservative", 146 | "right.wing.populist" 147 | ) 148 | ) 149 | }) 150 | 151 | parties <- as.data.frame(parties) 152 | parties <- parties[as.character(electors$party),] 153 | electors <- cbind(electors,parties) 154 | rownames(electors) <- NULL 155 | 156 | electors 157 | }) -------------------------------------------------------------------------------- /pkg/demo/00Index: -------------------------------------------------------------------------------- 1 | mclogit.test Test run of mclogit with simulated data 2 | test-mblogit-random-nonnested Test run of mblogit with simulated data, model with non-nested random effects 3 | -------------------------------------------------------------------------------- /pkg/demo/mclogit.test.R: -------------------------------------------------------------------------------- 1 | library(mclogit) 2 | options(error=recover) 3 | 4 | mclogitP <- function(eta,s){ 5 | expeta <- exp(eta) 6 | sum.expeta <- rowsum(expeta,s) 7 | expeta/sum.expeta[s] 8 | } 9 | 10 | N <- 10000 11 | n <- 100 12 | 13 | test.data <- data.frame( 14 | x = rnorm(N), 15 | f = gl(4,N/4), 16 | set = gl(N/5,5,N), 17 | altern0 = gl(5,1,N), 18 | nat = gl(15,N/15,N), 19 | occ = gl(10,1,N) 20 | ) 21 | 22 | test.data <- within(test.data,{ 23 | 24 | altern <- as.integer(interaction(altern0,nat)) 25 | altern.occ <- as.integer(interaction(altern,occ)) 26 | b1 <- rnorm(n=length(altern)) 27 | b2 <- rnorm(n=length(altern.occ)) 28 | ff <- 1+.2*(as.numeric(f)-1) 29 | eta <- x*ff + b1[altern] + b2[altern.occ] 30 | p <- mclogitP(eta,set) 31 | n <- unlist(tapply(p,set,function(p)rmultinom(n=1,size=n,prob=p))) 32 | rm(b1,b2) 33 | }) 34 | 35 | 36 | test.mc0 <- mclogit(cbind(n,set)~x:f,data=test.data 37 | ) 38 | 39 | 40 | test.mc <- mclogit(cbind(n,set)~x:f,data=test.data, 41 | random=~1|altern/occ, 42 | #start.theta=c(1,1) 43 | maxit=100 44 | ) 45 | 46 | # By construction, the `true' coefficient values 47 | # are 1, 1.2, 1.4, 1.6 48 | coef(test.mc) 49 | 50 | # The asymptotic covariance matrix of the coefficient estimates 51 | vcov(test.mc) 52 | 53 | print(test.mc) 54 | 55 | summary(test.mc) 56 | 57 | p0 <- predict(test.mc0) 58 | 59 | p <- predict(test.mc) 60 | -------------------------------------------------------------------------------- /pkg/demo/test-mblogit-random-nonnested.R: -------------------------------------------------------------------------------- 1 | library(mclogit) 2 | set.seed(534) 3 | 4 | nwithin <- 100 5 | nbetween1 <- 20 6 | nbetween2 <- 20 7 | 8 | nbetween <- nbetween1*nbetween2 9 | 10 | a1 <- -1 11 | a2 <- 1 12 | 13 | x <- seq(from=-2,to=2,length=nwithin) 14 | 15 | x <- rep(x,nbetween) 16 | 17 | u1_1 <- rnorm(nbetween1,sd=1) 18 | u2_1 <- rnorm(nbetween1,sd=1) 19 | 20 | u1_2 <- rnorm(nbetween2,sd=1) 21 | u2_2 <- rnorm(nbetween2,sd=1) 22 | 23 | 24 | g1 <- rep(1:nbetween1,each=nwithin*nbetween2) 25 | g2 <- rep(1:nbetween2,each=nwithin,nbetween1) 26 | 27 | eta1 <- 1*x + a1 + u1_1[g1] + u1_2[g2] 28 | eta2 <- -1*x + a2 + u2_1[g1] + u2_2[g2] 29 | 30 | exp.eta1 <- exp(eta1) 31 | exp.eta2 <- exp(eta2) 32 | sum.exp.eta <- 1 + exp.eta1 + exp.eta2 33 | 34 | pi2 <- exp.eta1/sum.exp.eta 35 | pi3 <- exp.eta2/sum.exp.eta 36 | pi1 <- 1 - pi2 - pi3 37 | pi <- cbind(pi1,pi2,pi3) 38 | 39 | y <- sapply(1:length(x), 40 | function(i)sample.int(n=3,size=1,prob=pi[i,])) 41 | y <- factor(y,labels=letters[1:3]) 42 | 43 | plot(y~x) 44 | 45 | 46 | (fem <- mblogit(y~x)) 47 | 48 | (mxm_x <- mblogit(y~x, 49 | random=list(~1|g1,~1|g2), 50 | estimator="REML" 51 | )) 52 | summary(mxm_x) 53 | 54 | (mxm <- mblogit(y~x, 55 | random=~1|g1, 56 | estimator="REML" 57 | )) 58 | summary(mxm) 59 | 60 | pred_x <- predict(mxm_x,type="response") 61 | 62 | pred_1 <- predict(mxm,type="response") 63 | 64 | plot(pred_x,type="l") 65 | 66 | plot(x,pred_x[,1],type="l") 67 | 68 | plot(x,pred_x[,2],type="l") 69 | 70 | plot(x,pred_x[,3],type="l") 71 | 72 | 73 | plot(x,pi1,type="l") 74 | 75 | plot(x,pi2,type="l") 76 | 77 | plot(x,pi3,type="l") 78 | 79 | 80 | plot(pi1,pred_x[,1],type="l") 81 | 82 | plot(pi2,pred_x[,2],type="l") 83 | 84 | plot(pi3,pred_x[,3],type="l") 85 | 86 | 87 | epred_x <- predict(mxm_x) 88 | 89 | plot(eta1,epred_x[,1],type="l") 90 | abline(a=0,b=1,col="red") 91 | 92 | plot(eta2,epred_x[,2],type="l") 93 | abline(a=0,b=1,col="red") 94 | 95 | Bmxm_x <- mclogit:::reff(mxm_x) 96 | 97 | c(u1_1=mean(u1_1), 98 | u1_1_hat=mean(Bmxm_x[[1]][,1])) 99 | 100 | plot(u1_1-mean(u1_1),Bmxm_x[[1]][,1]) 101 | abline(a=0,b=1) 102 | 103 | plot(u2_1-mean(u2_1),Bmxm_x[[1]][,2]) 104 | abline(a=0,b=1) 105 | 106 | plot(u1_2-mean(u1_2),Bmxm_x[[2]][,1]) 107 | abline(a=0,b=1) 108 | 109 | plot(u2_2-mean(u2_2),Bmxm_x[[2]][,2]) 110 | abline(a=0,b=1) 111 | 112 | (mxm_i <- mblogit(y~x, 113 | random=~1+x|g1 114 | )) 115 | 116 | f <- sample(1:2,size=length(x),replace=TRUE) 117 | 118 | (mxm_ii <- mblogit(y~x*f, 119 | random=~1+x|g1 120 | )) 121 | 122 | summary(mxm_ii) 123 | -------------------------------------------------------------------------------- /pkg/examples/mblogit-ex.R: -------------------------------------------------------------------------------- 1 | library(MASS) # For 'housing' data 2 | library(nnet) 3 | library(memisc) 4 | 5 | (house.mult<- multinom(Sat ~ Infl + Type + Cont, weights = Freq, 6 | data = housing)) 7 | 8 | 9 | (house.mblogit <- mblogit(Sat ~ Infl + Type + Cont, weights = Freq, 10 | data = housing)) 11 | 12 | summary(house.mult) 13 | 14 | summary(house.mblogit) 15 | 16 | mtable(house.mblogit) 17 | -------------------------------------------------------------------------------- /pkg/inst/ChangeLog-old: -------------------------------------------------------------------------------- 1 | 2023-04-05: 2 | - Allow estimation of overdispersion across groups indicated by 3 | grouping factor. 4 | 5 | 2023-03-29: 6 | - Add support for 'ucminf' as inner optimisation method. 7 | 8 | 2023-01-11: 9 | - Added 'rebase' function (and method) to change the baseline category of a 10 | fitted model. (That is adjust the coefficients without the need of refitting.) 11 | 12 | 2023-01-08: 13 | - Bugfix in 'predict.mmblogit' that caused an error if 'conditional=FALSE' 14 | was set. 15 | 16 | 2023-01-06: 17 | - More compact output of mblogit models random effects and diagonal covariance 18 | matrix. 19 | 20 | 2023-01-05: 21 | - Added support for alternative optimizers to be used in the inner iterations 22 | of MQL/PQL 23 | 24 | 2022-10-23: 25 | - Refactored MQL/PQL algorithm: Eliminated redundant code and adapted it to 26 | both 'nlm' and 'nlminb' 27 | 28 | 2022-10-16: 29 | - Fixed bug in MQL/PQL-objective function that led to false non-convergence and 30 | bias in variance parameter estimates 31 | 32 | 2022-10-12: 33 | - Support for starting values in random effects models 34 | - Support for restriction on random effects variances in multinomial baseline 35 | logit models 36 | 37 | 2022-10-09: 38 | - Improve handling of boundary values and singular information matrices 39 | 40 | 2022-10-07: 41 | - Remove spurious messages about missing starting values 42 | 43 | 2022-05-21: 44 | - Add checks of 'control=' argument of 'mclogit()' and 'mblogit()'. 45 | 46 | 2022-04-13: 47 | - Fixed bug in 'blockMatrix' and make it check for argument validity 48 | 49 | 2022-04-11: 50 | - Hotfix of prediction method 51 | 52 | 2022-04-10: 53 | - Fix handling of singular initial covariance matrices in PQLMQL_innerFit 54 | - Issue a warning if models with random effects are compared using anova 55 | - Fix predict methods for mmclogit models 56 | - Handle DOIs in documentation as required by new guidelines 57 | 58 | 2022-01-16: 59 | - Fix prediction with complicated terms in the model 60 | - Add some more demos 61 | 62 | 2021-08-13: 63 | - predict.mmclogit: create W-Matrix only when really needed 64 | 65 | 2021-07-13: 66 | - Include variance parameters in the computation of degrees of freedom 67 | 68 | 2021-06-03: 69 | - Be less zealous about group-level covariates constant in some choice sets. 70 | 71 | 2021-05-30: 72 | - Added support for vertical-bar syntax for responses of conditional 73 | logit models. 74 | 75 | 2021-05-27: 76 | - Added support for non-nested random effects. 77 | 78 | 2021-05-25: 79 | - Fixed serious bug in the handling of multilevel random effects models. 80 | - Detect some misspecified models with too many groups. 81 | 82 | 2021-04-17: 83 | - Merged pull request by Russel V. Lenth that adds support for "emmeans". 84 | 85 | 2021-04-04: 86 | - Apply patch suggested by Ilya Yalchyk to improve formula argument 87 | of 'mclogit()' and 'mblogit()'. 88 | 89 | 2021-03-19: 90 | - Last fixes for CRAN 91 | 92 | 2021-03-18: 93 | - Improved support 'mtable()' for multinomial logit models with random effects. 94 | 95 | 2021-02-21: 96 | - Fixed predictions from models with scaled independent variables etc. 97 | - 'summary()' now reports the number of groups per random effects level. 98 | 99 | 2021-01-28: 100 | - Another prediction fix. Do not refer to weights that are not needed. 101 | 102 | 2021-01-10: 103 | - Fixed prediction method also for mmclogit objects 104 | 105 | 2020-12-23: 106 | - Refactored computations 107 | - Fixed predictions from random-effects models where group indices are not 108 | a sequence of integers starting at 1. 109 | 110 | 2020-11-03: 111 | - Correct URLs in DESCRIPTION 112 | 113 | 2020-09-09: 114 | - Fix reference to weights in 'predict()' methods 115 | 116 | 2020-08-06: 117 | - Let 'mclogit'/'mblogit' handle empty responses (i.e. where counts sum to 118 | zero) correclty. 119 | - Make 'mclogit' complain about non-numeric responses 120 | 121 | 2020-07-17: 122 | - Documented prediction methods. 123 | - Improved flexibility of prediction methods. 124 | 125 | 2020-07-16: 126 | - Implemented reasonable 'predict' method for mmblogit and mmclogit objects. 127 | 128 | 2020-07-15: 129 | - Bugfix: Make 'update' work with missing 'dispersion=' argument. 130 | - Bugfix: Make 'vcov' work for objects without 'phi' component. 131 | - Add 'vcov' method for 'mmclogit' objects. 132 | 133 | 2020-06-27: 134 | - Documented 'simulate()' methods. 135 | 136 | 2020-06-11: 137 | - Implemented (approximate) REML estimator. 138 | 139 | 2020-06-07: 140 | - Added a 'simulate()' method for "mblogit" and "mclogit" models. 141 | 142 | 2020-05-24: 143 | - Adapt the package NAMESPACE file to explicitly export S3 methods as methods, 144 | even if they are export as functions, as newly required by R 4.0. 145 | 146 | 2020-05-23: 147 | - Added documentation of (over-)dispersion parameter estimation, rename 148 | 'overdispersion=' arguments into 'dispersion=' arguments. 149 | 150 | 2020-05-22: 151 | - Added support for estimation of (over-)dispersion parameters 152 | 153 | 2020-05-21: 154 | - Implemented MQL technique as an alternative to PQL estimation 155 | 156 | 2020-05-19: 157 | - Improve handling of numerical difficulties 158 | 159 | 2020-05-11: 160 | - Use a Cholesky-factor parameterisation to make sure that covariance matrices 161 | are positive (semi-)definite 162 | 163 | 2020-03-30: 164 | - Refactored the algorithm for fitting mixed-effects models 165 | 166 | 2020-01-09: 167 | - Document getSummary.mmclogit, getSummary.mmblogit 168 | - Make 'mblogit' handle matrix responses with zero-sum rows 169 | - Renamed 'residual.df' to 'df.residual' in results object of 'mclogit.fit' et 170 | al. (Fixes issue #4) 171 | 172 | 2019-10-23: 173 | - Merge pull request #3 from skyborla/fix-mblogit 174 | Fix mblogit for responses with only two levels 175 | - Export getSummary.mmclogit, getSummary.mmblogit 176 | 177 | 2019-04-20: 178 | - Let 'mmblogit' models inherit from class 'mblogit' 179 | 180 | 2019-02-04: 181 | - Merged pull request #2 from pmcharrison/ftt-fix: 182 | Fixed typo (ftt -> fit) 183 | 184 | 2018-09-26: 185 | - Fixed matrix column selection in predict.mclogit if there is only one 186 | predictor (also PR from skyborla) 187 | 188 | 2018-04-25: 189 | - Improved handling of with misspecified random effect structures. 190 | - Added documentation about new handling of misspecified models. 191 | 192 | 2017-10-25: 193 | - Fixed handling of dropped predictors in `predict.mclogit`. 194 | 195 | 2017-01-26: 196 | - Fixed some bugs in predict models for `mclogit` objects. 197 | - Made sure that dummy coding is used for response factors even if they are ordinal 198 | 199 | 2017-01-07: 200 | - Implemented random slopes for baseline logit models. 201 | 202 | 2017-01-05: 203 | - Implemented random slopes for conditional logit models. 204 | 205 | 2016-09-01: 206 | - Fixed `mclogit.fit()` and `predict.mclogit()` to work better without covariates. 207 | 208 | 2016-02-07: 209 | - Explicitely import package "methods" 210 | 211 | 2016-01-17: 212 | - Import `as` from package "methods". 213 | - Make sure `nobs` is defined in `mclogit.fit.rePQL`. 214 | 215 | 2016-01-16: 216 | - Updated `DESCRIPTION` file: Maintainer email address changed and no "This package" 217 | at start of package discriptions. 218 | 219 | 2015-10-08: 220 | - Fix display of number of observations 221 | - Drop redundant coefficients 222 | 223 | 2015-08-01: 224 | - Added row and column names to estimator result of `vcov()` 225 | - Make sure that scripts run with "mclogit" loaded by `devtools::load_all()` 226 | 227 | 2015-07-15: 228 | - mclogit, mclogit.fit: Added support for starting values. 229 | 230 | 2015-07-03: 231 | - predict.mblogit: 'contrasts.arg' not 'contast.arg' ... 232 | - predict-methods now should handle NAs in newdata arguments better. 233 | 234 | 2015-06-17: 235 | - Corrected handling of weights and standard errors of prediction. 236 | 237 | 2015-06-15: 238 | - 'getSummary' methods now return "contrasts" and "xlevels" components. 239 | - Fixed prediction method for 'mclogit' results. 240 | - Added 'fitted' and 'predict' methods for 'mblogit' results. 241 | 242 | 2015-01-25: 243 | - Added support for multinomial baseline logit models in form of 'mblogit' as a frontend to 'mclogit.fit' 244 | 245 | 2015-01-23: 246 | - Added URLs to DESCRIPTION file 247 | 248 | 2015-01-21: 249 | - Added `nobs` and `extractAIC` methods for `mclogit` objects, so that `drop1.default` should work with these. 250 | 251 | 2015-01-19: 252 | - Added call to result of `getSummary.mclogit`. 253 | 254 | 2015-01-18: 255 | - Cleanup of NAMESPACE file; added aliases to methods for `mclogit` objects so that users can see that they are present. 256 | - Export `mclogit.fit`, and `mclogit.fit.rePQL` to enable use by other packages. 257 | 258 | 2014-10-13: 259 | Simplified some namespace dependencies. Eliminated useless pseudo-R-squared statistics 260 | from getSummary.mclogit 261 | 262 | 2014-08-23: 263 | Added 'anova' methods 264 | 265 | 2014-03-10: 266 | Refactored code -- algorithms should be more transparent and robust now (hopefully!). 267 | mclogit without and with random effects can handle missing values now. 268 | Fixed predict method -- use of napredict; handles single indep-variable situation now. 269 | Fixed embarassing typo -- prior weights do work now (again?). 270 | Included AIC and BIC methods contributed by Nic Elliot 271 | -------------------------------------------------------------------------------- /pkg/inst/NEWS.Rd: -------------------------------------------------------------------------------- 1 | \name{NEWS} 2 | \title{\emph{mclogit} News} 3 | \encoding{UTF-8} 4 | 5 | \section{Version 0.9}{ 6 | \subsection{NEW FEATURES}{ 7 | \itemize{ 8 | \item It is now possible to estimate models with non-nested 9 | (e.g. crossed) random effects. Such models can be specified 10 | by providing a list of formulas as \code{random=} argument to the 11 | \code{mclogit()} or \code{mblogit()} function. 12 | \item The left-hand side of conditional logit models can now 13 | more conveniently specified using the vertical-bar (\code{|}) 14 | operator. 15 | \item It is now possible to choose between different 16 | optimizers to be used in the inner iterations of the MQL/PQL 17 | estimator: One can choose between \code{nlm()}, \code{nlminb()}, 18 | \code{ucminf()}, and most techniques provided by \code{optim()}. 19 | \item With \code{rebase()} the baseline category of a model 20 | can be changed without the need of refitting the model. 21 | \item \code{mblogit()} and \code{mclogit()} now have a 22 | \code{groups=} argument that allows to estimated 23 | overdispersion (across groups). 24 | \item \code{mblogit()} and \code{mclogit()} now also have an 25 | \code{offset=} argument that to add an offset to the model 26 | (i.e. a covariate with coeffecient fixed to unity). 27 | } 28 | } 29 | \subsection{BUGFIXES}{ 30 | \itemize{ 31 | \item Singular initial covariance matrices no longer cause errors. 32 | \item A warning about unreliable results is issued if 33 | \code{anova()} is applied to models with random effects. 34 | \item Estimating of overdispersion with group data now works. 35 | } 36 | } 37 | \subsection{IMPROVEMENTS}{ 38 | \itemize{ 39 | \item \code{mclogit()} and \code{mblogit()} check whether the list 40 | passed as \code{control} is complete i.e. contains all the relevant 41 | named arguments. 42 | \item A \code{ranef()} method is provided for objects created 43 | by \code{mclogit()} or \code{mblogit()}. 44 | } 45 | } 46 | } 47 | 48 | \section{Version 0.8}{ 49 | \subsection{NEW FEATURES}{ 50 | \itemize{ 51 | \item It is now possible to use the MQL estimation technique as an 52 | alternative to PQL. 53 | \item As an alternative to extending a logit model with random 54 | effects, it is now possible to add an over-dispersion parameter to 55 | the model. 56 | \item In addition to approximate the ML estimator, MQL and PQL 57 | have a variant that approximates the REML estimator. 58 | \item There is now a \code{simulate()} method for objects returned 59 | by \code{mblogit()} or \code{mclogit()} (but only for those 60 | without random effects). 61 | \item Predictions from random-effects models estimated using the 62 | PQL technique now are now conditional on the random effects 63 | (unless requested otherwise). 64 | } 65 | } 66 | \subsection{BUGFIXES}{ 67 | \itemize{ 68 | \item \code{mclogit()} now handles empty responses (i.e. counts that 69 | sum to zero) correclty. 70 | \item \code{mclogit()} now flags non-numeric response vectors as an 71 | error. 72 | \item \code{predict()} now handles scaled independent variables correcty. 73 | } 74 | } 75 | \subsection{IMPROVEMENTS}{ 76 | \itemize{ 77 | \item \code{summary()} shows the number of groups per random 78 | effects level (if present). 79 | \item \code{mclogit()} and \code{mblogit()} with random effects now work with 80 | \code{formula=}-argumements passed in variables. 81 | } 82 | } 83 | } 84 | 85 | \section{Version 0.7}{ 86 | \subsection{IMPROVEMENTS}{ 87 | \itemize{ 88 | \item The algorithm for fitting random-effects models tended to 89 | stop prematurely returning the starting values obtained using a 90 | methods of moments. It has been completely refactored and proceeds 91 | similar to the PQL algorithm in Professor Brian Ripley's MASS 92 | package: 93 | 94 | Now an inner step, in which a linear mixed model is fitted to a 95 | working dependent variable is nested into outer step iterations, 96 | in which the the working dependent variable is 97 | updated. 98 | 99 | \item Also, the PQL algorithm no longer builds on starting values from a 100 | no-random-effects model, because surprisingly this makes the 101 | algorithm more stable and not less. 102 | 103 | As a consequence, the algorithm does a much better job at avoiding 104 | divergence or running into numerical difficulties. 105 | 106 | \item The PQL estimator for random-effects model uses a (inverse) 107 | Cholesky factor parametrisation, which makes sure that 108 | random-effects (Co-)Variance matrices are always positive 109 | (semi-)definite. 110 | } 111 | } 112 | } 113 | 114 | \section{Version 0.6}{ 115 | \subsection{NEW FEATURES}{ 116 | \itemize{ 117 | \item \code{mclogit} now complains about (i.e. throws an error 118 | exception) when the random effects structure cannot be estimated, 119 | e.g. because random effects are constant within choice sets 120 | and therefore drop out by the formation of conditional logits. 121 | } 122 | } 123 | \subsection{BUGFIXES}{ 124 | \itemize{ 125 | \item \code{mblogit} now handles responses with only two columns. 126 | \item \code{mblogit} now can deal with matrix responses that have 127 | rows that sum to zero. 128 | \item \code{mclogit} and \code{mblogit} now return a component 129 | named "df.residual" instead of "residual.df". 130 | } 131 | } 132 | } 133 | 134 | \section{Version 0.5}{ 135 | \subsection{NEW FEATURES}{ 136 | \itemize{ 137 | \item \code{mclogit} now supports conditional logit models with 138 | random slopes. 139 | \item \code{mblogit} now supports multinomial baseline models with 140 | random intercept and random slopes. 141 | } 142 | } 143 | \subsection{BUGFIXES}{ 144 | \itemize{ 145 | \item \code{predict} methods of objects created by \code{mclogit} 146 | and \code{mblogit} are better in handling missing data. 147 | } 148 | } 149 | } 150 | 151 | \section{Version 0.4}{ 152 | \subsection{NEW FEATURES}{ 153 | \itemize{ 154 | \item New \code{nobs} and \code{extractAIC} methods for \code{mclogit} objects, so that \code{drop1.default} should work with these. 155 | \item New function \code{mblogit} to fit multinomial baseline logit models. 156 | \item \code{mclogit} \code{mclogit.fit} now allow user-provided starting values. 157 | } 158 | } 159 | \subsection{BUGFIXES}{ 160 | \itemize{ 161 | \item \code{getSummary} methods now return "contrasts" and "xlevels" components. 162 | \item Fixed prediction method for \code{mclogit} results. 163 | \item Corrected handling of weights and standard errors of prediction. 164 | \item Matrices returned by the \code{mclogit} method of \code{vcov()} have 165 | row and column names. 166 | \item The number of observations is now displayed where it was not before. 167 | \item \code{nobs} is defined in \code{mclogit.fit.rePQL}. 168 | } 169 | } 170 | \subsection{USER-VISIBLE CHANGES}{ 171 | \itemize{ 172 | \item \code{mclogit.fit} and \code{mclogit.fit.rePQL} are exported to enable their use by other packages. 173 | } 174 | } 175 | } 176 | 177 | -------------------------------------------------------------------------------- /pkg/man/Transport.Rd: -------------------------------------------------------------------------------- 1 | \name{Transport} 2 | \alias{Transport} 3 | \title{Choice of Means of Transport} 4 | \description{This is an artificial data set on 5 | choice of means of transport based on cost and walking distance. 6 | } 7 | \usage{data(Transport)} 8 | \format{A data frame containing the following variables: 9 | 10 | \describe{ 11 | \item{transport}{means of transportation that can be chosen.} 12 | \item{suburb}{identifying number for each suburb} 13 | \item{distance}{walking distance to bus or train station} 14 | \item{cost}{cost of each means of transportation} 15 | \item{working}{size of working population of each suburb} 16 | \item{prop.true}{true choice probabilities} 17 | \item{resp}{choice frequencies of means of transportation} 18 | } 19 | } 20 | 21 | \keyword{datasets} 22 | -------------------------------------------------------------------------------- /pkg/man/dispersion.Rd: -------------------------------------------------------------------------------- 1 | \name{dispersion} 2 | \alias{dispersion} 3 | \alias{dispersion.mclogit} 4 | \title{Overdispersion in Multinomial Logit Models} 5 | \description{ 6 | The function \code{dispersion()} extracts the dispersion parameter 7 | from a multinomial logit model or computes a dispersion parameter 8 | estimate based on a given method. This dispersion parameter can 9 | be attached to a model using \code{update()}. It can also given as an 10 | argument to \code{summary()}. 11 | } 12 | \usage{ 13 | dispersion(object, method, \dots) 14 | \method{dispersion}{mclogit}(object, method=NULL, \dots) 15 | } 16 | \arguments{ 17 | \item{object}{an object that inherits class \code{"mclogit"}. 18 | When passed to \code{dispersion()}, it 19 | should be the result of a call of \code{mclogit()} of 20 | \code{mblogit()}, \emph{without} random effects. 21 | } 22 | \item{method}{a character string, either \code{"Afroz"}, 23 | \code{"Fletcher"}, \code{"Pearson"}, or \code{"Deviance"}, that 24 | specifies the estimator of the dispersion; or 25 | \code{NULL}, in which case the default estimator, \code{"Afroz"} 26 | is used. The estimators are discussed in Afroz et al. (2019). 27 | } 28 | \item{\dots}{other arguments, ignored or passed to other methods.} 29 | } 30 | \references{ 31 | Afroz, Farzana, Matt Parry, and David Fletcher. (2020). 32 | "Estimating Overdispersion in Sparse Multinomial Data." 33 | \emph{Biometrics} 76(3): 834-842. \doi{10.1111/biom.13194}. 34 | } 35 | \examples{ 36 | library(MASS) # For 'housing' data 37 | 38 | # Note that with a factor response and frequency weighted data, 39 | # Overdispersion will be overestimated: 40 | house.mblogit <- mblogit(Sat ~ Infl + Type + Cont, 41 | weights = Freq, 42 | data = housing) 43 | dispersion(house.mblogit, method = "Afroz") 44 | dispersion(house.mblogit, method = "Deviance") 45 | 46 | # In order to be able to estimate overdispersion accurately, 47 | # data like the above (which usually comes from applying 48 | # 'as.data.frame' to a contingency table) the model has to be 49 | # fitted with the optional argument 'aggregate=TRUE' or 50 | # by requesting the dispersion in advance. 51 | house.mblogit.agg <- mblogit(Sat ~ Infl + Type + Cont, 52 | weights = Freq, 53 | data = housing, 54 | aggregate = TRUE) 55 | # Now the estimated dispersion parameter is no longer larger than 20, 56 | # but just bit over 1.0. 57 | dispersion(house.mblogit.agg, method = "Afroz") 58 | dispersion(house.mblogit.agg, method = "Deviance") 59 | 60 | # It is possible to obtain the dispersion after estimating the coefficients: 61 | phi.Afroz <- dispersion(house.mblogit.agg, method = "Afroz") 62 | summary(house.mblogit.agg, dispersion = phi.Afroz) 63 | 64 | summary(update(house.mblogit.agg, dispersion = "Afroz")) 65 | 66 | # If an estimate of the (over-)dispersion is requested, 'aggregate' is set to 67 | # TRUE by default: 68 | house.mblogit.odsp <- mblogit(Sat ~ Infl + Type + Cont, 69 | weights = Freq, 70 | data = housing, 71 | dispersion = "Afroz") 72 | summary(house.mblogit.odsp) 73 | dispersion(house.mblogit.odsp, method = "Deviance") 74 | 75 | # Note that aggregation (either implicitly or explicitly required) affects 76 | # the reported deviance in surprising ways: 77 | house.mblogit.o.00 <- mblogit(Sat ~ Infl, 78 | weights = Freq, 79 | data = housing, 80 | dispersion = TRUE) 81 | deviance(house.mblogit.o.00) 82 | dispersion(house.mblogit.o.00) 83 | # The deviance is (almost) zero, because aggregation leads to a two-way 84 | # table and a single-predictor model is already saturated. 85 | 86 | # In order to make models comparable, one will need to set the groups: 87 | house.mblogit.o.0 <- mblogit(Sat ~ Infl, 88 | weights = Freq, 89 | data = housing, 90 | groups = ~ Infl + Type + Cont, 91 | dispersion = TRUE) 92 | deviance(house.mblogit.o.0) 93 | dispersion(house.mblogit.o.0) 94 | 95 | anova(house.mblogit.o.0, 96 | house.mblogit.odsp) 97 | 98 | # These complications with the deviances do not arrise if no aggregation is 99 | # requested: 100 | house.mblogit.0 <- mblogit(Sat ~ Infl, 101 | weights = Freq, 102 | data = housing) 103 | anova(house.mblogit.0, 104 | house.mblogit) 105 | 106 | 107 | # Using frequences on the left-hand side is perhaps the safest option: 108 | housing.wide <- memisc::Aggregate(table(Sat) ~ Infl + Type + Cont, 109 | data = housing) # Note that 'Aggegate' uses 110 | # variable 'Freq' for weighting. 111 | house.mblogit.wide <- mblogit(cbind(Low,Medium,High) ~ Infl + Type + Cont, 112 | data = housing.wide) 113 | summary(house.mblogit.wide) 114 | dispersion(house.mblogit.wide, method = "Afroz") 115 | 116 | house.mblogit.wide.0 <- mblogit(cbind(Low,Medium,High) ~ Infl, 117 | data = housing.wide) 118 | summary(house.mblogit.wide.0) 119 | dispersion(house.mblogit.wide.0, method="Afroz") 120 | 121 | anova(house.mblogit.wide.0, 122 | house.mblogit.wide) 123 | } 124 | -------------------------------------------------------------------------------- /pkg/man/electors.Rd: -------------------------------------------------------------------------------- 1 | \name{electors} 2 | \alias{electors} 3 | \title{Class, Party Position, and Electoral Choice} 4 | \description{This is an artificial data set on 5 | electoral choice as influenced by class and party positions. 6 | } 7 | \usage{data(electors)} 8 | \format{A data frame containing the following variables: 9 | 10 | \describe{ 11 | \item{class}{class position of voters} 12 | \item{party}{party that runs for election} 13 | \item{Freq}{freqency by which each party list is chosen by members of each class} 14 | \item{time}{time variable, runs from zero to one} 15 | \item{econ.left}{economic-policy "leftness" of each party} 16 | \item{welfare}{emphasis of welfare expansion of each party} 17 | \item{auth}{position on authoritarian issues} 18 | } 19 | } 20 | \examples{ 21 | data(electors) 22 | 23 | summary(mclogit( 24 | cbind(Freq,interaction(time,class))~econ.left+welfare+auth, 25 | data=electors)) 26 | 27 | summary(mclogit( 28 | cbind(Freq,interaction(time,class))~econ.left/class+welfare/class+auth/class, 29 | data=electors)) 30 | 31 | \dontrun{# This takes a bit longer. 32 | summary(mclogit( 33 | cbind(Freq,interaction(time,class))~econ.left/class+welfare/class+auth/class, 34 | random=~1|party.time, 35 | data=within(electors,party.time<-interaction(party,time)))) 36 | 37 | summary(mclogit( 38 | cbind(Freq,interaction(time,class))~econ.left/(class*time)+welfare/class+auth/class, 39 | random=~1|party.time, 40 | data=within(electors,{ 41 | party.time <-interaction(party,time) 42 | econ.left.sq <- (econ.left-mean(econ.left))^2 43 | }))) 44 | } 45 | } 46 | 47 | \keyword{datasets} 48 | -------------------------------------------------------------------------------- /pkg/man/getSummary-mclogit.Rd: -------------------------------------------------------------------------------- 1 | \name{getSummary-methods} 2 | \alias{getSummary.mclogit} 3 | \alias{getSummary.mblogit} 4 | \alias{getSummary.mmclogit} 5 | \alias{getSummary.mmblogit} 6 | \title{`getSummary` Methods} 7 | \description{ 8 | \code{\link[memisc]{getSummary}} methods for use by \code{\link[memisc]{mtable}} 9 | } 10 | \usage{ 11 | \method{getSummary}{mblogit}(obj, 12 | alpha=.05, 13 | \dots) 14 | \method{getSummary}{mclogit}(obj, 15 | alpha=.05, 16 | rearrange=NULL, 17 | \dots) 18 | \method{getSummary}{mmblogit}(obj, 19 | alpha=.05, 20 | \dots) 21 | \method{getSummary}{mmclogit}(obj, 22 | alpha=.05, 23 | rearrange=NULL, 24 | \dots) 25 | 26 | } 27 | \arguments{ 28 | \item{obj}{an object returned by \code{\link{mblogit}} or \code{\link{mclogit}}} 29 | \item{alpha}{level of the confidence intervals; their coverage should 30 | be 1-alpha/2 } 31 | \item{rearrange}{an optional named list of character vectors. 32 | Each element of the list designates a column in the table of estimates, 33 | and each element of a character vector refers to a coefficient. 34 | Names of list elements become column heads and names 35 | of the character vector elements become coefficient labels. 36 | } 37 | \item{\dots}{further arguments; ignored.} 38 | } 39 | \examples{ 40 | \dontrun{ 41 | summary(classd.model <- mclogit(cbind(Freq,choice.set)~ 42 | (econdim1.sq+nonmatdim1.sq+nonmatdim2.sq)+ 43 | (econdim1+nonmatdim1+nonmatdim2)+ 44 | (econdim1+nonmatdim1+nonmatdim2):classd, 45 | data=mvoteint.classd,random=~1|mvoteint/eb, 46 | subset=classd!="Farmers")) 47 | myGetSummary.classd <- function(x)getSummary.mclogit(x,rearrange=list( 48 | "Econ. Left/Right"=c( 49 | "Squared effect"="econdim1.sq", 50 | "Linear effect"="econdim1", 51 | " x Intermediate/Manual worker"="econdim1:classdIntermediate", 52 | " x Service class/Manual worker"="econdim1:classdService class", 53 | " x Self-employed/Manual worker"="econdim1:classdSelf-employed" 54 | ), 55 | "Lib./Auth."=c( 56 | "Squared effect"="nonmatdim1.sq", 57 | "Linear effect"="nonmatdim1", 58 | " x Intermediate/Manual worker"="nonmatdim1:classdIntermediate", 59 | " x Service class/Manual worker"="nonmatdim1:classdService class", 60 | " x Self-employed/Manual worker"="nonmatdim1:classdSelf-employed" 61 | ), 62 | "Mod./Trad."=c( 63 | "Squared effect"="nonmatdim2.sq", 64 | "Linear effect"="nonmatdim2", 65 | " x Intermediate/Manual worker"="nonmatdim2:classdIntermediate", 66 | " x Service class/Manual worker"="nonmatdim2:classdService class", 67 | " x Self-employed/Manual worker"="nonmatdim2:classdSelf-employed" 68 | ) 69 | )) 70 | 71 | library(memisc) 72 | mtable(classd.model,getSummary=myGetSummary.classd) 73 | # Output would look like so: 74 | # ================================================================================== 75 | # Econ. Left/Right Lib./Auth. Mod./Trad. 76 | # ---------------------------------------------------------------------------------- 77 | # Squared effect 0.030 0.008 -0.129** 78 | # (0.081) (0.041) (0.047) 79 | # Linear effect -0.583*** -0.038 0.137** 80 | # (0.063) (0.041) (0.045) 81 | # x Intermediate/Manual worker 0.632*** -0.029 -0.015 82 | # (0.026) (0.020) (0.019) 83 | # x Service class/Manual worker 1.158*** 0.084** 0.000 84 | # (0.040) (0.032) (0.030) 85 | # x Self-employed/Manual worker 1.140*** 0.363*** 0.112*** 86 | # (0.035) (0.027) (0.026) 87 | # Var(mvoteint) 1.080*** 88 | # (0.000) 89 | # Var(mvoteint x eb) 0.118*** 90 | # (0.000) 91 | # ---------------------------------------------------------------------------------- 92 | # Dispersion 1.561 93 | # Deviance 15007.0 94 | # N 173445 95 | # ================================================================================== 96 | } 97 | } 98 | -------------------------------------------------------------------------------- /pkg/man/mblogit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mblogit.R 3 | \name{mblogit} 4 | \alias{mblogit} 5 | \alias{print.mblogit} 6 | \alias{summary.mblogit} 7 | \alias{print.summary.mblogit} 8 | \alias{fitted.mblogit} 9 | \alias{weights.mblogit} 10 | \alias{print.mmblogit} 11 | \alias{summary.mmblogit} 12 | \alias{print.summary.mmblogit} 13 | \title{Baseline-Category Logit Models for Categorical and Multinomial Responses} 14 | \usage{ 15 | mblogit( 16 | formula, 17 | data = parent.frame(), 18 | random = NULL, 19 | catCov = c("free", "diagonal", "single"), 20 | subset, 21 | weights = NULL, 22 | offset = NULL, 23 | na.action = getOption("na.action"), 24 | model = TRUE, 25 | x = FALSE, 26 | y = TRUE, 27 | contrasts = NULL, 28 | method = NULL, 29 | estimator = c("ML", "REML"), 30 | dispersion = FALSE, 31 | start = NULL, 32 | aggregate = !isFALSE(dispersion), 33 | groups = NULL, 34 | from.table = FALSE, 35 | control = if (length(random)) mmclogit.control(...) else mclogit.control(...), 36 | ... 37 | ) 38 | } 39 | \arguments{ 40 | \item{formula}{the model formula. The response must be a factor or a matrix 41 | of counts.} 42 | 43 | \item{data}{an optional data frame, list or environment (or object coercible 44 | by \code{\link{as.data.frame}} to a data frame) containing the variables 45 | in the model. If not found in \code{data}, the variables are taken from 46 | \code{environment(formula)}, typically the environment from which 47 | \code{glm} is called.} 48 | 49 | \item{random}{an optional formula or list of formulas that specify the 50 | random-effects structure or NULL.} 51 | 52 | \item{catCov}{a character string that specifies optional restrictions 53 | on the covariances of random effects between the logit equations. 54 | "free" means no restrictions, "diagonal" means that random effects 55 | pertinent to different categories are uncorrelated, while "single" means 56 | that the random effect variances pertinent to all categories are identical.} 57 | 58 | \item{subset}{an optional vector specifying a subset of observations to be 59 | used in the fitting process.} 60 | 61 | \item{weights}{an optional vector of weights to be used in the fitting 62 | process. Should be \code{NULL} or a numeric vector.} 63 | 64 | \item{offset}{an optional model offset.} 65 | 66 | \item{na.action}{a function which indicates what should happen when the data 67 | contain \code{NA}s. The default is set by the \code{na.action} setting 68 | of \code{\link{options}}, and is \code{\link{na.fail}} if that is unset. 69 | The \sQuote{factory-fresh} default is \code{\link{na.omit}}. Another 70 | possible value is \code{NULL}, no action. Value \code{\link{na.exclude}} 71 | can be useful.} 72 | 73 | \item{model}{a logical value indicating whether \emph{model frame} should be 74 | included as a component of the returned value.} 75 | 76 | \item{x, y}{logical values indicating whether the response vector and model 77 | matrix used in the fitting process should be returned as components of 78 | the returned value.} 79 | 80 | \item{contrasts}{an optional list. See the \code{contrasts.arg} of 81 | \code{model.matrix.default}.} 82 | 83 | \item{method}{\code{NULL} or a character string, either "PQL" or "MQL", 84 | specifies the type of the quasilikelihood approximation to be used if a 85 | random-effects model is to be estimated.} 86 | 87 | \item{estimator}{a character string; either "ML" or "REML", specifies which 88 | estimator is to be used/approximated.} 89 | 90 | \item{dispersion}{a logical value or a character string; whether and how a 91 | dispersion parameter should be estimated. For details see 92 | \code{\link{dispersion}}.} 93 | 94 | \item{start}{an optional matrix of starting values (with as many rows 95 | as logit equations). If the model has random effects, the matrix 96 | should have a "VarCov" attribute wtih starting values for 97 | the random effects (co-)variances. If the random effects model 98 | is estimated with the "PQL" method, the starting values matrix 99 | should also have a "random.effects" attribute, which should have 100 | the same structure as the "random.effects" component of an object 101 | returned by \code{mblogit()}.} 102 | 103 | \item{aggregate}{a logical value; whether to aggregate responses by 104 | covariate classes and groups before estimating the model 105 | if the response variable is a factor. 106 | 107 | This will not affect the estimates, but the dispersion and the 108 | residual degrees of freedom. If \code{aggregate=TRUE}, the 109 | dispersion will be relative to a saturated model; it will be much 110 | smaller than with \code{aggregate=TRUE}. In particular, with only 111 | a single covariate and no grouping, the deviance will be close to 112 | zero. If \code{dispersion} is not \code{FALSE}, then the 113 | default value of \code{aggregate} will be \code{TRUE}. For details see 114 | \code{\link{dispersion}}. 115 | 116 | This argument has consequences only if the response in \code{formula} 117 | is a factor.} 118 | 119 | \item{groups}{an optional formula that specifies groups of observations 120 | relevant for the estimation of overdispersion. For details see 121 | \code{\link{dispersion}}.} 122 | 123 | \item{from.table}{a logical value; should be FALSE. This argument 124 | only exists for the sake of compatibility and will be removed 125 | in the next relase.} 126 | 127 | \item{control}{a list of parameters for the fitting process. See 128 | \code{\link{mclogit.control}}} 129 | 130 | \item{\dots}{arguments to be passed to \code{mclogit.control} or 131 | \code{mmclogit.control}} 132 | } 133 | \value{ 134 | \code{mblogit} returns an object of class "mblogit", which has almost 135 | the same structure as an object of class "\link[stats]{glm}". The 136 | difference are the components \code{coefficients}, \code{residuals}, 137 | \code{fitted.values}, \code{linear.predictors}, and \code{y}, which are 138 | matrices with number of columns equal to the number of response 139 | categories minus one. 140 | } 141 | \description{ 142 | The function \code{mblogit} fits baseline-category logit models for categorical 143 | and multinomial count responses with fixed alternatives. 144 | } 145 | \details{ 146 | The function \code{mblogit} internally rearranges the data into a 147 | 'long' format and uses \code{\link{mclogit.fit}} to compute 148 | estimates. Nevertheless, the 'user data' are unaffected. 149 | } 150 | \examples{ 151 | library(MASS) # For 'housing' data 152 | library(nnet) 153 | library(memisc) 154 | 155 | (house.mult<- multinom(Sat ~ Infl + Type + Cont, weights = Freq, 156 | data = housing)) 157 | 158 | 159 | (house.mblogit <- mblogit(Sat ~ Infl + Type + Cont, weights = Freq, 160 | data = housing)) 161 | 162 | summary(house.mult) 163 | 164 | summary(house.mblogit) 165 | 166 | mtable(house.mblogit) 167 | } 168 | \references{ 169 | Agresti, Alan. 2002. 170 | \emph{Categorical Data Analysis.} 2nd ed, Hoboken, NJ: Wiley. 171 | \doi{10.1002/0471249688} 172 | 173 | Breslow, N.E. and D.G. Clayton. 1993. 174 | "Approximate Inference in Generalized Linear Mixed Models". 175 | \emph{Journal of the American Statistical Association} 88 (421): 9-25. 176 | \doi{10.1080/01621459.1993.10594284} 177 | } 178 | \seealso{ 179 | The function \code{\link[nnet]{multinom}} in package \pkg{nnet} also 180 | fits multinomial baseline-category logit models, but has a slightly less 181 | convenient output and does not support overdispersion or random 182 | effects. However, it provides some other options. Baseline-category logit 183 | models are also supported by the package \pkg{VGAM}, as well as some 184 | reduced-rank and (semi-parametric) additive generalisations. The package 185 | \pkg{mnlogit} estimates logit models in a way optimized for large numbers 186 | of alternatives. 187 | } 188 | -------------------------------------------------------------------------------- /pkg/man/mclogit.Rd: -------------------------------------------------------------------------------- 1 | \name{mclogit} 2 | \alias{mclogit} 3 | \alias{anova.mclogit} 4 | \alias{print.mclogit} 5 | \alias{vcov.mclogit} 6 | \alias{deviance.mclogit} 7 | \alias{logLik.mclogit} 8 | \alias{summary.mclogit} 9 | \alias{print.summary.mclogit} 10 | \alias{fitted.mclogit} 11 | \alias{residuals.mclogit} 12 | \alias{weights.mclogit} 13 | \alias{AIC.mclogit} 14 | \alias{BIC.mclogit} 15 | \alias{update.mclogit} 16 | \alias{anova.mclogit} 17 | \alias{summary.mmclogit} 18 | \alias{print.summary.mmclogit} 19 | \alias{ranef.mmclogit} 20 | 21 | \title{Conditional Logit Models and Mixed Conditional Logit Models} 22 | \description{ 23 | \code{mclogit} fits conditional logit models and mixed conditional 24 | logit models to count data and individual choice data, 25 | where the choice set may vary across choice occasions. 26 | 27 | Conditional logit models without random effects are fitted by 28 | Fisher-scoring/IWLS. Models with random effects 29 | (mixed conditional logit models) are estimated via maximum likelihood 30 | with a simple Laplace aproximation (aka PQL). 31 | } 32 | \usage{ 33 | 34 | mclogit(formula, data=parent.frame(), random=NULL, 35 | subset, weights = NULL, offset=NULL, na.action = getOption("na.action"), 36 | model = TRUE, x = FALSE, y = TRUE, contrasts=NULL, 37 | method = NULL, estimator=c("ML","REML"), 38 | dispersion = FALSE, 39 | start=NULL, 40 | groups = NULL, 41 | control=if(length(random)) 42 | mmclogit.control(\dots) 43 | else mclogit.control(\dots), \dots) 44 | 45 | \method{update}{mclogit}(object, formula., dispersion, \dots) 46 | 47 | \method{summary}{mclogit}(object, dispersion = NULL, correlation = FALSE, 48 | symbolic.cor = FALSE, \dots) 49 | } 50 | \arguments{ 51 | \item{formula}{a model formula: a symbolic description of the 52 | model to be fitted. The left-hand side should result in 53 | a two-column matrix. The first column contains 54 | the choice counts or choice indicators (alternative is 55 | chosen=1, is not chosen=0). The second column contains 56 | unique numbers for each choice set. 57 | 58 | The left-hand side can either take the form \code{cbind(choice,set)} 59 | or (from version 0.9.1) \code{choice|set} 60 | 61 | If individual-level data is used, choice sets correspond 62 | to individuals, if aggregated data with choice counts are used, 63 | choice sets usually correspond to covariate classes. 64 | 65 | The right-hand of the formula contains choice predictors. It should be noted 66 | that constants are deleted from the formula as are predictors that do not vary 67 | within choice sets. 68 | } 69 | 70 | \item{data}{an optional data frame, list or environment (or object 71 | coercible by \code{\link{as.data.frame}} to a data frame) containing 72 | the variables in the model. If not found in \code{data}, the 73 | variables are taken from \code{environment(formula)}, 74 | typically the environment from which \code{glm} is called.} 75 | 76 | \item{random}{an optional formula or list of formulas that specify the 77 | random-effects structure or NULL.} 78 | 79 | \item{subset}{an optional vector specifying a subset of observations 80 | to be used in the fitting process.} 81 | 82 | \item{weights}{an optional vector of weights to be used in the fitting 83 | process. Should be \code{NULL} or a numeric vector.} 84 | 85 | \item{offset}{an optional model offset.} 86 | 87 | \item{na.action}{a function which indicates what should happen 88 | when the data contain \code{NA}s. The default is set by 89 | the \code{na.action} setting of \code{\link{options}}, and is 90 | \code{\link{na.fail}} if that is unset. The \sQuote{factory-fresh} 91 | default is \code{\link{na.omit}}. Another possible value is 92 | \code{NULL}, no action. Value \code{\link{na.exclude}} can be useful.} 93 | 94 | \item{start}{an optional numerical vector of starting values for the 95 | conditional logit parameters. If the model has random effects, the 96 | vector should have a "VarCov" attribute wtih starting values for the 97 | random effects (co-)variances. If the random effects model is 98 | estimated with the "PQL" method, the starting values matrix should 99 | also have a "random.effects" attribute, which should have the same 100 | structure as the "random.effects" component of an object returned by 101 | \code{mblogit()}. } 102 | 103 | \item{model}{a logical value indicating whether \emph{model frame} 104 | should be included as a component of the returned value.} 105 | 106 | \item{x, y}{ 107 | logical values indicating whether the response vector and model 108 | matrix used in the fitting process should be returned as components 109 | of the returned value. 110 | } 111 | 112 | \item{contrasts}{an optional list. See the \code{contrasts.arg} 113 | of \code{model.matrix.default}.} 114 | 115 | \item{method}{\code{NULL} or a character string, either "PQL" or "MQL", specifies 116 | the type of the quasilikelihood approximation to be used if 117 | a random-effects model is to be estimated.} 118 | 119 | \item{estimator}{a character string; either "ML" or "REML", 120 | specifies which estimator is to be used/approximated.} 121 | 122 | \item{dispersion}{a real number used as dispersion parameter; 123 | a character vector that specifies the method to compute the dispersion; 124 | a logical value -- if \code{TRUE} the default method 125 | (\code{"Afroz"}) is used, if \code{FALSE}, the dispersion parameter 126 | is set to 1, that is, no dispersion. For details see \code{\link{dispersion}}.} 127 | 128 | \item{groups}{an optional formula that specifies groups of observations 129 | relevant for the estimation of overdispersion. Covariates should be 130 | constant within groups, otherwise a warning is generated 131 | since the overdispersion estimate may 132 | be imprecise. 133 | } 134 | 135 | \item{control}{a list of parameters for the fitting process. 136 | See \code{\link{mclogit.control}} } 137 | 138 | \item{\dots}{ 139 | arguments to be passed to \code{mclogit.control} or \code{mmclogit.control} 140 | } 141 | 142 | \item{object}{an object that inherits class \code{"mclogit"}. 143 | When passed to \code{dispersion()}, it 144 | should be the result of a call of \code{mclogit()} of 145 | \code{mblogit()}, \emph{without} random effects. 146 | } 147 | \item{formula.}{a changes to the model formula, 148 | see \code{\link[stats:update]{update.default}} and 149 | \code{\link[stats]{update.formula}}.} 150 | \item{correlation}{logical; see \code{\link[stats]{summary.lm}}.} 151 | \item{symbolic.cor}{logical; see \code{\link[stats]{summary.lm}}.} 152 | } 153 | \value{ 154 | \code{mclogit} returns an object of class "mclogit", which has almost the 155 | same structure as an object of class "\link[stats]{glm}". 156 | } 157 | 158 | 159 | \note{ 160 | Covariates that are constant within choice sets are automatically 161 | dropped from the model formula specified by the \code{formula} 162 | argument of \code{mclogit}. 163 | 164 | If the model contains random effects, these should 165 | \itemize{ 166 | \item either vary within choice sets (e.g. the levels of a factor 167 | that defines the choice sets should not be nested within the levels 168 | of factor) 169 | \item or be random coefficients of covariates that vary within 170 | choice sets. 171 | } 172 | 173 | In earlier versions of the package (prior to 0.6) it will lead to a 174 | failure of the model fitting algorithm if these conditions are not 175 | satisfied. Since version 0.6 of the package, the function 176 | \code{mclogit} will complain about such model a misspecification 177 | explicitely. 178 | 179 | From version 0.9.7 it is possible to choose the optimization 180 | technique used for the inner iterations of the PQL/MQL: either 181 | \code{\link[stats]{nlminb}} (the default), \code{\link[stats]{nlm}}, 182 | or any of the algorithms (other than "Brent" supported by 183 | \code{\link[stats]{optim}}). To choose the optimizer, use the 184 | appropriate argument for \code{\link{mmclogit.control}} . 185 | } 186 | 187 | \references{ 188 | Agresti, Alan (2002). 189 | \emph{Categorical Data Analysis.} 2nd ed, Hoboken, NJ: Wiley. 190 | \doi{10.1002/0471249688} 191 | 192 | Breslow, N.E. and D.G. Clayton (1993). 193 | "Approximate Inference in Generalized Linear Mixed Models". 194 | \emph{Journal of the American Statistical Association} 88 (421): 9-25. 195 | \doi{10.1080/01621459.1993.10594284} 196 | 197 | Elff, Martin (2009). 198 | "Social Divisions, Party Positions, and Electoral Behaviour". 199 | \emph{Electoral Studies} 28(2): 297-308. 200 | \doi{10.1016/j.electstud.2009.02.002} 201 | 202 | McFadden, D. (1973). 203 | "Conditionial Logit Analysis of Qualitative Choice Behavior". 204 | Pp. 105-135 in P. Zarembka (ed.). 205 | \emph{Frontiers in Econometrics}. 206 | New York: Wiley. 207 | \url{https://eml.berkeley.edu/reprints/mcfadden/zarembka.pdf} 208 | } 209 | 210 | \examples{ 211 | data(Transport) 212 | 213 | summary(mclogit( 214 | cbind(resp,suburb)~distance+cost, 215 | data=Transport 216 | )) 217 | # New syntactic sugar: 218 | summary(mclogit( 219 | resp|suburb~distance+cost, 220 | data=Transport 221 | )) 222 | 223 | 224 | \dontrun{ # This takes a bit longer. 225 | data(electors) 226 | 227 | electors <- within(electors,{ 228 | party.time <-interaction(party,time) 229 | time.class <- interaction(time,class) 230 | }) 231 | 232 | # Time points nested within parties 233 | summary(mclogit( 234 | Freq|time.class~econ.left/class+welfare/class+auth/class, 235 | random=~1|party/time, 236 | data=electors)) 237 | 238 | # Party-level random intercepts and random slopes varying over time points 239 | summary(mclogit( 240 | Freq|time.class~econ.left/class+welfare/class+auth/class, 241 | random=list(~1|party,~econ.left+0|time), 242 | data=electors)) 243 | } 244 | } 245 | \keyword{models} 246 | \keyword{regression} 247 | 248 | \seealso{ 249 | Conditional logit models are also supported by \pkg{gmnl}, \pkg{mlogit}, and \pkg{survival}. 250 | \pkg{survival} supports conditional logit models for binary panel data and case-control studies. 251 | \pkg{mlogit} and \pkg{gmnl} treat conditional logit models from an econometric perspective. 252 | Unlike the present package, they focus on the random utility interpretation of discrete choice models 253 | and support generalisations of conditional logit models, such as nested logit models, that are intended 254 | to overcome the IIA (indipendence from irrelevant alterantives) assumption. Mixed multinomial models are 255 | also supported and estimated using simulation-based techniques. Unlike the present package, 256 | mixed or random-effects extensions are mainly intended to fit repeated choices of the same individuals and not 257 | aggregated choices of many individuals facing identical alternatives. 258 | } 259 | -------------------------------------------------------------------------------- /pkg/man/mclogit.fit.Rd: -------------------------------------------------------------------------------- 1 | \name{mclogit.fit} 2 | \alias{mclogit.fit} 3 | \alias{mmclogit.fitPQLMQL} 4 | \title{ 5 | Internal functions used for model fit. 6 | } 7 | \description{ 8 | These functions are exported and documented for use by other packages. They are not 9 | intended for end users. 10 | } 11 | \usage{ 12 | mclogit.fit(y, s, w, X, 13 | dispersion=FALSE, 14 | start = NULL, offset = NULL, 15 | control = mclogit.control()) 16 | 17 | mmclogit.fitPQLMQL(y, s, w, X, Z, d, 18 | start = NULL, 19 | start.Phi = NULL, 20 | start.b = NULL, 21 | offset = NULL, method=c("PQL","MQL"), 22 | estimator = c("ML","REML"), 23 | control = mmclogit.control()) 24 | } 25 | \arguments{ 26 | \item{y}{a response vector. Should be binary.} 27 | \item{s}{a vector identifying individuals or covariate strata} 28 | \item{w}{a vector with observation weights.} 29 | \item{X}{a model matrix; required.} 30 | \item{dispersion}{a logical value or a character string; whether and how 31 | a dispersion parameter should be estimated. For details see \code{\link{dispersion}}.} 32 | \item{Z}{the random effects design matrix.} 33 | \item{d}{dimension of random effects. Typically $d=1$ for random intercepts 34 | only, $d>1$ for models with random intercepts.} 35 | \item{start}{an optional numerical vector of starting values 36 | for the coefficients. 37 | } 38 | \item{offset}{an optional model offset. Currently only supported 39 | for models without random effects.} 40 | \item{start.Phi}{an optional matrix of strarting values for the 41 | (co-)variance parameters.} 42 | \item{start.b}{an optional list of vectors with starting values 43 | for the random effects.} 44 | \item{method}{a character string, either "PQL" or "MQL", specifies 45 | the type of the quasilikelihood approximation.} 46 | \item{estimator}{a character string; either "ML" or "REML", 47 | specifies which estimator is to be used/approximated.} 48 | \item{control}{a list of parameters for the fitting process. 49 | See \code{\link{mclogit.control}} } 50 | 51 | } 52 | \value{ 53 | A list with components describing the fitted model. 54 | } 55 | -------------------------------------------------------------------------------- /pkg/man/mclogit_control.Rd: -------------------------------------------------------------------------------- 1 | \name{mclogit.control} 2 | \alias{mclogit.control} 3 | \alias{mmclogit.control} 4 | 5 | \title{Control Parameters for the Fitting Process} 6 | \description{ 7 | \code{mclogit.control} returns a list of default parameters 8 | that control the fitting process of \code{mclogit}. 9 | } 10 | \usage{ 11 | mclogit.control(epsilon = 1e-08, 12 | maxit = 25, trace=TRUE) 13 | mmclogit.control(epsilon = 1e-08, 14 | maxit = 25, trace=TRUE, 15 | trace.inner=FALSE, 16 | avoid.increase = FALSE, 17 | break.on.increase = FALSE, 18 | break.on.infinite = FALSE, 19 | break.on.negative = FALSE, 20 | inner.optimizer = "nlminb", 21 | maxit.inner = switch(inner.optimizer, 22 | SANN = 10000, 23 | `Nelder-Mead` = 500, 24 | 100), 25 | CG.type = 1, 26 | NM.alpha = 1, 27 | NM.beta = 0.5, 28 | NM.gamma = 2.0, 29 | SANN.temp = 10, 30 | SANN.tmax = 10, 31 | grtol = 1e-6, 32 | xtol = 1e-8, 33 | maxeval = 100, 34 | gradstep = c(1e-6, 1e-8), 35 | use.gradient = c("analytic","numeric")) 36 | } 37 | \arguments{ 38 | \item{epsilon}{positive convergence tolerance \eqn{\epsilon}; 39 | the iterations converge when 40 | \eqn{|dev - dev_{old}|/(|dev| + 0.1) < \epsilon}{|dev - devold|/(|dev| + 0.1) < \epsilon}.} 41 | \item{maxit}{integer giving the maximal number of IWLS or PQL iterations.} 42 | \item{trace}{logical indicating if output should be produced for each 43 | iteration.} 44 | \item{trace.inner}{logical; indicating if output should be produced for each 45 | inner iteration of the PQL method.} 46 | \item{avoid.increase}{logical; should an increase of the deviance 47 | be avoided by step truncation?} 48 | \item{break.on.increase}{logical; should an increase of the deviance 49 | be avoided by stopping the algorithm?} 50 | \item{break.on.infinite}{logical; should an infinite deviance 51 | stop the algorithm instead of leading to step truncation?} 52 | \item{break.on.negative}{logical; should a negative deviance 53 | stop the algorithm?} 54 | \item{inner.optimizer}{a character string, one of 55 | "nlminb", "nlm", "ucminf", "Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN". 56 | See \code{\link[stats]{nlminb}}, \code{\link[stats]{nlm}}, 57 | \code{\link[ucminf]{ucminf}}, or 58 | \code{\link[stats]{optim}}. 59 | } 60 | \item{maxit.inner}{integer; the maximum number of inner iterations} 61 | \item{CG.type}{integer; the \code{type} argument passed to 62 | \code{\link{optim}} if 63 | "CG" is selected as inner optimizer.} 64 | \item{NM.alpha}{integer; the \code{alpha} argument passed to 65 | \code{\link{optim}} if 66 | "Nelder-Mead" is selected as inner optimizer.} 67 | \item{NM.beta}{integer; the \code{beta} argument passed to 68 | \code{\link{optim}} if 69 | "Nelder-Mead" is selected as inner optimizer.} 70 | \item{NM.gamma}{integer; the \code{gamma} argument passed to 71 | \code{\link{optim}} if 72 | "Nelder-Mead" is selected as inner optimizer.} 73 | \item{SANN.temp}{integer; the \code{temp} argument passed to 74 | \code{\link{optim}} if 75 | "SANN" is selected as inner optimizer.} 76 | \item{SANN.tmax}{integer; the \code{tmax} argument passed to 77 | \code{\link{optim}} if 78 | "SANN" is selected as inner optimizer.} 79 | \item{grtol}{numeric; the \code{grtol} control parameter 80 | for \code{ucminf} if "ucminf" is selected as inner optimizer.} 81 | \item{xtol}{numeric; the \code{xtol} control parameter 82 | for \code{ucminf} if "ucminf" is selected as inner optimizer.} 83 | \item{maxeval}{integer; the \code{maxeval} control parameter 84 | for \code{ucminf} if "ucminf" is selected as inner optimizer.} 85 | \item{gradstep}{a numeric vector of length; the \code{gradstep} control parameter 86 | for \code{ucminf} if "ucminf" is selected as inner optimizer.} 87 | \item{use.gradient}{a character string; whether the gradient should 88 | be computed analytically or whether a finite-difference approximation 89 | should be used.} 90 | } 91 | \value{ 92 | A list. 93 | } 94 | -------------------------------------------------------------------------------- /pkg/man/predict.Rd: -------------------------------------------------------------------------------- 1 | \name{predict} 2 | \alias{predict.mblogit} 3 | \alias{predict.mmblogit} 4 | \alias{predict.mclogit} 5 | \alias{predict.mmclogit} 6 | 7 | \title{Predicting responses or linear parts of the baseline-category and 8 | conditional logit models} 9 | 10 | \description{ 11 | The \code{predict()} methods allow to obtain within-sample and 12 | out-of-sample predictions from models 13 | fitted with \code{mclogit()} and \code{mblogit()}. 14 | 15 | For models with random effecs fitted using the PQL-method, it is 16 | possible to obtain responses that are conditional on the reconstructed 17 | random effects. 18 | } 19 | 20 | \usage{ 21 | 22 | \method{predict}{mblogit}(object, newdata=NULL,type=c("link","response"),se.fit=FALSE, \dots) 23 | \method{predict}{mclogit}(object, newdata=NULL,type=c("link","response"),se.fit=FALSE, \dots) 24 | \method{predict}{mmblogit}(object, newdata=NULL,type=c("link","response"),se.fit=FALSE, 25 | conditional=TRUE, \dots) 26 | \method{predict}{mmclogit}(object, newdata=NULL,type=c("link","response"),se.fit=FALSE, 27 | conditional=TRUE, \dots) 28 | } 29 | \arguments{ 30 | \item{object}{an object in class "mblogit", "mmblogit", "mclogit", or 31 | "mmclogit"} 32 | \item{newdata}{an optional data frame with new data} 33 | \item{type}{a character string specifying the kind of prediction} 34 | \item{se.fit}{a logical value; whether predictions should be 35 | accompanied with standard errors} 36 | \item{conditional}{a logical value; whether predictions should be made 37 | conditional on the random effects (or whether they are set to zero, 38 | i.e. their expectation). This argument is consequential only if 39 | the "mmblogit" or "mmclogit" object was created with \code{method="PQL"}.} 40 | \item{\dots}{other arguments, ignored.} 41 | } 42 | \value{ 43 | The \code{predict} methods return either a matrix (unless called with 44 | \code{se.fit=TRUE}) or a list with two matrix-valued elements 45 | \code{"fit"} and \code{"se.fit"}. 46 | } 47 | \examples{ 48 | library(MASS) 49 | (house.mblogit <- mblogit(Sat ~ Infl + Type + Cont, 50 | data = housing, 51 | weights=Freq)) 52 | 53 | head(pred.house.mblogit <- predict(house.mblogit)) 54 | str(pred.house.mblogit <- predict(house.mblogit,se=TRUE)) 55 | 56 | head(pred.house.mblogit <- predict(house.mblogit, 57 | type="response")) 58 | str(pred.house.mblogit <- predict(house.mblogit,se=TRUE, 59 | type="response")) 60 | \donttest{ # This takes a bit longer. 61 | data(electors) 62 | (mcre <- mclogit( 63 | cbind(Freq,interaction(time,class))~econ.left/class+welfare/class+auth/class, 64 | random=~1|party.time, 65 | data=within(electors,party.time<-interaction(party,time)))) 66 | 67 | str(predict(mcre)) 68 | str(predict(mcre,type="response")) 69 | 70 | str(predict(mcre,se.fit=TRUE)) 71 | str(predict(mcre,type="response",se.fit=TRUE)) 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /pkg/man/rebase.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mclogit-rebase.R 3 | \name{rebase} 4 | \alias{rebase} 5 | \alias{rebase.mblogit} 6 | \title{Change baseline category of multinomial logit or similar model} 7 | \usage{ 8 | rebase(object, to, ...) 9 | 10 | \method{rebase}{mblogit}(object, to, ...) 11 | } 12 | \arguments{ 13 | \item{object}{a statistical model object} 14 | 15 | \item{to}{usually, a string; the baseline category} 16 | 17 | \item{...}{other arguments, currently ignored} 18 | } 19 | \description{ 20 | `rebase` returns an model object that is equivalent to the one 21 | given as argument but differs in parameterization 22 | } 23 | -------------------------------------------------------------------------------- /pkg/man/simulate.Rd: -------------------------------------------------------------------------------- 1 | \name{simulate.mclogit} 2 | \alias{simulate.mclogit} 3 | \alias{simulate.mblogit} 4 | \alias{simulate.mmclogit} 5 | \alias{simulate.mmblogit} 6 | \title{ 7 | Simulating responses from baseline-category and conditional logit models 8 | } 9 | \description{ 10 | The \code{simulate()} methods allow to simulate responses from models 11 | fitted with \code{mclogit()} and \code{mblogit()}. Currently only 12 | models \emph{without} random effects are supported for this. 13 | } 14 | \usage{ 15 | \method{simulate}{mblogit}(object, nsim = 1, seed = NULL, \dots) 16 | \method{simulate}{mclogit}(object, nsim = 1, seed = NULL, \dots) 17 | 18 | # These methods are currently just 'stubs', causing an error 19 | # message stating that simulation from models with random 20 | # effects are not supported yet 21 | \method{simulate}{mmblogit}(object, nsim = 1, seed = NULL, \dots) 22 | \method{simulate}{mmclogit}(object, nsim = 1, seed = NULL, \dots) 23 | } 24 | \arguments{ 25 | \item{object}{an object from the relevant class} 26 | \item{nsim}{a number, specifying the number of simulated responses 27 | for each observation.} 28 | \item{seed}{an object specifying if and how the random number 29 | generator should be initialized ('seeded'). The interpetation of 30 | this argument follows the default method, see \code{link[stats]{simulate}} 31 | } 32 | \item{\dots}{other arguments, ignored.} 33 | } 34 | \value{ 35 | The result of the \code{\link[stats]{simulate}} method for objects 36 | created by \code{\link{mclogit}} is a data frame with one variable for 37 | each requested simulation run (their number is given by the 38 | \code{nsim=} argument). The contents of the columns are counts (or 39 | zero-one values), with group-wise multinomial distribution (within 40 | choice sets) just like it is assumed for the original response. 41 | 42 | The shape of the result of the \code{\link[stats]{simulate}} method 43 | for objects created by \code{\link{mblogit}} is also a data frame. 44 | The variables within the data frame have a mode or shape that 45 | corresponds to the response to which the model was fitted. If the 46 | response is a matrix of counts, then the variables in the data frame 47 | are also matrices of counts. If the response is a factor and 48 | \code{\link{mblogit}} was called with an argument 49 | \code{from.table=FALSE}, the variables in the data frame are factors 50 | with the same factor levels as the response to which the model was 51 | fitted. If instead the function was called with 52 | \code{from.table=TRUE}, the variables in the data frame are counts, 53 | which represent frequency weights that would result from applying 54 | \code{\link[base]{as.data.frame}} to a contingency table of simulated 55 | frequency counts. 56 | } 57 | \examples{ 58 | library(MASS) 59 | (house.mblogit <- mblogit(Sat ~ Infl + Type + Cont, 60 | data = housing, 61 | weights=Freq, 62 | aggregate=TRUE)) 63 | sm <- simulate(house.mblogit,nsim=7) 64 | 65 | housing.long <- housing[rep(seq.int(nrow(housing)),housing$Freq),] 66 | (housel.mblogit <- mblogit(Sat ~ Infl + Type + Cont, 67 | data=housing.long)) 68 | sml <- simulate(housel.mblogit,nsim=7) 69 | 70 | housing.table <- xtabs(Freq~.,data=housing) 71 | housing.mat <- memisc::to.data.frame(housing.table) 72 | head(housing.mat) 73 | 74 | (housem.mblogit <- mblogit(cbind(Low,Medium,High) ~ 75 | Infl + Type + Cont, 76 | data=housing.mat)) 77 | smm <- simulate(housem.mblogit,nsim=7) 78 | 79 | str(sm) 80 | str(sml) 81 | str(smm) 82 | 83 | head(smm[[1]]) 84 | } 85 | -------------------------------------------------------------------------------- /pkg/pkgdown/_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://melff.github.io/mclogit 2 | template: 3 | bootstrap: 5 4 | bootswatch: zephyr 5 | light-switch: true 6 | articles: 7 | - title: The statistical models 8 | navbar: The statistical models 9 | contents: 10 | - conditional-logit 11 | - baseline-logit 12 | - baseline-and-conditional-logit 13 | - random-effects 14 | - title: Technical aspects of model fitting 15 | navbar: Technical aspects of model fitting 16 | contents: 17 | - fitting-mclogit 18 | - approximations 19 | 20 | -------------------------------------------------------------------------------- /pkg/vignettes/approximations.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: Approximate Inference for Multinomial Logit Models with Random Effects 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | % \VignetteIndexEntry{Approximate Inference for Multinomial Logit Models with Random Effects} 6 | % \VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | bibliography: mclogit.bib 9 | --- 10 | 11 | # The problem 12 | 13 | A crucial problem for inference about non-linear models with random 14 | effects is that the likelihood function for such models involves 15 | integrals for which no analytical solution exists. 16 | 17 | For given values $\boldsymbol{b}$ of the random effects the likelihood 18 | function of a conditional logit model (and therefore also of a 19 | baseline-logit model) can be written in the form 20 | 21 | $$ 22 | \mathcal{L}_{\text{cpl}}(\boldsymbol{y},\boldsymbol{b}) 23 | = 24 | \exp\left(\ell_{\text{cpl}}(\boldsymbol{y},\boldsymbol{b})\right) 25 | =\exp 26 | \left( 27 | \ell(\boldsymbol{y}|\boldsymbol{b};\boldsymbol{\alpha}) 28 | -\frac12\ln\det(\boldsymbol{\Sigma}) 29 | -\frac12\boldsymbol{b}'\boldsymbol{\Sigma}^{-1}\boldsymbol{b} 30 | \right) 31 | $$ 32 | 33 | However, this "complete data" likelihood function cannot be used for 34 | inference, because it depends on the unobserved random effects. To 35 | arrive at a likelihood function that depends only on observed data, one 36 | needs to used the following integrated likelihood function: 37 | 38 | $$ 39 | \mathcal{L}_{\text{obs}}(\boldsymbol{y}) 40 | = 41 | \int 42 | \exp\left(\ell_{\text{cpl}}(\boldsymbol{y},\boldsymbol{b})\right) 43 | \partial \boldsymbol{b} 44 | = 45 | \int 46 | \exp 47 | \left( 48 | \ell(\boldsymbol{y}|\boldsymbol{b};\boldsymbol{\alpha}) 49 | -\frac12\ln\det(\boldsymbol{\Sigma}) 50 | -\frac12\boldsymbol{b}'\boldsymbol{\Sigma}^{-1}\boldsymbol{b} 51 | \right) 52 | \partial \boldsymbol{b} 53 | $$ 54 | 55 | In general, this integral cannot be "solved", i.e. eliminated from the 56 | formula by analytic means (it is "analytically untractable"). Instead, 57 | one will compute it either using numeric techniques (e.g. using 58 | numerical quadrature) or approximate it using analytical techniques. 59 | Unless there is only a single level of random effects numerical 60 | quadrature can become computationally be demanding, that is, the 61 | computation of the (log-)likelihood function and its derivatives can 62 | take a lot of time even on modern, state-of-the-art computer hardware. 63 | Yet approximations based on analytical techniques hand may lead to 64 | biased estimates in particular in samples where the number of 65 | observations relative to the number of random offects is small, but at 66 | least they are much easier to compute and sometimes making inference 67 | possible after all. 68 | 69 | The package "mclogit" supports to kinds of analytical approximations, 70 | the Laplace approximation and what one may call the Solomon-Cox 71 | appoximation. Both approximations are based on a quadratic expansion of 72 | the integrand so that the thus modified integral does have a closed-form 73 | solution, i.e. is analytically tractable. 74 | 75 | # The Laplace approximation and PQL 76 | 77 | ## Laplace approximation 78 | 79 | The (first-order) Laplace approximation is based on the quadratic 80 | expansion the logarithm of the integrand, the complete-data 81 | log-likelihood 82 | 83 | $$ 84 | \ell_{\text{cpl}}(\boldsymbol{y},\boldsymbol{b})\approx 85 | \ell(\boldsymbol{y}|\tilde{\boldsymbol{b}};\boldsymbol{\alpha}) 86 | - 87 | \frac12 88 | (\boldsymbol{b}-\tilde{\boldsymbol{b}})' 89 | \tilde{\boldsymbol{H}} 90 | (\boldsymbol{b}-\tilde{\boldsymbol{b}}) 91 | -\frac12\ln\det(\boldsymbol{\Sigma}) 92 | -\frac12(\boldsymbol{b}-\tilde{\boldsymbol{b}})'\boldsymbol{\Sigma}^{-1}(\boldsymbol{b}-\tilde{\boldsymbol{b}}) 93 | $$ 94 | 95 | where $\tilde{\boldsymbol{b}}$ is the solution to 96 | 97 | $$ 98 | \frac{\partial\ell_{\text{cpl}}(\boldsymbol{y},\boldsymbol{b})}{\partial\boldsymbol{b}} 99 | = 0 100 | $$ 101 | 102 | and $\tilde{\boldsymbol{H}}=\boldsymbol{H}(\tilde{\boldsymbol{b}})$ is the 103 | value of the negative Hessian with respect to $\boldsymbol{b}$ 104 | 105 | $$ 106 | \boldsymbol{H}(\boldsymbol{b})=-\frac{\partial^2\ell(\boldsymbol{y}|\boldsymbol{b};\boldsymbol{\alpha})}{\partial\boldsymbol{b}\partial\boldsymbol{b}'} 107 | $$ 108 | 109 | for $\boldsymbol{b}=\tilde{\boldsymbol{b}}$. 110 | 111 | Since this quadratic expansion---let us call it 112 | $\ell^*_{\text{Lapl}}(\boldsymbol{y},\boldsymbol{b})$---is a 113 | (multivariate) quadratic function of $\boldsymbol{b}$, the integral of 114 | its exponential does have a closed-form solution (the relevant formula 115 | can be found in @harville:matrix.algebra). 116 | 117 | For purposes of estimation, the resulting approximate log-likelihood is 118 | more useful: 119 | 120 | $$ 121 | \ell^*_{\text{Lapl}} 122 | = 123 | \ln\int \exp(\ell_{\text{Lapl}}(\boldsymbol{y},\boldsymbol{b})) \partial\boldsymbol{b} 124 | = 125 | \ell(\boldsymbol{y}|\tilde{\boldsymbol{b}};\boldsymbol{\alpha}) 126 | - 127 | \frac12\tilde{\boldsymbol{b}}'\boldsymbol{\Sigma}^{-1}\tilde{\boldsymbol{b}} 128 | - 129 | \frac12\ln\det(\boldsymbol{\Sigma}) 130 | - 131 | \frac12\ln\det\left(\tilde{\boldsymbol{H}}+\boldsymbol{\Sigma}^{-1}\right). 132 | $$ 133 | 134 | ## Penalized quasi-likelihood (PQL) 135 | 136 | If one disregards the dependence of $\tilde{\boldsymbol{H}}$ on 137 | $\boldsymbol{\alpha}$ and $\boldsymbol{b}$, then 138 | $\tilde{\boldsymbol{b}}$ maximizes not only 139 | $\ell_{\text{cpl}}(\boldsymbol{y},\boldsymbol{b})$ but also 140 | $\ell^*_{\text{Lapl}}$. This motivates the following IWLS/Fisher 141 | scoring equations for $\hat{\boldsymbol{\alpha}}$ and 142 | $\tilde{\boldsymbol{b}}$ (see 143 | @breslow.clayton:approximate.inference.glmm and [this 144 | page](fitting-mclogit.html)): 145 | 146 | $$ 147 | \begin{aligned} 148 | \begin{bmatrix} 149 | \boldsymbol{X}'\boldsymbol{W}\boldsymbol{X} & \boldsymbol{X}'\boldsymbol{W}\boldsymbol{Z} \\ 150 | \boldsymbol{Z}'\boldsymbol{W}\boldsymbol{X} & \boldsymbol{Z}'\boldsymbol{W}\boldsymbol{Z} + \boldsymbol{\Sigma}^{-1}\\ 151 | \end{bmatrix} 152 | \begin{bmatrix} 153 | \hat{\boldsymbol{\alpha}}\\ 154 | \tilde{\boldsymbol{b}}\\ 155 | \end{bmatrix} 156 | = 157 | \begin{bmatrix} 158 | \boldsymbol{X}'\boldsymbol{W}\boldsymbol{y}^*\\ 159 | \boldsymbol{Z}'\boldsymbol{W}\boldsymbol{y}^* 160 | \end{bmatrix} 161 | \end{aligned} 162 | $$ 163 | 164 | where 165 | 166 | $$ 167 | \boldsymbol{y}^* = \boldsymbol{X}\boldsymbol{\alpha} + 168 | \boldsymbol{Z}\boldsymbol{b} + 169 | \boldsymbol{W}^{-}(\boldsymbol{y}-\boldsymbol{\pi}) 170 | $$ 171 | 172 | is the IWLS "working dependend variable" with $\boldsymbol{\alpha}$, 173 | $\boldsymbol{b}$, $\boldsymbol{W}$, and $\boldsymbol{\pi}$ computed in 174 | an earlier iteration. 175 | 176 | Substitutions lead to the equations: 177 | 178 | $$ 179 | (\boldsymbol{X}\boldsymbol{V}^-\boldsymbol{X})\hat{\boldsymbol{\alpha}} = 180 | \boldsymbol{X}\boldsymbol{V}^-\boldsymbol{y}^* 181 | $$ 182 | 183 | and 184 | 185 | $$ 186 | (\boldsymbol{Z}'\boldsymbol{W}\boldsymbol{Z} + 187 | \boldsymbol{\Sigma}^{-1})\boldsymbol{b} = 188 | \boldsymbol{Z}'\boldsymbol{W}(\boldsymbol{y}^*-\boldsymbol{X}\boldsymbol{\alpha}) 189 | $$ 190 | 191 | which can be solved to compute $\hat{\boldsymbol{\alpha}}$ and 192 | $\tilde{\boldsymbol{b}}$ (for given $\boldsymbol{\Sigma}$) 193 | 194 | Here 195 | 196 | $$ 197 | \boldsymbol{V} = 198 | \boldsymbol{W}^-+\boldsymbol{Z}\boldsymbol{\Sigma}\boldsymbol{Z}' 199 | $$ 200 | 201 | and 202 | 203 | $$ 204 | \boldsymbol{V}^- = \boldsymbol{W}- 205 | \boldsymbol{W}\boldsymbol{Z}'\left(\boldsymbol{Z}'\boldsymbol{W}\boldsymbol{Z}+\boldsymbol{\Sigma}^{-1}\right)^{-1}\boldsymbol{Z}\boldsymbol{W} 206 | $$ 207 | 208 | Following @breslow.clayton:approximate.inference.glmm the variance 209 | parameters in $\boldsymbol{\Sigma}$ are estimated by minimizing 210 | 211 | $$ 212 | q_1 = 213 | \det(\boldsymbol{V})+(\boldsymbol{y}^*-\boldsymbol{X}\boldsymbol{\alpha})\boldsymbol{V}^-(\boldsymbol{y}^*-\boldsymbol{X}\boldsymbol{\alpha}) 214 | $$ 215 | 216 | or the "REML" variant: 217 | 218 | $$ 219 | q_2 = 220 | \det(\boldsymbol{V})+(\boldsymbol{y}^*-\boldsymbol{X}\boldsymbol{\alpha})\boldsymbol{V}^-(\boldsymbol{y}^*-\boldsymbol{X}\boldsymbol{\alpha})+\det(\boldsymbol{X}'\boldsymbol{V}^{-}\boldsymbol{X}) 221 | $$ 222 | 223 | This motivates the following algorithm, which is strongly inspired by 224 | the `glmmPQL()` function in Brian Ripley's *R* package 225 | [MASS](https://cran.r-project.org/package=MASS) [@MASS]: 226 | 227 | 1. Create some suitable starting values for $\boldsymbol{\pi}$, 228 | $\boldsymbol{W}$, and $\boldsymbol{y}^*$ 229 | 2. Construct the "working dependent variable" $\boldsymbol{y}^*$ 230 | 3. Minimize $q_1$ (quasi-ML) or $q_2$ (quasi-REML) iteratively 231 | (inner loop), to obtain an estimate of $\boldsymbol{\Sigma}$ 232 | 4. Obtain $hat{\boldsymbol{\alpha}}$ and $\tilde{\boldsymbol{b}}$ based 233 | on the current estimate of $\boldsymbol{\Sigma}$ 234 | 5. Compute updated $\boldsymbol{\eta}=\boldsymbol{X}\boldsymbol{\alpha} + 235 | \boldsymbol{Z}\boldsymbol{b}$, $\boldsymbol{\pi}$, $\boldsymbol{W}$. 236 | 6. If the change in $\boldsymbol{\eta}$ is smaller than a given 237 | tolerance criterion stop the algorighm and declare it as converged. 238 | Otherwise go back to step 2 with the updated values of 239 | $\hat{\boldsymbol{\alpha}}$ and $\tilde{\boldsymbol{b}}$. 240 | 241 | This algorithm is a modification of the [IWLS](fitting-mclogit.html) 242 | algorithm used to fit conditional logit models without random effects. 243 | Instead of just solving a linear requatoin in step 3, it estimates a 244 | weighted linear mixed-effects model. In contrast to `glmmPQL()` it does 245 | not use the `lme()` function from package 246 | [nlme](https://cran.r-project.org/package=nlme) [@nlme-book] for this, because the 247 | weighting matrix $\boldsymbol{W}$ is non-diagonal. Instead, $q_1$ or 248 | $q_2$ are minimized using the function `nlminb` from the standard *R* 249 | package "stats" or some other optimizer chosen by the user. 250 | 251 | # The Solomon-Cox approximation and MQL 252 | 253 | ## The Solomon-Cox approximation 254 | 255 | The (first-order) Solomon approximation [@Solomon.Cox:1992] is based on the quadratic 256 | expansion the integrand 257 | 258 | $$ 259 | \ell_{\text{cpl}}(\boldsymbol{y},\boldsymbol{b})\approx 260 | \ell(\boldsymbol{y}|\boldsymbol{0};\boldsymbol{\alpha}) 261 | + 262 | \boldsymbol{g}_0' 263 | \boldsymbol{b} 264 | - 265 | \frac12 266 | \boldsymbol{b}' 267 | \boldsymbol{H}_0 268 | \boldsymbol{b} 269 | -\frac12\ln\det(\boldsymbol{\Sigma}) 270 | -\frac12\boldsymbol{b}'\boldsymbol{\Sigma}^{-1}\boldsymbol{b} 271 | $$ 272 | 273 | where $\boldsymbol{g}\_0=\boldsymbol{g}(\boldsymbol{0})$ is the gradient 274 | of $\ell(\boldsymbol{y}\|\boldsymbol{b};\boldsymbol{\alpha})$ 275 | 276 | $$ 277 | \boldsymbol{g}(\boldsymbol{b})=-\frac{\partial\ell(\boldsymbol{y}|\boldsymbol{b};\boldsymbol{\alpha})}{\partial\boldsymbol{b}} 278 | $$ 279 | 280 | at $\boldsymbol{b}=\boldsymbol{0}$, while 281 | $\boldsymbol{H}\_0=\boldsymbol{H}(\boldsymbol{0})$ is the negative 282 | Hessian at $\boldsymbol{b}=\boldsymbol{0}$. 283 | 284 | Like before, the integral of the exponential this quadratic expansion 285 | (which we refer to as 286 | $\ell_{\text{SC}}(\boldsymbol{y},\boldsymbol{b})$) has a closed-form 287 | solution, as does its logarithm, which is: 288 | 289 | $$ 290 | \ln\int \exp(\ell_{\text{SC}}(\boldsymbol{y},\boldsymbol{b})) \partial\boldsymbol{b} 291 | = 292 | \ell(\boldsymbol{y}|\boldsymbol{0};\boldsymbol{\alpha}) 293 | - 294 | \frac12\boldsymbol{g}_0'\left(\boldsymbol{H}_0+\boldsymbol{\Sigma}^{-1}\right)^{-1}\boldsymbol{g}_0 295 | - 296 | \frac12\ln\det(\boldsymbol{\Sigma}) 297 | - 298 | \frac12\ln\det\left(\boldsymbol{H}_0+\boldsymbol{\Sigma}^{-1}\right). 299 | $$ 300 | 301 | ## Marginal quasi-likelhood (MQL) 302 | 303 | The resulting estimation technique is very similar to PQL [again, see 304 | @breslow.clayton:approximate.inference.glmm for a discussion]. The only 305 | difference is the construction of the "working dependent" variable 306 | $\boldsymbol{y}^*$. With PQL it is constructed as 307 | $$\boldsymbol{y}^* = 308 | \boldsymbol{X}\boldsymbol{\alpha} + \boldsymbol{Z}\boldsymbol{b} + 309 | \boldsymbol{W}^{-}(\boldsymbol{y}-\boldsymbol{\pi})$$ 310 | while the MQL working 311 | dependent variable is just 312 | 313 | $$ 314 | \boldsymbol{y}^* = \boldsymbol{X}\boldsymbol{\alpha} + 315 | \boldsymbol{W}^{-}(\boldsymbol{y}-\boldsymbol{\pi}) 316 | $$ 317 | 318 | so that the algorithm has the following steps: 319 | 320 | 1. Create some suitable starting values for $\boldsymbol{\pi}$, 321 | $\boldsymbol{W}$, and $\boldsymbol{y}^*$ 322 | 2. Construct the "working dependent variable" $\boldsymbol{y}^*$ 323 | 3. Minimize $q_1$ (quasi-ML) or $q_2$ (quasi-REML) iteratively 324 | (inner loop), to obtain an estimate of $\boldsymbol{\Sigma}$ 325 | 4. Obtain $\hat{\boldsymbol{\alpha}}$ based on the current estimate of 326 | $\boldsymbol{\Sigma}$ 327 | 5. Compute updated $\boldsymbol{\eta}=\boldsymbol{X}\boldsymbol{\alpha}$, 328 | $\boldsymbol{\pi}$, $\boldsymbol{W}$. 329 | 6. If the change in $\boldsymbol{\eta}$ is smaller than a given 330 | tolerance criterion stop the algorighm and declare it as converged. 331 | Otherwise go back to step 2 with the updated values of 332 | $\hat{\boldsymbol{\alpha}}$. 333 | 334 | # References 335 | -------------------------------------------------------------------------------- /pkg/vignettes/baseline-and-conditional-logit.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: The relation between baseline logit and conditional logit models 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | % \VignetteIndexEntry{The relation between baseline logit and conditional logit models} 6 | % \VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | Baseline-category logit models can be expressed as particular form of 11 | conditional logit models. In a conditional logit model (without random 12 | effects) the probability that individual $i$ chooses alternative $j$ 13 | from choice set $\mathcal{S}_i$ is 14 | 15 | $$ 16 | \pi_{ij} = \frac{\exp(\eta_{ij})}{\sum_{k\in\mathcal{S}_i}\exp(\eta_{ik})} 17 | $$ 18 | 19 | where 20 | 21 | $$ 22 | \eta_{ij} = \alpha_1x_{1ij}+\cdots+\alpha_qx_{qij} 23 | $$ 24 | 25 | In a baseline-category logit model, the set of alternatives is the same 26 | for all individuals $i$ that is $\mathcal{S}_i = {1,\ldots,q}$ and 27 | the linear part of the model can be written like: 28 | 29 | $$ 30 | \eta_{ij} = \beta_{j0}+\beta_{j1}x_{i1}+\cdots+\beta_{jr}x_{ri} 31 | $$ 32 | 33 | where the coefficients in the equation for baseline category $j$ are 34 | all zero, i.e. 35 | 36 | $$ 37 | \beta_{10} = \cdots = \beta_{1r} = 0 38 | $$ 39 | 40 | After setting 41 | 42 | $$ 43 | \begin{aligned} 44 | x_{(g\times(j-1))ij} = d_{gj}, \quad 45 | x_{(g\times(j-1)+h)ij} = d_{gj}x_{hi}, \qquad 46 | \text{with }d_{gj}= 47 | \begin{cases} 48 | 0&\text{for } j\neq g\text{ or } j=g\text{ and } j=0\\ 49 | 1&\text{for } j=g \text{ and } j\neq0\\ 50 | \end{cases} 51 | \end{aligned} 52 | $$ 53 | 54 | we have for the log-odds: 55 | 56 | $$ 57 | \begin{aligned} 58 | \begin{aligned} 59 | \ln\frac{\pi_{ij}}{\pi_{i1}} 60 | &=\beta_{j0}+\beta_{ji}x_{1i}+\cdots+\beta_{jr}x_{ri} 61 | \\ 62 | &=\sum_{h}\beta_{jh}x_{hi}=\sum_{g,h}\beta_{jh}d_{gj}x_{hi} 63 | =\sum_{g,h}\alpha_{g\times(j-1)+h}(d_{gj}x_{hi}-d_{g1}x_{hi}) 64 | =\sum_{g,h}\alpha_{g\times(j-1)+h}(x_{(g\times(j-1)+h)ij}-x_{(g\times(j-1)+h)i1})\\ 65 | &=\alpha_{1}(x_{1ij}-x_{1i1})+\cdots+\alpha_{s}(x_{sij}-x_{si1}) 66 | \end{aligned} 67 | \end{aligned} 68 | $$ 69 | 70 | where $\alpha_1=\beta_{21}$, $\alpha_2=\beta_{22}$, etc. 71 | 72 | That is, the baseline-category logit model is translated into a 73 | conditional logit model where the alternative-specific values of the 74 | attribute variables are interaction terms composed of 75 | alternativ-specific dummes and individual-specific values of 76 | characteristics variables. 77 | 78 | Analogously, the random-effects extension of the baseline-logit model 79 | can be translated into a random-effects conditional logit model where 80 | the random intercepts in the logit equations of the baseline-logit model 81 | are translated into random slopes of category-specific dummy variables. 82 | -------------------------------------------------------------------------------- /pkg/vignettes/baseline-logit.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: Baseline-category logit models 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | % \VignetteIndexEntry{Baseline-category logit models} 6 | % \VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | bibliography: mclogit.bib 9 | --- 10 | 11 | 12 | Multinomial baseline-category logit models are a generalisation of 13 | logistic regression, that allow to model not only binary or dichotomous 14 | responses, but also polychotomous responses. In addition, they allow to 15 | model responses in the form of counts that have a pre-determined sum. 16 | These models are described in 17 | @agresti:categorical.data.analysis.2002. 18 | Estimating these models is also supported by the function 19 | `multinom()` in the *R* package "nnet" [@MASS]. 20 | In the package "mclogit", the function to estimate these 21 | models is called `mblogit()`, which uses the infrastructure for estimating 22 | conditional logit models, exploiting the fact that baseline-category 23 | logit models can be re-expressed as condigional logit models. 24 | 25 | Baseline-category logit models are constructed as follows. Suppose a 26 | categorical dependent variable or response with categories 27 | $j=1,\ldots,q$ is observed for individuals $i=1,\ldots,n$. Let 28 | $\pi_{ij}$ denote the probability that the value of the dependent 29 | variable for individual $i$ is equal to $j$, then the 30 | baseline-category logit model takes the form: 31 | 32 | $$ 33 | \begin{aligned} 34 | \pi_{ij} = 35 | \begin{cases} 36 | \dfrac{\exp(\alpha_{j0}+\alpha_{j1}x_{1i}+\cdots+\alpha_{jr}x_{ri})} 37 | {1+\sum_{k>1}\exp(\alpha_{k0}+\alpha_{k1}x_{1i}+\cdots+\alpha_{kr}x_{ri})} 38 | & \text{for } j>1\\[20pt] 39 | \dfrac{1} 40 | {1+\sum_{k>1}\exp(\alpha_{k0}+\alpha_{k1}x_{1i}+\cdots+\alpha_{kr}x_{ri})} 41 | & \text{for } j=1 42 | \end{cases} 43 | \end{aligned} 44 | $$ 45 | 46 | where the first category ($j=1$) is the baseline category. 47 | 48 | Equivalently, the model can be expressed in terms of log-odds, relative 49 | to the baseline-category: 50 | 51 | $$ 52 | \ln\frac{\pi_{ij}}{\pi_{i1}} 53 | = 54 | \alpha_{j0}+\alpha_{j1}x_{1i}+\cdots+\alpha_{jr}x_{ri}. 55 | $$ 56 | 57 | Here the relevant parameters of the model are the coefficients 58 | $\alpha_{jk}$ which describe how the values of independent variables 59 | (numbered $k=1,\ldots,r$) affect the relative chances of the response 60 | taking a value $j$ versus taking the value $1$. Note that there is 61 | one coefficient for each independent variable and *each response* other 62 | than the baseline category. 63 | 64 | # References 65 | -------------------------------------------------------------------------------- /pkg/vignettes/conditional-logit.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: Conditional logit models 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | % \VignetteIndexEntry{Conditional logit models} 6 | % \VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | bibliography: mclogit.bib 9 | --- 10 | 11 | Conditional logit models are motivated by a variety of considerations, 12 | notably as a way to model binary panel data or responses in 13 | case-control-studies. The variant supported by the package "mclogit" 14 | is motivated by the analysis of discrete choices and goes back to 15 | @mcfadden:conditional.logit. Here, a 16 | series of individuals $i=1,\ldots,n$ is observed to have made a choice 17 | (represented by a number $j$) from a choice set $\mathcal{S}_i$, the 18 | set of alternatives at the individual's disposal. Each alternatives 19 | $j$ in the choice set can be described by the values 20 | $x_{1ij},\ldots,x_{1ij}$ of $r$ attribute variables (where the 21 | variables are enumerated as $i=1,\ldots,r$). (Note that in contrast to 22 | the baseline-category logit model, these values vary between choice 23 | alternatives.) Conditional logit models then posit that individual $i$ 24 | chooses alternative $j$ from his or her choice set $\mathcal{S}_i$ 25 | with probability 26 | 27 | $$ 28 | \pi_{ij} = \frac{\exp(\alpha_1x_{1ij}+\cdots+\alpha_rx_{rij})} 29 | {\sum_{k\in\mathcal{S}_i}\exp(\alpha_1x_{1ik}+\cdots+\alpha_rx_{rik})}. 30 | $$ 31 | 32 | It is worth noting that the conditional logit model does not require 33 | that all individuals face the same choice sets. Only that the 34 | alternatives in the choice sets can be distinguished from one another by 35 | the attribute variables. 36 | 37 | The similarities and differences of these models to baseline-category 38 | logit model becomes obvious if one looks at the log-odds relative to the 39 | first alternative in the choice set: 40 | 41 | $$ 42 | \ln\frac{\pi_{ij}}{\pi_{i1}} 43 | = 44 | \alpha_{1}(x_{1ij}-x_{1i1})+\cdots+\alpha_{r}(x_{rij}-x_{ri1}). 45 | $$ 46 | 47 | Conditional logit models appear more parsimonious than baseline-category 48 | logit models in so far as they have only one coefficient for each 49 | independent variables.[^1] In the "mclogi\" package, these models can 50 | be estimated using the function `mclogit()`. 51 | 52 | My interest in conditional logit models derives from my research into 53 | the influence of parties\' political positions on the patterns of 54 | voting. Here, the political positions are the attributes of the 55 | alternatives and the choice sets are the sets of parties that run 56 | candidates in a countries at various points in time. For the application 57 | of the conditional logit models, see 58 | @elff:divisions.positions.voting. 59 | 60 | # References 61 | -------------------------------------------------------------------------------- /pkg/vignettes/fitting-mclogit.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: The IWLS algorithm used to fit conditional logit models 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | % \VignetteIndexEntry{The IWLS algorithm used to fit conditional logit models} 6 | % \VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | bibliography: mclogit.bib 9 | --- 10 | 11 | The package "mclogit" fits conditional logit models using a maximum 12 | likelihood estimator. It does this by maximizing the log-likelihood 13 | function using an *iterative weighted least-squares* (IWLS) algorithm, 14 | which follows the algorithm used by the `glm.fit()` function from the 15 | "stats" package of *R* [@nelder.wedderburn:glm;@mccullagh.nelder:glm.2ed;@Rcore]. 16 | 17 | If $\pi_{ij}$ is the probability that individual $i$ chooses 18 | alternative $j$ from his/her choice set $\mathcal{S}_i$, where 19 | 20 | $$ 21 | \pi_{ij}=\frac{\exp(\eta_{ij})}{\sum_k{\in\mathcal{S}_i}\exp(\eta_{ik})} 22 | $$ 23 | 24 | and if $y_{ij}$ is the dummy variable with equals 1 if individual 25 | $i$ chooses alternative $j$ and equals 0 otherwise, the 26 | log-likelihood function (given that the choices are identically 27 | independent distributed given $\pi_{ij}$) can be written as 28 | 29 | $$ 30 | \ell=\sum_{i,j}y_{ij}\ln\pi_{ij} 31 | =\sum_{i,j}y_{ij}\eta_{ij}-\sum_i\ln\left(\sum_j\exp(\eta_{ij})\right) 32 | $$ 33 | 34 | If the data are aggregated in the terms of counts such that 35 | $n_{ij}$ is the number of individuals with the same choice set and 36 | the same choice probabilities $\pi_{ij}$ that have chosen 37 | alternative $j$, the log-likelihood is (given that the choices are 38 | identically independent distributed given $\pi_{ij}$) 39 | 40 | $$ 41 | \ell=\sum_{i,j}n_{ij}\ln\pi_{ij} 42 | =\sum_{i,j}n_{ij}\eta_{ij}-\sum_in_{i+}\ln\left(\sum_j\exp(\eta_{ij})\right) 43 | $$ 44 | 45 | where $n_{i+}=\sum_{j\in\mathcal{S}_i}n_{ij}$. 46 | 47 | If 48 | 49 | $$ 50 | \eta_{ij} = 51 | \alpha_1x_{1ij}+\cdots+\alpha_rx_{rij}=\boldsymbol{x}_{ij}'\boldsymbol{\alpha} 52 | $$ 53 | 54 | then the gradient of the log-likelihood with respect to the coefficient 55 | vector $\boldsymbol{\alpha}$ is 56 | 57 | $$ 58 | \frac{\partial\ell}{\partial\boldsymbol{\alpha}} 59 | = 60 | \sum_{i,j} 61 | \frac{\partial\eta_{ij}}{\partial\boldsymbol{\alpha}} 62 | \frac{\partial\ell}{\partial\eta_{ij}} 63 | = 64 | \sum_{i,j} 65 | \boldsymbol{x}_{ij} 66 | (n_{ij}-n_{i+}\pi_{ij}) 67 | = 68 | \sum_{i,j} 69 | \boldsymbol{x}_{ij} 70 | n_{i+} 71 | (y_{ij}-\pi_{ij}) 72 | = 73 | \boldsymbol{X}'\boldsymbol{N}(\boldsymbol{y}-\boldsymbol{\pi}) 74 | $$ 75 | 76 | and the Hessian is 77 | 78 | $$ 79 | \frac{\partial^2\ell}{\partial\boldsymbol{\alpha}\partial\boldsymbol{\alpha}'} 80 | = 81 | \sum_{i,j} 82 | \frac{\partial\eta_{ij}}{\partial\boldsymbol{\alpha}} 83 | \frac{\partial\eta_{ij}}{\partial\boldsymbol{\alpha}'} 84 | \frac{\partial\ell^2}{\partial\eta_{ij}^2} 85 | = 86 | - 87 | \sum_{i,j,k} 88 | \boldsymbol{x}_{ij} 89 | n_{i+} 90 | (\delta_{jk}-\pi_{ij}\pi_{ik}) 91 | \boldsymbol{x}_{ij}' 92 | = 93 | - 94 | \boldsymbol{X}'\boldsymbol{W}\boldsymbol{X} 95 | $$ 96 | 97 | Here $y_{ij}=n_{ij}/n_{i+}$, while 98 | $\boldsymbol{N}$ is a diagonal matrix with diagonal elements 99 | $n_{i+}$. 100 | 101 | Newton-Raphson iterations then take the form 102 | 103 | $$ 104 | \boldsymbol{\alpha}^{(s+1)} 105 | = 106 | \boldsymbol{\alpha}^{(s)} 107 | - 108 | \left( 109 | \frac{\partial^2\ell}{\partial\boldsymbol{\alpha}\partial\boldsymbol{\alpha}'} 110 | \right)^{-1} 111 | \frac{\partial\ell}{\partial\boldsymbol{\alpha}} 112 | = 113 | \boldsymbol{\alpha}^{(s)} 114 | + 115 | \left( 116 | \boldsymbol{X}'\boldsymbol{W}\boldsymbol{X} 117 | \right)^{-1} 118 | \boldsymbol{X}'\boldsymbol{N}(\boldsymbol{y}-\boldsymbol{\pi}) 119 | $$ 120 | 121 | where $\boldsymbol{\pi}$ and $\boldsymbol{W}$ are evaluated at 122 | $\boldsymbol{\alpha}=\boldsymbol{\alpha}^{(s)}$. 123 | 124 | Multiplying by $\boldsymbol{X}'\boldsymbol{W}\boldsymbol{X}$ gives 125 | 126 | $$ 127 | \boldsymbol{X}'\boldsymbol{W}\boldsymbol{X} 128 | \boldsymbol{\alpha}^{(s+1)} 129 | = 130 | \boldsymbol{X}'\boldsymbol{W}\boldsymbol{X} 131 | \boldsymbol{\alpha}^{(s)} 132 | + 133 | \boldsymbol{X}'\boldsymbol{N}(\boldsymbol{y}-\boldsymbol{\pi}) 134 | = 135 | \boldsymbol{X}'\boldsymbol{W} 136 | \left(\boldsymbol{X}\boldsymbol{\alpha}^{(s)}+\boldsymbol{W}^-\boldsymbol{N}(\boldsymbol{y}-\boldsymbol{\pi})\right) 137 | = 138 | \boldsymbol{X}'\boldsymbol{W}\boldsymbol{y}^* 139 | $$ 140 | 141 | where $\boldsymbol{W}^-$ is a generalized inverse of $\boldsymbol{W}$ 142 | and $\boldsymbol{y}^*$ is a "working response vector" with elements 143 | 144 | $$ 145 | y_{ij}^*=\boldsymbol{x}_{ij}'\boldsymbol{\alpha}^{(s)}+\frac{y_{ij}-\pi_{ij}}{\pi_{ij}} 146 | $$ 147 | 148 | The IWLS algorithm thus involves the following steps: 149 | 150 | 1. Create some suitable starting values for $\boldsymbol{\pi}$, 151 | $\boldsymbol{W}$, and $\boldsymbol{y}^*$ 152 | 153 | 2. Construct the "working dependent variable" $\boldsymbol{y}^*$ 154 | 155 | 3. Solve the equation 156 | 157 | $$ 158 | \boldsymbol{X}'\boldsymbol{W}\boldsymbol{X} 159 | \boldsymbol{\alpha} 160 | = 161 | \boldsymbol{X}'\boldsymbol{W}\boldsymbol{y}^* 162 | $$ 163 | 164 | for $\boldsymbol{\alpha}$. 165 | 166 | 4. Compute updated $\boldsymbol{\eta}$, $\boldsymbol{\pi}$, 167 | $\boldsymbol{W}$, and $\boldsymbol{y}^*$. 168 | 169 | 5. Compute the updated value for the log-likelihood or the deviance 170 | 171 | $$ 172 | d=2\sum_{i,j}n_{ij}\ln\frac{y_{ij}}{\pi_{ij}} 173 | $$ 174 | 175 | 6. If the decrease of the deviance (or the increase of the 176 | log-likelihood) is smaller than a given tolerance criterian 177 | (typically $\Delta d \leq 10^{-7}$) stop the algorighm and declare 178 | it as converged. Otherwise go back to step 2 with the updated value 179 | of $\boldsymbol{\alpha}$. 180 | 181 | The starting values for the algorithm used by the *mclogit* package are 182 | constructe as follows: 183 | 184 | 1. Set 185 | 186 | $$ 187 | \eta_{ij}^{(0)} = \ln (n_{ij}+\tfrac12) 188 | - \frac1{q_i}\sum_{k\in\mathcal{S}_i}\ln (n_{ij}+\tfrac12) 189 | $$ 190 | 191 | (where $q_i$ is the size of the choice set $\mathcal{S}_i$) 192 | 193 | 2. Compute the starting values of the choice probabilities 194 | $\pi_{ij}^{(0)}$ according to the equation at the beginning of 195 | the page 196 | 197 | 3. Compute intial values of the working dependent variable according to 198 | 199 | $$ 200 | y_{ij}^{*(0)} 201 | = 202 | \eta_{ij}^{(0)}+\frac{y_{ij}-\pi_{ij}^{(0)}}{\pi_{ij}^{(0)}} 203 | $$ 204 | 205 | # References 206 | -------------------------------------------------------------------------------- /pkg/vignettes/mclogit.bib: -------------------------------------------------------------------------------- 1 | 2 | @book{agresti:categorical.data.analysis.2002, 3 | title = {Categorical Data Analysis}, 4 | author = {Agresti, Alan}, 5 | year = {2002}, 6 | edition = {Second}, 7 | publisher = {Wiley}, 8 | address = {New York}, 9 | } 10 | 11 | 12 | 13 | @incollection{mcfadden:conditional.logit, 14 | title = {Conditional Logit Analysis of Qualitative Choice Behaviour}, 15 | booktitle = {Frontiers in Econometrics}, 16 | author = {McFadden, Daniel}, 17 | editor = {Zarembka, Paul}, 18 | year = {1974}, 19 | pages = {105-142}, 20 | publisher = {Academic Press}, 21 | address = {New York}, 22 | } 23 | 24 | 25 | @article{breslow.clayton:approximate.inference.glmm, 26 | title = {Approximate Inference in Generalized Linear Mixed Models}, 27 | author = {Breslow, Norman E. and Clayton, David G.}, 28 | year = {1993}, 29 | volume = {88}, 30 | pages = {9-25}, 31 | journal = {Journal of the American Statistical Association}, 32 | number = {421} 33 | } 34 | 35 | 36 | @article{nelder.wedderburn:glm, 37 | title = {Generalized Linear Models}, 38 | author = {Nelder, J. A. and Wedderburn, R. W. M.}, 39 | year = {1972}, 40 | month = jan, 41 | volume = {135}, 42 | pages = {370-384}, 43 | issn = {0035-9238}, 44 | doi = {10.2307/2344614}, 45 | abstract = {The technique of iterative weighted linear regression can be used 46 | to obtain maximum likelihood estimates of the parameters with 47 | observations distributed according to some exponential family 48 | and systematic effects that can be made linear by a suitable 49 | transformation. A generalization of the analysis of variance 50 | is given for these models using log-likelihoods. These 51 | generalized linear models are illustrated by examples relating 52 | to four distributions; the Normal, Binomial (probit analysis, 53 | etc.), Poisson (contingency tables) and gamma (variance 54 | components). The implications of the approach in designing 55 | statistics courses are discussed.}, 56 | journal = {Journal of the Royal Statistical Society. Series A (General)}, 57 | number = {3} 58 | } 59 | 60 | 61 | @book{mccullagh.nelder:glm.2ed, 62 | title = {Generalized Linear Models}, 63 | author = {McCullagh, P. and Nelder, J.A.}, 64 | year = {1989}, 65 | publisher = {Chapman \& Hall/CRC}, 66 | address = {Boca Raton et al.}, 67 | series = {Monographs on Statistics \& Applied Probability} 68 | } 69 | 70 | 71 | 72 | @article{mcfadden.train:mixed.mlogit, 73 | title = {Mixed {{MNL}} Models for Discrete Response}, 74 | author = {McFadden, Daniel and Train, Kenneth}, 75 | year = {2000}, 76 | volume = {15}, 77 | pages = {447-470}, 78 | journal = {Journal of Applied Econometrics}, 79 | number = {5} 80 | } 81 | 82 | @Book{MASS, 83 | title = {Modern Applied Statistics with S}, 84 | author = {W. N. Venables and B. D. Ripley}, 85 | publisher = {Springer}, 86 | edition = {Fourth}, 87 | address = {New York}, 88 | year = {2002}, 89 | url = {http://www.stats.ox.ac.uk/pub/MASS4}, 90 | } 91 | 92 | 93 | 94 | @book{harville:matrix.algebra, 95 | title = {Matrix Algebra From a Statistician's Perspective}, 96 | author = {Harville, David A.}, 97 | year = {1997}, 98 | publisher = {Springer}, 99 | address = {New York}, 100 | } 101 | 102 | @article{elff:divisions.positions.voting, 103 | author = {Martin Elff}, 104 | title = {Social Divisions, Party Positions, and Electoral Behaviour}, 105 | journal = {Electoral Studies}, 106 | year = {2009}, 107 | volume = {28}, 108 | number = {2}, 109 | pages = {297-308}, 110 | doi = {10.1016/j.electstud.2009.02.002} 111 | } 112 | 113 | @Manual{Rcore, 114 | title = {R: A Language and Environment for Statistical Computing}, 115 | author = {{R Core Team}}, 116 | organization = {R Foundation for Statistical Computing}, 117 | address = {Vienna, Austria}, 118 | year = {2023}, 119 | url = {https://www.R-project.org/}, 120 | } 121 | 122 | @Book{MASS, 123 | title = {Modern Applied Statistics with S}, 124 | author = {W. N. Venables and B. D. Ripley}, 125 | publisher = {Springer}, 126 | edition = {Fourth}, 127 | address = {New York}, 128 | year = {2002}, 129 | note = {ISBN 0-387-95457-0}, 130 | url = {https://www.stats.ox.ac.uk/pub/MASS4/}, 131 | } 132 | 133 | @Book{nlme-book, 134 | title = {Mixed-Effects Models in S and S-PLUS}, 135 | author = {José C. Pinheiro and Douglas M. Bates}, 136 | year = {2000}, 137 | publisher = {Springer}, 138 | address = {New York}, 139 | doi = {10.1007/b98882}, 140 | } 141 | 142 | 143 | @article{Solomon.Cox:1992, 144 | title = {Nonlinear component of variance models}, 145 | volume = {79}, 146 | issn = {0006-3444, 1464-3510}, 147 | doi = {10.1093/biomet/79.1.1}, 148 | number = {1}, 149 | journal = {Biometrika}, 150 | author = {Solomon, P. J. and Cox, D. R.}, 151 | year = {1992}, 152 | pages = {1--11}, 153 | } 154 | 155 | 156 | 157 | 158 | 159 | -------------------------------------------------------------------------------- /pkg/vignettes/random-effects.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: Random effects in baseline logit models and conditional logit models 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | % \VignetteIndexEntry{Random effects in baseline logit models and conditional logit models} 6 | % \VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | bibliography: mclogit.bib 9 | --- 10 | 11 | The "mclogit" package allows for the presence of random effects in 12 | baseline-category logit and conditional logit models. In 13 | baseline-category logit models, the random effects may represent 14 | (unobserved) characteristics that are common the individuals in 15 | clusters, such as regional units or electoral districts or the like. In 16 | conditional logit models, random effects may represent attributes that 17 | share across several choice occasions within the same context of choice. 18 | That is, if one analyses voting behaviour across countries then an 19 | random effect specific to the Labour party may represent unobserved 20 | attributes of this party in terms of which it differs from (or is more 21 | like) the Social Democratic Party of Germany (SPD). My original 22 | motivation for working on conditional logit models with random effects 23 | was to make it possible to assess the impact of parties' political 24 | positions on the patterns of voting behaviour in various European 25 | countries. The results of this research are published in an article in 26 | @elff:divisions.positions.voting. 27 | 28 | In its earliest incarnation, the package supported only a very simple 29 | random-intercept extension of conditional logit models (or "mixed 30 | conditional logit models", hence the name of the package). These models 31 | can be written as 32 | 33 | $$ 34 | \pi_{ij} = \frac{\exp(\eta_{ij})}{\sum_{k\in\mathcal{S}_i}\exp(\eta_{ik})} 35 | $$ 36 | 37 | with 38 | 39 | $$ 40 | \eta_{ij}=\sum_h\alpha_hx_{hij}+\sum_kz_{ik}b_{jk} 41 | $$ 42 | 43 | where $x_{hij}$ represents values of independent variables, $\alpha_h$ 44 | are coefficients, $z_{ik}$ are dummy ariables (that are equal to 45 | $1$ if $i$ is in cluster $k$ and equal to $0$ otherwise), 46 | $b_{jk}$ are random effects with a normal distribution with expectation 47 | $0$ and variance parameter $\sigma^2$. 48 | 49 | Later releases also added support for baseline-category logit models 50 | (initially only without random effects). In order to support random 51 | effects in baseline-category logit models, the package had to be further 52 | modified to allow for conditional logit models with random slopes (this 53 | is so because baseline-categoy logit models can be expressed as a 54 | particular type of conditional logit models). 55 | 56 | It should be noted that estimating the parameters of random effects 57 | multinomial logit models (whether of baseline-category logit variety or 58 | the conditional logit variety) involves the considerable challenges 59 | already known from the "generalized linear mixed models" literature. 60 | The main challenge is that the likelihood function involves analytically 61 | intractable integrals (i.e. there is know way to "solve" or eliminate 62 | the intergrals from the formula of the likelihood function). This means 63 | that either computationally intensive methods for the computation of 64 | such integrals have to be used or certain approximations (most notably 65 | the Laplace approximation technique and its variants), which may lead to 66 | biases in certain situations. The "mclogit" package only supports 67 | approximate likelihood-based inference. Most of the time the 68 | PQL-technique based on a (first-order) Laplace approximation was 69 | supported, release 0.8, "mclogit" also supports the MQL technique, 70 | which is based on a (first-order) Solomon-Cox approximation. The ideas 71 | behind the PQL and MQL techniques are described e.g. in 72 | @breslow.clayton:approximate.inference.glmm. 73 | 74 | # References 75 | --------------------------------------------------------------------------------