Функция, возвращающая NA, если подмножество пуста

Question

Я хотел бы получить эффективную функцию или фрагмент кода, который пытается подмножить вектор, и возвращает NA, если в подмножестве нет элементов. Например, для

v1 = c(1, 1, NA) 

Кодекса unique(v1[!is.na(v1)]) возвращает одну запись, которая является большим, но для

v2 = c(NA, NA, NA) 

Кодекса unique(v2[!is.na(v2)]) возвращает logical(0), который не является большим, когда эта операция Подменю используется как часть dplyr цепь, содержащая summarise_each или summarise. Я бы хотел, чтобы вторая операция вернула NA вместо logical(0).

В этом контексте я пытаюсь решить this question, используя несколько команд spread. Пример данные взяты из предыдущего вопроса:

set.seed(10) 
tmp_dat <- data_frame(
    Person = rep(c("greg", "sally", "sue"), each=2), 
    Time = rep(c("Pre", "Post"), 3), 
    Score1 = round(rnorm(6, mean = 80, sd=4), 0), 
    Score2 = round(jitter(Score1, 15), 0), 
    Score3 = 5 + (Score1 + Score2)/2 
) 

> tmp_dat 
Source: local data frame [6 x 5] 

    Person Time Score1 Score2 Score3 
    <chr> <chr> <dbl> <dbl> <dbl> 
1 greg Pre  80  78 84.0 
2 greg Post  79  80 84.5 
3 sally Pre  75  74 79.5 
4 sally Post  78  78 83.0 
5 sue Pre  81  78 84.5 
6 sue Post  82  81 86.5 

Теперь, используя несколько разворотов мы можем достичь желаемых результатов (хотя и с разными названиями столбцов):

tmp_dat %>% 
    mutate(Time_2 = Time, 
      Time_3 = Time) %>% 
    spread(Time, Score1, sep = '.') %>% 
    spread(Time_2, Score2, sep = '.') %>% 
    spread(Time_3, Score3, sep = '.') %>% 
    group_by(Person) %>% 
    summarise_each(funs(((function(x)x[!is.na(x)])(.)))) 

Теперь проблема возникает, если есть слишком многие числовые апертуры:

# Replace last two entries in the last row with NA's 
tmp_dat$Score2[6] <- NA 
tmp_dat$Score3[6] <- NA 

Теперь запуск фрагмента кода с summarise_each выдает ошибку:

Error in eval(substitute(expr), envir, enclos) : expecting a single value 

Answer 1

Это можно легко сделать с dcast из data.table, который может принимать несколько value.var колонн

library(data.table) 
dcast(setDT(tmp_dat), Person ~paste0("Time.", Time), 
       value.var = c("Score1", "Score2", "Score3")) 
#  Person Score1_Time.Post Score1_Time.Pre Score2_Time.Post Score2_Time.Pre Score3_Time.Post Score3_Time.Pre 
#1: greg    79    80    80    78    84.5   84.0 
#2: sally    78    75    78    74    83.0   79.5 
#3: sue    82    81    NA    78    NA   84.5 

---

Если нам нужно использовать dplyr/tidyr, вариант будет gather «Показатель» колонки к " длинный ', unite столбцов в один столбец (' Time1 '), а затем spread

library(dplyr) 
library(tidyr) 
gather(tmp_dat, Var, Val, Score1:Score3) %>% 
      mutate(TimeN = 'Time', Var = sub("\\D+", "", Var)) %>% 
      unite(Time1, TimeN, Time, Var) %>% 
      spread(Time1, Val) 
# # A tibble: 3 × 7 
# Person Time_Post_1 Time_Post_2 Time_Post_3 Time_Pre_1 Time_Pre_2 Time_Pre_3 
# * <chr>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl> 
#1 greg   79   80  84.5   80   78  84.0 
#2 sally   78   78  83.0   75   74  79.5 
#3 sue   82   NA   NA   81   78  84.5