Квазиквотация в мурлыканье - PullRequest
1 голос
/ 24 марта 2020

Как часть большой функции для сохранения значений только во временных рядах роста растений, которые происходят до травмы для каждого человека (plantid), я пишу 2 блока, которые по порядку будут содержать функцию

  1. Управляет тем, что все переменные, заданные в аргументе, являются символьными векторами (как во второй функции, %in% не распознает названные факторы), и, если нет, преобразует в символ при выдаче предупреждения.

  2. Идентифицируйте и отметьте строки из приведенных выше переменных, которые включают одну из строк аргумента b.

Я вполне уверен, что что-то не так с операторами цитата / квазиквотация или bang-bang (!!) / big-bang (!!!) (я впервые пишу функцию с цитатой). Мне постоянно выдаются предупреждения «!!! не может использоваться на верхнем уровне» или тому подобное, которые я не знаю, как решить. Мне также нужна помощь, чтобы найти хороший способ попытаться преобразовать переменные, которые не являются символами.

Это то, что я получил до сих пор

Описание аргумента

  • df: data.frame

  • plantid: уникальный идентификатор для каждого отдельного завода

  • year: год наблюдения

  • injuries: список (в моем случае) 3 столбцов, которые могут содержать код травмы, например, c("PrimaryInjury", "SecondaryInjury", "OtherInjury")

  • forbidden_values: интересующие коды травм, например c("Rust", "Insect", "Snow break")

Функция

id_injured <- function(df, plantid, year, injuries, forbidden_values){
    #parsing unquoted strings.
    plantid <- enquo(plantid)
    year <- enquo(year)
    forbidden_values <- enquos(forbidden_values)
    injuries <- syms(injuries)

    #if all variables in injuries are not characters, stop and warn (attempt to convert to character those variables which are not character)

    if(!all(purrr::pmap_int(select(df, !!!injuries), ~is.character(...))))){
       stop("All injury variables are not characters. Convert factors in injuries to character variables")} else {
          (1) #Control to give output while testing function, replace with conversion and warning?
    }

    #Identify rows with matching injury codes with 1, else 0.
    Dataplantid <- df %>% mutate(is_injured = purrr::pmap_int(select(df, !!!injuries), any(c(...) %in% !!!forbidden values)))

    #End of function
}


Использование по назначению

I ' мы удалили часть (1) функции, чтобы она попыталась пометить только 1 или 0.

Dataplantid <- id_injured(df=df, plantid=plantid, year=year, injuries=c("PrimaryInjury","SecondaryInjury","OtherInjury"),forbidden_values=c("Rust","Insect","Snow break")

Результат

Ошибка: невозможно использовать !!! при верхний уровень.

> last_trace()
<error/rlang_error>
Can't use `!!!` at top level.
Backtrace:
     █
  1. └─global::so_injured(...)
  2.   └─`%>%`(...)
  3.     ├─base::withVisible(eval(quote(`_fseq`(`_lhs`)), env, env))
  4.     └─base::eval(quote(`_fseq`(`_lhs`)), env, env)
  5.       └─base::eval(quote(`_fseq`(`_lhs`)), env, env)
  6.         └─`_fseq`(`_lhs`)
  7.           └─magrittr::freduce(value, `_function_list`)
  8.             ├─base::withVisible(function_list[[k]](value))
  9.             └─function_list[[k]](value)
 10.               ├─dplyr::mutate(...)
 11.               └─dplyr:::mutate.data.frame(...)
 12.                 ├─base::as.data.frame(mutate(tbl_df(.data), ...))
 13.                 ├─dplyr::mutate(tbl_df(.data), ...)
 14.                 └─dplyr:::mutate.tbl_df(tbl_df(.data), ...)
 15.                   └─rlang::enquos(..., .named = TRUE)
 16.                     └─rlang:::endots(...)
 17.                       └─rlang:::map(...)
 18.                         └─base::lapply(.x, .f, ...)
 19.                           └─rlang:::FUN(X[[i]], ...)
 20.                             └─rlang::splice(...)

Связанные данные

plantid <- rep(c(1,2,3,4,5), times=c(3,3,3,3,3))
year <- rep(1:3, length.out=length(plantid))
set.seed(42)
PrimaryInjury <- sample(c(NA,NA,NA,"Rust","Insect", "Snow break"), 15, replace=TRUE)
SecondaryInjury <- rep(NA, length.out=length(plantid)) #Filled with NA for example
OtherInjury <- rep(NA, length.out=length(plantid)) #Filled NA for example
df <- data.frame(plantid,year,PrimaryInjury,SecondaryInjury,OtherInjury)
#Right now, PrimaryInjury is a factor, SecondaryInjury and OtherInjury are logical.

Ожидаемый результат

Dataplantid <- df
Dataplantid$is_injured <- c(0,1,0,0,0,1,0,0,0,1,0,1,1,1,0)

1 Ответ

1 голос
/ 24 марта 2020

Есть несколько проблем, от наименьшего до большинства проблем c:

  1. Используйте map_lgl вместо map_int для логических результатов.
  2. В частности используйте map_lgl вместо <em>p</em>map_int, если только вы не собираетесь отображать несколько аргументов параллельно, что здесь не так.
  3. Не назначайте результат функции переменной внутри функция. Это на самом деле не вредит, но не нужно и вводит в заблуждение.
  4. Не ставьте в кавычки, а затем интерполируйте значения forbidden_values. Вы хотите, чтобы использовал здесь символьный вектор, а не имена R.
  5. Вы пропустили ~ в вызове purrr для вычисления is_injured.
  6. Логика c для выявления поврежденных значений не совсем так работает; здесь может быть способом использования pmap_lgl здесь, но я думаю, что более просто - хотя, возможно, более многословно - преобразовать ваши данные в длинный формат и работать с этим.

Вместе мы получаем:

id_injured <- function(df, plantid, year, injuries, forbidden_values) {
    plantid <- enquo(plantid)
    year <- enquo(year)
    injuries <- syms(injuries)

    df_injuries <- select(df, !!! injuries)

    if (! all(purrr::map_lgl(df_injuries, is.character))) {
        stop("All injury variables are not characters. Convert factors in injuries to character variables")
    }

    is_injured <- df_injuries %>%
        mutate(.RowID = row_number()) %>%
        tidyr::gather(Key, Value, -.RowID) %>%
        group_by(.RowID) %>%
        summarize(is_injured = any(Value %in% forbidden_values)) %>%
        pull(is_injured)

    df %>% mutate(is_injured = is_injured)
}
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...