0

所以我想在使用facet_wrap. 代码如下：

library(tidyverse)
library(quantreg)

mtcars %>% 
  gather("variable", "value", -c(3, 10)) %>% 
  ggplot(aes(value, disp)) + 
  geom_point(aes(color = factor(gear))) + 
  geom_quantile(quantiles = 0.5, 
                aes(group = factor(gear), color = factor(gear))) +
  facet_wrap(~variable, scales = "free")
#> [multiple warnings removed for clarity]

由reprex 包（v0.3.0）于 2019-12-05 创建

可以看出回归线没有完整的范围，我不能轻易解决这个问题。

4

1 回答 1

1

这感觉设计过度，但一种方法是在 ggplot 之外获取斜率截距图，然后使用geom_abline. 此实现的一个潜在缺点是它使用一些抖动来防止 中的“奇异设计矩阵”错误rq，但这意味着即使对于只有一个 x 值的数据，它也会生成随机斜率。为了解决这个问题，如果该可变齿轮组合只有一个值，这里有一个步骤可以从斜率计算中删除数据。

mtcars %>% 
  gather("variable", "value", -c(3, 10)) -> mt_tidy

mt_tidy %>%
  # EDIT: Added section to remove data that only has one value for that
  #   variable and gear. 
  group_by(variable, gear) %>%
    mutate(distinct_values = n_distinct(value)) %>% 
    ungroup() %>%
    filter(distinct_values > 1) %>%
    select(-distinct_values) %>%

  nest_legacy(-c(variable, gear)) %>% 
  # the jittering here avoids the "Singular design matrix" error
  mutate(qtile = map(data, ~ rq(jitter(.x$disp) ~ jitter(.x$value), 
                                tau = 0.5)),
         tidied = map(qtile, broom::tidy)) %>%
  unnest_legacy(tidied) %>%
  select(gear:estimate) %>%
  pivot_wider(names_from = term, values_from = estimate) %>%
  select(gear, variable, 
         intercept = `(Intercept)`, 
         slope = `jitter(.x$value)`) -> qtl_lines

ggplot(mt_tidy, aes(value, disp, color = factor(gear))) + 
  geom_point() + 
  geom_abline(data = qtl_lines,
              aes(intercept = intercept, slope = slope,
                  color = factor(gear))) +
  facet_wrap(~variable, scales = "free")

于 2019-12-08T05:16:34.363 回答