R映射斜率和截距从具有线性模型的表中分面环绕后答案

【问题标题】：R mapping slope and intercept from a table with linear models after facet wrapR映射斜率和截距从具有线性模型的表中分面环绕后
【发布时间】：2021-08-18 17:05:49
【问题描述】：

使用 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)

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

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"))

这是它的截图：

然后，我将创建的这个新表拆分为两个：一个包含斜率信息的表和一个包含截距信息的表。（不确定这是否是最好的主意）

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')

【问题讨论】：

标签： r ggplot2 mapping

【解决方案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 年 8 月 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"))

【讨论】：