Thực hiện các công thức hồi quy logistic trong R

Question

Tôi cố gắng để xây dựng hàm hồi quy logistic của riêng tôi sử dụng ngẫu nhiên gradient descent trong R, nhưng những gì tôi có ngay bây giờ làm cho trọng lượng lớn mà không bị ràng buộc và do đó không bao giờ ngừng:

# Logistic regression 
# Takes training example vector, output vector, learn rate scalar, and convergence delta limit scalar 
my_logr <- function(training_examples,training_outputs,learn_rate,conv_lim) { 
    # Initialize gradient vector 
    gradient <- as.vector(rep(0,NCOL(training_examples))) 
    # Difference between weights 
    del_weights <- as.matrix(1) 
    # Weights 
    weights <- as.matrix(runif(NCOL(training_examples))) 
    weights_old <- as.matrix(rep(0,NCOL(training_examples))) 

    # Compute gradient 
    while(norm(del_weights) > conv_lim) { 

    for (k in 1:NROW(training_examples)) { 
     gradient <- gradient + 1/NROW(training_examples)* 
     ((t(training_outputs[k]*training_examples[k,] 
      /(1+exp(training_outputs[k]*t(weights)%*%as.numeric(training_examples[k,])))))) 
    } 

    # Update weights 
    weights <- weights_old - learn_rate*gradient 
    del_weights <- as.matrix(weights_old - weights) 
    weights_old <- weights 

    print(weights) 
    } 
    return(weights) 
} 

các chức năng có thể được thử nghiệm với đoạn mã sau:

data(iris) # Iris data already present in R  
# Dataset for part a (first 50 vs. last 100) 
iris_a <- iris 
iris_a$Species <- as.integer(iris_a$Species) 
# Convert list to binary class 
for (i in 1:NROW(iris_a$Species)) {if (iris_a$Species[i] != "1") {iris_a$Species[i] <- -1}}  
random_sample <- sample(1:NROW(iris),50) 

weights_a <- my_logr(iris_a[random_sample,1:4],iris_a$Species[random_sample],1,.1) 

tôi kiểm tra lại thuật toán của tôi chống lại Abu-Mostafa's, đó là như sau:

1. Khởi tạo vector trọng lượng
2. Đối với mỗi bước thời gian tính toán gradient:
   gradient <- -1/N * sum_{1 to N} (training_answer_n * training_Vector_n/(1 + exp(training_answer_n * dot(weight,training_vector_n))))
3. weight_new <- weight - learn_rate*gradient
4. Lặp lại cho đến khi đồng bằng trọng lượng là đủ nhỏ

Tôi có thiếu cái gì ở đây?

Answer 1

Từ góc độ toán học, độ lớn không bị giới hạn trên vectơ trọng số không mang lại giải pháp duy nhất. Khi tôi bổ sung thêm hai dòng sau vào chức năng phân loại, nó hội tụ theo hai bước:

# Normalize 
weights <- weights/norm(weights) 

...

# Update weights 
weights <- weights_old - learn_rate*gradient 
weights <- weights/norm(weights) 

Tôi không thể làm việc @ SimonO101, và tôi không sử dụng này mã cho công việc thực tế (có các nội trang dựng sẵn như glm), do đó, nó đủ để làm các vòng mà tôi hiểu. Toàn bộ chức năng như sau:

# Logistic regression 
# Takes training example vector, output vector, learn rate scalar, and convergence delta limit scalar 
my_logr <- function(training_examples,training_outputs,learn_rate,conv_lim) { 
    # Initialize gradient vector 
    gradient <- as.vector(rep(0,NCOL(training_examples))) 
    # Difference between weights 
    del_weights <- as.matrix(1) 
    # Weights 
    weights <- as.matrix(runif(NCOL(training_examples))) 
    weights_old <- as.matrix(rep(0,NCOL(training_examples))) 

    # Normalize 
    weights <- weights/norm(weights) 

    # Compute gradient 
    while(norm(del_weights) > conv_lim) { 

    for (k in 1:NCOL(training_examples)) { 
     gradient <- gradient - 1/NROW(training_examples)* 
     ((t(training_outputs[k]*training_examples[k,] 
      /(1+exp(training_outputs[k]*t(weights)%*%as.numeric(training_examples[k,])))))) 
    } 
#  gradient <- -1/NROW(training_examples) * sum(training_outputs * training_examples/(1 + exp(training_outputs * weights%*%training_outputs))) 

    # Update weights 
    weights <- weights_old - learn_rate*gradient 
    weights <- weights/norm(weights) 
    del_weights <- as.matrix(weights_old - weights) 
    weights_old <- weights 

    print(weights) 
    } 
    return(weights) 
} 

Answer 2

Có một số vấn đề. Thứ nhất, bạn có thể sử dụng tốt hơn các phương pháp vector hóa của R. Thứ hai, tôi không phải là một chuyên gia về gốc dốc ngẫu nhiên, nhưng thuật toán bạn đưa ra bên dưới câu hỏi của bạn không tương ứng với cách bạn tính toán độ dốc của hàm trong hàm. Kiểm tra mã này một cách cẩn thận, nhưng nó dường như hội tụ, và Tôi nghĩ rằng nó sau Abu-Mostfafa của. Tôi thu thập rằng bạn muốn tính toán gradient này;

gradient <- -1/N * sum(training_outputs * training_examples/(1 + exp(training_outputs * dot(weights ,training_outputs)))) 

Vì vậy, phần này của thuật toán của bạn nên đọc ...

while(norm(del_weights) > conv_lim) { 
gradient <- -1/NROW(iris_a) * sum(training_outputs * training_examples/(1 + exp(training_outputs * as.matrix(training_examples) %*% weights))) 

# Update weights 
weights <- weights_old - learn_rate*gradient 
del_weights <- as.matrix(weights_old - weights) 
weights_old <- weights 
print(weights) 

}

Bạn có thể tạo một phân loại nhị phân từ biến loài dễ dàng hơn khi sử dụng:

iris_a$Species <- as.numeric(iris_a$Species) 
iris_a$Species[ iris_a$Species != 1 ] <- -1  

Tôi không thể cho bạn biết nếu kết quả trả lại là hợp lý, nhưng mã đó nên thực hiện theo bước 2. Kiểm tra từng bước cẩn thận, và nhớ R là vectorised, do đó bạn có thể làm các hoạt động khôn ngoan yếu tố trên vectơ mà không có vòng lặp. ví dụ:

x <- 1:5 
y <- 1:5 
x*y 
#[1] 1 4 9 16 25