4

我正在寻找一种将前 N 行中基于列的信息编码到给定行的方法。数据集已排序。

简而言之，我想创建一个名为的列，如果该列在七行之后大于 0（或！NA），则oneweeksince返回。TRUEvictims

换句话说，如果，对于row[i]，在从到row[i]$victims > 0的任何行内，那么应该是。该值还应位于其中或row[i - 7]row[i]row[i]$oneweeksinceTRUEoneweeksinceTRUEvictims > 0!is.na(victims)

如何自动创建此列/功能？也可以使用日期列来计算日期距离。由于 R 中的缓慢性能，我试图避免创建循环。

数据集应如下所示：

      date           oneweeksince victims
1    2009-01-01         FALSE      NA
2    2009-01-02         FALSE      NA
3    2009-01-03         FALSE      NA
4    2009-01-04         FALSE      NA
5    2009-01-05         FALSE      NA
6    2009-01-06         FALSE      NA
7    2009-01-07         FALSE      NA
8    2009-01-08          TRUE       1
9    2009-01-09          TRUE      NA
10   2009-01-10          TRUE      NA
11   2009-01-11          TRUE      NA
12   2009-01-12          TRUE      NA
13   2009-01-13          TRUE      NA
14   2009-01-14          TRUE      NA
15   2009-01-15          TRUE      NA
16   2009-01-16         FALSE      NA
17   2009-01-17         FALSE      NA
18   2009-01-18         FALSE      NA
19   2009-01-19         FALSE      NA
20   2009-01-20         FALSE      NA

数据集长达很多年，所以我需要一种有效的方法来做到这一点。

4

4 回答 4

4

@G.Grothendieck 的解决方案

经过一番讨论，这是最有效和最有效的答案。

library(dplyr)
library(zoo)

dat2 <- dat %>%
  mutate(roll = rollapplyr(victims > 0, 8, any, na.rm = TRUE, fill = NA, partial = TRUE)) %>%
  mutate(oneweeksince = roll > 0) %>%
  select(-roll)

我之前尝试的解决方案

使用包中的解决rollapplyr方案zoo。rollapplyr可以应用带有滚动窗口的函数。在这种情况下，我们可以将滚动窗口指定为 8 并应用该mean函数。请注意，rollmean函数在这种情况下不适合，因为我们无法na.rm = TRUE在rollmean函数中指定。最后一步是简单地评估roll列是否大于 1。

library(dplyr)
library(zoo)

dat2 <- dat %>%
  mutate(roll = rollapplyr(victims, width = 8, FUN = function(x) mean(x, na.rm = TRUE), fill = NA)) %>%
  mutate(oneweeksince = roll > 0) %>%
  select(-roll)
# dat2
#          date victims oneweeksince
# 1  2009-01-01      NA           NA
# 2  2009-01-02      NA           NA
# 3  2009-01-03      NA           NA
# 4  2009-01-04      NA           NA
# 5  2009-01-05      NA           NA
# 6  2009-01-06      NA           NA
# 7  2009-01-07      NA           NA
# 8  2009-01-08       1         TRUE
# 9  2009-01-09      NA         TRUE
# 10 2009-01-10      NA         TRUE
# 11 2009-01-11      NA         TRUE
# 12 2009-01-12      NA         TRUE
# 13 2009-01-13      NA         TRUE
# 14 2009-01-14      NA         TRUE
# 15 2009-01-15      NA         TRUE
# 16 2009-01-16      NA           NA
# 17 2009-01-17      NA           NA
# 18 2009-01-18      NA           NA
# 19 2009-01-19      NA           NA

数据

dat <- read.table(text = "      date           oneweeksince victims
1    '2009-01-01'         FALSE      NA
                  2    '2009-01-02'         FALSE      NA
                  3    '2009-01-03'         FALSE      NA
                  4    '2009-01-04'         FALSE      NA
                  5    '2009-01-05'         FALSE      NA
                  6    '2009-01-06'         FALSE      NA
                  7    '2009-01-07'         FALSE      NA
                  8    '2009-01-08'          TRUE       1
                  9    '2009-01-09'          TRUE      NA
                  10   '2009-01-10'          TRUE      NA
                  11   '2009-01-11'          TRUE      NA
                  12   '2009-01-12'          TRUE      NA
                  13   '2009-01-13'          TRUE      NA
                  14   '2009-01-14'          TRUE      NA
                  15   '2009-01-15'          TRUE      NA
                  16   '2009-01-16'         FALSE      NA
                  17   '2009-01-17'         FALSE      NA
                  18   '2009-01-18'         FALSE      NA
                  19   '2009-01-19'         FALSE      NA
                  20   '2009-01-20'         FALSE      NA",
                  header = TRUE, stringsAsFactors = FALSE)

