Programmierung Logistische Regression mit stochastischem Gradientenabfall in R

Question

Ich versuche die logistische Regression mit stochastischem absteigendem Gradienten in R zu programmieren. Zum Beispiel habe ich das Beispiel von Andrew Ng mit dem Namen "ex2data1.txt" verfolgt.

Der Punkt ist, dass der Algorithmus richtig funktioniert, aber die Schätzung ist nicht genau das, was ich erwartet habe. Also habe ich versucht, den ganzen Algorithmus zu ändern, um dieses Problem zu lösen. Es war jedoch fast unmöglich für mich. Ich konnte den Fehler, der dieses Problem verursacht, nicht erkennen. Daher wäre es sehr nützlich, wenn jemand das Beispiel überprüfen und mir sagen könnte, warum Thetas nicht korrekt berechnet werden. Ich schätze es sehr.

Im Hinblick auf die Programmierung, ich jede Funktion nicht verwenden implementiert in R oder Matrizenberechnung. Ich benutze nur Summen und Subtraktionen in Schleifen, weil ich den Code in hadoop verwenden möchte und ich kann Matrixrechnung oder sogar Funktionen, die bereits in R wie "sum", "sqrt" programmiert sind, nicht verwenden

Stochastic Gradient Descent ist:

Loop { 
    for i = 1 to m, { 
    θj := θj + α(y(i) - hθ(x(i)))(xj)(i) 
    } 
}` 

und Regressions Logistic:

Mein Code ist:

data1 <- read.table("~/ex2data1.txt", sep = ",") 
names(data1) <- c("Exam1", "Exam2", "Admit") 

# Sample the data for stochastic gradient decent 

ss<-data1[sample(nrow(data1),size=nrow(data1),replace=FALSE),] 

x <- with(ss, matrix(cbind(1, Exam1), nrow = nrow(ss))) 
y <- c(ss$Admit) 
m <- nrow(x) 

# startup parameters 

iterations<-1 
j<-vector() 
alpha<-0.05 
theta<-c(0,0) 



#My loop 

while(iterations<=10){ 

    coste<-c(0,0) 
    suma<-0 

    for(i in 1:m){ 

     # h<-1/(1+exp(-Q*x) 

     h<-1/(1+exp((-theta)*x[i,])) 

     #Cost(hQ(x),y)=y(i)*log(hQ(x))+(1-y(i))*log(1-hQ(x)) 

      cost<-((y[i]*log(h))+((1-y[i])*log(1-h))) 

     #sum(cost) i=1 to m 

      suma<-suma+cost 

     #Diferences=(hQ(x(i))-y(i))*x(i) 

      difference<-(h-y[i])*x[i,] 

     #sum the differences 

      coste<-coste+difference 

     #calculation thetas and upgrade = Qj:= Qj - alpha* sum((h-y[i])*x[i,]*x(i)) 

      theta[1]<-(theta[1]-alpha*1/m*(coste[1])) 
      theta[2]<-(theta[2]-alpha*1/m*(coste[2])) 

    } 
     #J(Q)=(-1/m)* sum (y(i)*log(hQ(x))+(1-y(i))*log(1-hQ(x))) 

      j[iterations]<-(-1/m)*suma 

      iterations=iterations+1 

} 



#If I compare my thetas with R glm 


Call: glm(formula = y ~ x[, 2], family = binomial("logit"), data = data1) 

Coefficients: 

Intercept:-4.71816 

x[, 2] :0.08091 

Mein thgr

Intercept: 0.4624024 
x[,2]: 1.3650234 

Answer 1

ich eine Lösung in R für die anderen Ng Beispielsatz implementiert haben: ex2data2.txt. Hier ist mein Code:

sigmoid <- function(z) { 
return(1/(1 + exp(-z))) 
} 


mapFeature <- function(X1, X2) { 
degree <- 6 
out <- rep(1, length(X1)) 
for (i in 1:degree) { 
for (j in 0:i) { 
out <- cbind(out, (X1^(i - j)) * (X2^j)) 
} 
} 
return(out) 
} 


## Cost Function 
fr <- function(theta, X, y, lambda) { 
m <- length(y) 
return(1/m * sum(-y * log(sigmoid(X %*% theta)) - (1 - y) * 
log(1 - sigmoid(X %*% theta))) + lambda/2/m * sum(theta[-1]^2)) 
} 


## Gradient 
grr <- function(theta, X, y, lambda) { 
return(1/m * t(X) %*% (sigmoid(X %*% theta) - y) + lambda/m * 
c(0, theta[-1])) 
} 

data <- read.csv("ex2data2.txt", header = F) 
X = as.matrix(data[,c(1,2)]) 
y = data[,3] 
X = mapFeature(X[,1],X[,2]) 
m <- nrow(X) 
n <- ncol(X) 
initial_theta = rep(0, n) 
lambda <- 1 
res <- optim(initial_theta, fr, grr, X, y, lambda, 
method = "BFGS", control = list(maxit = 100000)) 

Answer 2

Sollte nicht * in einigen Fällen% *% sein? Z.B. h<-1/(1+exp((-theta) %*% x[i,])) statt h<-1/(1+exp((-theta)*x[i,]))