R语言:K-近邻(KNN)算法对个人年收入的预测


本期实操在R语言中使用K-近邻(KNN)算法预测个人年收入是否会超过50k美金。本文中所用到的数据为国外的一份人口普查的数据。同样的,关于算法原理本文将不作介绍。

数据基本情况

本文中所使用的数据来源于UCI机器学习库,在这个网站上有非常丰富和多样的真实数据集,并且为了方便大家理解和使用,其对每个数据集的情况有这非常详细的说明。本文数据获取:http://archive.ics.uci.edu/ml/datasets/Adult

接下来,我们将数据导入,看看数据的具体情况。由于其已经存在了测试集和训练集,我们将其合并,方便后续统一进行数据处理。

library(data.table)adult <- data.table(read.csv("/R/python/knn/adult.csv"))
adult_test <- data.table(read.csv("/R/python/knn/adult_test.csv"))
adult[,label := rep("train",nrow(adult))]
adult_test[,label := rep("test",nrow(adult_test))]
adult_total_data <- rbind(adult,adult_test) 

该数据集一共48842条数据,包含13列(其中的label是自行添加的,方便后续区分训练集和测试集),另外我们可以看到其中8个变量是分类变量,其中的salary是分类结果变量,它包含了四类,而这份数据是一个二分类的数据集,所以分类结果变量还需要进行进一步的处理。同时其他的连续变量因在K-近邻(KNN)算法需要计算距离,也需要进行标准化。具体各个变量的处理方式如下:


age:年龄,连续变量;标准化
workclass:个人企业类型,标称变量;进行onehot编码,“?” 作为特殊的一类
fnlwgt:记录id;删掉
education:教育水平,有序变量,与education_num表达信息;删除
education_num:受教育年限;标准化
marital_status:婚姻状况,标称变量;进行onehot编码
occupation 职业,标称变量;进行onehot编码
relationship 家庭关系,标称变量;进行onehot编码
race 种族,标称变量;进行onehot编码
sex 性别,标称变量;进行onehot编码
capital_gain 收益,连续变量;标准化
capital_loss 损失,连续变量;标准化
hours_per_week 周工作小时数,连续变量;标准化
native_country 国籍,标称变量;进行onehot编码,“?” 作为特殊的一类
salary 收入水平,目标变量


数据分类处理

在这一步,我们将不同处理要求的字段,分批进行处理,然后进行合并,具体的处理情况如下:

  • 删除不需要的变量:fnlwgt education
library(dplyr)adult_total_data <- select(adult_total_data,-fnlwgt,-education)
  • 标称变量处理,生成哑变量:workclass marital_status occupation relationship race sex native_country
library(caret)
adult_total_data_part <- select(adult_total_data,workclass,marital_status,occupation,relationship,race,sex,native_country) 
dummies <- dummyVars(~., data = adult_total_data_part, levelsOnly = FALSE, fullRank = TRUE)
adult_total_data_unordered <- predict(dummies, newdata = adult_total_data_part)  %>% as.data.frame()
  • 连续变量处理,标准化:age education_num capital_gain capital_loss hours_per_week
adult_total_data_part2 <- select(adult_total_data,age,education_num,capital_gain,capital_loss,hours_per_week)
adult_total_data_numerical <- preProcess(adult_total_data_part2,method = "scale") %>% predict(.,adult_total_data_part2)
  • 目标变量处理:salary
library(stringr)adult_total_data_part3 <- select(adult_total_data,salary,label)
adult_total_data_part3[,salary := gsub("[\\. ]","",salary)]
adult_total_data_target <-adult_total_data_part3
[,salary := factor(salary,levels = c("<=50K",">50K"),labels = c(0,1))]
  • 将分批处理的字段合并,得到处理好的数据集
adult_total_data_final <- cbind(adult_total_data_target,adult_total_data_unordered,adult_total_data_numerical)

最后,我们进行训练集和测试集的拆分,方便下一步的模型训练.

adult_train <- adult_total_data_final[label == "train",] %>% select(.,-label)
adult_test <- adult_total_data_final[label == "test",] %>% select(.,-label)

分类模型训练

本文中使用的K-近邻(KNN)算法来自class包,这是一个经典的机器学习的包。在K-近邻(KNN)算法中k值的选在十分的关键,它很大程度上决定了最后的分类效果。
首先,我们随机尝试一个k的取值,比如k = 10。

library(class)
library(pROC)
adult_pre  <- knn(train = adult_train[,-1],test = adult_test[,-1],cl = adult_train$salary,k= 10)
auc <- auc(as.numeric(adult_test$salary),as.numeric(adult_pre))

此时,得到的分类器对测试集的分类效果:auc = 0.7612。

为了寻找到更合适的k值,我们可以对多个k值进行测试,选择其中分类效果最好的k,作为最终的k值。我们将k值取1~50的值,选择使auc值最大的k值。

temp = 0for (i in 1:50){  
adult_pre  <- knn(train = adult_train[,-1],test = adult_test[,-1],cl = adult_train$salary,k= i)  
auc <- auc(as.numeric(adult_test$salary),as.numeric(adult_pre))  
if(auc >temp) {temp = auc;temp_k = i}  
print(i)
}

在这一次的尝试中,我们可以看到在k值取34时,auc 最大,其值为0.7711。但是其对分类效果的提升并不明显。

再进一步的观察中可以发现,这是一个并不平衡的数据,其中>50k的样本占比为24%,大部分均是 <=50k的样本,这可能会影响到最终的分类效果。处理数据的不平衡问题,可以使用DMwR

library(DMwR)
test_train <- SMOTE(salary~.,adult_train,perc.over=100,perc.under=200)

处理完后的数据,<=50k与>50k的样本各占50%。同样的,将k值取1~50的值,选择使auc值最大的k值。

temp = 0
for (i in 1:50){  
adult_pre  <- knn(train = test_train[,-1],test = adult_test[,-1],cl = test_train$salary,k= i) 
 auc <- auc(as.numeric(adult_test$salary),as.numeric(adult_pre))  
if(auc >temp) {temp = auc;temp_k = i} 
print(i)
}

最终,在k值取44时,得到的模型分类效果最好,其auc = 0.8072,相比之前有了比较明显的提升。

以上是在R语言中使用K-近邻(KNN)算法的全过程。如有做的不好或这不对的地方还请大家指正!

最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 211,948评论 6 492
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 90,371评论 3 385
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 157,490评论 0 348
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 56,521评论 1 284
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 65,627评论 6 386
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 49,842评论 1 290
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 38,997评论 3 408
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 37,741评论 0 268
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 44,203评论 1 303
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 36,534评论 2 327
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 38,673评论 1 341
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 34,339评论 4 330
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 39,955评论 3 313
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 30,770评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,000评论 1 266
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 46,394评论 2 360
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 43,562评论 2 349