Пакеты, которые я подозреваю, необходимы / я планировал использовать, но не могу работать
#Load packages
if(!("pacman" %in% .packages(all.available = T))){
install.packages("pacman")
library("pacman")
}else if(!("pacman" %in% (.packages()))){
library("pacman")
}
p_load(magrittr, plyr, dplyr,
rlang, tibble, tidyr,
purrr)
Создайте некоторые данные для этого примера:
#For reproducability
set.seed(1)
tib <- tibble(
ID = letters,
A_1 = runif(26),
A_2 = runif(26),
B_1 = runif(26),
B_2 = runif(26),
B_3 = runif(26),
C_1 = runif(26),
C_2 = runif(26),
C_3 = runif(26),
C_4 = runif(26)
)
#Remove some datapoint
for(i in 2:9){
pick_rows <- sample(1:nrow(tib[i]), nrow(tib[i])*.25)
tib[pick_rows, i] <- NA
}
Тогда идея о том, чтоЯ хочу сделать это следующим образом:
Для каждой категории (добавьте один новый столбец для каждой категории) и строки (ID), проверьте и отметьте следующее:
(a) - все значенияNA?Пометить как «MNAR»
(b) пропущены некоторые, но не все значения?Пометить как «MAR / MCAR»
(c) нет пропущенных значений?Пометить как «Не пропал»
Мне кажется, эта часть должна быть вычислительно дешевой, но в моем текущем подходе это является основным узким местом в моем коде.
Это мой текущийподход:
for (i in tib %>%
#Only numeric columns contain relevant data
keep(is.numeric) %>%
#Get unique identifiers
colnames() %>% gsub('[0-9]$', '', .) %>% unique()
) {
#Generate a new column
tib[[paste0(i, 'missing')]] <- tib %>%
#Select the conditions columns
select(contains(i)) %>%
#For each row
apply(1, function(x) x %>%
#Check if
{case_when(
#no values, (the most common event)
all(!is.na(.)) ~ 'Not missing',
#all values, (the least most common event)
all(is.na(.)) ~ 'MNAR',
#or any values (the second most common event)
any(is.na(.)) ~ 'MAR/MCAR'
#are missing
)}
)
}
и подход, который я пытаюсь разработать, поскольку я думаю, что он даст некоторую лучшую скорость:
categories <- tib %>%
keep(is.numeric) %>%
colnames() %>%
gsub('[0-9]$', '', .) %>%
unique()
tib %>%
mutate_at(
vars(syms(grep(paste0(categories, collapse = '|'),
colnames(tib),
value = T))),
funs(missing = case_when(
#no values
all(!is.na(.)) ~ 'Not missing',
#or all values
all(is.na(.)) ~ 'MNAR',
#any values
any(is.na(.)) ~ 'MAR/MCAR'
#are missing
)
)
)
, который, очевидно, не работает, но я думаю, что этокакой-то приличный псевдокод для того, что я пытаюсь.Сторона, которой нужно вызвать map из purrr, но я даже не могу изменить его, чтобы определить правильную группу столбцов в данный момент (я работал с более примитивным кодом для этого).
Поиск в StackOverflow, который я нашелследующие потоки:
dplyr - мутировать формулу на основе сходства в именах столбцов
Условно мутировать столбцы на основе класса столбцов
dplyr изменяет несколько столбцов на основе имен в векторах
Изменяет несколько столбцов в кадре данных
, из которых я не могу сказать, что какое-либо имеет отношениена мой вопрос.
РЕДАКТИРОВАТЬ:
Желаемый вывод:
> tib
# A tibble: 26 x 13
ID A_1 A_2 B_1 B_2 B_3 C_1 C_2 C_3 C_4 A_missing B_missing C_missing
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <chr> <chr>
1 a 0.266 0.0134 0.438 0.777 0.633 0.575 0.530 NA 0.256 Not missi~ Not missi~ MAR/MCAR
2 b 0.372 0.382 0.245 0.961 0.213 NA NA 0.503 0.718 Not missi~ Not missi~ MAR/MCAR
3 c 0.573 0.870 0.0707 NA 0.129 0.0355 NA 0.877 0.961 Not missi~ MAR/MCAR MAR/MCAR
4 d 0.908 NA NA 0.713 0.478 NA NA 0.189 0.100 MAR/MCAR MAR/MCAR MAR/MCAR
5 e 0.202 NA 0.316 0.400 0.924 NA NA NA 0.763 MAR/MCAR Not missi~ MAR/MCAR
6 f 0.898 0.600 0.519 NA 0.599 0.598 0.895 0.724 0.948 Not missi~ MAR/MCAR Not missi~
7 g 0.945 0.494 0.662 0.757 NA 0.561 NA NA 0.819 Not missi~ MAR/MCAR MAR/MCAR
8 h 0.661 NA 0.407 0.203 NA 0.526 0.780 0.548 0.308 MAR/MCAR MAR/MCAR Not missi~
9 i 0.629 0.827 0.913 0.711 0.357 0.985 0.881 0.712 0.650 Not missi~ Not missi~ Not missi~
10 j NA NA 0.294 0.122 NA 0.508 NA 0.389 0.953 MNAR MAR/MCAR MAR/MCAR
# ... with 16 more rows