如何将插图放置在 ggplot 的确切位置并设置 geom_segment 的颜色?
How do I place insets at exact positions on a ggplot and set the colors of geom_segment?
我正在创建一个说明黄土如何工作的插图。我的两个查询在这个问题的末尾。首先,设置:
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:如何放置四个inset,使权重函数的y = 0在对应geom_segment
的高度?我想要主图坐标中的 inset heights = 2。
问题2:如何将每段的颜色设置为对应inset的颜色?
不确定我是否做对了一切。但我尽力了。 (; 你可以大大简化你的代码
- ...通过将您的模型数据绑定到一个数据帧以及段的数据中。
- ... 通过一些命名向量和
scale_xxx_manual
映射美学并设置颜色和形状
对于您的插图,无需制作单独的图并尝试将它们放入主图中。您可以通过额外的 geom_line
和 geom_ribbon
简单地添加它们。要获取段的高度,请将段数据连接到模型数据,以便您可以根据段
的 y
值设置 geom_ribbon
的起始值
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)
我正在创建一个说明黄土如何工作的插图。我的两个查询在这个问题的末尾。首先,设置:
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:如何放置四个inset,使权重函数的y = 0在对应geom_segment
的高度?我想要主图坐标中的 inset heights = 2。
问题2:如何将每段的颜色设置为对应inset的颜色?
不确定我是否做对了一切。但我尽力了。 (; 你可以大大简化你的代码
- ...通过将您的模型数据绑定到一个数据帧以及段的数据中。
- ... 通过一些命名向量和
scale_xxx_manual
映射美学并设置颜色和形状
对于您的插图,无需制作单独的图并尝试将它们放入主图中。您可以通过额外的 geom_line
和 geom_ribbon
简单地添加它们。要获取段的高度,请将段数据连接到模型数据,以便您可以根据段
y
值设置 geom_ribbon
的起始值
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)