第八周作业
在MINE的网站(网址见第8周幻灯片)下载有关程序和数据,试对“WHO”数据集进行无特定主题挖掘,看是否能挖掘出一些有趣的关联关系,将实验的主要过程copy或抓图作为作业内容,并且解读挖掘结果
这里先对论坛大神表示感谢,引用之处无法一一列出请见谅。虽然回头看前面学的稀里糊涂,好在这里有很多巨人的肩膀让我们来站。再次表示感谢。
如果没相应的数据或过程去掉R命令的注释即可
1.安装Java(步骤略)
2.修改MINE.r 原.jinit(classpath=“MINE.jar”) 修改为 .jinit(classpath=“MINE.jar”, parameters=“-Xms2048m”)
setwd("E:/baiduyun/百度云同步盘/R 培训及资料/R08")
3.下载数据
# download.file('http://www.exploredata.net/ftp/WHO.csv', 'WHO.csv')
4.先期的数据处理,把过长的变量名缩短一些,否则后期很烦。然后做了MINE函数的调用
library(rJava)
source("MINE.r")
who <- read.csv("WHO.csv", header = T)
names(who) <- paste("v", 1:358, sep = "")
write.csv(who, "whonew.csv", row.names = F)
# MINE('whonew.csv','all.pairs',0)
# 因速度过慢屏蔽了这一步,结果已计算出共63101个结果
和论坛其他同学计算的好像不大一样,好像相差有几十个
5.引入中文变量名称对照,这里将zhlight同学的名称文件去掉了第一列并另存为csv文件
colcn <- read.csv("colcn.csv", header = F)
这样的话通过colcn[行,][列],即可获得变量的中英文名称 列1-英文 2-中文
6.兴冲冲的看了好多结果集结果发现,不明白呀不明白,老师说的好像靠不上呀,回头看了下发现居然好多缺失值。不知道缺失值它是咋处理的,貌似忽略了所有缺失值,只对完整的数据对进行了计算,如果不对缺失值进行处理估计会出现很大的偏差结论,就像我们被平均的工资一样。 这里吐槽下,老湿应该把结果里的参数含义和用法好好给我们讲下呀,度娘都快哭了,MINE的中文资料除了在dataguru,其他地方基本是0。
闲话少絮,下面先处理下缺失值 @在沉默同学(http://www.dataguru.cn/thread-86232-1-1.html) 给了我很多启发,但是感觉处理的方式我不大认可,作为数据控我不大喜欢对原始数据的直接修改。只好查阅了R 语言实战里面的15章,目前我的水平还无法做到类似多重查补的方法补全数据,那就进行下缺失值的探索吧。 这里用到了VIM和mice包,是不是都用上了没仔细研究先装上吧
# install.packages(c('VIM','mice'),dependencies=T)
require(VIM) #这里有个下列对象被屏蔽了from ‘package:datasets’: sleep提示可以忽略
## Loading required package: VIM
## Loading required package: colorspace
## Loading required package: grid
## VIM is ready to use.
## Since version 4.0.0 the GUI is in its own package VIMGUI.
##
## Please use the package to use the new (and old) GUI.
##
##
## Attaching package: 'VIM'
##
## 下列对象被屏蔽了from 'package:datasets':
##
## sleep
# 如需使用VIM的sleep数据集使用data(sleep,package='VIM')
参考hegq12同学的帖子进行了数据的筛选http://f.dataguru.cn/thread-200505-1-2.html 考虑到hegq12同学未进行缺失值的筛选,这里条件放宽一些
who = read.csv("whonew.csv", header = T, stringsAsFactors = F)
wpairs = read.csv("whonew.csv,allpairs,cv=0.0,B=n^0.6,Results.csv", header = T,
stringsAsFactors = F)
nrow(wpairs)
## [1] 63100
wpairs = wpairs[wpairs[, 3] > 0.75, ]
nrow(wpairs)
## [1] 1196
wpairs = wpairs[abs(wpairs[, 8]) < 0.25, ]
total <- nrow(wpairs)
得到了149个数值对。
7.下面进行缺失值的检查,NACount用于成对参数的有效数据比率
NACount <- numeric(total)
nw <- nrow(who)
for (i in 1:total) {
c1 <- wpairs[i, 1]
c2 <- wpairs[i, 2]
c1 <- as.numeric(substring(c1, first = 2))
c2 <- as.numeric(substring(c2, first = 2))
tmpcsv <- data.frame(who[c1], who[c2])
NACount[i] <- nrow(tmpcsv[complete.cases(tmpcsv), ])/nw
}
NACount
## [1] 0.034653 0.034653 0.034653 0.084158 0.316832 0.079208 0.029703
## [8] 0.891089 0.891089 0.896040 0.861386 0.891089 0.891089 0.891089
## [15] 0.821782 0.074257 0.232673 0.891089 0.014851 0.034653 0.831683
## [22] 0.851485 0.797030 0.891089 0.118812 0.009901 0.024752 0.019802
## [29] 0.841584 0.707921 0.925743 0.861386 0.797030 0.029703 0.000000
## [36] 0.024752 0.014851 0.009901 0.009901 0.009901 0.009901 0.311881
## [43] 0.925743 0.757426 0.797030 0.094059 0.217822 0.381188 0.831683
## [50] 0.925743 0.950495 0.183168 0.321782 0.356436 0.212871 0.306931
## [57] 0.891089 0.891089 0.306931 0.311881 0.306931 0.886139 0.113861
## [64] 0.797030 0.311881 0.301980 0.891089 0.381188 0.891089 0.301980
## [71] 0.717822 0.138614 0.103960 0.381188 0.381188 0.643564 0.381188
## [78] 0.925743 0.846535 0.316832 0.346535 0.277228 0.311881 0.306931
## [85] 0.277228 0.361386 0.891089 0.782178 0.311881 0.381188 0.361386
## [92] 0.381188 0.306931 0.306931 0.381188 0.707921 0.752475 0.311881
## [99] 0.336634 0.103960 0.757426 0.836634 0.381188 0.138614 0.361386
## [106] 0.851485 0.891089 0.103960 0.638614 0.836634 0.524752 0.891089
## [113] 0.316832 0.277228 0.638614 0.772277 0.297030 0.886139 0.361386
## [120] 0.752475 0.891089 0.900990 0.896040 0.361386 0.886139 0.311881
## [127] 0.168317 0.816832 0.891089 0.311881 0.871287 0.846535 0.103960
## [134] 0.103960 0.306931 0.925743 0.871287 0.301980 0.168317 0.277228
## [141] 0.821782 0.772277 0.297030 0.797030 0.301980 0.356436 0.683168
## [148] 0.594059 0.717822
8.最后根据有效数据比例筛选结果
for (i in 1:total)
{
if (NACount[i] > 0.91) #通过修改这里的参数调整输出结果的多少
{
c1 <- wpairs[i,1]
c2 <- wpairs[i,2]
c1 <- as.numeric(substring(c1,first=2))
c2 <- as.numeric(substring(c2,first=2))
print(colcn[c1,][1:2])
print(colcn[c2,][1:2])
print(wpairs[i,8])
print("----------")
}
}
## V1 V2
## 230 Fixed_line_and_mobile_phone_subscribers 固定电话和移动电话用户
## V1 V2
## 189 Cell_phones_per_100_people 每100人手机
## [1] -0.02932
## [1] "----------"
## V1
## 115 Deaths among children under five years of age due to malaria (%)
## V2
## 115 5岁以下儿童中疟疾造成的死亡(%)
## V1
## 112 Deaths among children under five years of age due to diarrhoeal diseases (%)
## V2
## 112 死亡者中5岁以下的儿童因腹泻病(%)
## [1] 0.03095
## [1] "----------"
## V1
## 119 Deaths among children under five years of age due to pneumonia (%)
## V2
## 119 在5岁以下儿童因肺炎(%)
## V1
## 112 Deaths among children under five years of age due to diarrhoeal diseases (%)
## V2
## 112 死亡者中5岁以下的儿童因腹泻病(%)
## [1] 0.02463
## [1] "----------"
## V1 V2
## 17 Total fertility rate (per woman) 总和生育率(每名妇女)
## V1 V2
## 15 Population proportion under 15 (%) 15岁以下人口的比例(%)
## [1] -0.1211
## [1] "----------"
## V1 V2
## 250 Income_per_person 人均收入
## V1 V2
## 189 Cell_phones_per_100_people 每100人手机
## [1] -0.06121
## [1] "----------"
## V1
## 115 Deaths among children under five years of age due to malaria (%)
## V2
## 115 5岁以下儿童中疟疾造成的死亡(%)
## V1
## 58 Per capita government expenditure on health at average exchange rate (US$)
## V2
## 58 人均政府卫生支出的平均汇率(美元)
## [1] -0.2337
## [1] "----------"
相对有些意义的结果:
Income_per_person 人均收入 VS Cell_phones_per_100_people 每100人手机
Deaths among children under five years of age due to malaria (%)5岁以下儿童中疟疾造成的死亡(%) VS Per capita government expenditure on health at average exchange rate (US$) 人均政府卫生支出的平均汇率(美元)
最终的结果还是需要经过肉眼挑选,这里依旧也没有解决通过参数的聚类,剔除多余计算结果的问题。另外可视化等问题留在今后继续研究。
本题的收获:
MINE的可视化应该是使用processing2完成的,有兴趣的同学可以去processing.org看看