6

私は人間の家族のために次のタイプのデータを持っています:

indvidual <- c("John",  "Kris", "Peter",  "King",  "Marry",  "Renu", "Kim",    "Ken", "Lu")
Parent1 <- c(    NA,     NA,     "John",  "John",   "John",    NA,    "Peter",  NA,    NA)
Parent2 <- c(    NA,     NA,    "Kris",   "Kris",  "Renu",   NA,      "Lu",     NA,   NA)
X <-       c(    2,     3,       2,       3,           4,     5,        1.5,      1,    1)
Y <-       c(    3,     3,       2,       2,           2,     3,        1,      3,    2)
pchsize <- c( 4.5,      4.3,     9.2,     6.2,         3.2,   6.4,      2.1,    1.9,  8)
fillcol <- c( 8.5,      8.3,     1.2,     3.2,         8.2,   2.4,      2.6,    6.1,  3.2)
myd <- data.frame (indvidual, Parent1, Parent2, X, Y, pchsize,fillcol)

 indvidual Parent1 Parent2   X Y pchsize fillcol
1      John    <NA>    <NA> 2.0 3     4.5     8.5
2      Kris    <NA>    <NA> 3.0 3     4.3     8.3
3     Peter    John    Kris 2.0 2     9.2     1.2
4      King    John    Kris 3.0 2     6.2     3.2
5     Marry    John    Renu 4.0 2     3.2     8.2
6      Renu    <NA>    <NA> 5.0 3     6.4     2.4
7       Kim   Peter      Lu 1.5 1     2.1     2.6
8       Ken    <NA>    <NA> 1.0 3     1.9     6.1
9        Lu    <NA>    <NA> 1.0 2     8.0     3.2

次のようなプロットが必要です。個々のポイントは親に接続されています(リストされているParent1およびParent2とは異なる線の色が望ましいです)。また、pch size と pch fill は、他の変数 pchsize と fillcol にスケーリングされます。したがって、プロットのアウトラインは次のとおりです。

ここに画像の説明を入力

ggplot2 での進行状況は次のとおりです。

require(ggplot2) 
ggplot(data=myd, aes(X, Y,fill = fillcol)) +
  geom_point(aes(size = pchsize, fill = fillcol), pch = "O") +
  geom_text(aes (label = indvidual, vjust=1.25))

ここに画像の説明を入力

未解決の問題: 線の接続、pch のサイズの拡大と塗りつぶしの色の同時作成。

4

4 に答える 4

3

これがggplot2ソリューションです

library(ggplot2)
individual <- c("John",  "Kris", "Peter",  "King",  "Marry",  "Renu", "Kim",    "Ken", "Lu")
Parent1 <- c(    NA,     NA,     "John",  "John",   "John",    NA,    "Peter",  NA,    NA)
Parent2 <- c(    NA,     NA,    "Kris",   "Kris",  "Renu",   NA,      "Lu",     NA,   NA)
X <-       c(    2,     3,       2,       3,           4,     5,        1.5,      1,    1)
Y <-       c(    3,     3,       2,       2,           2,     3,        1,      3,    2)
pchsize <- c( 4.5,      4.3,     9.2,     6.2,         3.2,   6.4,      2.1,    1.9,  8)
fillcol <- c( 8.5,      8.3,     1.2,     3.2,         8.2,   2.4,      2.6,    6.1,  3.2)
myd <- data.frame (individual, Parent1, Parent2, X, Y, pchsize,fillcol)

SegmentParent1 <- merge(
  myd[, c("individual", "X", "Y")], 
  myd[!is.na(myd$Parent1), c("Parent1", "X", "Y")], 
  by.x = "individual", by.y = "Parent1")
SegmentParent2 <- merge(
  myd[, c("individual", "X", "Y")], 
  myd[!is.na(myd$Parent1), c("Parent2", "X", "Y")], 
  by.x = "individual", by.y = "Parent2")
Segments <- rbind(SegmentParent1, SegmentParent2)

ggplot(data=myd, aes(X, Y)) + 
  geom_segment(data = Segments, aes(x = X.x, xend = X.y, y = Y.x, yend = Y.y)) + 
  geom_point(aes(size = pchsize, colour = fillcol)) + 
  geom_text(aes (label = indvidual), vjust = 0.5, colour = "red", fontface = 2) + 
  scale_x_continuous("", expand = c(0, 0.6), breaks = NULL) + 
  scale_y_continuous("", expand = c(0, 0.4), breaks = NULL) + 
  scale_size(range = c(20, 40)) + 
  theme_bw()

ここに画像の説明を入力

于 2012-07-20T13:04:35.657 に答える
3

plot()text()、およびを使用したソリューションを次に示しarrows()ます。ループは少し雑然としていforますが、より大きなデータ セットでも機能し、プロットと矢印で簡単に操作できるはずです。

plot(myd$X,myd$Y, col='white', type="p", main="", ylab="", xlab="",
    axes = FALSE, ylim = c(min(myd$Y)*.8, max(myd$Y)*1.2),
    xlim = c(min(myd$X)*.8, max(myd$X)*1.2))

