在R中，使用mutate（）根據組的條件創建新列

Question

對於每個人，有兩種類型的訪問，每次訪問都有日期記錄。 數據集如下所示。

p <-c(1,1,1,2,2,2,2,3,3,3,4)
type <- c(15,20,20,15,20,15,20,20,15,15,15)
date <- as.Date.factor(c("2014-02-03","2014-02-04","2014-02-06","2014-01-28","2014-02-03","2014-03-03","2014-03-13","2014-04-03","2014-04-09","2014-12-03","2014-04-05"))
d <- data.frame(p,type,date)

所以現在數據集看起來像這樣。

> d
   p type       date
1  1   15 2014-02-03
2  1   20 2014-02-04
3  1   20 2014-02-06
4  2   15 2014-01-28
5  2   20 2014-02-03
6  2   15 2014-03-03
7  2   20 2014-03-13
8  3   20 2014-04-03
9  3   15 2014-04-09
10 3   15 2014-12-03

現在，我想創建三個新列。

1. 指示在類型15訪問后7天內是否發生類型20訪問，如果是則則指示符為1，否則為0.（例如，對於p2，在第4行中，此值應為1，並且在第6行中，這個值應該是0）

2. 15型訪問后7天內第20次訪問的第一次約會是什么時候。 如果在類型15之后的7天內沒有20型訪問，則將其保持空白。 （例如，對於p1，該值應為2014-02-04而不是2014-02-06）

3. 15天訪問和20型訪問在7天內發生了多少天。 如果在類型15之后的7天內沒有類型20訪問，則保持空白。（例如，第1行中的值應為1）

我是R的超級新手，基本上不知道該怎么做。 我在組內嘗試了一個for循環，但它永遠不會起作用。

group_by(p)%>%
for(i in i:length(date)){
  *if(type[i]== 15 && date[i]+7 >= date[i+1:length(date)]){
  indicator = 1
  first_date = 
  days =* #Have no idea how to check in this part
} else {
  indicator = 0
  first_date = NA
  days = NA
}

預期產量如下。

   p type       date ind first_date days
1  1   15 2014-02-03   1 2014-02-04    1 # = 2014-02-04 - 2014-02-03  
2  1   20 2014-02-04  NA       <NA>   NA
3  1   20 2014-02-06  NA       <NA>   NA
4  2   15 2014-01-28   1 2014-02-03    6 # = 2014-02-03 - 2014-01-28   
5  2   20 2014-02-03  NA       <NA>   NA
6  2   15 2014-03-03   0       <NA>   NA # since (2014-03-13 - 2014-03-03) > 7   
7  2   20 2014-03-13  NA       <NA>   NA
8  3   20 2014-04-03  NA       <NA>   NA #I don't care about the value for type 20 lines
9  3   15 2014-04-09   0       <NA>   NA
10 3   15 2014-12-03   0       <NA>   NA

所以我提出了一個新想法。 如果我們按p和= = 15對記錄進行分組怎么辦。然后我們可以在組內使用減法作為天，其余的將很容易。

我找到了一種方法：

 d[,group:= cumsum(type ==15)]

但是，這將在遇到新的15類記錄時對組進行計數。 如何將p添加為另一個分組條件？

Answer 1

我抓住了這個。 但有一點需要注意：我的回答是假設在15次訪問后，7天內的下次訪問將是type_20訪問。 如果情況並非如此，即在7天內還有另一種15型訪問，則不會考慮第一次訪問類型15，並且只有第二種類型15訪問很重要：

library(dplyr)
library(tidyr)
library(lubridate)

d %>% 
  mutate(rownum = 1:n()) %>%
  spread(type, date, sep="_")  %>% 
  group_by(p) %>%
  mutate(ind = ifelse(lead(type_20) - type_15 <= 7, 1, 0)) %>%
  mutate(ind = ifelse(is.na(ind), 0, ind)) %>%
  mutate(ind = ifelse(is.na(type_15), NA, ind)) %>%
  mutate(first_date = ifelse(ind == 1, lead(type_20), NA)) %>%
  mutate(first_date = as.Date(first_date, origin = lubridate::origin)) %>%
  mutate(days = first_date - type_15) %>%
  gather("type", "date", type_15, type_20) %>% 
  filter(!is.na(date)) %>% 
  arrange(p, date) %>%
  select(p, type, date, ind, first_date, days)

#       p    type       date   ind first_date    days
#   <dbl>   <chr>     <date> <dbl>     <date>  <time>
#1      1 type_15 2014-02-03     1 2014-02-04  1 days
#2      1 type_20 2014-02-04    NA       <NA> NA days
#3      1 type_20 2014-02-06    NA       <NA> NA days
#4      2 type_15 2014-01-28     1 2014-02-03  6 days
#5      2 type_20 2014-02-03    NA       <NA> NA days
#6      2 type_15 2014-03-03     0       <NA> NA days
#7      2 type_20 2014-03-13    NA       <NA> NA days
#8      3 type_20 2014-04-03    NA       <NA> NA days
#9      3 type_15 2014-04-09     0       <NA> NA days
#10     3 type_15 2014-12-03     0       <NA> NA days

讓我試着解釋一下我在做什么：

首先，傳播type和date列，以便類型和日期顯示在單獨的列中（這樣可以更容易地比較兩種不同類型的日期）。 接下來，幾個變異。 前三個應用問題中列出的條件如下：如果lead(type_20) - type_15 <= 7)這意味着在15型訪問的7天內有20型訪問，所以我們將其標記為1，否則我們標記為0.在此之后，如果ind是NA ，我們假設沒有找到20型訪問，所以我們也將其標記為0.在第三次變異中，我們將15種NA行標記為NA。

