Question

我有一个很大的data.frame有'交错'的数据，想要对齐它。我的意思是我想采取像

这样的东西

并从所有列中删除前导（顶部）NAs以获取

我知道na.trim包中的zoo函数，但这不适用于上面提到的初始data.frame或其转置。为此，我使用了转置数据框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')

Answer 1

我们可以遍历列（lapply(..）并应用na.trim。然后，通过将list指定为length元素的最大长度，在每个list元素的末尾填充NA。

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)))

Answer 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))
}

Answer 3

我们可以使用qpcR包中的cbind.na()函数，并将其与zoo包中的na.trim()函数结合使用：

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

Answer 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

删除前导NA以对齐数据

4 个答案: