Персептрон в R не сходится - PullRequest
2 голосов
/ 19 апреля 2020

Я пытаюсь лучше понять нейронные сети, поэтому я пытаюсь реализовать простой персептрон с нуля в R. Я знаю, что это очень неэффективно, так как есть много библиотек, которые делают это чрезвычайно хорошо оптимизированными, но моя цель - понять Основы нейронных сетей лучше и продвигаемся дальше к более сложным моделям.

Я создал несколько искусственных тестовых данных с очень простой линейной границей решений и разделил их на обучающий набор и тестовый набор. Затем я выполнил регрессию logisti c на данных обучения, проверил прогнозы из набора тестов и получил + 99% точности, что и следовало ожидать, учитывая простую природу данных. Затем я попытался реализовать персептрон с 2 входами, 1 нейроном, 1000 итерациями, скоростью обучения 0,1 и функцией активации сигмовидной кишки.

Я ожидал бы получить точность, очень похожую на регрессионную модель логистики c, но мои результаты намного хуже (около 70% правильных классификаций в ). поэтому я определенно сделал что-то не так. Похоже, что предсказания улучшаются только после первой пары итераций, а затем просто go назад и вперед вокруг определенного значения c (я пробовал с разными скоростями обучения, но безуспешно). Я прилагаю свой сценарий, и я благодарен за любой совет! Я думаю, что проблема заключается в вычислении ошибки или корректировке веса, но я не могу понять, как это ...

### Reproducible Example for StackOverflow


#### Setup

# loading libraries
library(data.table)

#remove scientifc notation
options(scipen = 999)

# setting seed for random number generation
seed <- 123




#### Selfmade Test Data

# input points
x1 <- runif(10000,-100,100)
x2 <- runif(10000,-100,100)

# setting decision boundary to create output
output <- vector()
output[0.5*x1 + -1.2*x2 >= 50] <- 0
output[0.5*x1 + -1.2*x2 < 50] <- 1

# combining to dataframe
points <- cbind.data.frame(x1,x2,output)

# plotting all data points
plot(points$x1,points$x2, col = as.factor(points$output), main = "Self-created data", xlab = "x1",ylab = "x2")

# split into test and training sets
trainsize = 0.2
set.seed(seed)
train_rows <- sample(1:dim(points)[1], size = trainsize * dim(points)[1])
train <- points[train_rows,]
test <- points[-c(train_rows),]

# plotting training set only
plot(train$x1,train$x2, col = as.factor(train$output), main = "Self-created data (training set)", xlab = "x1",ylab = "x2")





#### Approaching the problem with logistic regression

# building model
train_logit <- glm(output ~ x1 + x2, data = train, family = "binomial", maxit = 10000)
summary(train_logit)

# testing performance in training set
table(round(train_logit$fitted.values) == train$output)

# testing performance of train_logit model in test set
table(test$output == round(predict(train_logit,test[,c(1,2)], type = "response")))

# We get 100% accuracy in the training set and near 100% accuracy in the test set









#### Approaching Problem with a Perceptron from scratch


# setting inputs, outputs and weights
inputs <- as.matrix(train[,c(1,2)])
output <- as.matrix(train[,3])
set.seed(123456)
weights <- as.matrix(runif(dim(inputs)[2],-1,1))


## Defining activation function + derivative

# defining sigmoid and it's derivative
sigmoid <- function(x) {1 / (1 + exp(-x))}
sig_dir <- function(x){sigmoid(x)*(1 - sigmoid(x))}


## Perceptron nitial Settings
bias <- 1

# number of iterations
iterations <- 1000

# setting learning rate
alpha <- 0.1



## Perceptron

# creating vectors for saving results per iteration
weights_list <- list()
weights_list[[1]] <- weights
errors_vec <- vector()
outputs_vec <- vector()

# saving results across iterations
weights_list_all <- list()
outputs_list <- list()
errors_list <- list()


