R图: Uniform distance between ticks for non-uniform numbers

Question

我正在尝试在 R 中重建这个古温度图的基本温度趋势。(Original image 和 data。)

x 轴的刻度间隔从百万年的几十到百万到百万，再到万年的几十，等等，但刻度线是均匀分布的。原始图形在 Excel 中精心布置在五个单独的图形中以实现间距。我试图在 R 中获得相同的 x 轴布局。

我尝试了两种基本方法。第一种方法是使用 par(fig=c(x1,x2,y1,y2)) 并排放置五个单独的图形。问题是刻度线之间的间隔不均匀，标签重叠。

#1
par(fig=c(0,0.2,0,0.5), mar=c(3,4,0,0))
plot(paleo1$T ~ paleo1$Years, col='red3', xlim=c(540,60), bty='l',type='l', ylim=c(-6,15), ylab='Temperature Anomaly (°C)')
abline(0,0,col='gray')

#2
par(fig=c(0.185,0.4,0,0.5), mar=c(3,0,0,0), new=TRUE)
plot(paleo2$T ~ paleo2$Year, col='forestgreen', axes=F, type='l', xlim=c(60,5), ylab='', ylim=c(-6,15))
axis(1, xlim=c(60,5))
abline(0,0,col='gray')

#etc.

第二种方法(如果可能，也是我的首选方法)是在单个图表中绘制数据。这会导致刻度线之间的距离不均匀，因为它们遵循它们的“自然”顺序。 (编辑: 添加了示例数据以及指向完整数据集的链接。)。

years <- c(500,400,300,200,100,60,50,40,30,20,10,5,4,3,2,1)
temps <- c(13.66, 8.6, -2.16, 3.94, 8.44, 5.28, 12.98, 8.6, 5, 5.34, 3.66, 2.65, 0.78, 0.25, -1.51, -1.77)
test <- data.frame(years, temps)
names(test) <- c('Year','T')

# The full csv file can be used with this line instead of the above.
# test <- read.csv('https://www.dropbox.com/s/u0dfmlvzk0ztpkv/paleo_test.csv?dl=1')

plot(test$T ~ test$Year, type='l', xaxt='n', xlim=c(520,1), bty='l', ylim=c(-5,15), xlab="", ylab='Temperature Anomaly (°C)')
ticklabels = c(500,400,300,200,100,60,50,40,30,20,10,5,4,3,2,1)
axis(1, at=ticklabels)

将 log='x' 添加到 plot 最接近，但刻度之间的间隔仍然不均匀，实际比例当然不是对数比例。

我的示例只下降到 100 万年，因为我试图首先解决问题，但我的目标是匹配上面的原始数字。我对 ggplot 解决方案持开放态度，尽管我只是短暂地熟悉它。

Answer 1

我要表达不同的看法:不要。根据我的经验，在 ggplot2 中做的事情越难(并且在较小程度上，基础图形)，它就越不可能成为一个好主意。这里的问题是，像这样不断地改变比例更有可能让观众误入歧途。

相反，我建议使用对数刻度并手动设置截止值。

首先，这里有一些更长的数据，只是为了涵盖您问题的全部可能规模:

longerTest <-
  data.frame(
    Year = rep(1:9, times = 6) * rep(10^(3:8), each = 9)
    , T = rnorm(6*9))

然后，我选择了一些截止点以将标签放置在绘图中。这些可以根据您的需要进行调整，但至少是合理间隔刻度的起点:

forLabels <-
  rep(c(1,2,5), times = 6) * rep(10^(3:8), each = 3)

然后，我手动设置一些东西附加到标签上。因此，您不必在轴的一部分下方说“千年”，只需用“k”标记即可。每个数量级都有一个值。注意名称只是为了帮助保持直截了当:下面我只是使用索引来匹配。因此，如果您跳过前两个，则需要调整下面的索引。

toAppend <-
  c("1" = "0"
    , "2" = "00"
    , "3" = "k"
    , "4" = "0k"
    , "5" = "00k"
    , "6" = "M"
    , "7" = "0M"
    , "8" = "00M")

然后，我将我的 forLabels 更改为我想要使用的文本版本，方法是获取第一个数字，并与上面的正确后缀连接。

myLabels <-
  paste0(
    substr(as.character(forLabels), 1, 1)
    , toAppend[floor(log10(forLabels))]
  )

这给出:

 [1] "1k"   "2k"   "5k"   "10k"  "20k"  "50k"  "100k" "200k" "500k" "1M"   "2M"  
[12] "5M"   "10M"  "20M"  "50M"  "100M" "200M" "500M"

您可能会将这些用于基本图形，但让对数刻度来执行您想要的操作有时会很棘手。相反，既然你说你对 ggplot2 解决方案持开放态度，我从 this answer 中获取了这个修改后的对数刻度。获得从大到小的对数标度:

library("scales")
reverselog_trans <- function(base = exp(1)) {
  trans <- function(x) -log(x, base)
  inv <- function(x) base^(-x)
  trans_new(paste0("reverselog-", format(base)), trans, inv, 
            log_breaks(base = base), 
            domain = c(1e-100, Inf))
}

然后，只需传入数据，并使用所需的间隔设置比例:

ggplot(longerTest
       , aes(x = Year
             , y = T)) +
  geom_line() +
  scale_x_continuous(
    breaks = forLabels
    , labels = myLabels
    , trans=reverselog_trans(10)
  )

给予:

它具有一致的比例，但标记更加统一。

如果你想要颜色，你可以使用 cut 来实现:

ggplot(longerTest
       , aes(x = Year
             , y = T
             , col = cut(log10(Year)
                         , breaks = c(3,6,9)
                         , labels = c("Thousands", "Millions")
                         , include.lowest = TRUE)
             , group = 1
             )) +
  geom_line() +
  scale_x_continuous(
    breaks = forLabels
    , labels = myLabels
    , trans=reverselog_trans(10)
  ) +
  scale_color_brewer(palette = "Set1"
                     , name = "How long ago?")

这是一个使用 facet_wrap 来创建不同比例的版本。我在这里使用 6，但您可以设置任何您想要的阈值。

longerTest$Period <-
  cut(log10(longerTest$Year)
      , breaks = c(3, 4, 5, 6, 7, 8, 9)
      , labels = paste(rep(c("", "Ten", "Hundred"), times = 2)
                       , rep(c("Thousands", "Millions"), each = 3) )
      , include.lowest = TRUE)

longerTest$Period <-
  factor(longerTest$Period
        , levels =  rev(levels(longerTest$Period)))


newBreaks <-
  rep(c(2,4,6,8, 10), times = 6) * rep(10^(3:8), each = 5)

newLabels <-
  paste0(
    substr(as.character(newBreaks), 1, 1)
    , toAppend[floor(log10(newBreaks))]
  )

ggplot(longerTest
       , aes(x = Year
             , y = T
       )) +
  geom_line() +
  facet_wrap(~Period, scales = "free_x") +
  scale_x_reverse(
    breaks = newBreaks
    , labels = newLabels
  )

给出: