Пользовательская функция dplyr и несколько ggplot нескольких аргументов

Question

Мне нужна помощь для технической манипуляции на R плз.

Моя проблема: у меня есть данные наблюдений за птицами по наличию / отсутствию в разных типах местообитаний.Я хочу знать, насколько успешны наблюдения в этих различных средах обитания в зависимости от их диапазона поверхности:

data_observation <- data.frame(
  habitat_bush = c(
    0, 0, 0, 0, 10,
    10, 30, 30, 30, 45,
    65, 65, 65, 80, 80,
    80, 90, 95, 100
  ),
  obs = c(
    "yes", "no", "no", "no", "yes",
    "no", "no", "yes", "no", "yes",
    "yes", "no", "yes", "no", "yes",
    "yes", "yes", "yes", "yes"
  )
)

Здесь у вас есть только данные для "Места обитания", но у вас есть еще 10 мест обитания.

С помощью коллеги мы сделали эту функцию, чтобы составить график отношения успешных наблюдений при разном размере области "габарита":

library(dplyr)
library(ggplot2)
library(scales)


plot_forest_test <- function(data = NULL, habitat_type = NULL, colour = NULL) {
  x <- enquo(habitat_type)
  fill <- enquo(colour)

  ggdata <- data %>%
    select(x = !!x, fill = !!fill) %>%
    mutate(
      group = case_when(
        x == 0 ~ "[0]",
        x > 0.0001 & x < 10.0001 ~ "]0-10]",
        x > 10.0001 & x < 25.0001 ~ "]10-25]",
        x > 25.0001 & x < 50.0001 ~ "]25-50]",
        x > 50.0001 & x < 75.0001 ~ "]50-75]",
        x > 75.0001 ~ "]75- 100]"
      )
    ) %>%
    select(-x) %>%
    group_by(group, fill) %>%
    count() %>%
    group_by(group) %>%
    group_modify(~ mutate(.data = .x, freq = n / sum(n)))

  ggplot(data = ggdata, mapping = aes(x = group, y = freq, fill = fill)) +
    geom_bar(stat = "identity") +
    scale_fill_brewer(palette = "Greens") +
    scale_y_continuous(labels = scales::percent) +
    theme_minimal() +
    labs(x = expr(!!x), fill = expr(!!fill))
}

plot_forest_test(data = data_observation, habitat_type = habitat_bush, colour = obs)

Это работает очень хорошо.Но наблюдение может зависеть от усилий, приложенных специалистами для поиска присутствия птицы.Итак, у меня есть такие данные:

data_observation_2 <- data.frame(
  superficie_essence = c(
    0, 0, 0, 0, 10,
    10, 30, 30, 30, 45,
    65, 65, 65, 80, 80,
    80, 90, 95, 100
  ),
  obs = c(
    "yes", "no", "no", "no", "yes",
    "no", "no", "yes", "no", "yes",
    "yes", "no", "yes", "no", "yes",
    "yes", "yes", "yes", "yes"
  ),
  effort = c(low, low, mid-low, mid-low, low, mid-low, mid-low,
            mid-high, mid-high, high, mid-low, mid-low, mid-high, mid-low, mid-high, high, high, mid-high, high)
)

Мои навыки R на этом заканчиваются.Я хочу иметь тот же ранее график, но подразделяется на тип_удобрения для каждой модальности типов мест обитания, в том же графическом (например, многоканальном графическом).Другими словами, я хочу 5 подграфов предыдущего графика с 1 барплотом по модальности усилий.Но у меня есть много данных, поэтому я хотел бы поместить эту процедуру в такую ​​функцию:

plot_forest_test_2(data = data_observation, habitat_type = habitat_bush, effort = Q_effort, colour = obs)

Можете ли вы помочь мне, пожалуйста?Спасибо за вашу помощь!

cdlt

Answer 1

Задания не моя сильная сторона, особенно когда они могут отсутствовать, но попробуйте. Я создал новый столбец для граненого элемента, а затем добавил facet_wrap(). Вы также можете использовать facet_grid(). Надеюсь, это поможет.

plot_forest_test <- function(data = NULL, habitat_type = NULL, colour = NULL, facet = NULL) {
  x <- enquo(habitat_type)
  fill <- enquo(colour)

  # this is new ####################
  facet <- enquo(facet)
  has_facet <- quo_name(facet) != "NULL"

  df <- 
    data %>% 
    mutate(
      x = !!x, 
      fill = !!fill,
      facet = ""
    )

  if (has_facet) {
    df <- 
      df %>% 
      mutate(facet = !!facet)
  }
  ##################################

  ggdata <- 
    df %>%
    mutate(
      group = case_when(
        x == 0 ~ "[0]",
        x > 0.0001 & x < 10.0001 ~ "]0-10]",
        x > 10.0001 & x < 25.0001 ~ "]10-25]",
        x > 25.0001 & x < 50.0001 ~ "]25-50]",
        x > 50.0001 & x < 75.0001 ~ "]50-75]",
        x > 75.0001 ~ "]75- 100]"
      )
    ) %>%
    select(-x) %>%
    # adding facet here
    group_by(group, fill, facet) %>% 
    count() %>%
    group_by(group, facet) %>%
    arrange(desc(fill)) %>% 
    mutate(
      freq = n/sum(n),
      # these steps set up the label placement
      running_freq = cumsum(freq),
      prev_freq = lag(running_freq, default = 0),
      label_y = (prev_freq + running_freq)/2 ,
      label_n = paste0("n = ", sum(n))
    ) %>% 
    ungroup()

  # create plot w/o facet
  p <-
    ggplot(data = ggdata, mapping = aes(x = group, y = freq, fill = fill)) +
    geom_bar(stat = "identity") +
    geom_hline(yintercept = 0) +
    geom_text(aes(y = -0.05, label = label_n), size = 3.5) +
    #geom_text(aes(y = label_y, label = n)) +
    scale_fill_brewer(palette = "Greens") +
    scale_y_continuous(labels = scales::percent) +
    theme(
      panel.background = element_rect(fill = "white"),
      panel.border = element_rect(color = "grey90", fill = NA)
    ) +
    labs(x = expr(!!x), fill = expr(!!fill))

  # add in if facet was mentioned
  if (has_facet) {
    p <-
      p +
      facet_grid(~facet)
  }

  # return final plot
  p
}

Я включаю правку в data_observation_2, поскольку строки не были в кавычках, а некоторые значения имеют пробелы вокруг дефисов, а другие - нет. Я сделал их одинаковыми без пробелов

data_observation_2 <- data.frame(
  superficie_essence = c(
    0, 0, 0, 0, 10,
    10, 30, 30, 30, 45,
    65, 65, 65, 80, 80,
    80, 90, 95, 100
  ),
  obs = c(
    "yes", "no", "no", "no", "yes",
    "no", "no", "yes", "no", "yes",
    "yes", "no", "yes", "no", "yes",
    "yes", "yes", "yes", "yes"
  ),
  effort = c(
    "low", "low", "mid-low", "mid-low", "low", "mid-low", "mid-low",
    "mid-high", "mid-high", "high", "mid-low", "mid-low", 
    "mid-high", "mid-low", "mid-high", "high", "high", "mid-high", "high"
  )
  )
)

И окончательный результат. Я использовал fct_relevel(), чтобы привести их в порядок усилий.

plot_forest_test(
  data = data_observation, 
  habitat_type = habitat_bush, 
  colour = obs
)

data_observation_2 %>% 
  mutate(effort = fct_relevel(effort, "low", "mid-low", "mid-high", "high")) %>% 
  plot_forest_test(
    habitat_type = superficie_essence, 
    colour = obs, 
    facet = effort
  )