项目02_TalkingData Mobile User Demographics R代码
#######step 1 start#############
#内存空间查看
gc()
memory.size(T) #查看已分配内存，6972
memory.size(F) #查看已使用内存，6852.55
memory.limit() #查看内存上限，返回8075
memory.limit(size=20000) #扩大内存上限
#批量导入.csv数据
library("data.table") #加载大数据文件读取包data.table
file_list <- list.files(getwd(),pattern="*.csv")
file_name <- unlist(lapply(file_list,function(x) {
strsplit(x,".csv")[[1]]}))
#批量生成每个csv对应的df数据框
for(i in 1:length(file_name))
{
name <- file_name[i]
#fread() 快速读取大文件，返回data.table类型
value <- fread(input=file_list[i],stringsAsFactors = FALSE,encoding="UTF-8")
df <- as.data.frame(value) #data.table强制转换成data.frame
#assign动态为df赋值
assign(name,df)
}
rm(df,value,name,i) #for函数内部过渡变量空间回收
#gc()，有两个功能，一是立即执行一次垃圾清理，二是显示剩余内存的统计信息
gc()
#used是当前使用情况
#gc trigger是会触发垃圾回收的值
#max used是上次gc()操作或者是此次启动R后使用最大值。
#(Mb)是Ncells和Vcells的大小转换为Mb单位时的值。
#Ncells即cons cells，32位R中占28B，64位R中占56B，我是用的32位的R，所以2616689*28/(1024^2) = 69.9。
#Vcells即vector cells，占8B，所以63817864*8/(1024^2) = 486.9。
#######step 1 stop##############
#######step 2 start#############
#数据合并
#2.1结果集测试集合并，新数据集comb
#参考训练集，修正测试集
str(gender_age_train) #74645 obs. of 4 variables
str(gender_age_test) #112071 obs. of 1 variable
#赋值NULL表示取消当前列
gender_age_test$gender <- NA
gender_age_test$age <- NA
gender_age_test$group <- NA
str(gender_age_test) #112071 obs. of 4 variables
comb <- rbind(gender_age_train,gender_age_test)
str(comb) #186716 obs. of 4 variables:74645+112071=186716
comb$device_id <- as.character(comb$device_id)
str(comb) #186716 obs. of 4 variables:74645+112071=186716
#rm(gender_age_train,gender_age_test) #释放过渡变量
gc()
device_id_all <- comb$device_id
mode(device_id_all) #返回character类型
length(unique(device_id_all))
#返回186716，comb数据框中device_id均为唯一值
#device_id为唯一值，在进行表格合并时，非常重要
#2.2 修正多表device_id数据，达到主动缩减数据量的效果
#device_id以device_id_all 186716个值为保留依据
#2.2.1修正phone_brand_device_model数据
#最终结果，将行数从187245减少529到186716
str(phone_brand_device_model) #187245 obs. of 3 variables
#%in% 字符串查找时，必须保持类型一致
phone_brand_device_model <- phone_brand_device_model[which(as.character(phone_brand_device_model$device_id) %in% device_id_all),]
str(phone_brand_device_model) #筛选后，仍旧返回187245 obs. of 3 variables
length(unique(phone_brand_device_model$device_id)) #返回186716
#186716 < 187245,说明device_id存在重复值
library("dplyr")
t <- table(phone_brand_device_model$device_id)
t <- as.data.frame(t)
t[t$Freq>1,] #取三个，代表全行相同，前两列值相同，第一列值相同
phone_brand_device_model[phone_brand_device_model$device_id=="8313479583375224298",]
phone_brand_device_model[phone_brand_device_model$device_id=="-3004353610608679970",]
phone_brand_device_model[phone_brand_device_model$device_id=="-7059081542575379359",]
#删除重复行
#duplicated主要是判定向量或数据框中的元素是否重复，它返回一个元素（行）是不是重复的逻辑向量
#device_id，phone_brand，device_model，3列完全相同，返回重复总量为523行
sum(duplicated(phone_brand_device_model))
#device_id,phone_brand，两项完全相同的行,返回525个，523个为全相等，2个为额外的device_id,phone_brand相等
sum(duplicated(phone_brand_device_model[,c(1,2)]))
#device_id,device_model，两项完全相同的行,返回523个，523个为全相等
sum(duplicated(phone_brand_device_model[,c(1,3)]))
#device_id，单项完全相同的行,返回529个，其中523个为全相等，2个device_id,phone_brand相等，4个仅device_id相等
sum(duplicated(phone_brand_device_model[,c(1)]))
#认定device_id单列重复，即为重复值
dup_v <- duplicated(phone_brand_device_model[,c(1)]) #FALSE 表示不重复，TRUE 表示重复
sum(dup_v) #返回529行
phone_brand_device_model <- phone_brand_device_model[!dup_v,]
phone_brand_device_model$device_id <- as.character(phone_brand_device_model$device_id)
str(phone_brand_device_model) #186716 obs. of 3 variables
rm(t,dup_v)
gc()
#2.2.2 修正envents数据
##最终结果，将行数从3252950减少92533 到3160417
str(events) #3252950 obs. of 5 variables
events <- events[which(as.character(events$device_id) %in% device_id_all),]
str(events) #3160417 obs. of 5 variables
sum(duplicated(events[,c(1,2)])) #返回0，表示event_id,device_id没有完全相同的行
events$device_id <- as.character(events$device_id)
events$event_id <- as.character(events$event_id)
#2.3 修正app_events数据,缩减数据量的行数
str(app_events) #32473067 obs. of 4 variables
sum(duplicated(app_events)) #返回0，无法缩减
app_events$event_id <- as.character(app_events$event_id)
app_events$app_id <- as.character(app_events$app_id)
#2.4 修正app_labels数据
str(app_labels) #459943 obs. of 2 variables
sum(duplicated(app_labels)) #返回491，可以缩减
app_labels <- app_labels[!duplicated(app_labels),]
str(app_labels)#459452 obs. of 2 variables
app_labels$app_id <- as.character(app_labels$app_id)
app_labels$label_id <- as.character(app_labels$label_id)
#2.5 修正label_categories数据
str(label_categories) #930 obs. of 2 variables
sum(duplicated(label_categories)) #返回0，不可以缩减行数
label_categories$label_id <- as.character(label_categories$label_id)
#######step 2 stop##############
#######step 3 start#############
#描述性探索
#品牌在市场的占有性描述
library("dplyr")
gender_age_train$device_id <- as.character(gender_age_train$device_id)
gender_age_brand <- left_join(gender_age_train,phone_brand_device_model)
str(gender_age_brand) #74645 obs. of 6 variables
sum(duplicated(gender_age_brand$device_id)) #返回0
#3.1 基于性别，分析品牌占有率情况
brand_count <- as.data.frame(table(gender_age_brand$phone_brand))
brand_arrange <- arrange(brand_count,desc(brand_count$Freq)) #各品牌总计数
t <- table(gender_age_brand$gender,gender_age_brand$phone_brand)
t <- as.data.frame(t) #各品牌，男女分别计数
top10_brand <- brand_arrange[1:10,] #取前十名品牌名，总量
t_top10_brand <- t[t$Var2 %in% top10_brand$Var1,] #取前十名品牌，对应的男女统计
t_top10_brand$Var2 <- droplevels(t_top10_brand$Var2) #基于现有数据，减少因子维度，从120个，降低到10个
t_top10_brand$Var2 <- factor(t_top10_brand$Var2,levels=top10_brand$Var1) #修改因子水平排序，影响x轴属性显示顺序
#数据框，根据指定列排序
#library("plyr")
#t <- arrange(t,t$Freq)
#总量扇形图
library(plotrix)
fan.plot(top10_brand$Freq,labels=as.character(top10_brand$Var1),main="Fre for brand")
#总量饼图
pct <- round(top10_brand$Freq/sum(top10_brand$Freq)*100)
labels <- paste0(top10_brand$Var1,"",pct,"%")
pie(pct,labels=labels,main="Pie Chart with Percentages")
#各品牌，男女购买数
library("ggplot2")
ggplot(data=t_top10_brand,aes(x=Var2,y=Freq,color=Var1))+
geom_point(size=3)+
scale_y_continuous(breaks=c(2000,4000,6000,8000),
labels=c("2K","4K","6K","8K"))+
#facet_grid(.~Var1)+
labs(title="Freq by brand and Sex",
x="brand",
y="Frequency",
fill="Var1")+
theme(legend.position = "right")+
theme(plot.title = element_text(hjust = 0.5)) #让标题位于正中间
#结果解读
#市场排名前三名：小米，三星，华为
#男性钟爱品牌前三名：小米，华为，三星
#女性钟爱品牌前三名：小米，三星，华为
#OPPO，vivo,金立，htc品牌中，男女消费者比例相当
#小米，三星，华为等品牌中，男性消费者比例较高
#3.2 基于年龄，查看品牌的市场占有率
age_brand <- gender_age_brand[gender_age_brand$phone_brand %in% top10_brand$Var1,c("gender","age","phone_brand")]
age_brand <- unique(age_brand)#从原始的68213条记录，减少至1216条记录
age_brand$phone_brand <- factor(age_brand$phone_brand,levels=top10_brand$Var1)
t2 <- table(age_brand$age,age_brand$phone_brand)
t2 <- as.data.frame(t) #各品牌，男女分别计数
top10_brand <- brand_arrange[1:10,] #取前十名品牌名，总量
t_top10_age <- t[t2$Var2 %in% top10_brand$Var1,] #取前十名品牌，对应的男女统计
t_top10_age$Var2 <- droplevels(t_top10_age$Var2) #基于现有数据，减少因子维度，从120个，降低到10个
t_top10_age$Var2 <- factor(t_top10_age$Var2,levels=top10_brand$Var1) #修改因子水平排序，影响x轴属性显示顺序,不影响列值显示
#各品牌年龄箱线图
library("ggplot2")
ggplot(data=age_brand,aes(x=phone_brand,y=age,fill=gender))+
geom_boxplot()+
ylim(15,55)+
#facet_grid(.~gender)+
labs(title=" Age under brand",
x="age",
y="",
fill="gender")+
theme(legend.position = "right")+
theme(plot.title = element_text(hjust = 0.5)) #让标题位于正中间
#结果解读
#除去金立，htc，其余品牌下购买的年龄阶段相当
#金立，htc,品牌下男性年龄略比女性年龄小
#######step 3 stop##############
######step 4 start###############
#思路概况：
#基于comb中186716个独立的device_id，构建稀疏矩阵
#矩阵的行数=186716个独立的device_id
#矩阵的列数=phone_brand,device_model,app_id全量属性下的所有总和
#利用0,1来标识，该device_id是否具有该属性特征
library("Matrix")
#属性标识构造函数
feature <- function(df,colname,dimrow=length(device_id_all),rname=device_id_all){
#提取对应列值
colname_v <- as.character(df[,colname])
#提取所有组名,排除NA
colname_feature <- unique(colname_v[!is.na(colname_v)])
#提取组别个数
colname_n <- length(colname_feature)
#定位每个device_id的colname在未重复的组名中的排名，即对应列名的索引位置
#y_index的区间位于1：colname_n
c_index <- match(colname_v,colname_feature)
#r_index的区间位于1：dimrow
r_index <- match(as.character(df[,c("device_id")]),rname)
#r_index,c_index不同时为空的位置集合
df_index <- na.omit(cbind(r_index,c_index))
r_index <- df_index[,1]
c_index <- df_index[,2]
#生成device_id,colname的稀疏矩阵
#r_index[1]对应r坐标,c_index[1]对应c坐标,指定坐标赋值为1，其余均为0
t_Matrix <- sparseMatrix(r_index,c_index,
x=1,
dims=c(dimrow,colname_n))
#规范t_Matrix的行，命名
#行命名，采用rname
rownames(t_Matrix) <- rname
#列命名，采用colname_feature:组名
colname_feature <- paste0(colname,"_feature:",colname_feature)
colnames(t_Matrix) <- colname_feature
#资源释放
rm(colname_feature,colname_n,r_index,c_index)
gc()
return(t_Matrix)
}
debug(feature)
undebug(feature)
#4.1 phone_brand_device_model中phone_brand,device_model中属性标识构造
#4.1.1 phone_brand_device_mode,comb基于device_id进行表格聚合
#使用dplyr
#inner_join #内连接
#left_join #左连接
#right_join #右连接
#full_join #全连
#semi_join # 返回能够与y表匹配的x表所有记录
#anti_join # 返回无法与y表匹配的x表的所有记录
c_p <- left_join(comb,phone_brand_device_model)
str(c_p) #186716 obs. of 6 variables
#4.1.2 基于phone_brand属性标识构造
phone_brand_Matrix <- feature(c_p,"phone_brand")
Result_Matrix <- phone_brand_Matrix
rm(phone_brand_Matrix)
gc()
dim(Result_Matrix) #131列
#4.1.3 基于device_model属性标识构造
device_model_Matrix <- feature(c_p,"device_model")
Result_Matrix <- cbind(Result_Matrix,device_model_Matrix)
rm(device_model_Matrix)
gc()
dim(Result_Matrix) #131+1598=1729
#4.1.4 释放资源
rm(c_p,phone_brand_device_model)
gc()
#4.2 events,app_events中app_id属性标识构造
#基于event_id,合并app_events,events表格
#使用dplyr
device_app_id <- inner_join(events[,c("event_id","device_id")],app_events[,c("event_id","app_id")])
str(device_app_id) #31800268 obs. of 3 variables
sum(duplicated(device_app_id[,c("device_id","app_id")])) #返回29497299，存在重复值
device_app_id <- device_app_id[!duplicated(device_app_id[,c("device_id","app_id")]),-1]
str(device_app_id) #去重以后，2302969 obs. of 2 variables
app_id_Matrix <- feature(device_app_id,"app_id")
dim(app_id_Matrix) #186716 18888
#结果集合并
Result_Matrix <- cbind(Result_Matrix,app_id_Matrix)
rm(app_id_Matrix)
gc()
dim(Result_Matrix) #131+1598+18888=20617
colnames(Result_Matrix) #行名，正确保留
rownames(Result_Matrix) #列名，正确保留
#以测试集为参考标准
#将所有列中，全部填充为0，或者全部填充为1的无效列删除
#减少噪音
refer_Train <- Result_Matrix[1:74645,]
flag_col <- colSums(refer_Train)
Matrix_bakup <- Result_Matrix
Result_Matrix <- Result_Matrix[,flag_col >0 & flag_col < nrow(Result_Matrix)]
dim(Result_Matrix) # 186716 15320,实际减少：20617-15320=5297列
#4.3拆分训练集，测试集
#前74645行，对应训练集数据，包含所有列
#74646:186716,共计112071条数据对应测试集数据，必须包含group_feature的列
Train <- Result_Matrix[1:74645,]
colnames(Train)
rownames(Train)
Test <- Result_Matrix[74646:186716,]
#统计每个大类下，小类的个数
library(stringr)
sum(str_detect(xx,"device_model:"))
sum(str_detect(xx,"phone_brand:"))
sum(str_detect(xx,"app_id:"))
######step 4 stop################
######step 5 start###############
#训练模型
#############训练xgboost模型######
library(xgboost)
#生成xgb.DMatrix的label对象
group_y <- comb[,"group"]
group_feature <- unique(group_y[!is.na(group_y)])
#提取组别个数
group_n <- length(group_feature)
#训练集的label,返回trian的各个因变量在因变量组中的位置索引
#由于label的有效值范围为[0,nrow(train))
#训练集的label=位置索引整体-1
#训练集的label是有效数值
train_index <- match(comb$group[comb$device_id %in% rownames(Train)],group_feature)
train_label <- train_index -1
#生成xgb.DMatrix对象
train_DMatrix <- xgb.DMatrix(Train,label=train_label,missing=NA)
xgboost_p <- list(booster="gblinear",
num_class=group_n,
objective="multi:softprob",
eval_metric="mlogloss",
eta=0.005,
lambda=5,
lambda_bias=0,
alpha=2)
#（1）objective [ default=reg:linear ] 定义学习任务及相应的学习目标，可选的目标函数如下：
#“reg:linear” –线性回归。
#“reg:logistic” –逻辑回归。
#“binary:logistic” –二分类的逻辑回归问题，输出为概率。
#“binary:logitraw” –二分类的逻辑回归问题，输出的结果为wTx。
#“count:poisson” –计数问题的poisson回归，输出结果为poisson分布。 在poisson回归中，max_delta_step的缺省值为0.7。(used to safeguard optimization)
#“multi:softmax” –让XGBoost采用softmax目标函数处理多分类问题，同时需要设置参数num_class（类别个数）
#“multi:softprob” –和softmax一样，但是输出的是ndata * nclass的向量，可以将该向量reshape成ndata行nclass列的矩阵。没行数据表示样本所属于每个类别的概率。
#“rank:pairwise” –set XGBoost to do ranking task by minimizing the pairwise loss
#（2）’eval_metric’ The choices are listed below，评估指标:
# “rmse”: root mean square error
#“logloss”: negative log-likelihood
#“error”: Binary classification error rate. It is calculated as #(wrong cases)/#(all cases). For the predictions, the evaluation will regard the instances with prediction value larger than 0.5 as positive instances, and the others as negative instances.
#“merror”: Multiclass classification error rate. It is calculated as #(wrong cases)/#(all cases).
#“mlogloss”: Multiclass logloss
#“auc”: Area under the curve for ranking evaluation.
#“ndcg”:Normalized Discounted Cumulative Gain
#“map”:Mean average precision
#“ndcg@n”,”map@n”: n can be assigned as an integer to cut off the top positions in the lists for evaluation.
#“ndcg-“,”map-“,”ndcg@n-“,”map@n-“: In XGBoost, NDCG and MAP will evaluate the score of a list without any positive samples as 1. By adding “-” in the evaluation metric XGBoost will evaluate these score as 0 to be consistent under some conditions.
#（3）lambda [default=0] L2 正则的惩罚系数
#（4）alpha [default=0] L1 正则的惩罚系数
#（5）lambda_bias 在偏置上的L2正则。缺省值为0（在L1上没有偏置项的正则，因为L1时偏置不重要）
#（6）eta [default=0.3]
#为了防止过拟合，更新过程中用到的收缩步长。在每次提升计算之后，算法会直接获得新特征的权重。 eta通过缩减特征的权重使提升计算过程更加保守。缺省值为0.3
#取值范围为：[0,1]
#（7）max_depth [default=6] 数的最大深度。缺省值为6 ，取值范围为：[1,∞]
#（8）min_child_weight [default=1]
#孩子节点中最小的样本权重和。如果一个叶子节点的样本权重和小于min_child_weight则拆分过程结束。在现行回归模型中，这个参数是指建立每个模型所需要的最小样本数。该成熟越大算法越conservative
#取值范围为: [0,∞]
watchlist <- list(train=train_DMatrix)
ntree <- 1000
set.seed(1234)
fit_xgboost <- xgb.train(params=xgboost_p,
data=train_DMatrix,
nrounds=ntree,
watchlist=watchlist,
verbose=1)
#############训练xgboost模型######
######setp 5 stop################
######step 6 start###############
#############基于xgboost模型，预测######
#测试集的因变量需要预测，所以在因变量组中的位置索引，返回NA
#NA-1=NA
#测试集的label是NA
test_index <- match(comb$group[comb$device_id %in% rownames(Test)],group_feature)
test_label <- test_index-1
#生成xgb.DMatrix对象
test_DMtrix <- xgb.DMatrix(Test,label=test_label,missing=NA)
pred <- predict(fit_xgboost,test_DMtrix)
pred_detail <- t(matrix(pred,nrow=group_n))
res_submit <- cbind(id=device_id_all[74646:186716],as.data.frame(pred_detail))
tocheck <- rowSums(res_submit[,-1])
length(tocheck) #返回112071
head(tocheck) #粗略查看针对每一个device_id的所有组别概率相加总和为1
colnames(res_submit) <- c("device_id",group_feature)
write.csv(res_submit,file="submission.csv",row.names=F,quote=F)
#############基于xgboost模型，预测######
######setp 6 stop################
#kaggle 得分2.42794，1503/1689
项目02_TalkingData Mobile User Demographics R代码相关推荐
- 手把手教你用Prophet快速进行时间序列预测（附Prophet和R代码）
作者:ANKIT CHOUDHARY 翻译:王雨桐 校对:丁楠雅 本文约3000字,建议阅读12分钟. 本文将通过拆解Prophet的原理及代码实例来讲解如何运用Prophet进行时间序列预测. 简介 ...
- 机器学习算法清单！附Python和R代码
来源:数据与算法之美 本文约6000字,建议阅读8分钟. 通过本文为大家介绍了3种机器学习算法方式以及10种机器学习算法的清单,学起来吧~ 前言 谷歌董事长施密特曾说过:虽然谷歌的无人驾驶汽车和机器人 ...
- 10 种机器学习算法的要点（附 Python 和 R 代码）（转载）
10 种机器学习算法的要点(附 Python 和 R 代码)(转载) from:https://zhuanlan.zhihu.com/p/25273698 前言 谷歌董事长施密特曾说过:虽然谷歌的无人 ...
- 10 种机器学习算法的要点（附 Python 和 R 代码）
前言 谷歌董事长施密特曾说过:虽然谷歌的无人驾驶汽车和机器人受到了许多媒体关注,但是这家公司真正的未来在于机器学习,一种让计算机更聪明.更个性化的技术. 也许我们生活在人类历史上最关键的时期:从使用大 ...
- 【课题总结】OpenCV 抠图项目实战（12）源程序代码
Python 小白的课题报告-OpenCV 抠图项目实战(12)源程序代码 本系列是 Python 小白的课题作业<基于OpenCV 的图像分割和抠图>. 需要说明的是,本系列并不能算是 ...
- 机器学习算法的要点（附 Python 和 R 代码）
前言 谷歌董事长施密特曾说过:虽然谷歌的无人驾驶汽车和机器人受到了许多媒体关注,但是这家公司真正的未来在于机器学习,一种让计算机更聪明.更个性化的技术. 也许我们生活在人类历史上最关键的时期:从使用大 ...
- Code Clinic: R 代码诊所：R语言 Lynda课程中文字幕
Code Clinic: R 中文字幕 代码诊所:R语言 中文字幕Code Clinic: R 成功的程序员不仅仅知道如何编码 他们也知道如何思考解决问题 Code Clinic是一系列课程,我们的教 ...
- 电网知识图谱项目总结（1）python代码实现RDF三元组自动化标注
电网知识图谱项目总结(1)python代码实现RDF三元组自动化标注 文章目录 电网知识图谱项目总结(1)python代码实现RDF三元组自动化标注 简介 文档内容 RDF规范 标注思路 代码结构 详 ...
- python 时间序列prophet 模型分析_手把手教你用Prophet快速进行时间序列预测（附Prophet和R代码）...
原标题:手把手教你用Prophet快速进行时间序列预测(附Prophet和R代码) 作者:ANKIT CHOUDHARY:翻译:王雨桐:校对:丁楠雅: 本文约3000字,建议阅读12分钟. 本文将通过 ...
最新文章
- SmartAuditor----IT访问审计解决方案
- Cordova入门系列（一）创建项目
- Linux环境多线程编程基础设施
- 【学习笔记】Dilworth 定理的构造性证明
- 判断手机浏览器还是桌面浏览器
- 【线段树】Traffic Jams in the Land（CF498D）
- 前端学习（540）：node.js简介
- MySQL快速生成连续整数
- python怎样画动态文字_Python制作动态字符图的实例
- Mac电脑开机出现带问号的文件夹并且闪烁 apple.com/support -2003F
- SHELL下获得指定进程的进程号，并截取为整数
- 【路径规划】局部路径规划算法——B样条曲线法（含python实现）
- 多核处理器真的能提升软件系统性能吗？
- 自然语言在公路交通各建设阶段运用
- html模板查询,前台模板查找
- Flutter跑马灯Marquee
- 【李宏毅机器学习学习1】
- 罗技无线键盘linux,罗技发布旗下第一款无线机械游戏键盘 G613
- SQL Server 和 Oracle 以及 MySQL 的区别
- Linux C/C++ 调试的那些“歪门邪道”