R_Divisive_Clustering_diana関数とnj関数 のバックアップ差分(No.2) - アールメカブ

アールメカブ


R_Divisive_Clustering_diana関数とnj関数 のバックアップ差分(No.2)


  • 追加された行はこの色です。
  • 削除された行はこの色です。
パプアニューギニアとオセアニアの諸言語の系統発生を,それらの分布的特徴を使って分類するという課題である.

Baayen pp.154--
Baayen [[Analyzing Linguistic Data:http://www.amazon.co.jp/Analyzing-Linguistic-Data-Introduction-Statistics/dp/0521882591/]] のpp.154--

 phylogeny.dist <- dist(phylogeny[, 3:ncol(phylogeny)], 
          method = "binary")

# 一方の言語のラベルを大文字に変更し,他方は小文字のままにして対照する
 plotname <- as.character(phylogeny$Language)
 plotname[phylogeny$Family == "Papuan"] <-  
     toupper(plotname[phylogeny$Family == "Papuan"])

# plot する.ここで引数 which.plot = 2 の意味は,print.diana がデフォルトで出力するふたつのグラフの二つめのみを表示するよう指定している.

- &size(18){&color(red){Divisive Clustering};};

 plot(diana(phylogeny.dist), labels = plotname, 
 cex = 0.8,  main = " ", xlab = " ",  which.plot = 2)

なお Baayen では  col = c("black","white") と言う引数が与えられているが,これは print.diana メソッドに固有の定義はないようである.


- &size(18){&color(red){neighbor-joining による unrooted tree  を作成する};};
 library(ape)
 
 phylogeny.dist.tr <- nj(phylogeny.dist)
 
# nj  オブジェクトのラベルはデフォルトでは数値なので変更する 
 families <- 
     as.character(phylogeny$Family[as.numeric
         (phylogeny.dist.tr$tip.label)])
 
 languages <- 
     as.character(phylogeny$Language[as.numeric
         (phylogeny.dist.tr$tip.label)])
 
 phylogeny.dist.tr$tip.label <- languages
 
 plot(phylogeny.dist.tr, type = "u", 
       font = as.numeric(as.factor(families)))

引数 type = "u"  は unrooted tree を指定.また各ノードは少なくとも三つの枝を持つ.
パプア諸語とオセアン諸語がきれいに分類されているのが分かる.

#ref(baayen156-2.png,left,nowrap,around,Divisive_Clustering))

二つまとめて png 画像にする.十分なマージンが必要なので 
par(mfrow = c(1,2), oma = c(1,1,1,1), mar = c(1,1,1,1), bg = "white"); dev.print(device = png, file = "baayen156.png",width = 480, height = 480)
と実行する.