如何在clmm之后使用texreg(我想提取随机效果组件)

时间:2016-08-25 11:13:39

标签: r mixed-models stargazer ordinal texreg

我在收到@PhilipLeifeld的建议后,根据我的进度重新撰写此帖子(请参阅下面的评论部分)。

我尝试使用clmmtexreg输出放到latex中。由于软件包在默认模式下不支持clmm,因此我尝试使用extract函数扩展软件包(请参阅Print "beautiful" tables for h2o models in R上的答案部分)。同时,我发现https://gist.github.com/kjgarza/340201f6564ca941fe25上发布的代码可以作为我的起点;我将代码作为下面的基线代码。以下模型(结果)几乎代表了我的实际代码。

library(ordinal)
library(texreg)
d<-data.frame(wine)
result<-clmm(rating~ 1+temp+contact+(1+temp|judge), data=d)

我想在乳胶表中显示的是随机效果组件,在基线代码中省略了这些组件。以下是摘要输出的一部分。

summary(result)

Random effects:
 Groups Name        Variance Std.Dev. Corr  
 judge  (Intercept) 1.15608  1.0752         
        tempwarm    0.02801  0.1674   0.649 
 Number of groups:  judge 9 

具体来说,我想显示方差(和组数);我不需要关联部分。在研究基线代码的同时,我也学到了&#34; texreg&#34;仅允许乳胶显示的一组有限参数以及&#34; include.variance&#34;的选项。与我的目标相关。因此,我尝试将随机效果组件添加到&#34; gof&#34;论证包括&#34; include.variance&#34;在基线代码中。

这就是我所做的。首先,我添加&#34; include.variance&#34;到定义extract.clmm函数的部分。