dat$oneweeksince <- NULL

我的第二次尝试

OP 指出，如果前 N 行中有条目，其中 N 是窗口宽度，我的解决方案将不起作用。在这里，我提供了一个解决方案来解决这个问题。我将使用相同的示例数据框，只是将第二行更改victims为1. 新的解决方案需要来自purrrand的函数tidyr，所以我为此加载了tidyverse包。

library(tidyverse)
library(zoo)

dat2 <- dat %>%
  mutate(roll = rollapplyr(victims, width = 8, FUN = function(x) mean(x, na.rm = TRUE), fill = NA)) %>%
  # Split the data frame for the first width - 1 rows and others
  mutate(GroupID = ifelse(row_number() <= 7, 1L, 2L)) %>%
  split(.$GroupID) %>%
  # Check if the GroupID is 1. If yes, change the roll column to be the same as victims
  # After that, use fill to fill in NA
  map_if(function(x) unique(x$GroupID) == 1L, 
         ~.x %>% mutate(roll = victims) %>% fill(roll)) %>%
  # Combine data frames
  bind_rows() %>%
  mutate(oneweeksince = roll > 0) %>%
  select(-roll)
# dat2
# date victims GroupID oneweeksince
# 1  2009-01-01      NA       1           NA
# 2  2009-01-02       1       1         TRUE
# 3  2009-01-03      NA       1         TRUE
# 4  2009-01-04      NA       1         TRUE
# 5  2009-01-05      NA       1         TRUE
# 6  2009-01-06      NA       1         TRUE
# 7  2009-01-07      NA       1         TRUE
# 8  2009-01-08       1       2         TRUE
# 9  2009-01-09      NA       2         TRUE
# 10 2009-01-10      NA       2         TRUE
# 11 2009-01-11      NA       2         TRUE
# 12 2009-01-12      NA       2         TRUE
# 13 2009-01-13      NA       2         TRUE
# 14 2009-01-14      NA       2         TRUE
# 15 2009-01-15      NA       2         TRUE
# 16 2009-01-16      NA       2           NA
# 17 2009-01-17      NA       2           NA
# 18 2009-01-18      NA       2           NA
# 19 2009-01-19      NA       2           NA
# 20 2009-01-20      NA       2           NA

数据

dat <- read.table(text = "      date           oneweeksince victims
1    '2009-01-01'         FALSE      NA
                  2    '2009-01-02'         FALSE       1
                  3    '2009-01-03'         FALSE      NA
                  4    '2009-01-04'         FALSE      NA
                  5    '2009-01-05'         FALSE      NA
                  6    '2009-01-06'         FALSE      NA
                  7    '2009-01-07'         FALSE      NA
                  8    '2009-01-08'          TRUE       1
                  9    '2009-01-09'          TRUE      NA
                  10   '2009-01-10'          TRUE      NA
                  11   '2009-01-11'          TRUE      NA
                  12   '2009-01-12'          TRUE      NA
                  13   '2009-01-13'          TRUE      NA
                  14   '2009-01-14'          TRUE      NA
                  15   '2009-01-15'          TRUE      NA
                  16   '2009-01-16'         FALSE      NA
                  17   '2009-01-17'         FALSE      NA
                  18   '2009-01-18'         FALSE      NA
                  19   '2009-01-19'         FALSE      NA
                  20   '2009-01-20'         FALSE      NA",
                  header = TRUE, stringsAsFactors = FALSE)

dat$oneweeksince <- NULL
于 2019-03-26T03:09:06.143 回答
1

我们可以做一个滚动求和并测试它是否大于 0：

