层次聚类分析案例(二)

之前的笔记:
聚类介绍:点这里
层次聚类分析案例(一)

案例二:亚马逊雨林烧毁情况

1999~2010年,33000平方英里(85500平方公里),即2.8%的亚马逊雨林被烧毁。这一结果是被NASA领导的研究项目发现的。该研究的主要目的是衡量森林树冠下暗火的蔓延程度。该研究发现火灾烧毁的森林比用于农耕而砍伐的森林面积大很多。然而,森林烧毁情况和火灾之间没有建立起联系。

如何建立火灾和森林烧毁情况之间的联系,需要基于NASA的Aqua卫星上的大气红外探测仪(AIRS)设备的湿度数据。火灾频率与夜间的低湿度相吻合,低湿度使得地表的低强度火灾能够持续燃烧。

准备工作

为了进行层次聚类,我们应该使用采集于亚马逊雨林(1999~2010年)的数据集。

第1步:收集和描述数据

该任务使用名为NASAUnderstory的数据集。该数据以标准格式存储在名为NASAUnderstory.csv的CSV格式的文件中。其中包含64行数据和32个变量。数据在这里

非数值型数据如下:Overstory Species ;Labels 。其余为数值型变量。
具体实施步骤
以下为实现细节。

第2步:探索数据

让我们探索数据并理解变量间的关系。我们从导入名为NASAUnderstory.csv的文件开始,将该数据存储到NASA数据框中:

NASA = read.csv("Data/NASAUnderstory.csv",header = T)

下一步,我们应该获取每一个物种列标签的长版本:

NASA.lab = NASA$Labels

之后,输出NASA.lab数据框。这包含了每一个物种的完整名字。

结果如下:


接下来把整个数据内容传递给NASA数据框:

NASA = NASA[,-32]

输出NASA数据框可以把整体的数据内容显示出来。

NASA

结果如下:


第3步:转换数据

接下来进行数据归一化。scale()函数将中心化并拉伸所有先前提到的数值型变量列:

NASAscale <- scale(NASA[,3:31])

这会拉伸缩NASA数据框中第3~31列的所有数值型变量。

输出NASAscale数据框可以显示所有的拉伸和中心化后的数值。

NASAscale

结果如下:


为了将一个向量编码为一个因子,需要使用factor函数。如果自变量排序是TRUE,因子等级将被排序。这里,我们将OverstorySpecies列作为一个值传给factor函数:

rownames(NASAscale) = as.factor(NASA$Overstory.Species)

as.factor()返回列名的数据框。

输出数据框rownames(NASAscale)将显示OverstorySpecies列的所有值:

rownames(NASAscale)

结果如下:


第4步:训练和评估模型

下一步是训练模型。首先计算距离矩阵。dist()函数用来计算并返回距离矩阵,使用特定的距离度量来计算数据矩阵中各行间的距离。这里使用的距离度量可以是欧式距离、最大距离、曼哈顿距离、堪培拉距离、二进制距离,或闵可夫斯基距离。这里的距离度量使用欧式距离。欧式距离计算两个向量间的距离为sqrt(sum((x_i-y_i)^2))。结果存储在一个新的数据框dist1中。

dist1 <- dist(NASAscale, method = "euclidean")

下一步是使用Ward方法进行聚类。hclust()函数对一组不同的n个对象进行聚类分析。第一阶段,每个对象被指派给它自己的簇。之后每个阶段,算法迭代聚合两个最相似的簇。这个过程不断持续直到只剩一个簇。hclust()函数要求我们以距离矩阵的形式提供数据。dist1数据框被传入。默认使用全链接进行聚类。此外还可以使用不同的聚集方法,包括ward.D、ward.D2、single、complete和average。

clust1 <- hclust(dist1,method = "ward.D")

clust1

调用clust1,结果显示了聚集方法、计算距离的方法,以及对象的数量。结果如下:


第5步:绘制模型

plot()函数是绘制R对象的通用函数。这里,plot()函数用来绘制系统树图:

plot(clust1,labels=NASA[,2], cex=0.5,

     xlab="",ylab="Distance",main="Clustering for NASA Understory Data")

结果如下:


rect.hclust()函数会围绕系统树图的某些枝干绘制矩形以强调对应的簇。系统树图首先在某个等级上被剪切,之后在选定的枝干上绘制长方形。

