connecting line like tree in r

Question

I have following type data for human family:

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

I want plot something like the following, individuals points are connected to parents (Preferably different line color to Parent1 and Parent2 listed). Also pch size and pch fill is scaled to other variables pchsize and fillcol. Thus plot outline is:

Here is my progress in 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))

Issues unsolved: connecting lines, making size of pch big and fill color at the sametime.

Answer 1

Here is ggplot2 solution

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()

Answer 2

Here is a solution just using plot(), text(), and arrows(). The for loop is a bit cluttered, but will work for larger data sets and it should be easy to play with the plot and arrows:

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")