数据分析中非常实用的自编函数和代码模块整理

大家周末好!

搞了接近四个周的模型开发工作，今天整理代码文件，评分卡模型基本告一段落了。那么在模型开发或者是我们日常的数据分析工作中，根据我们具体的业务需求，经常会重复地用到某些模块的功能。而这些模块的功能在R的packages里是没有的，这个时候，我们一般是通过自己写代码实现功能。通俗的说，在数据分析工作中，我们经常会通过调用自编函数来实现某些高级的功能。

一般在结束某项数据分析的工作之后，对于使用频率比较高的模块功能，我会将实现代码封装在一个模块函数当中，并命好名，方便下次调用。其实你可以把它理解为自己开发的一个package，通过模块化的调用，提高我们在数据分析工作中的效率，而不用每次都用造轮子式的方法来敲代码！

我一直认为这是一个很好的习惯，你的自编函数或者说是代码模块积累得越多，对于以后的建模工作来说会更加轻车熟路，这也是每一个数据分析师在工作的过程当中积累的宝贵经验。

说了这么多，今天给大家分享几个我平时用得比较多，实用性也比较强的自编函数和代码模块，方便大家借鉴参考。

1、centralImputation( )

根据样本间的相似性填补缺失值方法，把实现代码封装在如下函数中，并将该函数命名为centralImputation

根据样本之间的相似性填补缺失值是指用这些缺失值最可能的值来填补它们，通常使用能代表变量中心趋势的值进行填补，因为代表变量中心趋势的值反映了变量分布的最常见值。代表变量中心趋势的指标包括平均值、中位数、众数等，那么我们采用哪些指标来填补缺失值呢？最佳选择是由变量的分布来确定，例如，对于接近正态分布的变量来说，由于所有观测值都较好地聚集在平均值周围，因此平均值就就是填补该类变量缺失值的最佳选择。然而，对于偏态分布或者离群值来说，平均值就不是最佳选择。因为偏态分布的大部分值都聚集在变量分布的一侧，平均值不能作为最常见值的代表。对于偏态分布或者有离群值的分布而言，中位数是更好地代表数据中心趋势的指标。对于名义变量（如定性指标），通常采用众数填补缺失值。

我们将上述分析放在一个统一的函数centralImputation( )中，对于数值型变量，我们用中位数填补，对于名义变量，我们用众数填补，函数代码如下：

centralImputation<-function(data)
{
for(i in seq(ncol(data)))
if(any(idx<-is.na(data[,i])))
{
data[idx,i]<-centralValue(data[,i])
}
data}
centralValue<-function(x,ws=NULL)
{
if(is.numeric(x))
{
if(is.null(ws))
{
median(x,na.rm = T)
}
else if((s<sum(ws))>0)
{
sum(x*(ws/s))
}
else NA
}
else
{
x<-as.factor(x)
if(is.null(ws))
{
levels(x)[which.max(table(x))]
}
else
{
levels(x)[which.max(aggregate(ws,list(x),sum)[,2])]
}
}
}

调用上述函数对缺失值进行填补，代码如下：

x<-centralImputation(data)
View(x)     #查看填补结果

2、knnImputation( )

根据变量间的相关关系填补缺失值（基于knn算法）

上述按照中心趋势进行缺失值填补的方法，考虑的是数据每列的数值或字符属性，在进行缺失值填补时，我们也可以考虑每行的属性，即根据变量之间的相关关系填补缺失值。

当我们采用数据集每行的属性进行缺失值填补时，通常有两种方法，第一种方法是计算k个（我用的k=10）最相近样本的中位数并用这个中位数来填补缺失值。如果缺失值是名义变量，则使用这k个最近相似数据的加权平均值进行填补，权重大小随着距离待填补缺失值样本的距离增大而减小，本文我们采用高斯核函数从距离获得权重，即如果相邻样本距离待填补缺失值的样本的距离为d，则它的值在加权平均中的权重为：



在寻找跟包含缺失值的样本最近的k个邻居样本时，最常用的经典算法是knn(k-nearest-neighbor) 算法，它通过计算样本间的欧氏距离，来寻找距离包含缺失值样本最近的k个邻居，样本x和y之间欧式距离的计算公式如下：



式中：δi()是变量i的两个值之间的距离，即



在计算欧式距离时，为了消除变量间不同尺度的影响，通常要先对数值变量进行标准化，即：



我们将上述根据数据集每行的属性进行缺失值填补的方法，封装到knnImputation( )函数中，代码如下：

knnImputation<-function(data,k=10,scale=T,meth="weighAvg",distData=NULL)
{
n<-nrow(data)
if(!is.null(distData))
{
distInit<-n+1
data<-rbind(data,distData)
}
else
{
disInit<-1
}
N<-nrow(data)
ncol<-ncol(data)
nomAttrs<-rep(F,ncol)
for(i in seq(ncol))
{
nomAttrs[i]<-is.factor(data[,1])
}
nomAttrs<-which(nomAttrs)
hasNom<-length(nomAttrs)
contAttrs<-setdiff(seq(ncol),nomAttrs)
dm<-data
if(scale)
{
dm[,contAttrs]<-scale(dm[,contAttrs])
}
if(hasNom)
{
for(i in nomAttrs)
dm[,i]<-as.integer(dm[,i])
}
dm<as.matrix(dm)
nas<-which(!complete.cases(dm))
if(!is.null(distData))
{
tgt.nas<-nas[nas<=n]
}
else
{
tgt.nas<-nas
}
if(length(tgt.nas)==0)
{
warning("No case has missing values. Stopping as there is nothing to do.")
}
xcomplete<-dm[setdiff(disInit:N,nas),]
if(nrow(xcomplete)<k)
{
stop("Not sufficient complete cases for computing neighbors.")
}
for(i in tgt.nas)
{
tgtAs<-which(is.na(dm[i,]))
dist<-scale(xcomplete,dm[i,],FALSE)
xnom<-setdiff(nomAttrs,tgtAs)
if(length(xnom))
{
dist[,xnom]<-ifelse(dist[,xnom]>0,1,dist[,xnom])
}
dist<-dist[,-tgtAs]
dist<-sqrt(drop(dist^2%*%rep(1,ncol(dist))))
ks<-order(dist)[seq(k)]
for(j in tgtAs) if(meth=="median")
{
data[i,j]<-centralValue(data[setdiff(distInit:N,nas),j][ks])
}
else
{
data[i,j]<-centralValue(data[setdiff(distInit:N,nas),j]
[ks],exp(-dist[ks]))
}
}
data[1:n,]
}

调用knnImputation( )函数，用knn方法填补缺失值，代码如下：

d<-knnImputation(data)
View(d)     #查看填补结果

以上两个模块化函数的分析和代码实现，大家get到了吗。在数据分析最头痛，最花时间的数据清洗和数据预处理环节，通过直接调用模块化函数，大大的节省了我们耗费的时间，提高数据分析工作的效率。

我是雷锋，下次再见！

——Copyright Reserved by Erin