1

我正在创建一个关于黄土如何工作的插图。我的两个问题在这个问题的末尾。首先，设置：

library(tidyverse)
data(melanoma, package = "lattice")
mela <- as_tibble(melanoma)
tric = function(x) if_else(abs(x) < 1, (1 - abs(x)^3)^3, 0)
scl = function(x) (x - min(x))/(max(x) - min(x))
mela1 <- mela %>%
  slice(1:9) %>%
  mutate(dist = abs(year - year[5]),
         scaled = scl(dist),
         weight = tric(scaled)
  )
mod1 <- lm(incidence ~ year, data = mela1, weights = weight) %>%
  augment(., mela1)
mela2 <- mela %>%
  slice(10:18) %>%
  mutate(dist = abs(year - year[5]),
         scaled = scl(dist),
         weight = tric(scaled)
  )
mod2 <- lm(incidence ~ year, data = mela2, weights = weight) %>%
  augment(., mela2)
mela3 <- mela %>%
  slice(19:27) %>%
  mutate(dist = abs(year - year[5]),
         scaled = scl(dist),
         weight = tric(scaled)
  )
mod3 <- lm(incidence ~ year, data = mela3, weights = weight) %>%
  augment(., mela3)
mela4 <- mela %>%
  slice(28:37) %>%
  mutate(dist = abs(year - year[5]),
         scaled = scl(dist),
         weight = tric(scaled)
  )
mod4 <- lm(incidence ~ year, data = mela4, weights = weight) %>%
  augment(., mela4)

主线剧情：

col <- rainbow_hcl(start = 12, 4, l = 20)
colB <- rainbow_hcl(start = 12, 4, l = 100)
main <- ggplot(data = mela, aes(x = year, y = incidence)) +
# segment 1
  geom_segment(
    aes(x = 1936, xend = 1944, y = 2.115717, yend = 2.115717)) +
# segment 2
  geom_segment(
    aes(x = 1945, xend = 1953, y = 3.473217, yend = 3.473217)) +
# segment 3
  geom_segment(
    aes(x = 1954, xend = 1962, y = 1.170247, yend = 1.170247)) +
# segment 4
  geom_segment(
    aes(x = 1963, xend = 1972, y = 2.7, yend = 2.7)) +
  geom_point(data = mod1, color = col[1], shape = 1) +
  geom_point(data = mod2, color = col[2], shape = 0) +
  geom_point(data = mod3, color = col[4], shape = 5) +
  geom_point(data = mod4, color = col[3], shape = 2) +
  geom_line(data = mod1, aes(x = year, y = .fitted), color = col[1]) +
  geom_line(data = mod2, aes(x = year, y = .fitted), color = col[2]) +
  geom_line(data = mod3, aes(x = year, y = .fitted), color = col[4]) +
  geom_line(data = mod4, aes(x = year, y = .fitted), color = col[3]) +
  scale_x_continuous(breaks = c(1940, 1949, 1958, 1967))

插图

inset1 <- ggplot(data = mod1, aes(x = year, y = weight)) +
  geom_line(color = col[1]) +
  geom_area(fill = colB[1]) +
  theme_void()
inset2 <- ggplot(data = mod2, aes(x = year, y = weight)) +
  geom_line(color = col[12) +
  geom_area(fill = colB[2]) +
  theme_void()
inset3 <- ggplot(data = mod3, aes(x = year, y = weight)) +
  geom_line(color = col[3]) +
  geom_area(fill = colB[3]) +
  theme_void()
inset4 <- ggplot(data = mod4, aes(x = year, y = weight)) +
  geom_line(color = col[4]) +
  geom_area(fill = colB[4]) +
  theme_void()

问题 1：如何放置四个插图，使权重函数的 y = 0 位于对应的高度geom_segment？我想在主图坐标中插入高度 = 2。

问题2：如何将每个segment的颜色设置为对应inset的颜色？

4

1 回答 1

1

不确定我是否做对了一切。但我尽力了。(; 你可以大大简化你的代码

  1. ...通过将您的模型数据绑定到一个数据框以及段的数据中。
  2. ...通过一些命名向量映射美学并设置颜色和形状scale_xxx_manual

对于您的插图，无需制作单独的图并尝试将它们放入主图。您可以简单地通过附加geom_line和geom_ribbon. 要获取线段的高度，请将线段数据连接到模型数据，以便您可以geom_ribbon根据y线段的值设置起始值

library(tidyverse)
library(broom)
library(colorspace)

col <- setNames(col, c("mod1", "mod2", "mod4", "mod3"))
colB <- setNames(colB, c("mod1", "mod2", "mod4", "mod3"))
shapes <- setNames(c(1, 0, 5, 2), c("mod1", "mod2", "mod3", "mod4"))

mods <- list(mod1 = mod1, mod2 = mod2, mod3 = mod3, mod4 = mod4) %>% 
  bind_rows(.id = "mod")

# segments data
dseg <- tribble(
  ~mod, ~x, ~xend, ~y,
  "mod1", 1936, 1944, 2.115717,
  "mod2", 1945, 1953, 3.473217,
  "mod3", 1954, 1962, 1.170247,
  "mod4", 1963, 1972, 2.7,
)

main <- ggplot(data = mela, aes(x = year, y = incidence)) +
  geom_segment(data = dseg, aes(x = x, xend = xend, y = y, yend = y, color = mod)) +
  geom_point(data = mods, aes(color = mod, shape = mod)) +
  geom_line(data = mods, aes(x = year, y = .fitted, color = mod)) +
  scale_color_manual(values = col) +
  scale_shape_manual(values = shapes) +
  scale_x_continuous(breaks = c(1940, 1949, 1958, 1967)) +
  guides(color = FALSE, shape = FALSE, fill = FALSE)

mods1 <- left_join(mods, select(dseg, mod, y), by = "mod")

# Add insets
main +
  geom_line(data = mods1, aes(x = year, y = weight + y, color = mod, group = mod)) +
  geom_ribbon(data = mods1, aes(x = year, ymin = y, ymax = weight + y, fill = mod, group = mod)) +
  scale_fill_manual(values = colB)

于 2021-04-11T16:55:05.210 回答