Programmazione Regressione logistica con discesa del gradiente stocastico in R

Question

Sto provando a programmare la regressione logistica con gradiente discendente stocastico in R. Ad esempio, ho seguito l'esempio di Andrew Ng denominato: "ex2data1.txt".

Il punto è che l'algoritmo funziona correttamente, ma la stima non è esattamente quello che mi aspettavo. Così ho provato a cambiare l'intero algoritmo per risolvere questo problema. Tuttavia, era quasi impossibile per me. Non ero in grado di rilevare l'errore che sta causando questo problema. Quindi, sarebbe molto utile se qualcuno potesse controllare l'esempio e dirmi perché non vengono calcolati correttamente. Lo apprezzo molto.

quanto riguarda la programmazione, non sto usando qualsiasi funzione implementata in R o calcolo matriciale. Sto solo usando somme e sottrazioni nei loop perché voglio usare il codice in hadoop e non posso usare matrix calcolo o anche funzioni che sono già programmate in R come "sum", "sqrt", ecc.

stocastico Gradient Descent è:

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

e di regressione logistica:

Il mio codice è:

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 

miei thetas

Intercept: 0.4624024 
x[,2]: 1.3650234 

Answer 1

ho implementato una soluzione in R, ad esempio il set di altra Ng: ex2data2.txt. Ecco il mio codice:

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

Non dovrebbe * essere% *% in alcuni casi? Per esempio. h<-1/(1+exp((-theta) %*% x[i,])) anziché h<-1/(1+exp((-theta)*x[i,]))