Векторизация Расчет разницы от минимального значения даты R

Question

Я работаю над фреймом данных, который имеет 4 функции: County, State, # COVID cases и date. Я хочу добавить столбец, который рассчитывает количество дней с момента наименьшего значения даты для этого округа. Я нашел способ сделать это, но он требует для l oop и занимает слишком много времени для выполнения, учитывая, что строк более 60k. Я сбит с толку, если и как я могу рассчитать это векторным способом, так что это занимает разумное время.

daysSinceFirstCase <- function (x) {
    # create vector the length of the row count 
    vals <- 1:nrow(x)

    # for each row 
    for(i in 1:nrow(x)) {
        row <- x[i, ]
        # get occurrences of that county and state
        countyCases <- x[x$county == row$county & x$state == row$state,]

        # get first date
        firstDate <- countyCases[order(countyCases$date),]$date[1]

        #calculate difference
        diff <- as.integer(row$date - firstDate)

        #store difference
        vals[i] <- diff 
        print(i)
    }
    return(vals)
}
df['days_since_first_case'] <- daysSinceFirstCase(df)

Редактировать: Вот пример моих данных и столбца, который я пытаюсь создать.

Date       |  County      | State | Cases | Days since first case 
2020-03-14 | Philadelphia | PA    | 500   | 0
2020-03-15 | Philadelphia | PA    | 892   | 1
2020-03-16 | Philadelphia | PA    | 1502  | 2
2020-03-22 | Baltimore    | MD    | 12    | 0
2020-03-23 | Baltimore    | MD    | 152   | 1
2020-03-24 | Baltimore    | MD    | 348   | 2

Answer 1

Рассмотрим ave, чтобы найти минимум по группе и взять разницу

df['days_since_first_case'] <- with(df, as.integer(Date - ave(Date, County, State, FUN=min)))

В качестве альтернативы, запустите aggregate + merge, затем возьмите разницу:

df <- within(merge(df, aggregate(cbind(Min_Date=Date) ~ County + State, df, FUN=min),
                   by = c("County", "State")), {
                 days_since_first_case <- as.integer(Date - Min_Date)
                 rm(Min_Date)
             })

Answer 2

Мы можем вычесть текущую дату с минимальной датой для каждого County и State.

library(dplyr)

df %>%
  mutate(Date = as.Date(Date)) %>%
  group_by(County, State) %>%
  mutate(Days_since_first_case = as.integer(Date - min(Date)))


#  Date       County       State Cases Days_since_first_case
#  <date>     <chr>        <chr> <int>                 <int>
#1 2020-03-14 Philadelphia PA      500                     0
#2 2020-03-15 Philadelphia PA      892                     1
#3 2020-03-16 Philadelphia PA     1502                     2
#4 2020-03-22 Baltimore    MD       12                     0
#5 2020-03-23 Baltimore    MD      152                     1
#6 2020-03-24 Baltimore    MD      348                     2

Если у вас есть запись для каждого дня, вы также можете посчитать номер строки по первому номеру.

df %>%
  mutate(Date = as.Date(Date)) %>%
  arrange(County, State, Date) %>%
  group_by(County, State) %>%
  mutate(Days_since_first_case = row_number() - 1)

Answer 3

Чтобы ответить на ваш вопрос, ваш код не векторизован.

# get first date
firstDate <- countyCases[order(countyCases$date),]$date[1]

Я думаю, вы зациклили 60к раз этой строки. Потенциальное улучшение может быть сделано зацикливанием этой строки один раз для каждой группы страны + штата, а не для каждой отдельной строки.

Или у вас есть попытка опустить data.table решение

library(data.table)
library(lubridate)

dt <- fread('Date       |  County      | State | Cases | Days since first case 
2020-03-14 | Philadelphia | PA    | 500   | 0
2020-03-15 | Philadelphia | PA    | 892   | 1
2020-03-16 | Philadelphia | PA    | 1502  | 2
2020-03-22 | Baltimore    | MD    | 12    | 0
2020-03-23 | Baltimore    | MD    | 152   | 1
2020-03-24 | Baltimore    | MD    | 348   | 2')


dt[,Date:=ymd(Date)]

dt[,first_case_date:=Date[which(Cases==min(Cases))],by=.(County)]

dt
#>          Date       County State Cases Days since first case first_case_date
#> 1: 2020-03-14 Philadelphia    PA   500                     0      2020-03-14
#> 2: 2020-03-15 Philadelphia    PA   892                     1      2020-03-14
#> 3: 2020-03-16 Philadelphia    PA  1502                     2      2020-03-14
#> 4: 2020-03-22    Baltimore    MD    12                     0      2020-03-22
#> 5: 2020-03-23    Baltimore    MD   152                     1      2020-03-22
#> 6: 2020-03-24    Baltimore    MD   348                     2      2020-03-22

dt[,Days_since_first_case:= Date-first_case_date]

dt
#>          Date       County State Cases Days since first case first_case_date
#> 1: 2020-03-14 Philadelphia    PA   500                     0      2020-03-14
#> 2: 2020-03-15 Philadelphia    PA   892                     1      2020-03-14
#> 3: 2020-03-16 Philadelphia    PA  1502                     2      2020-03-14
#> 4: 2020-03-22    Baltimore    MD    12                     0      2020-03-22
#> 5: 2020-03-23    Baltimore    MD   152                     1      2020-03-22
#> 6: 2020-03-24    Baltimore    MD   348                     2      2020-03-22
#>    Days_since_first_case
#> 1:                0 days
#> 2:                1 days
#> 3:                2 days
#> 4:                0 days
#> 5:                1 days
#> 6:                2 days

^{Создано в 2020-04-19 пакетом Представить (v0.3.0)}

Я не уверен в производительности, так как тест ниже только 2 группы для данных. Вы можете проверить свой реальный набор данных.

library(data.table)
library(lubridate)
library(microbenchmark)

dt <- fread('Date       |  County      | State | Cases | Days since first case 
2020-03-14 | Philadelphia | PA    | 500   | 0
2020-03-15 | Philadelphia | PA    | 892   | 1
2020-03-16 | Philadelphia | PA    | 1502  | 2
2020-03-22 | Baltimore    | MD    | 12    | 0
2020-03-23 | Baltimore    | MD    | 152   | 1
2020-03-24 | Baltimore    | MD    | 348   | 2')

dt <- rbindlist(replicate(10000,dt,simplify = FALSE)) #60k records


dt[,Date:=ymd(Date)]

#key line for result
microbenchmark(dt[,first_case_date:=head(Date[which(Cases==min(Cases))],1),by=.(County)])
#> Unit: milliseconds
#>                                                                                      
#> expr: dt[, `:=`(first_case_date, head(Date[which(Cases == min(Cases))],1)), by = .(County)]
#>     min     lq     mean median     uq    max neval
#>  1.6829 1.7602 2.015732 1.8329 2.1797 4.3841   100