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 用于第二个。

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。这可以在绘图时用于设置颜色。

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 回答