接下來的三個mutate行添加了問題中2和3中列出的列。

最后，將列回收到先前的格式，過濾掉冗余行，按p和日期排列數據幀，並選擇所需的列。

我希望這很清楚。 逐行運行代碼，停止在每行之后查看轉換后的數據框以查看轉換如何對數據幀起作用可能會有所幫助。

Answer 2

這是一個基本的R方式。 一般來說，我更喜歡創建一個執行任務的函數，然后可以在其他部分上重復這些函數，並在看起來不起作用的測試用例上進行調試。

第一步是定義碎片：

d <- structure(list(p = c(1, 1, 1, 2, 2, 2, 2, 3, 3, 3),
                    type = c(15, 20, 20, 15, 20, 15, 20, 20, 15, 15),
                    date = structure(c(16104, 16105, 16107, 16098, 16104, 16132, 16142, 16163, 16169, 16407), class = "Date")),
               .Names = c("p", "type", "date"),
               row.names = c(NA, -10L), class = "data.frame")

id <- with(d, {
  id <- ave(type, p, FUN = function(x) cumsum(x == 15))
  factor(paste0(p, id), unique(paste0(p, id)))
})

sp <- split(d, id)

因此， sp創建了一個我們將應用函數的數據框列表。 每個部分都是一個唯一的p ，最多只有一種type == 15 （加上很多type == 20秒跟隨。

前兩件是

sp[1:2]

# $`11`
#   p type       date
# 1 1   15 2014-02-03
# 2 1   20 2014-02-04
# 3 1   20 2014-02-06
# 
# $`21`
#   p type       date
# 4 2   15 2014-01-28
# 5 2   20 2014-02-03

我們可以在每個上面應用以下功能

first_date(sp[[1]])

#   p type       date ind first_date days
# 1 1   15 2014-02-03   1 2014-02-04    1
# 2 1   20 2014-02-04  NA       <NA>   NA
# 3 1   20 2014-02-06  NA       <NA>   NA

first_date(sp[[2]])

#   p type       date ind first_date days
# 4 2   15 2014-01-28   1 2014-02-03    6
# 5 2   20 2014-02-03  NA       <NA>   NA

或者一次循環

(sp1 <- lapply(sp, first_date))
`rownames<-`(do.call('rbind', sp1), NULL)

#    p type       date ind first_date days
# 1  1   15 2014-02-03   1 2014-02-04    1
# 2  1   20 2014-02-04  NA       <NA>   NA
# 3  1   20 2014-02-06  NA       <NA>   NA
# 4  2   15 2014-01-28   1 2014-02-03    6
# 5  2   20 2014-02-03  NA       <NA>   NA
# 6  2   15 2014-03-03   0       <NA>   NA
# 7  2   20 2014-03-13  NA       <NA>   NA
# 8  3   20 2014-04-03  NA       <NA>   NA
# 9  3   15 2014-04-09   0       <NA>   NA
# 10 3   15 2014-12-03   0       <NA>   NA

您可以利用參數，例如window或您添加的任何其他參數，而無需更改大部分功能，例如，更改窗口

