Question

对于一年内ID A到E，我有以下数据框 0 ， 1 和 NA ：

dat <- data.frame(
 id = c("A", "B", "C", "D", "E"),
 jan = c(0, 0, NA, 1, 0),
 feb = c(0, 1, 1, 0, 0),
 mar = c(0, 0, 1, 0, 1),
 apr = c(0, NA, 0, NA, 1),
 may = c(0, NA, 0, 0, 0),
 jun = c(0, 0, 0, 0, 0),
 jul = c(0, 0, 0, 0, 1),
 aug = c(NA, 0, 0, 1, 1),
 sep = c(NA, 0, 0, 1, NA),
 okt = c(NA, 0, 0, 0, NA),
 nov = c(NA, 0, 0, 0, 1),
 dez = c(NA, 0, 0, 0, 0)
)

> dat
  id jan feb mar apr may jun jul aug sep okt nov dez
   A   0   0   0   0   0   0   0  NA  NA  NA  NA  NA
   B   0   1   0  NA  NA   0   0   0   0   0   0   0
   C  NA   1   1   0   0   0   0   0   0   0   0   0
   D   1   0   0  NA   0   0   0   1   1   0   0   0
   E   0   0   1   1   0   0   1   1  NA  NA   1   0

我想计算一年内每个ID的1个数，但需要满足以下条件：

第一次出现1始终计为1
NA应被视为0
第二次出现的1只计算，如果前面有六次或更多 0s / NAs

在我的例子中，计数将是：

> dat
   id jan feb mar apr may jun jul aug sep okt nov dez     count
 1  A   0   0   0   0   0   0   0  NA  NA  NA  NA  NA      => 0
 2  B   0   1   0  NA  NA   0   0   0   0   0   0   0      => 1
 3  C  NA   1   1   0   0   0   0   0   0   0   0   0      => 1
 4  D   1   0   0  NA   0   0   0   1   1   0   0   0      => 2
 5  E   0   0   1   1   0   0   1   1  NA  NA   1   0      => 1

该函数应以apply(dat[, -1], 1, my_fun)的形式逐行应用，并返回包含计数的向量（即0, 1, 1, 2, 1）。有没有人知道如何实现这个目标？

Answer 1

如何使用zoo包中的rollapply：

library(zoo)
library(magrittr)

myfun <- function(y, pattern = c(0,0,0,0,0,0,1)){
    y[is.na(y)] <- 0 # to account for both 0s and NAs
    first <- sum(y[1:(length(pattern)-1)])!=0
    rest  <- y %>% as.numeric() %>% rollapply(7, identical, pattern) %>% sum
    return(first+rest)
}

apply(dat[,-1],1,myfun)

[1] 0 1 1 2 1

rollapply部分将匹配任何六个0的序列，然后每行一个。

剩下的唯一一件事就是在前6个月中占1分（你想要计算但却不会被rollapply匹配）。这是通过myfun的第一行完成的。

Answer 2

我将利用你的函数每行最多返回2的事实，因为永远不会有多个这样的六个零序列。如果某处至少有六个零的序列，它将达到最大值，该序列不在行的开头或结束处开始（从那时起它被两侧的1包围。）

yoursum <- function(x)
{
  x[is.na(x)]<-0
  booleans = with(rle(x),values==0 & lengths>5)
  if(any(booleans))
  {
    if(which(booleans)<length(booleans) & which(booleans)>1 )
      return(2)
  }

  if(any(x>0))
    return(1)
  else
    return(0)
}

apply(dat[,-1],1,yoursum)

输出：

[1] 0 1 1 2 1

Answer 3

由于你的数据集是几个月，然后12个月你只能有一个模式，其中1将计为第二个1，所以你将拥有的最大数量是1。在这种情况下，您不需要任何类型的循环。我们可以用完全矢量化的方式做到这一点，即

#Create the pattern to accept 6 or more 0 before the second 1
#Compliments of @DavidArenburg
ptn <- "10{6,}1"


replace(grepl(ptn, do.call(paste0, dat[-1]))+1, rowSums(dat[-1]) == 0, 0)
#[1] 0 1 1 2 1

或者使其成为一种功能，

get_counts <- function(df, ptn = "10{6,}1"){
  v1 <- paste0(ptn, collapse = '')
  replace(grepl(v1, do.call(paste0, df[-1]))+1, rowSums(df[-1]) == 0, 0)
}

get_counts(dat)
#[1] 0 1 1 2 1

Answer 4

一种直接的方法是简单地循环每行的数字并检查先前的条目以确定是否要计算找到的“1”。 R的运算符是矢量化的，因此循环超过12个数字或12个数字系列对于解决问题没有任何区别。

所有需要的是跟踪最后一个：

last_seen_one = integer(nrow(dat))

和累积的数量：

ones_nr = integer(nrow(dat))

然后，转换成一个非常简单的算法，如：

for(j in 2:length(dat)) {
    has_one = dat[[j]] == 1L
    no_one = !last_seen_one
    i = which(has_one & (no_one | ((j - last_seen_one) >= 6)))
    ones_nr[i] = ones_nr[i] + 1L
    last_seen_one[has_one] = j
}

我们得到：

ones_nr
#[1] 0 1 1 2 1

这样，只需要超过12个月/列的循环，而不是每个id /行的循环。

按行计算数字序列

4 个答案: