A tree-like connecting line in r

I have the following type data for a 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 XY 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 to do something like the following: the individual points are connected to the parents (it is desirable that the different line colors be listed in Parent1 and Parent2). Also the size of pch and pch fill is scaled for the other variables pchsize and fillcol. Thus, the chart diagram:

enter image description here

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

enter image description here

Unsolved problems: connecting lines, pch size, and fill color at one time.

+6
source share
4 answers

One thing that popped up on me was to consider this network - R has many packages to build them.

Here's a very simple solution: First, I used your parent list to create sociomatrix - you can usually enter networks using edge lists - here I put 1 for the first parent relationship and 2 for the second.

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

Then, using the network packet, I simply clicked:

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

This is not very beautiful in itself, but I think it gives you all the basic elements that you wanted.

For flowers, I think decimals are simply rounded - I was not sure what to do with them.

I know that I have seen people build networks in ggplot, so this can give you a better result.

example picture

Edit: So here is a really confusing way to directly turn your data into a network object - someone else can fix it. In addition, I add an edge attribute (named "P" for parental status) and assign the first set to 1 and the second set to 2. This can be used when plotting to set the colors.

 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') 
+2
source

Here is the 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 = Xx, xend = Xy, y = Yx, yend = Yy)) + 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() 

enter image description here

+3
source

Here is a solution using only plot() , text() and arrows() . The for loop is a bit cluttered, but will work for large datasets, and it should be easy to play with graphs 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") 

enter image description here

+3
source

Alternative solution uses 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]) 

enter image description here

Just play with the color!

+1
source

Source: https://habr.com/ru/post/920621/


All Articles