Question

我正在尝试在R中重建这个Paleotemperature数字的基本温度趋势。{Original image和data。

x轴的刻度间隔从数百万年的100s变为数百万的数百万到数百万，然后变为100s，依此类推，但刻度线均匀分布。原始图形在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
  )

给出：

Answer 2

这是一个开始：

#define the panels
breaks <- c(-Inf, 8, 80, Inf)
test$panel <- cut(test$Year, breaks, labels = FALSE)
test$panel <- ordered(test$panel, levels = unique(test$panel))

#for correct scales
dummydat <- data.frame(Year = c(0, 8, 8, 80, 80, max(test$Year)),
                       T = mean(test$T),
                       panel = ordered(rep(1:3, each = 2), levels = levels(test$panel)))

library(ggplot2)
ggplot(test, aes(x = Year, y = T, color = panel)) +
  geom_line() +
  geom_blank(data = dummydat) + #for correct scales
  facet_wrap(~ panel, nrow = 1, scales = "free_x") +
  theme_minimal() + #choose a theme you like
  theme(legend.position = "none", #and customize it
        panel.spacing.x = unit(0, "cm"),
        strip.text = element_blank() , 
        strip.background = element_blank()) +
  scale_x_reverse(expand = c(0, 0))

Answer 3

这是使用gridExtra使用单独的图表执行此操作的基本示例。这可能与额外的grobs结合起来很有用，例如在顶部创建纪元框（此处未完成）。如果需要，这可能最好与Roland的解决方案相结合。

# ggplot with gridExtra
library('ggplot2')
library('gridExtra')
library('grid')

d1 <- test[1:5, ]
d2 <- test[6:11, ]
d3 <- test[12:16, ]

plot1 <- ggplot(d1, aes(y = T, x = seq(1:nrow(d1)))) +
  geom_line() +
  ylim(c(-5, 15)) +
  theme_minimal() +
  theme(axis.title.x = element_blank(),
        plot.margin = unit(c(1,0,1,1), "cm")) +
  scale_x_continuous(breaks=)

plot2 <- ggplot(d2, aes(y = T, x = seq(1:nrow(d2)))) +
  geom_line() +
  ylim(c(-5, 15)) +
  theme_minimal() +
  theme(axis.text.y = element_blank(),
        axis.title.y = element_blank(),
        axis.ticks.y = element_blank(),
        axis.title.x = element_blank(),
        plot.margin = unit(c(1,0,1,0), "cm"))

plot3 <- ggplot(d3, aes(y = T, x = seq(1:nrow(d3)))) +
  geom_line() +
  theme_minimal() +
  theme(axis.text.y = element_blank(),
        axis.title.y = element_blank(),
        axis.ticks.y = element_blank(), 
        axis.title.x = element_blank(),
        plot.margin = unit(c(1,0,1,0), "cm")) +
  ylim(c(-5, 15))

# put together
grid.arrange(plot1, plot2, plot3, nrow = 1,
             widths = c(1.5,1,1)) # allow extra width for first plot which has y axis

R plot：非均匀数字的刻度之间的均匀距离

3 个答案: