R语言入门——不掉包实现FNN（单层感知机）

Posted 2021-10-09 统计学小王子

tags:

篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了R语言入门——不掉包实现FNN（单层感知机）相关的知识，希望对你有一定的参考价值。

0引言

感知机是个硬分类模型，是1962年Rosenblatt提出的。在深度学习占有很高的历史地位。他是一个二分类模型，激活函数是一个sign函数。本文使用R语言编写简单的感知器分类。并展示他的收敛过程以及误差收敛速度。

1、数据的构造

感知机对数据的要求很严格，需要数据本身是线性可分的，因此我们构造的数据需要具有很好线性可分的性质。构造代码如下：

# 双分类数据的构造
n <- 100  # 数据规模
set.seed(0)  # 为了可重复
x1 <- c(rnorm(n/2,1,1),rnorm(n/2,5,1))  # 数据特征1
x2 <- c(rnorm(n/2,1,1),rnorm(n/2,5,1))  # 数据特征2
Data <- data.frame(x1 = x1, x2 = x2, 
y = c(rep(0,n/2), rep(1,n/2)))  # 数据标签
x = cbind(1, x1, x2)
y = cbind(c(rep(0,n/2), rep(1,n/2)))
head(Data)

可以看出这个数据具有很好的线性可分性。数据长下面这样子：

> head(Data)
          x1         x2 y
1  2.2629543  1.7818592 0
2  0.6737666  0.2232234 0
3  2.3297993  0.3840101 0
4  2.2724293  1.0465803 0
5  1.4146414 -0.1303858 0
6 -0.5399500  1.5767188 0

2、感知机函数的构造

接下来是构造感知机函数，先是初始化的参数介绍：

r = 0.2  # 学习率
head(x)  # 输入层
head(y)  # 目标层
maxiter = 1000  # 最大迭代次数
w = NULL  # 初始权重
eps = 1e-5  # 模型训练精度

然后是主函数的编写：

FNN <- function(x, y, r = 0.2, eps = 1e-5, maxiter = 1000, w = NULL){
  n <- ncol(x);ero <- c()
  if(is.null(w)) w <- rep(1/n, n) 
  wo <- cbind(w)
  for(i in 1:maxiter){
    yhat <- ifelse(sign(x %*% w) >= 0, 1, 0)
    erro <- abs(y - yhat)
    ero <- c(ero, mean(erro))
    if(mean(erro) <= eps) break
    w <- w - r * t(x) %*% (yhat - y) 
    wo <- cbind(wo, w)
    i <- i + 1
  }
  out <- list(i = i - 1, ws = wo, erros = ero, w = w, 
  erro = mean(erro))
  return(out)
}

3、函数调用

> fit <- FNN(x, y, r = 0.06, w = rep(0.3, 3))
> fit
$i
[1] 7

$ws
     w                                                           
   0.3 -2.700000  0.30000 -2.400000 -4.920000 -7.200000 -8.760000
x1 0.3 -2.771793 12.29242  9.206068  6.137912  3.227952  0.954251
x2 0.3 -2.067328 13.29203 10.844937  8.408246  5.958045  3.737178
             
   -9.1800000
x1  0.1451833
x2  2.7521902

$erros
[1] 0.50 0.50 0.45 0.42 0.38 0.26 0.07 0.00

$w
         [,1]
   -9.1800000
x1  0.1451833
x2  2.7521902

$erro
[1] 0

函数输出了迭代次数、最终参数结果，误差集合，参数收敛集合。

4、结果可视化

4.1收敛误差

plot(fit$erros, type = "o")

4.2参数收敛过程

w <- FNN(x, y, r = 0.1, w = rep(1, 3))
fun <- function(x, w){
  c <- w[1]
  k1 <- w[2]
  k2 <- w[3]
  -(c + k1*x)/k2
}
library(ggplot2)
plotData <- c()
for(i in 1:dim(w$ws)[2]){
  t <- seq(-1,7,,100)
  y <- fun(t, w$ws[,i])
  plotData <- rbind(plotData,
  cbind(t, y, i))
}
plotData[,3] <- as.factor(plotData[,3])
plotData <- data.frame(plotData)
p <- ggplot(data = plotData, aes(x = t, y = y))
p + geom_path() + facet_wrap( ~ i,2,4) + 
geom_point(data = data.frame(Data),aes(x = x1, y = x2, col = factor(y)))