table 的 R 映射斜率和截距，在刻面包裹后使用线性模型

Question

使用 mtcars 数据集，我使用 pivot_longer 得到一个带有数字变量的长数据帧。

mtcars_numeric <- mtcars %>%
  dplyr::select(car, origin, mpg, disp, hp, drat, wt, qsec) 

mtcars_long_numeric <- pivot_longer(mtcars_numeric, names_to = 'names', values_to = 'values', 4:8)

我现在也创建了自己的 table。我创建了不同的线性模型，并针对 mpg 选择了不同变量的斜率和截距。这是我创建的 table：

structure(list(terms = c("intercept", "intercept", "intercept", 
"intercept", "intercept", "slope", "slope", "slope", "slope", 
"slope"), names = c("wt", "disp", "drat", "hp", "qsec", "wt", 
"disp", "drat", "hp", "qsec"), values = c(37.2851, 29.59985, 
-7.525, 30.09886, -5.114, -5.3445, -0.04122, 7.678, -0.06823, 
1.412)), row.names = c(NA, -10L), class = c("tbl_df", "tbl", 
"data.frame"))

这是它的截图：

然后我将我创建的这个新 table 分成两部分：一个 table 包含有关斜率的信息，另一个包含有关截距的信息。（不确定这是否是最好的主意）

mapping_df_intercept <- mapping_df %>%
  filter(terms == "intercept")

mapping_df_slope <- mapping_df %>%
  filter(terms == "slope")

我现在正在尝试为每个方面获取一个具有唯一 geom_abline 的图表。

ggplot(mtcars_long_numeric, aes(x = values, y = mpg)) +
  geom_point() +
  facet_wrap(~names, scales = 'free') + 
  geom_abline(mapping = aes(intercept = values, data = mapping_df_intercept), aes(slope = values, data = mapping_df_slope), linetype = 'dashed')

这是行不通的。也许 geom_abline 不能采用两个不同的 aes 部分。

如果相反，我尝试只使用一个包含截距和斜率信息的数据帧，并尝试将过滤放入参数中，我也无法让它工作。

ggplot(mtcars_long_numeric, aes(x = values, y = mpg)) +
  geom_point() +
  facet_wrap(~names, scales = 'free') + 
  geom_abline(mapping = aes(intercept = mapping_df$values[mapping_df$terms == "intercept"], slope = mapping_df$values[mapping_df$terms == "slope"]), data = mapping_df, linetype = 'dashed')

我知道我可以只使用 geom_smooth，它更简单，但我正在尝试其他方法来练习这种 geom_abline 映射情况。

ggplot(mtcars_long_numeric, aes(x = values, y = mpg)) +
  geom_point() +
  facet_wrap(~names, scales = 'free') + 
  geom_smooth(method = 'lm')

Answer 1

我认为主要的困难在于尝试使用比方便实现此目的更长的 mapping_df 来做到这一点。如果 aes() 参数是该数据中的列，它会变得更容易。

mapping_df2 <- mapping_df %>%
  pivot_wider(names_from = terms, values_from = values)

ggplot(mtcars_long_numeric, aes(x = values, y = mpg)) +
  geom_point() +
  geom_abline(
    data = mapping_df2,
    aes(intercept = intercept, slope = slope)
  ) +
  facet_wrap(~ names, scales = "free")

^{由 reprex package (v1.0.0)}

于 2021-08-18 创建

下面的代码在顶部的代码之前运行，但没有解决问题。出于可重复性的原因附加此内容。

library(ggplot2)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(tidyr)

mtcars_numeric <- mtcars %>%
  mutate(car = rownames(.)) %>%
  dplyr::select(mpg, wt, disp, drat, hp, qsec) 

mtcars_long_numeric <- pivot_longer(mtcars_numeric, names_to = 'names', values_to = 'values', 2:6)

mapping_df <- structure(list(
  terms = c("intercept", "intercept", "intercept", 
            "intercept", "intercept", "slope", "slope", "slope", "slope", 
            "slope"), 
  names = c("wt", "disp", "drat", "hp", "qsec", "wt", 
            "disp", "drat", "hp", "qsec"), 
  values = c(37.2851, 29.59985, 
             -7.525, 30.09886, -5.114, -5.3445, -0.04122, 7.678, -0.06823, 
             1.412)
), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))

table 的 R 映射斜率和截距，在刻面包裹后使用线性模型

R mapping slope and intercept from a table with linear models after facet wrap

mapping

r

ggplot2