Доступ к имени столбца внутри функции, используемой внутри структуры sumrize_all dplyr

Question

Я строю структуру dplyr для запуска некоторых пользовательских функций над столбцами кадра данных в 1 блоке кода

В настоящее время моя функция выглядит следующим образом

 funx <- function(x) {

  logchoice <- if(max(x) < 400) {'T' } else { 'F' }
  logtest <- suppressWarnings(log10(x))
  remaining <- length(logtest[which(!is.na(logtest) & is.finite(logtest))])
  x <- if(remaining > 0.75*length(x)) {suppressWarnings(log10(x)) } else { x }
  x <- x[which(!is.na(x) & is.finite(x))]
  y <- diptest::dip.test(x)
  z <- tibble(pvalue = y$p.value, Transform = logchoice)

  return(z)
  }

и структура dplyr выглядит следующим образом:

mtcars %>% 
 sample_n(30) %>%
 select(colnames(mtcars)[2:5]) %>%
 summarise_all(list(~ list(funx(.)))) %>% 
 gather %>% 
 unnest %>% 
 arrange(pvalue) %>% 
 rename(Parameter = key)

, что дает мне:

  Parameter     pvalue Transform
1       cyl 0.00000000         T
2      drat 0.03026093         T
3        hp 0.04252001         T
4      disp 0.06050505         F

Я хотел бы знать, как получить доступ к имени столбца внутри моей функции, главным образом потому, что я хотел бы изменить имя в таблице результатов, чтобы оно выглядело как результат этого: paste(original_column_name, 'log10', sep = '') если функция применяет преобразование журнала , но оставьте оригинальное имя как есть, когда оно решит не делать этого.

так что ожидаемый результат:

   Parameter     pvalue Transform
1  log10_cyl 0.00000000         T
2 log10_drat 0.03026093         T
3   log10_hp 0.04252001         T
4       disp 0.06050505         F

Answer 1

Ответ в отдельном посте, так как решение другое. Чтобы получить имена столбцов в print(), я бы передал их в функцию и использовал purrr::map_dfr для построения кадра данных результата. Небольшие изменения, которые я сделал, - это захват имени столбца col_name и указание кадра данных. Я попробовал несколько подходов, чтобы получить имя столбца, используя исходную функцию, но безуспешно.

logtest_pval <- function(col, df) {

  col_name <- col
  x <- df %>% pull(!!col)

  logchoice <- ifelse(max(x) < 400, TRUE, FALSE)
  logtest <- log10(x)
  remaining <- length(logtest[which(!is.na(logtest) & is.finite(logtest))])

  x <- if(remaining > 0.75*length(x)) {suppressWarnings(log10(x)) } else { x }
  x <- x[which(!is.na(x) & is.finite(x))]
  y <- diptest::dip.test(x)

  z <- 
    tibble(
      transform = logchoice,
      column = ifelse(logchoice, paste0("log10_", col_name), col_name),
      pvalue = y$p.value
    )

  print(paste0(z, collapse = " | "))
  return(z)
}

Затем вы можете построить свой фрейм данных:

purrr::map_dfr(
  .x = names(mtcars), # the columns to use
  .f = logtest_pval,  # the function to use
  df = mtcars         # additional arguments needed
)

Вот еще один пример

df <-
  mtcars %>% 
  select_if(is.numeric)

pvalues <-
  map_dfr(names(df), logtest_pval, df)

Answer 2

Вы были довольно близко. Вы можете просто добавить mutate() в конец

mtcars %>% 
  sample_n(30) %>%
  select(colnames(mtcars)[2:5]) %>%
  summarise_all(list(~ list(funx(.)))) %>% 
  gather() %>% 
  unnest() %>% 
  arrange(pvalue) %>% 
  rename(Parameter = key) %>% 
  mutate(Parameter = ifelse(Transform == "T", paste0("log10_", Parameter), Parameter)) %>% 
  select(Parameter, pvalue)

#  Parameter     pvalue
#  log10_cyl 0.00000000
# log10_drat 0.01389723
#       disp 0.02771770
#   log10_hp 0.08493466