multinomial logit regression by hand in R

Question

I am trying to implement multinomial regression (mlogit or multinom package) in R with Codes and optim (Not using packages).

rm(list= ls())
data = read.table("~/Desktop/R Code/textfiles/keane.csv", sep = ",",header = T)

data1 = data[,c("educ","exper", "expersq", "black", "status")]
data1 = na.omit(data1)

data2 = as.matrix(data1)


y_1 = rep(0, nrow(data2))
y_2 = rep(0, nrow(data2))
y_3 = rep(0, nrow(data2))


data2 = cbind(data2[,1:5], y_1, y_2, y_3)

data2[,6] = ifelse(data2[,5] == 1, 1, 0)
data2[,7] = ifelse(data2[,5] == 2, 1, 0)
data2[,8] = ifelse(data2[,5] == 3, 1, 0)


int = rep(1, nrow(data2)) #intercept

data2 = cbind(int, data2[,c(1:4,6,7,8)]) 


X = as.matrix(data2[, c(1:5)])
y_1 = as.matrix(data2[, 6]) #replace y values(status = 1)
y_2 = as.matrix(data2[, 7]) #replace y values(status = 2)
y_3 = as.matrix(data2[, 8]) #replace y values(status = 3)


Y = cbind(y_1, y_2, y_3) 


##beta


beta = solve(t(X) %*% X) %*% t(X) %*% Y #LPM coefficient 


logit.nll = function (beta, X, Y) {
    
    
    
    
    P = as.matrix(rowSums(exp(X %*% beta))); #Sum_(h=1)^3 exp(X * Beta_(h))
    
    
    
    Pr_1 = exp(X %*% beta[,2])/(1 + P); #P(y = 2 | X)
    Pr_2 = exp(X %*% beta[,3])/(1 + P); #P(y = 3 | X)
    
    Pr_0 = 1/(1+P);#P(y = 1 | X)
    
 
 
 (colSums(Y[,1] * log(Pr_0)) + colSums(Y[,2] * log(Pr_1)) + colSums(Y[,3] * log(Pr_2))) #log-likelihood
    
    
    
}

optim(beta, logit.nll, X = X, Y = Y, method = "BFGS")

when I do this code it gives me the message that "Error in X %*% beta: non-conformable arguments". My approach might be fundamentally wrong or the implementation of loglikelihood function is wrong. Can I get some help to fix this code?

Answer 1

Not very familiar with your svm optimization or what you are trying to do, the error you have comes with optim working with a vector. You need to coerce it into a matrix inside the function, let's say your data is like this:

set.seed(111)
data = iris

X = model.matrix(~.,data=data[,1:4])
Y = model.matrix(~0+Species,data=data)

beta = solve(t(X) %*% X) %*% t(X) %*% Y

Now we add the matrix part, also note the by default optim performs minimization ( https://stat.ethz.ch/R-manual/R-devel/library/stats/html/optim.html ) so you need to return the negative of loglikelihood:

logit.nll = function (beta, X, Y) {
    
    beta = matrix(beta,ncol=3)    
    P = as.matrix(rowSums(exp(X %*% beta))); #Sum_(h=1)^3 exp(X * Beta_(h))    
    Pr_1 = exp(X %*% beta[,2])/(1 + P); #P(y = 2 | X)
    Pr_2 = exp(X %*% beta[,3])/(1 + P); #P(y = 3 | X)    
    Pr_0 = 1/(1+P);#P(y = 1 | X)
     
LL = (colSums(Y[,1] * log(Pr_0)) + colSums(Y[,2] * log(Pr_1)) + colSums(Y[,3] * log(Pr_2))) #log-likelihood
print(LL)
return(-LL)

}

res = optim(beta, logit.nll, X = X, Y = Y, method = "BFGS")

res
$par
             Speciessetosa Speciesversicolor Speciesvirginica
(Intercept)      -2.085162         15.040679        -27.60634
Sepal.Length     -4.649971         -8.971237        -11.43702
Sepal.Width      -9.286757         -5.016616        -11.69764
Petal.Length     12.803070         17.125483         26.55641
Petal.Width       6.025760          3.342659         21.63200