Получить имя строки, используемой для аннотации - PullRequest
Новая
       70

Получить имя строки, используемой для аннотации

1 голос
/ 01 апреля 2020

Прежде всего, мой вопрос связан с этими другими: Ленивая оценка с функцией расширения аннотаций R вложенная карта через столбцы

Итак, я получил это пример данных: 

t <- tibble(a = c("a", "b", "c", "d", "e", "f", "g", "h"), 
            b = c(  1,   1,   1,   1,   2,   2,   2,   2),
            c = c(  1,   1,   2,   2,   3,   3,   4,   4),
            d = c( NA,  NA,  NA, "D", "E",  NA,  NA,  NA),
            e = c("A",  NA, "C",  NA,  NA,  NA, "G", "H")
)

И эта функция 

f1 <- function(data, group_col, expand_col){ #, return_group_col = TRUE, name_group_col = "group_col"){
  data %>%
    dplyr::group_by({{group_col}}) %>%
    dplyr::mutate( 
      {{expand_col}} := dplyr::case_when(
        !is.na({{expand_col}}) ~ {{expand_col}} ,
        any( !is.na({{expand_col}})  ) & is.na({{expand_col}}) ~ 
          paste(unique(unlist(str_split(na.omit({{expand_col}}), " ")) ), 
                collapse = " "),
        TRUE ~ NA_character_  
      )
      )  %>%
    dplyr::ungroup()
}  

f2 <- function(data, group_col, expand_col, fun=f1){
  v1 <- rlang::syms( colnames(data)[group_col] )
  v2 <- rlang::syms( colnames(data)[expand_col] )
  V <- tidyr::crossing( v1, v2 )
  purrr::reduce2( V$v1, V$v2, fun, .init=data )
}

Функция f1 использует два столбца, первый {{group_col}} является идентификатором группы, второй {{expand_col}} может содержать аннотацию или NA. После group_by от {{group_col}} {{expand_col}} заполняется данными из других строк из той же группы, если это NA. Пример: f1(t, c, d).

Функция f2 просто распространяет функцию f1 с использованием двух наборов столбцов, первый набор относится к группирующим столбцам, а второй набор относится к столбцам аннотаций.

Затем я хочу изменить функцию f1, чтобы создать (при необходимости) другой столбец, который будет содержать информацию о том, какой {{group_col}} файл {{expand_col}} был срублен.

Это означает, что вы запускаете: t %>% f2(3:2, 4:5) вы получите это: 

structure(list(a = c("a", "b", "c", "d", "e", "f", "g", "h"), 
    b = c(1, 1, 1, 1, 2, 2, 2, 2), c = c(1, 1, 2, 2, 3, 3, 4, 
    4), d = c("D", "D", "D", "D", "E", "E", "E", "E"), e = c("A", 
    "A", "C", "C", "G H", "G H", "G", "H")), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -8L))

То же самое, что и для запуска: 

t %>%
  f1(c, d)# %>% 
  f1(b, d) %>%
  f1(c, e) %>% 
  f1(b, e)

Вы можете заметить, что некоторые строки были аннотированы ранее. Эти строки должны быть заполнены «я» или что-то эквивалентное.

Вот пример вывода, который я хочу: 

structure(list(a = c("a", "b", "c", "d", "e", "f", "g", "h"), 
               b = c(1, 1, 1, 1, 2, 2, 2, 2), 
               c = c(1, 1, 2, 2, 3, 3, 4, 4), 
               d = c("D", "D", "D", "D", "E", "E", "E", "E"), 
               e = c("A", "A", "C", "C", "G H", "G H", "G", "H"),
               d_fill = c("b", "b", "c", "self", "self", "c", "b", "b"),
               e_fill = c("self", "c", "self", "c", "b", "b", "self", "self")
               ),
          class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -8L))

Затем я попытался эту неудачную модификацию: 

f1 <- function(data, group_col, expand_col){ #, return_group_col = TRUE, name_group_col = "group_col"){
  fill_column <- str_c(deparse(substitute(group_col)), "fill", sep = "_")
  data %>%
    dplyr::group_by({{group_col}}) %>%
    dplyr::mutate( 
      {{fill_column}} := dplyr::if_else(
        !is.na({{expand_col}}) & is.na({{fill_column}}) ~ "self",
        is.na({{expand_col}}) & is.na({{fill_column}})  ~ deparse(substitute(group_col)),
        TRUE ~ NA_character_
      ),
      {{expand_col}} := dplyr::case_when(
        !is.na({{expand_col}}) ~ {{expand_col}} ,
        any( !is.na({{expand_col}})  ) & is.na({{expand_col}}) ~ 
          paste(unique(unlist(str_split(na.omit({{expand_col}}), " ")) ), 
                collapse = " "),
        TRUE ~ NA_character_  
      )
      )  %>%
    dplyr::ungroup()
}

Но когда я запускаю t %>% f1(c, d), чтобы проверить его Я получил это: 

 Error: `condition` must be a logical vector, not a `formula` object
Run `rlang::last_error()` to see where the error occurred. 
25.
stop(fallback) 
24.
signal_abort(cnd) 
23.
.abort(text) 
22.
glubort(fmt_args(args), ..., .envir = .envir) 
21.
bad_args("condition", "must be a logical vector, not {friendly_type_of(condition)}") 
20.
dplyr::if_else(!is.na(~d) & is.na(~"c_fill") ~ "self", is.na(~d) & 
    is.na(~"c_fill") ~ deparse(substitute(group_col)), TRUE ~ 
    NA_character_) 
19.
mutate_impl(.data, dots, caller_env()) 
18.
mutate.tbl_df(., `:=`({
    {
        fill_column
    } ... 
17.
dplyr::mutate(., `:=`({
    {
        fill_column
    } ... 
16.
function_list[[i]](value) 
15.
freduce(value, `_function_list`) 
14.
`_fseq`(`_lhs`) 
13.
eval(quote(`_fseq`(`_lhs`)), env, env) 
12.
eval(quote(`_fseq`(`_lhs`)), env, env) 
11.
withVisible(eval(quote(`_fseq`(`_lhs`)), env, env)) 
10.
data %>% dplyr::group_by({
    {
        group_col
    } ... 
9.
f1(., c, d) 
8.
function_list[[k]](value) 
7.
withVisible(function_list[[k]](value)) 
6.
freduce(value, `_function_list`) 
5.
`_fseq`(`_lhs`) 
4.
eval(quote(`_fseq`(`_lhs`)), env, env) 
3.
eval(quote(`_fseq`(`_lhs`)), env, env) 
2.
withVisible(eval(quote(`_fseq`(`_lhs`)), env, env)) 
1.
t %>% f1(c, d)

Я не понял, что не так.

Заранее спасибо.

...