child = data.frame()
child = myd[!is.na(myd$Parent1),]
DArrows = matrix(0,nrow(child),4);
MArrows = matrix(0,nrow(child),4);

for (n in 1:nrow(child)){
    d<-child[n,];
    c1<-myd$indvidual==as.character(d$Parent1);
    b1<-myd[t(c1)];
    c2<-myd$indvidual==as.character(d$Parent2);
    b2<-myd[t(c2)];
    DArrows[n, 1]=as.double(d$X)
    DArrows[n, 2]=as.double(d$Y)
    DArrows[n, 3]=as.double(b1[4])
    DArrows[n, 4]=as.double(b1[5])    
    MArrows[n, 1]=as.double(d$X)
    MArrows[n, 2]=as.double(d$Y)
    MArrows[n, 3]=as.double(b2[4])
    MArrows[n, 4]=as.double(b2[5])
}

arrows(DArrows[,3],DArrows[,4],DArrows[,1],DArrows[,2],lwd= 2, col = "blue",length=".1")
arrows(MArrows[,3],MArrows[,4],MArrows[,1],MArrows[,2],lwd=2, col = "red",length=".1")

par(new=TRUE)

plot(myd$X,myd$Y,type = "p", main = "", ylab = "", xlab = "",cex = myd$pchsize,
axes = FALSE, pch = 21, ylim = c(min(myd$Y)*.8, max(myd$Y)*1.2),
xlim=c(min(myd$X)*.8, max(myd$X)*1.2), bg = myd$fillcol,fg = 'black')

text(1.12*myd$X, .85*myd$Y, myd$indvidual)

arrows((DArrows[,3]+DArrows[,1])/2, (DArrows[,4]+DArrows[,2])/2,
    DArrows[,1], DArrows[,2], lwd = 2, col = "blue", length = ".1")
arrows((MArrows[,3]+MArrows[,1])/2, (MArrows[,4]+MArrows[,2])/2,
    MArrows[,1], MArrows[,2], lwd = 2, col = "red", length = ".1")

ここに画像の説明を入力

于 2012-07-20T16:32:41.500 に答える
2

私に飛びついたのは、これを扱うことでした。Rには、これらをプロットするための多くのパッケージがあります。

非常に簡単な解決策は次のとおりです。まず、親リストを使用して社会マトリックスを作成しました。通常、エッジリストを使用してネットワークを入力することもできます。ここでは、最初の親関係に1、2番目に2を設定します。

psmat <- rbind(c(0, 0, 1, 1, 1, 0, 0, 0, 0),
          c(0, 0, 2, 2, 0, 0, 0, 0, 0),
          c(0, 0, 0, 0, 0, 0, 1, 0, 0),
          rep(0, 9),
          rep(0, 9),
          c(0, 0, 0, 0, 2, 0, 0, 0, 0),
          rep(0, 9),
          rep(0, 9),
          c(0, 0, 0, 0, 0, 0, 2, 0, 0))

次に、ネットワークパッケージを使用して、次のようにします。

require(network)
plot(network(psmat), coord = cbind(X, Y), vertex.cex = pchsize, 
  vertex.col = fillcol, label = indvidual, edge.col = psmat)

これ自体はそれほどきれいではありませんが、必要なすべての基本的な要素が得られると思います。

色については、小数点以下が四捨五入されていると思いますが、どうしたらいいのかわかりませんでした。

私は人々がggplotでネットワークをプロットするのを見たことがあるので、それはあなたにより良い結果を与えるかもしれないことを知っています。

写真の例

編集:これが、データを直接ネットワークオブジェクトに変換する非常に厄介な方法です。他の誰かがそれを修正できる可能性があります。さらに、エッジ属性(親のステータスを表す「P」という名前)を追加し、最初のセットに値1を、2番目のセットに値2を指定します。これは、プロット時に色を設定するときに使用できます。

P1 <- match(Parent1, indvidual)
e1 <- cbind(P1, 1:9); e1 <- na.omit(e1); attr(e1, 'na.action') <- NULL
P2 <- match(Parent2, indvidual)
e2 <- cbind(P2, 1:9); e2 <- na.omit(e2); attr(e2, 'na.action') <- NULL

en1 <- network.initialize(9)
add.edges(en1, e1[,1], e1[,2])
set.edge.attribute(en1, 'P', 1)
add.edges(en1, e2[,1], e2[,2], names.eval = 'P', vals.eval = 2)

plot(en1, coord = cbind(X, Y), vertex.cex = pchsize, 
  vertex.col = fillcol, label = indvidual, edge.col = 'P')
于 2012-07-18T21:19:13.247 に答える
1

代替ソリューションの使用 igraph

library(igraph)
mm<-data.frame(dest=c(as.character(myd$Parent1),as.character(myd$Parent2)))
mm$orig<-myd$individual
g<-graph.edgelist(as.matrix(mm[!is.na(mm$dest),]))
rownames(myd)<-as.character(myd[,1])
l<-as.matrix(myd[V(g)$name,4:5])
plot(g,layout=l,vertex.color=myd[V(g)$name,6],vertex.size=myd[V(g)$name,6])

ここに画像の説明を入力

色とサイズで少し遊んでください!

于 2012-07-19T11:48:58.210 に答える