2017-07-26 56 views
4

我有以下的數據框與,,並NA S表示ID分別爲A到E的1年時間:計數序列橫行

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 

我想算要滿足以下條件需要1秒爲每個ID移到該一年內的數量,但:

  • 一個1的第一次出現是始終計爲1
  • 的NA應被視爲0
  • 一個1的第二次出現時僅計數,如果它是由六個或更多個 0之前/ 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)的形式逐行應用並返回一個包含count(即0, 1, 1, 2, 1)。有沒有人有一個想法如何實現這一點?

+0

你能連續3或4或更多的滿足條件?或者你已經修復的列數只有一個模式 – Sotos

+0

不,總是有12列。所以最大計數是2(在1之後只能有一個6個0的序列)。 – piptoma

+2

關於你的編輯:你可以很容易地使用下面的一些答案來解決你編輯的問題。其中一些已經在1之前有6個以上的零。在適當的地方用NA替換NA是最簡單的。例如,在我的回答中,'dat [is.na(dat)] < - 0'或者'y [is.na(y)] < - 0'。 – demirev

回答

4

如何使用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部分將匹配的6個0後跟一個1各行中的任何序列。

剩下的唯一要做的是在前6個月內計算1秒(您要計數但不會與折算相匹配)。這與第一行myfun完成。

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 
2

由於您的數據集數月,然後在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 
1

一個簡單的方式來處理,這是簡單地遍歷每一行和檢查的數量先前的條目決定是否計算找到的「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 /行上的循環。