library(RcppRoll)
your_data$result = roll_sum(
  x = your_data$victims,
  n = 8, 
  na.rm = TRUE,
  fill = 0,
  align = "right"
) > 0
your_data
#          date oneweeksince victims result
# 1  2009-01-01        FALSE      NA  FALSE
# 2  2009-01-02        FALSE      NA  FALSE
# 3  2009-01-03        FALSE      NA  FALSE
# 4  2009-01-04        FALSE      NA  FALSE
# 5  2009-01-05        FALSE      NA  FALSE
# 6  2009-01-06        FALSE      NA  FALSE
# 7  2009-01-07        FALSE      NA  FALSE
# 8  2009-01-08         TRUE       1   TRUE
# 9  2009-01-09         TRUE      NA   TRUE
# 10 2009-01-10         TRUE      NA   TRUE
# 11 2009-01-11         TRUE      NA   TRUE
# 12 2009-01-12         TRUE      NA   TRUE
# 13 2009-01-13         TRUE      NA   TRUE
# 14 2009-01-14         TRUE      NA   TRUE
# 15 2009-01-15         TRUE      NA   TRUE
# 16 2009-01-16        FALSE      NA  FALSE
# 17 2009-01-17        FALSE      NA  FALSE
# 18 2009-01-18        FALSE      NA  FALSE
# 19 2009-01-19        FALSE      NA  FALSE
# 20 2009-01-20        FALSE      NA  FALSE

使用这些数据：

your_data = read.table(header = T, text = '      date           oneweeksince victims
1    2009-01-01         FALSE      NA
2    2009-01-02         FALSE      NA
3    2009-01-03         FALSE      NA
4    2009-01-04         FALSE      NA
5    2009-01-05         FALSE      NA
6    2009-01-06         FALSE      NA
7    2009-01-07         FALSE      NA
8    2009-01-08          TRUE       1
9    2009-01-09          TRUE      NA
10   2009-01-10          TRUE      NA
11   2009-01-11          TRUE      NA
12   2009-01-12          TRUE      NA
13   2009-01-13          TRUE      NA
14   2009-01-14          TRUE      NA
15   2009-01-15          TRUE      NA
16   2009-01-16         FALSE      NA
17   2009-01-17         FALSE      NA
18   2009-01-18         FALSE      NA
19   2009-01-19         FALSE      NA
20   2009-01-20         FALSE      NA')
于 2019-03-26T03:04:56.403 回答
1

我更喜欢 Gregor 的回答，但这里有两种选择。

碱基R

x$y <- Sys.Date()[NA] # just a class-stable way
x$y[ !is.na(x$victims) ] <- x$date[ !is.na(x$victims) ]
x$since <- difftime(x$date, zoo::na.locf(x$y, na.rm = FALSE), units="days")
x$oneweeksince <- !is.na(x$since) & (0 <= x$since & x$since <= 7)

dplyr

library(dplyr)
x %>%
  mutate(
    y = zoo::na.locf(if_else(is.na(victims), date[NA], date), na.rm = FALSE),
    since = difftime(date, zoo::na.locf(if_else(is.na(victims), date[NA], date), na.rm = FALSE),
                     units = "days"),
    anotherweeksince = !is.na(since) & between(since, 0, 7)
  )

数据：

x <- read.table(stringsAsFactors=FALSE, header=TRUE, text="
      date           oneweeksince victims
1    2009-01-01         FALSE      NA
2    2009-01-02         FALSE      NA
3    2009-01-03         FALSE      NA
4    2009-01-04         FALSE      NA
5    2009-01-05         FALSE      NA
6    2009-01-06         FALSE      NA
7    2009-01-07         FALSE      NA
8    2009-01-08          TRUE       1
9    2009-01-09          TRUE      NA
10   2009-01-10          TRUE      NA
11   2009-01-11          TRUE      NA
12   2009-01-12          TRUE      NA
13   2009-01-13          TRUE      NA
14   2009-01-14          TRUE      NA
15   2009-01-15          TRUE      NA
16   2009-01-16         FALSE      NA
17   2009-01-17         FALSE      NA
18   2009-01-18         FALSE      NA
19   2009-01-19         FALSE      NA
20   2009-01-20         FALSE      NA")
x$date <- as.Date(x$date)
于 2019-03-26T03:06:47.673 回答
1

不确定效率，但在基础 R 中使用的一种方法sapply是，对于每一行，我们返回 7 行并检查它是否满足任何条件并相应地返回布尔输出。

sapply(seq_len(nrow(df)), function(x) {
    temp = df$victims[x : pmax(1, x - 7)]
    any(temp > 0) & any(!is.na(temp))
})

#[1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE 
#    TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE
于 2019-03-26T03:07:38.383 回答