Удалите ведущие NA для выравнивания данных

У меня есть большой data.frame с "шахматными" данными и хотел бы выровнять его. Я имею в виду, что я хотел бы взять что-то вроде

и удалите верхние (верхние) NA из всех столбцов, чтобы получить

Я знаю о функции na.trim из пакета zoo, но это не работало ни с начальным data.frame, представленным выше, ни с его транспонированием. Для этого я использовал, с транспонированным dataframe t.df,

t.df <- na.trim(t.df, sides = 'left')

Это возвращает пустой data.frame и не будет работать так, как я хотел, так как он создавал бы векторы разной длины. Может ли кто-нибудь указать мне на пакет или функцию, которые могут быть более полезными?

Вот код для моего примера, который использовался выше:

# example of what I have

var1 <- c(1,2,3,4,5,6,7,8,9,10)
var2 <- c(6,2,4,7,3,NA,NA,NA,NA,NA)
var3 <- c(NA,NA,8,6,3,7,NA,NA,NA,NA)
var4 <- c(NA,NA,NA,NA,5,NA,2,6,2,9)

df <- data.frame(var1, var2, var3, var4)


# transpose and (unsuccessful) attempt to remove leading NAs

t.df <- t(df)

t.df <-  na.trim(t.df, sides = 'left')

Ответ 1

Мы можем перебирать столбцы (lapply(..) и применять na.trim. Затем наберите NAs в конце каждого из элементов list, назначив length как максимальную длину из элементов list.

library(zoo)
lst <- lapply(df, na.trim)
df[] <- lapply(lst, `length<-`, max(lengths(lst)))
df
#   var1 var2 var3 var4
#1     1    6    8    5
#2     2    2    6   NA
##     3    4    3    2
#4     4    7    7    6
#5     5    3   NA    2
#6     6   NA   NA    9
#7     7   NA   NA   NA
#8     8   NA   NA   NA
#9     9   NA   NA   NA
#10   10   NA   NA   NA

Или как @G.Grothendieck, упомянутый в комментариях

replace(df, TRUE, do.call("merge", lapply(lst, zoo)))

Ответ 2

Вы можете выполнять базовые функции:

my.na.trim <- function(x) {
  r <- rle(is.na(x))
  if (!r$value[1]) return(x)
  x[c(((r$length[1]+1):length(x)), 1:r$length[1])]
}

df[,] <- lapply(df, my.na.trim)
df
#    var1 var2 var3 var4
# 1     1    6    8    5
# 2     2    2    6   NA
# 3     3    4    3    2
# 4     4    7    7    6
# 5     5    3   NA    2
# 6     6   NA   NA    9
# 7     7   NA   NA   NA
# 8     8   NA   NA   NA
# 9     9   NA   NA   NA
# 10   10   NA   NA   NA

альтернативное кодирование для функции:

my.na.trim <- function(x) {
  r <- rle(is.na(x))
  if (!r$value[1]) return(x)
  r1 <- r$length[1]
  c(tail(x, -r1), head(x, r1))
}

Ответ 3

Мы можем использовать функцию cbind.na() из пакета qpcR и объединить его с функцией na.trim() из zoo package:

do.call(qpcR:::cbind.na, lapply(df, zoo::na.trim))
#      var1 var2 var3 var4
# [1,]    1    6    8    5
# [2,]    2    2    6   NA
# [3,]    3    4    3    2
# [4,]    4    7    7    6
# [5,]    5    3   NA    2
# [6,]    6   NA   NA    9
# [7,]    7   NA   NA   NA
# [8,]    8   NA   NA   NA
# [9,]    9   NA   NA   NA
#[10,]   10   NA   NA   NA

Ответ 4

Если скорость - это вопрос, вы можете использовать это решение data.table.

library(data.table)

dt_foo <- function(dt) {
  shift_v <- sapply(dt, function(col) min(which(+(is.na(col)) == 0))-1)
  shift_expr <- parse(text = paste0("list(", paste("shift(", names(shift_v), ", n = ", shift_v, ", type = 'lead')", collapse = ", "), ")"))
  dt[, names(shift_v) := eval(shift_expr), with = F]
  dt[]
}

Ниже приведен сравнительный анализ.

library(zoo)
library(microbenchmark)

set.seed(1)
DT <- as.data.table(matrix(sample(c(0:9L, NA), 1e8, T, prob = c(rep(.01, 10), .9)), ncol = 1000))

zoo_foo <- function(df) {
  lst <- lapply(df, na.trim)
  df[] <- lapply(lst, `length<-`, max(lengths(lst)))
  df
}

my.na.trim <- function(x) {
  r <- rle(is.na(x))
  if (!r$value[1]) return(x)
  x[c(((r$length[1]+1):length(x)), 1:r$length[1])]
}

microbenchmark(dt_foo(copy(DT)), zoo_foo(DT),
  as.data.frame(lapply(DT, my.na.trim)), times = 10)

Unit: seconds
                                  expr      min       lq     mean   median       uq      max neval cld
                      dt_foo(copy(DT)) 1.468749 1.618289 1.690293 1.699926 1.725534 1.893018    10 a  
                           zoo_foo(DT) 6.493227 6.516247 6.834768 6.779045 7.190705 7.319058    10   c
 as.data.frame(lapply(DT, my.na.trim)) 4.988514 5.013340 5.384399 5.385273 5.508889 6.517748    10  b