用時間刻度和標籤創建線條圖r

Question

我試圖創建如下的情節（很多時候我最終都是通過手工繪製這樣的情節，但這一次我想自己繪製）。

這是我的數據，我的試驗：

myd <- data.frame (period = c("Triassic", "Jurasic", 
"Cretaceous", "Cenzoic"), myears = c(245, 208, 145, 65), 
label = c(226, 176,105, 32)) 
myd2 <- data.frame (event = c("Diansaurs_strt", "Birds", 
    "Diansaurs_ext", "Human"), myears = c(235, 200, 60, 0.5)) 
myd2$x <- -0.25 
with (myd2, plot(x,myears,ylim=c(0,250), 
xlim = c(0, 10), axes=F,xlab="",ylab="",type="p",pch=17)) 
with (myd2,text(x,myears,event,pos=4,xpd=T)) 
axis(side=2,at = myd$label, labels = myd$period) 

我有問題，有情節和文字點的方位尤其匹配軸。任何其他想法或改進幫助表示讚賞。

Answer 1

對於「從地上爬起來」，以及對單個圖形元素最大的控制建設新地塊，該電網圖形化系統是很難被擊敗：

library(grid) 

## Set up plotting area with reasonable x-y limits 
## and a "native" scale related to the scale of the data. 
x <- -1:1 
y <- extendrange(c(myd$myears, myd2$myears)) 
dvp <- dataViewport(x, y, name = "figure") 

grid.newpage() 
pushViewport(dvp) 

## Plot the central timeline 
grid.lines(unit(0, "native"), unit(c(0,245), "native"), 
      gp = gpar(col="dodgerblue")) 

## Annotate LHS 
grid.segments(x0=0.5, x1=0.47, 
       y0=unit(c(0, myd$myears), "native"), 
       y1=unit(c(0, myd$myears), "native"), 
       gp=gpar(col="dodgerblue")) 
grid.text(label=c(0, myd$myears), x=0.44, y=unit(c(0, myd$myears), "native")) 
grid.text(label=myd$period, x=0.3, y=unit(myd$label, "native"), 
      just=0, gp=gpar(col="dodgerblue", fontface="italic")) 

## Annotate RHS 
## Create a function that plots a pointer to the specified coordinate 
pointer <- function(x, y, width=1) { 
    grid.polygon(x = x + unit(width*(c(0, .1, .1)), "npc"), 
       y = y + unit(width*(c(0, .03, -.03)), "npc"), 
       gp = gpar(fill="dodgerblue", col="blue", lwd=2)) 
} 
## Call it once for each milestone 
for(y in myd2$myears) { 
    pointer(unit(.5, "npc"), y=unit(y, "native"), width=0.3) 
} 
## Or, if you just want blue line segments instead of those gaudy pointers: 
## grid.segments(x0=0.5, x1=0.53, 
##   y0=unit(c(myd2$myears), "native"), 
##   y1=unit(c(myd2$myears), "native"), gp=gpar(col="dodgerblue")) 

grid.text(label=myd2$event, x=0.55, y=unit(myd2$myears, "native"), 
      just=0) 

Answer 2

你可以嘗試這樣的事情，讓你開始：

myd <- data.frame(period = c("", "Triassic", "Jurasic", 
          "Cretaceous", "Cenzoic", ""), 
        myears = c(260, 245, 208, 145, 65, -5), 
        label = c(260, 226, 176,105, 32, -5)) 
myd2 <- data.frame(event = c("Dinosaurs_strt", "Birds", 
          "Dinosaurs_ext", "Human"), 
        myears = c(235, 200, 60, 0.5)) 
myd2$x <- 1 
with(myd2, plot(x, myears, ylim = c(-5, 250), xlim = c(0, 10), 
       axes = FALSE, xlab = "", ylab = "", type = "n")) 
with(myd2, text(x, myears, event, pos = 4, xpd = TRUE)) 
axis(side = 2, at = myd$label, labels = myd$period, las = 2) 
X0 <- rep(myd2$x, 4) 
Y0 <- myd2$myears 
X1 <- rep(-.25, 4) 
Y1 <- Y0 
arrows(X0, Y0, X1, Y1) 

我已經添加在開始和你的數據的一個額外的空元素結束「MYD」，以幫助軸。然後，我使用arrows來代替使用pch來將右手標籤與軸匹配。

一些調整可能會使它看起來好多了。

Answer 3

這裏有一些增強功能（我建議現在只是爲了讓規模以及加0）：

myd <- data.frame (period = c("Triassic", "Jurasic", 


"Cretaceous", "Cenzoic", "now"), myears = c(245, 208, 145, 65, 0), 
    label = c(226, 176,105, 32, NA)) 
    myd2 <- data.frame (event = c("Diansaurs_strt", "Birds", "Diansaurs_ext", "Human"), 
    myears = c(235, 200, 60, 0.5)) 
    myd2$x <- -0.25 
    with (myd2, plot(x,myears,ylim=c(0,250), xlim = c(0, 10), 
    axes=F,xlab="",ylab="",type="p",pch=17, col = "green")) 
    with (myd2, plot(x,myears,ylim=c(0,250), 
    xlim = c(0, 10), axes=F,xlab="",ylab="",type="p",pch="-", col = "green")) 
    with (myd2,text(x,myears,event,pos=4,xpd=T), col = "green") 
    axis(side=2,at = myd$label, labels = myd$period, tick = FALSE, 
    las = 2, col = "green",) 
    axis(side=2,at = myd$myears, labels = myd$myears, las = 2, col = "green") 

有剩餘，你可能要改變箭頭的oriantation（幾個問題我相信你可以找到< - 符號，但我不知道如何）。

Answer 4

要繪製三角形，請查看TeachingDemos包中的my.symbols和ms.polygon函數。

在恐龍的上方正確的圖表上移動，如果你想要這個一般的（移動標籤否則會太接近或重疊），然後看看TeachingDemos包中的spread.labs函數。

其他一些可能的功能，可以隨着劇情幫助是text，mtext，grconvertX，grconvertY，segments和axis。