Vectorizing Calculation of difference from lowest date value R - r

Question

I'm working on a dataframe which has 4 features, County, State, # COVID cases, and date. I want to add a column which calculates the number of days since the lowest date value for that county. I found a way to do it, but it requires a for loop and takes way too long to execute considering there are over 60k rows. I'm confused if and how I can calculate this in a vectored way so it takes a reasonable about of time.
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)
Edit: Here's an example of my data and the column I am trying to create.
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

We could subtract the current date with the minimum date for each County and 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
If you have record for each day, you can also count the row number from the first dat.
df %>%
mutate(Date = as.Date(Date)) %>%
arrange(County, State, Date) %>%
group_by(County, State) %>%
mutate(Days_since_first_case = row_number() - 1)

Answer 2

To answer your question, your code isn't vectorizing.
# get first date
firstDate <- countyCases[order(countyCases$date),]$date[1]
I think you are looping 60k times of this line. A potential improvement can be made is looping this line once for each group of country+state, rather than every single row.
Or you have a try of belowing data.table solution
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
Created on 2020-04-19 by the reprex package (v0.3.0)
I am not sure about the performance as the test below is still only 2 groups for the data. You can have a test on your real dataset.
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

Answer 3

Consider ave to find minimum by group and take the difference
df['days_since_first_case'] <- with(df, as.integer(Date - ave(Date, County, State, FUN=min)))
Alternatively, run aggregate + merge, then take the difference:
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)
})