clust1作为一个对象传入函数,同时传入的还有需要形成的簇的数量。

rect.hclust(clust1,k=2)

结果如下:


cuts()函数基于期望的簇数量或者切割高度切割这棵树中的节点到不同的组。这里,clust1被当作一个对象传入该函数,同时传入期望的簇数量。

cuts = cutree(clust1,k=2)

cuts

结果如下:


第6步:改进模型

首先需要载入以下包:

library(vegan)

vegan包最初被社会学和植被生态学家广泛使用。它包括排序方法、多样性分析以及其他功能。其中一些流行的工具包括多样性分析、物种丰富度模型、物种丰富度分析、差异分析等。

下一步是通过使用jaccard距离方法训练模型来改进模型。第一步是使用vegdist()函数计算距离矩阵。该函数计算成对元素的距离,并把结果存储在一个新的数据框dist1中。jaccard系数衡量有限样本集的相似性,该系数通过两集合的交集大小除以两集合的并集大小计算得来。

dist1 <- vegdist(NASA[,3:31],method="jaccard", upper=T)

下一步是使用Ward方法进行聚类。使用hclust()函数:

clust1 <- hclust(dist1,method = "ward.D")

clust1

调用clust1显示了使用的聚集方法、距离度量方法和对象的个数。结果如下:


plot()函数是绘制R语言对象的通用函数:

plot(clust1,labels=NASA[,2],cex=0.5,

     xlab=" ",ylab="Distance",main="Clustering for NASA Understory Data")

clust1数据框作为对象传入该函数。cex给出了缩放数值,通过该值可以把文字和符号相对放大到默认值。
结果如下:


clust1对象被作为一个对象传入函数,同时传入的还有聚类的数量:

rect.hclust(clust1,k=2)

结果如下:


cuts()函数能够基于期望的组数量或者切割的高度将树切割到不同的组:

cuts = cutree(clust1,k=2)

cuts

结果如下:


使用判别函数绘制两个类的解。

clusplot()函数能够绘制二维的聚类图。这里,把NASA数据框作为对象传入。

clusplot(pam(NASAscale,2))

结果如下:


使用判别函数绘制两个类的解。

为了区分给定的类别,plotcluster()函数使用映射函数进行绘图。不同的映射方法包括经典判别坐标、展现平均值和协方差结构区别的方法、非对称方法(从混合类中分离出同质类)、本地基于近邻的方法和基于鲁棒协方差矩阵的方法。

clusplot()函数可以画出二维的聚类图。这里把NASA的数据框作为对象传入:

clusplot(NASA,cuts,color = TRUE,shade = TRUE, labels = 2,lines = 0,

         main = "NASA Two Cluster Plot, Ward's Method, First two PC")

结果如下:


接下来,对NASAscale数据框用t()函数进行转换:

library(fpc)

NASAtrans=t(NASAscale)

下一步是使用闵可夫斯基距离方法改进模型。第一步是计算距离矩阵。这里使用dist()函数。

闵可夫斯基距离经常在变量为比例尺度以及绝对零值的情况下使用。

dist1 <- dist(NASAtrans, method="minkowski",p=3)

下一步是使用Ward方法进行聚类。使用hclust()方法。

clust1 <- hclust(dist1,method="ward.D")

clust1

调用clust1函数显示了使用的聚集方法、距离度量方法和对象的个数,结果如下:


plot()函数是绘制R对象的通用函数。这里,plot()函数被用来绘制系统树图:

plot(clust1, labels=NASA.lab[1:29], cex=1,
     xlab="",ylab="Distance",main="Clustering for NASA Understory Data")

结果如下:


rect.hclust()函数会围绕系统树图的某些枝干绘制矩形以强调对应的簇。系统树图首先在某个等级上被剪切,之后在选定的枝干上绘制长方形。

clust1对象被当作一个对象传入该函数,同时被传入的还有聚类的个数:

rect.hclust(clust1,k=3)

结果如下:


cuts()函数能够基于期望的簇数量或者切割的高度将树切分到三个不同的组。这里传入clust1对象和聚类的个数。

cuts = cutree(clust1,k=3)

cuts

结果如下:


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

推荐阅读更多精彩内容