Question

我试图使用多项逻辑回归模型，其中公式或线性预测因子对三种结果之一有所不同。

这是一个示例数据集。抱歉，创建数据集的代码有点长：

my.data <- read.table(text = '
  obs  cov  cov2 n.a  n.b  n.c
    1   -7   49   40   60    0
    2   -6   36   40   60    0
    3   -5   25   40   60    0
    4   -4   16   40   60    0
    5   -3    9   40   59    1
    6   -2    4   40   57    3
    7   -1    1   40   47   13
    8    0    0   40   27   33
    9    1    1   40    9   51
   10    2    4   40    2   58
   11    3    9   40    1   59
   12    4   16   40    0   60
   13    5   25   40    0   60
   14    6   36   40    0   60
   15    7   49   40    0   60
', header = TRUE, stringsAsFactors = FALSE)

# duplicate rows
n.times <- my.data$n.a
data.a  <- my.data[rep(seq_len(nrow(my.data)), n.times),]
data.a$stage <- 'a'
n.times <- my.data$n.b
data.b  <- my.data[rep(seq_len(nrow(my.data)), n.times),]
data.b$stage <- 'b'
n.times <- my.data$n.c
data.c  <- my.data[rep(seq_len(nrow(my.data)), n.times),]
data.c$stage <- 'c'

# combine data sets
my.data <- rbind(data.a, data.b)
my.data <- rbind(my.data, data.c)

my.data <- my.data[order(my.data$cov, my.data$stage),]
head(my.data)
dim(my.data)

以下是使用nnet包和mlogit包创建模型的代码：在此模型阶段，b和c使用相同的公式（截距，cov和cov2）建模。阶段a是参考。这两个包的估计值非常相似。

# first with package nnet

library(nnet)

my.data$stage  <- as.factor(my.data$stage)
my.data$stage2 <- relevel(my.data$stage, ref = "a")
model1 <- multinom(stage2 ~ cov + cov2, data = my.data)
summary(model1)

#
# Call:
# multinom(formula = stage2 ~ cov + cov2, data = my.data)
#
# Coefficients:
#   (Intercept)        cov       cov2
# b  -0.7180498 -0.6390276 -0.0735323
# c  -0.5639989  0.5903990 -0.0701099
#
# Std. Errors:
#   (Intercept)        cov        cov2
# b   0.1191425 0.06643554 0.010191801
# c   0.1109950 0.05976451 0.009468451
#
# Residual Deviance: 2301.073 
# AIC: 2313.073 
#

fitted(model1)[1:10,]

# now with package mlogit 

library(mlogit)

my.datad <- my.data

my.datad <- my.data[,c('stage', 'cov', 'cov2')]
rownames(my.datad) <- NULL
head(my.datad)

my.datae <- mlogit.data(my.datad, shape = "wide", choice = "stage")
head(my.datae)

summary(mlogit(stage ~ 0 | cov + cov2, data = my.datae))

#
# Call:
# mlogit(formula = stage ~ 0 | cov + cov2, data = my.datae, method = "nr", 
#     print.level = 0)
#
# Frequencies of alternatives:
#       a       b       c 
# 0.40000 0.29467 0.30533 
#
# nr method
# 8 iterations, 0h:0m:0s 
# g'(-H)^-1g = 8.63E-06 
# successive function values within tolerance limits 
#
# Coefficients :
#                 Estimate Std. Error t-value  Pr(>|t|)    
# b:(intercept) -0.7189757  0.1192246 -6.0304 1.635e-09 ***
# c:(intercept) -0.5634641  0.1109489 -5.0786 3.802e-07 ***
# b:cov         -0.6398978  0.0665175 -9.6200 < 2.2e-16 ***
# c:cov          0.5898187  0.0597128  9.8776 < 2.2e-16 ***
# b:cov2        -0.0736489  0.0102012 -7.2197 5.211e-13 ***
# c:cov2        -0.0700294  0.0094624 -7.4008 1.352e-13 ***
# ---
# Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
#
# Log-Likelihood: -1150.5
# McFadden R^2:  0.29554 
# Likelihood ratio test : chisq = 965.34 (p.value = < 2.22e-16)
#

但是，我想要做的是使用阶段b作为参考，模型阶段c作为截距的函数，cov和cov2如上所述， 但模型阶段a只是作为截距的函数。请注意，在数据集中，协变量不影响在a阶段结束的试验数量：40个试验在阶段a结束，无论协变量的值如何。

这样的模型可能吗？我相信它是，但我无法弄清楚如何使用这些包中的任何一个。我已尝试使用各种指标变量从阶段a的公式中删除协变量，但无论如何总是估计系数，标准误差变得很大。有时点估计也变得非常大。

我在Cross Validated上提出相关问题，但我认为目前的问题主要是关于编程问题。如果感兴趣的话，这里是关于Cross Validated的相关问题的链接：

https://stats.stackexchange.com/questions/183427/modeling-probability-with-the-multinomial-logit-link/184004#184004

感谢您的任何建议。

编辑2015年11月30日

我现在已从其他两个软件程序中获得估计值。这些估算值是我希望从R看到的可能目标值。虽然，我怀疑最终可能会有更好的估计。

来自一个申请的估计：

Parameter       Beta           SE    Lower 95%CI  Upper 95%CI
state a: B0   0.305620     0.062682     0.182764     0.428476
state c: B0  -0.094760     0.113606    -0.317428     0.127908
state c: B1   0.750266     0.038993     0.673841     0.826692
state d: B2  -0.085494     0.012216    -0.109437    -0.061551

第二次申请的估计：

Parameter       Beta           SE      Lower 95%CI   Upper 95%CI
state a: B0   0.3056197    0.0626826    0.1827618    0.4284777
state c: B0  -0.0947603    0.1124746   -0.3152105    0.1256900
state c: B1   0.7502663    0.0601626    0.6323476    0.8681850     
state c: B2  -0.0854941    0.0095836   -0.1042780   -0.0667102

编辑2015年11月30日

如果我使用两个协变量对a和c状态建模，我会从R个包和其他两个软件应用程序中获得以下内容：

#
# model data with stage 'b' as reference
#
# model stage 'a' as function of intercept, cov and cov2
# model stage 'c' as function of intercept, cov and cov2
#
# model: a(cov, cov2) c(cov1, cov2)
#
# Parameter        Beta       SE      95%CI Lower     95%CI Upper
#
#    1:        0.1555116   0.1390947  -0.1171141      0.4281373     
#    2:        0.7189753   0.1192245   0.4852953      0.9526554     
#    3:        1.2297161   0.0853667   1.0623974      1.3970347     
#    4:        0.0036194   0.0147607  -0.0253116      0.0325505     
#    5:        0.6398974   0.0665175   0.5095231      0.7702717     
#    6:        0.0736488   0.0102012   0.0536545      0.0936431     
#

library(nnet)
my.data2 <- my.data

my.data2$stage  <- as.factor(my.data2$stage)
my.data2$stage2 <- relevel(my.data2$stage, ref = "b")

model1.nnet <- multinom(stage2 ~ cov + cov2, data = my.data2)
summary(model1.nnet)

# Call:
# multinom(formula = stage2 ~ cov + cov2, data = my.data2)
#
# Coefficients:
#   (Intercept)       cov        cov2
# a   0.7189754 0.6398974 0.073648810
# c   0.1555120 1.2297159 0.003619449
#
# Std. Errors:
#   (Intercept)        cov       cov2
# a   0.1192246 0.06651748 0.01020116
# c   0.1390947 0.08536677 0.01476072
#
# Residual Deviance: 2301.073 
# AIC: 2313.073 

library(mlogit)
my.data2b <- my.data2[,c('stage', 'cov', 'cov2')]
rownames(my.data2b) <- NULL
head(my.data2b)

my.data2.mlogit <- mlogit.data(my.data2b, shape = "wide", choice = "stage")
head(my.data2.mlogit)

summary(mlogit(stage ~ 0 | cov + cov2, data = my.data2.mlogit, reflevel = "b"))

# Coefficients :
#               Estimate Std. Error t-value  Pr(>|t|)    
# a:(intercept) 0.7189757  0.1192246  6.0304 1.635e-09 ***
# c:(intercept) 0.1555116  0.1390948  1.1180    0.2636    
# a:cov         0.6398978  0.0665175  9.6200 < 2.2e-16 ***
# c:cov         1.2297166  0.0853668 14.4051 < 2.2e-16 ***
# a:cov2        0.0736489  0.0102012  7.2197 5.211e-13 ***
# c:cov2        0.0036195  0.0147607  0.2452    0.8063    
# ---
# Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
#

但是，如果我尝试使用拦截对状态a进行建模，我仍然没有得到与其他两个应用程序相同的R包的类似估计值：

#
# model data with stage 'b' as reference
#
# model stage 'a' as function of intercept only
# model stage 'c' as function of intercept, cov and cov2
#
#  Parameter        Beta           SE     95%CI Lower  95%CI Upper
#
#  stage a: B0    0.305620     0.062682     0.182764     0.428476
#  state c: B0   -0.094760     0.113606    -0.317428     0.127908
#  state c: B1    0.750266     0.038993     0.673841     0.826692
#  state c: B2   -0.085494     0.012216    -0.109437    -0.061551
#

library(nnet)

my.data3 <- my.data

my.data3$stage  <- as.factor(my.data3$stage)
my.data3$stage2 <- relevel(my.data3$stage, ref = "b")

my.data3$cov  <- ifelse(my.data3$stage == 'a', 0, my.data3$cov )
my.data3$cov2 <- ifelse(my.data3$stage == 'a', 0, my.data3$cov2)

model2.nnet <- multinom(stage2 ~ cov + cov2, data = my.data3)
summary(model2.nnet)

#     Call:
# multinom(formula = stage2 ~ cov + cov2, data = my.data3)
#
# Coefficients:
#   (Intercept)       cov         cov2
# a   3.1129805 0.5936333 -13.85909619
# c   0.2221975 1.5220859  -0.01343098
#
# Std. Errors:
#   (Intercept)        cov        cov2
# a   0.1694357 33.9858262 33.98601992
# c   0.1834233  0.1339483  0.06296883
#
# Residual Deviance: 661.0351 
# AIC: 673.0351 

library(mlogit)

my.data3b <- my.data3[,c('stage', 'cov', 'cov2')]
rownames(my.data3b) <- NULL
head(my.data3b)

my.data3.mlogit <- mlogit.data(my.data3b, shape = "wide", choice = "stage")
head(my.data3.mlogit)

summary(mlogit(stage ~ 0 | cov + cov2, data = my.data3.mlogit, reflevel = "b"))

# Coefficients :
#                 Estimate  Std. Error t-value Pr(>|t|)    
# a:(intercept)    3.112970    0.169436 18.3726   <2e-16 ***
# c:(intercept)    0.222162    0.183426  1.2112   0.2258    
# a:cov            0.829259 2276.499314  0.0004   0.9997    
# c:cov            1.522129    0.133954 11.3631   <2e-16 ***
# a:cov2         -22.295201 2276.499317 -0.0098   0.9922    
# c:cov2          -0.013431    0.062973 -0.2133   0.8311    
# ---
# Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
#

Answer 1

在我看来，解决这个问题的一个好方法是将其分解为两个模型。您需要阶段= a独立于协变量的概率。然后你想知道，给定那个阶段！= a，概率阶段= b或c取决于协变量。

#pr(stage=a)
my.data$stageA.BC = my.data$stage=="a"
glm(my.data$stageA.BC ~ 1,family=binomial)



#pr(stage=c|cov,cov2,stage!= a)
my.data.BC = my.data[my.data$stageA.BC==0,]
my.data.BC = relevel(my.data.BC$stage,ref="b")
glm(stage ~cov + cov2, data=my.data.BC,family=binomial)

由于pr（stage = b OR c）= 1 - pr（stage = a），您将拥有：

pr(stage = a) 

pr(stage = b) = (1 - pr(stage = a)) * pr(stage=b|cov,cov2,stage!= a)

pr(stage = c) = (1 - pr(stage = a)) * pr(stage=c|cov,cov2,stage!= a)

Answer 2

以下是R代码，当optim和a阶段与协变量c和cov相关时，使用cov2估算参数当阶段a仅使用截距建模时。

鉴于我现在能够以三种不同的方式对一个阶段a进行建模，我不清楚为什么我无法使用mlogit或{{1 }} nnet个包。

首先像以前一样创建数据集：

以下是多项逻辑回归的my.data <- read.table(text = ' obs cov cov2 n.a n.b n.c 1 -7 49 40 60 0 2 -6 36 40 60 0 3 -5 25 40 60 0 4 -4 16 40 60 0 5 -3 9 40 59 1 6 -2 4 40 57 3 7 -1 1 40 47 13 8 0 0 40 27 33 9 1 1 40 9 51 10 2 4 40 2 58 11 3 9 40 1 59 12 4 16 40 0 60 13 5 25 40 0 60 14 6 36 40 0 60 15 7 49 40 0 60 ', header = TRUE, stringsAsFactors = FALSE) # duplicate rows n.times.a <- my.data$n.a data.a <- my.data[rep(seq_len(nrow(my.data)), n.times.a),] data.a$stage <- 'a' n.times.b <- my.data$n.b data.b <- my.data[rep(seq_len(nrow(my.data)), n.times.b),] data.b$stage <- 'b' n.times.c <- my.data$n.c data.c <- my.data[rep(seq_len(nrow(my.data)), n.times.c),] data.c$stage <- 'c' # combine data sets my.data <- rbind(data.a, data.b) my.data <- rbind(my.data, data.c) my.data <- my.data[order(my.data$cov, my.data$stage),] # Here are a few additional lines to prepare the data set for my `optim` functions. cov <- my.data$cov cov2 <- my.data$cov2 n.a <- ifelse(my.data$stage == 'a', 1, 0) n.b <- ifelse(my.data$stage == 'b', 1, 0) n.c <- ifelse(my.data$stage == 'c', 1, 0)代码，它返回与optim和mlogit软件包以及其他两个软件应用程序（即阶段nnet和{ {1}}每个都使用截距建模，并a和c效果）：

cov1

当阶段cov2使用拦截，my.function <- function(betas, cov, cov2, n.a, n.b, n.c){ b0a = betas[1] b1a = betas[2] b2a = betas[3] b0c = betas[4] b1c = betas[5] b2c = betas[6] n = nrow(my.data) llh = 0 for(i in 1:n){ y <- ( (n.b[i] * (1 - exp(b0a + b1a * cov[i] + b2a * cov2[i]) / (1 + exp(b0a + b1a * cov[i] + b2a * cov2[i]) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) - exp(b0c + b1c * cov[i] + b2c * cov2[i]) / (1 + exp(b0a + b1a * cov[i] + b2a * cov2[i]) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) )) + (n.c[i] * ( exp(b0c + b1c * cov[i] + b2c * cov2[i]) / (1 + exp(b0a + b1a * cov[i] + b2a * cov2[i]) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) )) + (n.a[i] * ( exp(b0a + b1a * cov[i] + b2a * cov2[i]) / (1 + exp(b0a + b1a * cov[i] + b2a * cov2[i]) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) )) ) y <- log(y) y <- ifelse(is.na(y), 0.0000000001, y) llh = llh + y } -1 * llh } Nstar <- optim(c(0,0,0,0,0,0), my.function, cov = cov, cov2 = cov2, n.a = n.a, n.b = n.b, n.c = n.c, method = "BFGS", hessian = TRUE) Nstar$par # [1] 0.718951850 0.639832930 0.073637858 0.155471765 1.229635652 0.003612455和optim效果进行建模时，这是多项逻辑回归的c代码，但是阶段cov1仅使用截距建模。返回的估算值与我使用其他两个软件应用程序获得的估算值相匹配，但与使用cov2中的a或mlogit个数据包获得的估算值不相符：

nnet

也许我使用R采用的方法存在根本性的错误，这解释了为什么my.other.function <- function(betas, cov, cov2, n.a, n.b, n.c){ b0a = betas[1] b0c = betas[2] b1c = betas[3] b2c = betas[4] n = nrow(my.data) llh = 0 for(i in 1:n){ y <- ( (n.b[i] * (1 - exp(b0a ) / (1 + exp(b0a) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) - exp(b0c + b1c * cov[i] + b2c * cov2[i]) / (1 + exp(b0a) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) )) + (n.c[i] * ( exp(b0c + b1c * cov[i] + b2c * cov2[i]) / (1 + exp(b0a) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) )) + (n.a[i] * ( exp(b0a ) / (1 + exp(b0a) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) )) ) y <- log(y) y <- ifelse(is.na(y), 0.0000000001, y) llh = llh + y } -1 * llh } Nstar <- optim(c(0,0,0,0), my.other.function, cov = cov, cov2 = cov2, n.a = n.a, n.b = n.b, n.c = n.c, method = "BFGS", hessian = TRUE) Nstar$par # [1] 0.30561794 -0.09473753 0.75021769 -0.08548674和optim包不允许创建此模型结构？或者我可能还没有找到与mlogit和nnet包一起使用的正确语法？

我可能需要提取和研究mlogit和nnet包正在使用的源代码，以查看我是否可以对其进行修改，或至少弄清楚当我尝试使用它时它正在做什么模型阶段mlogit只有一个拦截。

如果我使用nnet或a（或a）mlogit套件找出如何使用拦截对阶段nnet进行建模，那么我将发布更新。

编辑：2015年12月7日

我现在可以使用mnlogit来重现R生成的估算值。 optim代码如下。结论是我到目前为止使用的三种方法都涉及我修改设计矩阵以从阶段mlogit中删除协变量。简单地将协变量数据设置为R并不会从设计矩阵中删除这些协变量。

我还剖析了0包的源代码。到目前为止，我已经能够从源代码中的设计矩阵中删除协变量，但只是这样做并不能返回正确的估计值。我在设计矩阵中的更改必须在以后的源代码中导致错误。

如果我能够修改其余的源代码以返回正确的估算值，或者我能够找到正确的语法来删除原始cov <- ifelse(my.data$stage == 'a', 0, cov ) cov2 <- ifelse(my.data$stage == 'a', 0, cov2) my.third.function <- function(betas, cov, cov2, n.a, n.b, n.c){ b0a = betas[1] b1a = betas[2] b2a = betas[3] b0c = betas[4] b1c = betas[5] b2c = betas[6] n = nrow(my.data) llh = 0 for(i in 1:n){ y <- ( (n.b[i] * (1 - exp(b0a + b1a * cov[i] + b2a * cov2[i]) / (1 + exp(b0a + b1a * cov[i] + b2a * cov2[i]) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) - exp(b0c + b1c * cov[i] + b2c * cov2[i]) / (1 + exp(b0a + b1a * cov[i] + b2a * cov2[i]) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) )) + (n.c[i] * ( exp(b0c + b1c * cov[i] + b2c * cov2[i]) / (1 + exp(b0a + b1a * cov[i] + b2a * cov2[i]) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) )) + (n.a[i] * ( exp(b0a + b1a * cov[i] + b2a * cov2[i]) / (1 + exp(b0a + b1a * cov[i] + b2a * cov2[i]) + exp(b0c + b1c * cov[i] + b2c * cov2[i])) )) ) # y <- ifelse(is.na(y) | y <= 0, 0.0000000001, y) y <- log(y) llh = llh + y } -1 * llh } model3 <- optim(c(0,0,0,0,0,0), my.third.function, cov = cov, cov2 = cov2, n.a = n.a, n.b = n.b, n.c = n.c, method = "BFGS", hessian = TRUE) model3$par # # [1] 3.11296505 0.61033815 -13.89223292 0.22214130 1.52209746 -0.01344045 #语句中的协变量，我会发布更新帖子。

针对不同结果的不同公式的多项Logistic回归

2 个答案: