——by不是杀杀
模式识别的三大核心问题包括：
- 特征数据采集与预处理
- 分类识别
-
特征选择与提取
特征选择和提取的目的在于选出最有代表性的特征，实现特征空间维数的压缩，用最少的特征达到所要求的分类识别正确率。通俗地讲就是要达到降维的目的。
特征选择和特征变换都能够达到降维的目的，但是两者所采用的方式方法是不同的。
特征提取主要是通过分析特征间的关系，变换原来特征空间，从而达到压缩特征的目的。主要方法有：主成分分析（PCA）、离散K-L变换法（DKLT）等。
特征选择选择方法是从原始特征集中挑选出子集，是原始特征的选择和组合，并没有更改原始特征空间，特征选择的过程必须确保不丢失重要特征。主要方法有：遗传算法（GA）、统计检验法、分支定界法等。
这里主要讲讲特征选择中遗传算法以及它的R语言实现（因为要写作业，虽然不一定写对了）。
遗传算法受进化论启发，根据“物竞天择，适者生存”这一规则，模拟自然界进化机制，寻找目标函数的最大值。
算法框架
需要写的小函数：
-
适应度计算函数——输出每个个体的适应度。这里适应度函数选用离散度的计算方法：
其中Sb为类间散度矩阵，Sw为类内散度矩阵
-
赌轮算法——输出每个个体的随机选中的次数。根据每个个体的适应度大小（适应度越大被选中的概率越大）随机N次（N为群体大小，即个体数）得到每个个体的选中次数，目的在于淘汰适应度低的个体。
函数输出如图
在这个实验中，我选择的终止条件是达到指定迭代次数（也可以在种群稳定时终止）。
步骤：
- 随机产生初始化个体
- 计算个体适应度
- 利用赌轮算法，根据适应度大小，适应度大的个体具有更高的选中概率，计算出每个个体随机选中的次数。
- 选择—复制：根据每个个体随机选中的次数复制个体
- 交叉：复制后，打乱个体的排序，前后个体交换编码最后两位
- 突变：计算从开始到目前所产生的个体数，若个体数x突变概率>1则在个体的编码中随机一位产生突变，0→1，1→0
- 重复步骤2-6，直至达到迭代次数
实验目的
采用遗传算法对男女生样本数据中的身高、体重、鞋码、50m成绩、肺活量、是否喜欢运动共6个特征进行特征选择。
实验数据
数据预览如图
算法实现
数据预处理
###数据输入
library('gdata')
Data<-read.xls("./作业数据_2020合成.xls",sheet=1,header =T,fileEncoding="utf8",stringsAsFactors=F)
### 选出需要的列，去除NA
GA_data<-na.omit(Data[,c(2,4,5,6,7,8,10)])
###数据归一化
GA_data_scale <- cbind(GA_data[,1],scale(GA_data[,2:7])) #第一列是性别，是label，不能归一化
colnames(GA_data_scale) <- colnames(GA_data)
GA_data <- as.data.frame(GA_data_scale)
参数编码
由于有6个特征，因此选用6位0/1进行编码，1表示选中该特征。
### 生成一个用于随机选择初始化种群的矩阵，当然这是在特征少时使用的方法，
###特征多时建议直接随机出初始种群，而不是像这样先枚举出所有可能再从中挑选。
feature_code <- matrix(NA,nrow=63,ncol=6) #建一个空矩阵
for (i in c(1:63)){ #1到63的二进制表示了六个特征组合的所有的可能
temp<-paste(rev(as.integer(intToBits(i)[1:6])), collapse="")
feature_code[i,] <- t(as.matrix(unlist(strsplit(temp,"")))) ##奇怪的方法获取十进制转二进制
}
colnames(feature_code)<-colnames(GA_data)[-1]
计算适应度
适应度函数的实现
#输入：个体（特征编码），如010111（矩阵形式）
#输出：该个体的适应度
Fitness <- function(feature_mat){
J <- matrix(NA,nrow=length(feature_mat[,1]),ncol=1)
for(i in 1:length(feature_mat[,1])){
feature <- as.matrix(feature_mat[i,])
# print(feature)
P_man <- sum(GA_data$性别)/length(GA_data$性别)
P_woman <- 1 - P_man
#数据准备
temp_data <- GA_data[,-1]
性别 <- GA_data$性别
After_feature_selet_data<- cbind(性别,temp_data[,feature=='1'])
man_data<-After_feature_selet_data[After_feature_selet_data[,1]==1,-1]
woman_data<-After_feature_selet_data[After_feature_selet_data[,1]==0,-1]
# 类内散度矩阵
if(length(which(feature=="1"))<2){
Tr_Sw<- sd(man_data)*P_man+sd(woman_data)*P_woman
}else{Tr_Sw<- sum(diag(cov(man_data)*P_man+cov(woman_data)*P_woman))}
# 类间散度矩阵
if(length(which(feature=="1"))<2){
M_man <- mean(man_data)
M_woman <- mean(woman_data)
M_all <- mean(temp_data[,feature=='1'])
Tr_Sb<- sum(diag(P_man*(M_man-M_all)*t(M_man-M_all)+ P_woman*(M_woman-M_all)*t(M_woman-M_all)))
}else{
M_man <- colMeans(man_data)
M_woman <- colMeans(woman_data)
M_all <- colMeans(temp_data[,feature=='1'])
Tr_Sb<- sum(diag(P_man*(M_man-M_all)%*%t(M_man-M_all)+ P_woman*(M_woman-M_all)%*%t(M_woman-M_all)))
}
# J
J[i] <- Tr_Sb/Tr_Sw
}
return(J)
}
赌轮算法
####堵轮算法
## 输入：个体适应度 格式：array/矩阵
##输出：一个矩阵，包含适应度、选择概率、累积概率、选中次数
WheelSelection<-function(J_array){
##选择概率
N <- sum(J_array)
P <- (J_array/N)
order_P<-order(P)
temp <- runif(length(J_array),min=0,max=1) #随机产生等同个体数的随机数
Result<- matrix(0,nrow=length(J_array),ncol=3) #结果矩阵，用来放结果
colnames(Result) <- c("选择概率","累积概率","选中次数")
Result[,1]<-P ##选择概率
###累积概率
for(i in 1:length(J_array)){
Result[i,2] <- (Result[i,2] + sum(P[1:i]))
}
Note0 <- 0 #初始区间边界
for (i in 1:length(J_array)){
Note1 <- Note0
Note2 <- Note1 + P[order_P[i]]
Result[order_P[i],3] <- length(which(temp>Note1 & temp < Note2)) #计算几个随机数落到对于区间（适应度越大区间越大）
Note0 <- Note2
}
Result <- cbind(J_array,Result)
colnames(Result)[1] <- "适应度"
return(Result)
}
遗传算法主函数
### 输入：种群大小 、迭代次数、突变概率（默认0.01）
### 输出：迭代结束后的个体情况、每个个体每一代的适应度（用于可视化）
GA<- function(P_size,Times,P_mut=0.01){
Init_featrue <- sample(1:63, size = P_size)
Init_Mat<-feature_code[Init_featrue,]
fitMat <- cbind(Init_Mat,WheelSelection(Fitness(Init_Mat)))
## 计算适应度J
mutAdd <- 1
J_mat <- Fitness(Init_Mat)
for(iteration in 1:Times){
# fitMat <- cbind(Init_Mat,WheelSelection(Fitness(Init_Mat)))
##记录每一代的适应度
###复制——选择
copyMat<- matrix(NA,nrow=1,ncol=6)
if(length(which(fitMat[,10]>0))<2)
{
sub_fitMat <-t(as.matrix(fitMat[which(fitMat[,10]>0),]))
print("only 1 feature")
}else{
sub_fitMat<- as.matrix(fitMat[which(fitMat[,10]>0),])
}
for( i in 1:nrow(sub_fitMat)){
temp <- matrix(rep(sub_fitMat[i,1:6],sub_fitMat[i,10]),ncol=6,byrow=T)
copyMat <- rbind(copyMat,temp)
}
copyMat <- na.omit(copyMat)
colnames(copyMat) <- colnames(fitMat)[1:6]
###打乱顺序，不然两两交换的时候会出现常常两个相同个体交换的情况
if(P_size<=4){
copyMat <- rbind(copyMat[seq(1,P_size,2),],copyMat[seq(2,P_size,2),])
J_mat <- rbind(as.matrix(J_mat[seq(1,P_size,2),]),as.matrix(J_mat[seq(2,P_size,2),]))
}else{
copyMat <- rbind(copyMat[seq(1,P_size,3),],copyMat[seq(2,P_size,3),],copyMat[seq(3,P_size,3),])
J_mat <- rbind(as.matrix(J_mat[seq(1,P_size,3),]),as.matrix(J_mat[seq(2,P_size,3),]),as.matrix(J_mat[seq(3,P_size,3),]))}
###交叉,交换后两位；交换哪几位由自己决定
crossMat <- copyMat
N <- seq(1,P_size-1,2)
for(i in N){
k <- i+1
temp <- crossMat[i,5:6]
crossMat[i,5:6] <- crossMat[k,5:6]
crossMat[k,5:6] <- temp
}
### 变异 ，随机选择变异位
mutMat <- crossMat
if(mutAdd*P_size*3*P_mut>1){ #累计突变概率
for(i in 1:P_size){
mut_site<- sample(1:6, size = 1)
if(mutMat[i,mut_site]=='1'){
Temp <- mutMat[i,]
Temp[mut_site]<- '0'
if(sum(as.numeric(Temp))!=0& Fitness(as.matrix(t(Temp)))>Fitness(as.matrix(t(mutMat[i,])))){
mutMat[i,] <- Temp ##由于突变常常会把适应度高的个体突变掉，因此加入一个比较过程，若适应度下降则放弃突变
}
}else{
Temp <- mutMat[i,]
Temp[mut_site]<- '1'
if(Fitness(as.matrix(t(Temp)))>Fitness(as.matrix(t(mutMat[i,])))){
mutMat[i,] <- Temp
}
}
}
mutAdd <- 1 #突变结束后初始化突变累积
}else{
mutAdd <- mutAdd+1
}
Init_Mat <- mutMat
fitMat <- cbind(Init_Mat,WheelSelection(Fitness(Init_Mat)))
J_mat <- cbind(J_mat,Fitness(Init_Mat)) ##每代适应度变化
}
return(list(fitMat,J_mat))
}
输出预览：fitMat，可以看见迭代到最后个体都一样了
输出预览：J_mat，这个矩阵是每个个体每一代的适应度
可视化（适应度变化）
library(gcookbook)
library(ggplot2)
library(data.table)
＃＃＃将前面输出的适应度矩阵转变为可视化的输入
changeFormat <- function(J_mat){
Generat<-matrix(NA,nrow=nrow(J_mat),ncol=1)
for(i in 1:nrow(J_mat)){
Generat[i]<- paste('Individual',i)
}
rownames(J_mat)<-Generat
J_mat <- rbind(c(1:(ncol(J_mat))),J_mat)
J_mat <- as.data.frame(t(J_mat))
return(J_mat)
}
GA_plot<- function(J_mat){
forplot<-changeFormat(J_mat)
TTemp<-melt(t(forplot))
forplot_3<-TTemp[-which(TTemp=="V1"),]
forplot_3$Var1 <- as.factor(forplot_3$Var1)
ggplot(forplot_3, aes(x=Var2, y=value, color=Var1,fill=Var1)) + ＃可再进一步美化
geom_line() +geom_point(size=1)+labs(x = "Generation",y = "Fitness")
}
示例
GA_plot(GA(8,50,0.01)[[2]])
结果如下
有什么不对的地方欢迎大家在评论区指出。
网友评论