(sp2 <- lapply(sp1, first_date, window = 14))
`rownames<-`(do.call('rbind', sp2), NULL)

#    p type       date ind first_date days ind first_date days
# 1  1   15 2014-02-03   1 2014-02-04    1   1 2014-02-04    1
# 2  1   20 2014-02-04  NA       <NA>   NA  NA       <NA>   NA
# 3  1   20 2014-02-06  NA       <NA>   NA  NA       <NA>   NA
# 4  2   15 2014-01-28   1 2014-02-03    6   1 2014-02-03    6
# 5  2   20 2014-02-03  NA       <NA>   NA  NA       <NA>   NA
# 6  2   15 2014-03-03   0       <NA>   NA   1 2014-03-13   10
# 7  2   20 2014-03-13  NA       <NA>   NA  NA       <NA>   NA
# 8  3   20 2014-04-03  NA       <NA>   NA  NA       <NA>   NA
# 9  3   15 2014-04-09   0       <NA>   NA   0       <NA>   NA
# 10 3   15 2014-12-03   0       <NA>   NA   0       <NA>   NA

---

first_date <- function(data, window = 7) {
  nr <- nrow(data)

  ## check at least one type 15 and > 1 row
  ty15 <- data$type == 15
  dt15 <- data$date[ty15]

  if (!any(ty15) | nr == 1L)
    return(cbind(data, ind = ifelse(any(ty15), 0, NA),
                 first_date = NA, days = NA))

  ## first date vector
  dts <- rep(min(data$date[!ty15]), nr)
  dts[!ty15] <- NA

  ## days from the type 15 date
  days <- as.numeric(data$date[!ty15] - min(dt15))
  days <- c(days, rep(NA, nr - length(days)))

  ## convert to NA if criteria not met
  to_na <- days > window | is.na(dts)
  days[to_na] <- dts[to_na] <- NA

  ## ind vector -- 1 or 0 if type 15, NA otherwise
  ind <- rep(NA, nr)
  ind[ty15] <- as.integer(!is.na(dts[ty15]))

  ## combine
  cbind(data, ind = ind, first_date = dts, days = days)
}

Answer 3

如果你願意使用purrr包中的一些函數並使用一些自定義函數，這是另一種選擇......

你需要的套餐

library(dplyr)
library(purrr)

設置數據（根據問題）

p <-c(1,1,1,2,2,2,2,3,3,3)
type <- c(15,20,20,15,20,15,20,20,15,15)
date <- as.Date.factor(c("2014-02-03","2014-02-04","2014-02-06","2014-01-28","2014-02-03","2014-03-03","2014-03-13","2014-04-03","2014-04-09","2014-12-03"))
d <- data.frame(cbind(p,type,date))
d$date = as.Date(date)

創建將與purrr map_*函數一起使用的自定義函數，以迭代數據框並創建ind和first_date 。

# Function to manage ind
ind_manager <- function(type, date, dates_20) {
  if (type == 20)
    return (NA_integer_)

  checks <- map_lgl(dates_20, between, date, date + 7)
  return (as.integer(any(checks)))
}

# Function to manage first_date
first_date_manager <- function(ind, date, dates_20) {
  if (is.na(ind) || ind != 1)
    return (NA_character_)

  dates_20 <- dates_20[order(dates_20)]
  as.character(dates_20[which.max(date < dates_20)])
}

保存type == 20的日期向量以用作比較

dates_20 <- d$date[d$type == 20]

最后的mutate()調用

# mutate() call to create variables
d %>% 
  mutate(
    ind = map2_int(type, date, ind_manager, dates_20),
    first_date = as.Date(map2_chr(ind, date, first_date_manager, dates_20)),
    days = as.integer(first_date - date)
  )
#>    p type       date ind first_date days
#> 1  1   15 2014-02-03   1 2014-02-04    1
#> 2  1   20 2014-02-04  NA       <NA>   NA
#> 3  1   20 2014-02-06  NA       <NA>   NA
#> 4  2   15 2014-01-28   1 2014-02-03    6
#> 5  2   20 2014-02-03  NA       <NA>   NA
#> 6  2   15 2014-03-03   0       <NA>   NA
#> 7  2   20 2014-03-13  NA       <NA>   NA
#> 8  3   20 2014-04-03  NA       <NA>   NA
#> 9  3   15 2014-04-09   0       <NA>   NA
#> 10 3   15 2014-12-03   0       <NA>   NA