Вывод lapply () как фрейм данных нескольких функций - R - PullRequest
Новая
       93

Вывод lapply () как фрейм данных нескольких функций - R

2 голосов
/ 22 октября 2019

Я пытался создать новый фрейм данных из нескольких вычислений с lapply(). Я дошел до этого, читая несколько вопросов ( 1 , 2 , 3 ): 

lapply(mtcars, function(x) c(colnames(x), 
                             NROW(unique(x)), 
                             sum(is.na(x)), 
                             round(sum(is.na(x))/NROW(x),2)   
                        )
       )

Однако, colnames(x) нене дать имя как x это вектор. Во-вторых, я не могу найти способ преобразовать эти выходные данные в фрейм данных: 

lapply(mtcars, function(x) data.frame(NROW(unique(x)), # if I put colnames(x) here it gives an error
                                      sum(is.na(x)), 
                                      round(sum(is.na(x))/NROW(x),2)   
                        )
       )

Как вы могли видеть выше, окончательный фрейм данных должен следовать такой структуре: 

| Variable_name | sum_unique | NA_count | NA_percent |

1 Ответ

3 голосов
/ 22 октября 2019

Следующее будет работать. Сначала создайте список с каждым элементом в качестве фрейма данных, а затем объедините все фреймы данных, чтобы получить окончательный результат. 

lst <- lapply(1:ncol(mtcars), function(i){
  x <- mtcars[[i]]
  data.frame(
    Variable_name = colnames(mtcars)[[i]],
    sum_unique = NROW(unique(x)), 
    NA_count = sum(is.na(x)), 
    NA_percent = round(sum(is.na(x))/NROW(x),2))  
  })

do.call(rbind, lst)
#    Variable_name sum_unique NA_count NA_percent
# 1            mpg         25        0          0
# 2            cyl          3        0          0
# 3           disp         27        0          0
# 4             hp         22        0          0
# 5           drat         22        0          0
# 6             wt         29        0          0
# 7           qsec         30        0          0
# 8             vs          2        0          0
# 9             am          2        0          0
# 10          gear          3        0          0
# 11          carb          6        0          0

Поскольку вы пометили этот пост как tidyverse, здесь я предоставил другую альтернативу,использует map_dfr, что приводит к более сжатому коду. 

library(tidyverse)

map_dfr(mtcars, function(x){
  tibble(sum_unique = NROW(unique(x)), 
         NA_count = sum(is.na(x)), 
         NA_percent = round(sum(is.na(x))/NROW(x),2))
}, .id = "Variable_name")
# # A tibble: 11 x 4
#    Variable_name sum_unique NA_count NA_percent
#    <chr>              <int>    <int>      <dbl>
#  1 mpg                   25        0          0
#  2 cyl                    3        0          0
#  3 disp                  27        0          0
#  4 hp                    22        0          0
#  5 drat                  22        0          0
#  6 wt                    29        0          0
#  7 qsec                  30        0          0
#  8 vs                     2        0          0
#  9 am                     2        0          0
# 10 gear                   3        0          0
# 11 carb                   6        0          0

Наконец, еще одно решение с использованием функций из dplyr и tidyr. 

mtcars %>%
  summarize_all(
    list(
      sum_unique = function(x) NROW(unique(x)), 
      NA_count = function(x) sum(is.na(x)), 
      NA_percent = function(x) round(sum(is.na(x))/NROW(x),2)
    )
  ) %>%
  pivot_longer(everything(), 
               names_to = "column", 
               values_to = "value") %>%
  separate(column, into = c("Variable_name", "parameter"), sep = "_", extra = "merge") %>%
  pivot_wider(names_from = "parameter", values_from = "value")
# # A tibble: 11 x 4
#    Variable_name sum_unique NA_count NA_percent
#    <chr>              <int>    <int>      <dbl>
#  1 mpg                   25        0          0
#  2 cyl                    3        0          0
#  3 disp                  27        0          0
#  4 hp                    22        0          0
#  5 drat                  22        0          0
#  6 wt                    29        0          0
#  7 qsec                  30        0          0
#  8 vs                     2        0          0
#  9 am                     2        0          0
# 10 gear                   3        0          0
# 11 carb                   6        0          0
...