学会等で発表をするのにシェーマを描く必要があった。
パワーポイントで作ってしまえば作るだけなら簡単に素早く作成できるが、ベクター画像にしてsvg もしくはeps とかにしてtex でコンパイルしようと思ったらRもしくはターミナル上で作業が完結するほうが最終的には仕上がりがいいので、igraph を使って分子生物学的な標的パスウェイ（これは凝固系だが）を無理やり作成した。
小ネタ的テクニックとしては、
パスウェイの矢印上に作用する、というのを表現するのにノード先がない矢印をノードの大きさ0 とする
tkplotでノードの配置を手作業でいい感じにしたあとtkplot.getcoordsで座標を取得して整形する
いままでigraph は正方形のグラフ描出領域しか出せずmar設定をうまくしても余白領域がただ余るだけの図しか出せず最終的にinkscape で手作業で余白をカットしていたが、xlimもしくはylimをいい感じに設定すれば余白がなくせた
というところである。
元ネタはFactor XI (eleven) deficiency
library(igraph) library(stringr) v <- list(txt=c('Contact factors, XIa, XIIa', 'Xa, Va, phospholipids', 'Tissue factor', 'blank_1', 'Prothrombin (II)', 'Thrombin (IIa)', 'blank_2', 'Fibrinogen (I)', 'Initial fibrin clot', 'Cross-linked fibrin clot', 'VIIIa', 'IXa', 'VIIa', 'XIIIa')) v$name <- str_replace_all(v$txt, "blank.*", "") v$size <- c(50, 50, 50, 0, 100, 90, 0, 50, 50, 50, 0, 0, 0, 0) v$pathway <- c("内因系", "外因系", "共通系") v$pathway <- sapply(strsplit(v$pathway, ""), paste0, collapse="\n") v$cols <- c("red", "blue", "darkgreen", "black") v$factor <- mapply(function(z) v$txt[z], list(c(1, 11, 12), c(3, 13), c(2, 5, 8), c(4, 6, 7, 9, 10, 14))) v$labelcol <- mapply(function(w) v$cols[which(rapply(v$factor, function(z) w %in% z))], v$txt) v$polygoncol <- c(rgb(255, 0, 0, 50, maxColorValue=255), rgb(0, 0, 255, 240, maxColorValue=255), rgb(0, 255, 0, 240, maxColorValue=255)) g <- graph_from_edgelist( rbind( v$txt[c(1, 2)], v$txt[c(3, 2)], v$txt[c(2, 4)], v$txt[c(5, 6)], v$txt[c(6, 7)], v$txt[c(8, 9)], v$txt[c(9, 10)]) ) g <- add_vertices(g, 4) vertex_attr(g)$name <- v$name bidx <- grep("blank", v$txt) V(g)$label <- vertex_attr(g)$name V(g)$size <- 20 V(g)$size[bidx] <- 0 V(g)$label[bidx] <- "" V(g)$shape <- "rectangle" V(g)$size <- v$size V(g)$color <- NA V(g)$label.cex <- 1.5 V(g)$label.font <- 2 V(g)$label.color <- "black" V(g)$label.color <- v$labelcol V(g)$label.family <- "Meiryo UI" # Helvetica Times-Roman E(g)$color <- "black" E(g)$color[which(apply(apply(as_edgelist(g), 1, duplicated), 2, any))] <- 0 E(g)$width <- 3 E(g)$curved <- 0 E(g)$curved[5] <- 0.8 # tkplot で座標をなんとなく目星をつけている x <- c(50, 225, 400) y <- 400 yd <- 80 y1 <- y+yd*0.5 y2 <- weighted.mean(c(y-yd, y1), c(1, 1)) lay <- norm_coords(rbind( c(weighted.mean(x[1:2], c(3, 1)), y1), c(x[2], y-yd), c(weighted.mean(x[2:3], c(1, 3)), y1), c(x[2], 240), c(x[1], y-yd*2), c(x[3], y-yd*2), c(weighted.mean(x[2:3], c(7, 1)), y-yd*3.5), c(x[2], y-yd*3), c(x[2], y-yd*4), c(x[2], y-yd*5), c(weighted.mean(x[1:2], c(3, 2)), y2), # VIIIa c(weighted.mean(x[1:2], c(1, 5)), y2), # IXa c(weighted.mean(x[2:3], c(2, 3)), y2), # VIIa c(weighted.mean(x[2:3], c(3, 1)), y-yd*4.5)) # XIIIa ) lwd <- 3 sd <- c(0.2, 0.12, 0.1, 0.08) s <- function(x) ifelse(x==1, 1, -1) # svg("pathway.svg", height=4.5) dev.new(height=4.5) par(mar=c(0, 0.2, 0.4, 0.2), xpd=TRUE) v$polygoncol <- c(rgb(255, 0, 0, 20, maxColorValue=255), rgb(0, 0, 255, 20, maxColorValue=255), rgb(0, 255, 0, 20, maxColorValue=255)) plot(g, layout=lay, vertex.frame.color=NA, ylim=c(-0.5, 0.5), add=FALSE) pa <- par()$usr for(i in 1:2){ # polygonx <- c(pa[i], lay[2,1]-0.01*s(i))[c(1,2,2,1)] polygony <- rep(c(lay[1,2]+sd[3], lay[2,2]+sd[2]), each=2) polygon(polygonx, polygony, col=v$polygoncol[i], border=NA) text(pa[i], mean(c(lay[1,2]+sd[3], lay[2,2]+sd[2]))-0.05, v$pathway[i], col=v$cols[i], font=2, pos=3+s(i), cex=1.5) text(pa[i]+sd[1]*s(i), lay[11,2], c("APTT", "PT")[i], font=2, col=v$cols[i], pos=3+s(i), cex=1.5) text(pa[i], mean(lay[c(2,7),2]), v$pathway[3], col=v$cols[3], font=2, pos=3+s(i), cex=1.5) } polygonx <- pa[c(1,2,2,1)] polygony <- rep(c(lay[2,2]+sd[4], lay[7,2]), each=2) polygon(polygonx, polygony, col=v$polygoncol[3], border=NA) # dev.off() # R 上でターミナルのコマンドを実行してtex をコンパイルする #system("inkscape pathway.svg --export-pdf=./poster/pathway.pdf") #system("cd ./poster; platex factor.tex; dvipdfmx factor.dvi; cd ..")