# looping through the backpropagation algorithm "iteration" # times
for (j in 1:iterations) {

  # Loop for backpropagation with updating weights after every datapoint
  for (i in 1:dim(train)[1]) {

    # taking the weights from the last iteration of the outer loop as a starting point
    if (j > 1) {

      weights_list[[1]] <- weights

    }

    # Feed Forward (Should we really round this?!)
    output_pred <- round(sigmoid(sum(inputs[i,] * as.numeric(weights)) + bias))
    error <- output_pred - output[i]

    # Backpropagation (Do I need the sigmoid derivative AND a learning rate? Or should I only take one of them?)
    weight_adjustments <- inputs[i,] * (error * sig_dir(output_pred)) * alpha
    weights <- weights - weight_adjustments

    # saving progress for later plots
    weights_list[[i + 1]] <- weights
    errors_vec[i] <- error
    outputs_vec[[i]] <- output_pred

  }

  # saving results for each iteration
  weights_list_all[[j]] <- weights_list
  outputs_list[[j]] <- outputs_vec
  errors_list[[j]] <- errors_vec

}



#### Formatting Diagnostics for easier plotting

# implementing empty list to transform weightslist
WeightList <- list()

# collapsing individual weightslist into datafames
for (i in 1:iterations) {

  WeightList[[i]] <- t(data.table::rbindlist(weights_list_all[i]))

}

# pasting dataframes together
WeightFrame <- do.call(rbind.data.frame, WeightList)
colnames(WeightFrame) <- paste("w",1:dim(WeightFrame)[2], sep = "")

# pasting dataframes together
ErrorFrame <- do.call(rbind.data.frame, errors_list)
OutputFrame <- do.call(rbind.data.frame, outputs_list)




##### Plotting Results


# Development of Mean Error per iteration
plot(rowMeans(abs(ErrorFrame)),
     type = "l",
     xlab = "Sum of absolute Error terms")

# Development of Weights over time
plot(WeightFrame$w1, type = "l",xlim = c(1,dim(train)[1]), ylim = c(min(WeightFrame),max(WeightFrame)), ylab = "Weights", xlab = "Iterations")
lines(WeightFrame$w2, col = "green")
# lines(WeightFrame$w3, col = "blue")
# lines(WeightFrame$w4, col = "red")
# lines(WeightFrame$w5, col = "orange")
# lines(WeightFrame$w6, col = "cyan")
# lines(WeightFrame$w7, col = "magenta")

# Empty vector for number of correct categorizations per iteration
NoCorr <- vector()

# Computing percentage of correct predictions per iteration
colnames(OutputFrame) <- paste("V",1:dim(OutputFrame)[2], sep = "")
Output_mat <- as.matrix(OutputFrame)

for (i in 1:iterations) {

  NoCorr[i] <- sum(output == Output_mat[i,]) / nrow(train)

}

# plotting number of correct predictions per iteration
plot(NoCorr, type = "l")


# Performance in training set after last iteration
table(output,round(OutputFrame[iterations,]))

1 Ответ

1 голос
/ 28 апреля 2020

Прежде всего, добро пожаловать в мир нейронных сетей :).

Во-вторых, я хочу порекомендовать вам отличную статью, которую я лично использовал, чтобы лучше понять откат и весь материал обучения NN: https://mattmazur.com/2015/03/17/a-step-by-step-backpropagation-example/. Иногда бывает немного сложно пройти, и для общей реализации, я думаю, намного проще следовать псевдокоду из книги NN. Однако, понять, что происходит в этой статье, очень приятно!

В-третьих, я надеюсь, что я решу вашу проблему :) Вы уже прокомментировали себя, стоит ли действительно округлять этот output_pred. Да, вы должны .. если вы хотите использовать этот output_pred, чтобы сделать прогноз! Однако, если вы хотите использовать его для обучения, это, как правило, не хорошо! Причина этого заключается в том, что если вы округлите его для обучения, то результат, который был округлен от 0,51 до 1 с целевым выходом 1, ничего не узнает, так как выходной результат был таким же, как и целевой, и, следовательно, является идеальным. Однако 0,99 было бы намного лучше прогноза, чем 0,51, и, следовательно, определенно есть чему поучиться!

Я не уверен на 100%, решит ли это все ваши проблемы (я не программист на R) и повысит вашу точность до 99%, но это должно решить некоторые из них, и, надеюсь, интуиция также ясна: )

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...