extract.clmm <- function(model, include.thresholds = TRUE, include.aic = TRUE, 
                     include.bic = TRUE, include.loglik = TRUE, include.variance = TRUE, oddsratios = TRUE, conf.level= 0.95, include.nobs = TRUE, ...) {
s <- summary(model, ...)

tab <- s$coefficients
thresh <- tab[rownames(tab) %in% names(s$alpha), ]
threshold.names <- rownames(thresh)
threshold.coef <- thresh[, 1]
threshold.se <- thresh[, 2]
threshold.pval <- thresh[, 4]
beta <- tab[rownames(tab) %in% names(s$beta), ]
beta.names <- rownames(beta)
beta.coef <- beta[, 1]
beta.se <- beta[, 2]
beta.pval <- beta[, 4]

然后,我添加了以下三行。

### for random effect components###   
rand<-s$ST[[1]]
rand.names<-rownames(rand)
rand.var<-rand[,1]

以下部分是我在基线代码中另外包含的内容(&#34; include.variance&#34;)。

if (include.variance == TRUE) {       
    gof.names <- c(gof.names, rand.names)
    gof <- c(gof, rand)
    gof.decimal <- c(gof.decimal, TRUE)   
}

运行extract.clmm函数后,运行以下命令。

test<-extract.clmm(result, include.variance=TRUE, oddsratios=FALSE)

然后,我收到一条错误消息:validityMethod(object)中的错误:gof.names和gof必须具有相同的长度!虽然我发现&#34; rand&#34的长度;和&#34; rand.names&#34;在&#34;结果&#34;的情况下是4和2,我不知道如何处理这个。任何评论都将非常感激。提前致谢。

2 个答案:

答案 0 :(得分:3)

让我们首先重写您的测试用例,使其包含具有随机效果的模型(clmm)和无随机效果的模型(clm),两者都来自{{1包。这样我们就可以检查我们要编写的ordinal函数是否会产生与extract.clmm包中现有extract.clm函数兼容的格式化结果:

texreg

library("ordinal") library("texreg") d <- data.frame(wine) result.clmm <- clmm(rating ~ 1 + temp + contact + (1 + temp|judge), data = d) result.clm <- clm(rating ~ 1 + temp + contact, data = d) 中通用clm函数的现有extract方法如下所示,我们可以将其用作编写texreg方法的模板因为两种对象类型都以类似的方式构建:

clmm

# extension for clm objects (ordinal package) extract.clm <- function(model, include.thresholds = TRUE, include.aic = TRUE, include.bic = TRUE, include.loglik = TRUE, include.nobs = TRUE, ...) { s <- summary(model, ...) tab <- s$coefficients thresh <- tab[rownames(tab) %in% names(s$aliased$alpha), , drop = FALSE] threshold.names <- rownames(thresh) threshold.coef <- thresh[, 1] threshold.se <- thresh[, 2] threshold.pval <- thresh[, 4] beta <- tab[rownames(tab) %in% names(s$aliased$beta), , drop = FALSE] beta.names <- rownames(beta) beta.coef <- beta[, 1] beta.se <- beta[, 2] beta.pval <- beta[, 4] if (include.thresholds == TRUE) { names <- c(beta.names, threshold.names) coef <- c(beta.coef, threshold.coef) se <- c(beta.se, threshold.se) pval <- c(beta.pval, threshold.pval) } else { names <- beta.names coef <- beta.coef se <- beta.se pval <- beta.pval } n <- nobs(model) lik <- logLik(model)[1] aic <- AIC(model) bic <- BIC(model) gof <- numeric() gof.names <- character() gof.decimal <- logical() if (include.aic == TRUE) { gof <- c(gof, aic) gof.names <- c(gof.names, "AIC") gof.decimal <- c(gof.decimal, TRUE) } if (include.bic == TRUE) { gof <- c(gof, bic) gof.names <- c(gof.names, "BIC") gof.decimal <- c(gof.decimal, TRUE) } if (include.loglik == TRUE) { gof <- c(gof, lik) gof.names <- c(gof.names, "Log Likelihood") gof.decimal <- c(gof.decimal, TRUE) } if (include.nobs == TRUE) { gof <- c(gof, n) gof.names <- c(gof.names, "Num.\ obs.") gof.decimal <- c(gof.decimal, FALSE) } tr <- createTexreg( coef.names = names, coef = coef, se = se, pvalues = pval, gof.names = gof.names, gof = gof, gof.decimal = gof.decimal ) return(tr) } setMethod("extract", signature = className("clm", "ordinal"), definition = extract.clm) 个对象的第一个区别是系数等不会存储在clmmsummary(model)$aliased$alpha下,而是直接存储在summary(model)$aliased$betasummary(model)$alpha下。

我们需要做的第二件事是为组数和随机差异添加拟合优度元素。

组的数量显然存储在summary(model)$beta下,具有不同条件变量的多个条目。这很容易。

随机差异不存储在任何地方,因此我们需要在source code of the ordinal package中查找。我们可以看到summary(model)$dims$nlev.gf函数使用名为print.summary.clmm的内部帮助函数来打印方差。此函数包含在相同的formatVC脚本中,基本上只是格式化并调用另一个名为R的内部帮助函数(也包含在同一文件中)来计算差异。反过来,该函数计算varcov的转置交叉积以获得方差。我们可以直接在model$ST函数的GOF块中执行相同的操作,例如,使用extract.clmm作为第一个随机效果。我们必须确保对所有随机效果都这样做,这意味着我们需要将它放在循环中并用diag(s$ST[[1]] %*% t(s$ST[[1]]))之类的迭代器替换[[1]]

[[i]]函数的最终clmm方法如下所示:

extract

您可以在运行时执行代码,# extension for clmm objects (ordinal package) extract.clmm <- function(model, include.thresholds = TRUE, include.loglik = TRUE, include.aic = TRUE, include.bic = TRUE, include.nobs = TRUE, include.groups = TRUE, include.variance = TRUE, ...) { s <- summary(model, ...) tab <- s$coefficients thresh <- tab[rownames(tab) %in% names(s$alpha), ] threshold.names <- rownames(thresh) threshold.coef <- thresh[, 1] threshold.se <- thresh[, 2] threshold.pval <- thresh[, 4] beta <- tab[rownames(tab) %in% names(s$beta), ] beta.names <- rownames(beta) beta.coef <- beta[, 1] beta.se <- beta[, 2] beta.pval <- beta[, 4] if (include.thresholds == TRUE) { cfnames <- c(beta.names, threshold.names) coef <- c(beta.coef, threshold.coef) se <- c(beta.se, threshold.se) pval <- c(beta.pval, threshold.pval) } else { cfnames <- beta.names coef <- beta.coef se <- beta.se pval <- beta.pval } gof <- numeric() gof.names <- character() gof.decimal <- logical() if (include.loglik == TRUE) { lik <- logLik(model)[1] gof <- c(gof, lik) gof.names <- c(gof.names, "Log Likelihood") gof.decimal <- c(gof.decimal, TRUE) } if (include.aic == TRUE) { aic <- AIC(model) gof <- c(gof, aic) gof.names <- c(gof.names, "AIC") gof.decimal <- c(gof.decimal, TRUE) } if (include.bic == TRUE) { bic <- BIC(model) gof <- c(gof, bic) gof.names <- c(gof.names, "BIC") gof.decimal <- c(gof.decimal, TRUE) } if (include.nobs == TRUE) { n <- nobs(model) gof <- c(gof, n) gof.names <- c(gof.names, "Num.\ obs.") gof.decimal <- c(gof.decimal, FALSE) } if (include.groups == TRUE) { grp <- s$dims$nlev.gf grp.names <- paste0("Groups (", names(grp), ")") gof <- c(gof, grp) gof.names <- c(gof.names, grp.names) gof.decimal <- c(gof.decimal, rep(FALSE, length(grp))) } if (include.variance == TRUE) { var.names <- character() var.values <- numeric() for (i in 1:length(s$ST)) { variances <- diag(s$ST[[i]] %*% t(s$ST[[i]])) var.names <- c(var.names, paste0("Variance: ", names(s$ST)[[i]], ": ", names(variances))) var.values <- c(var.values, variances) } gof <- c(gof, var.values) gof.names <- c(gof.names, var.names) gof.decimal <- c(gof.decimal, rep(TRUE, length(var.values))) } tr <- createTexreg( coef.names = cfnames, coef = coef, se = se, pvalues = pval, gof.names = gof.names, gof = gof, gof.decimal = gof.decimal ) return(tr) } setMethod("extract", signature = className("clmm", "ordinal"), definition = extract.clmm) 应该能够从texreg个对象创建表,包括随机差异。我将此代码添加到下一个clmm版本。

您可以按照以下方式将此应用于您的示例:

texreg

结果与screenreg(list(result.clmm, result.clm), single.row = TRUE) clmm个对象兼容,您可以在输出中看到:

clm

如果需要,您可以使用参数================================================================== Model 1 Model 2 ------------------------------------------------------------------ tempwarm 3.07 (0.61) *** 2.50 (0.53) *** contactyes 1.83 (0.52) *** 1.53 (0.48) ** 1|2 -1.60 (0.69) * -1.34 (0.52) ** 2|3 1.50 (0.60) * 1.25 (0.44) ** 3|4 4.22 (0.82) *** 3.47 (0.60) *** 4|5 6.11 (1.02) *** 5.01 (0.73) *** ------------------------------------------------------------------ Log Likelihood -81.55 -86.49 AIC 181.09 184.98 BIC 201.58 198.64 Num. obs. 72 72 Groups (judge) 9 Variance: judge: (Intercept) 1.16 Variance: judge: tempwarm 0.03 ================================================================== *** p < 0.001, ** p < 0.01, * p < 0.05 include.variances == FALSE来关闭差异和组大小的报告。

答案 1 :(得分:1)

作为对@ Philip的回答的快速评论,在新版本或R工作室中,以下内容不会返回矩阵:

thresh <- subset.matrix(tab, rownames(tab) %in% names(s$alpha) )
beta <- subset.matrix(tab, rownames(tab) %in% names(s$beta) )

这会导致以下代码返回错误。但是,快速解决此问题的方法可能是:

sudo ./sendsyn -h 192.168.1.1 -p 80 -i enp5s0