I am trying to use dplyr in R to calculate rolling stats (mean, sd, etc) based on a dynamic window based on dates and for specific models. For instance, within groupings of items, I would like to calculate the rolling mean for all data 10 days prior. The dates on the data are not sequential and not complete so I can't use a fixed window.
One way to do this is use rollapply referencing the window width as shown below. However, I'm having trouble calculating the dynamic width. I'd prefer a method that omits the intermediate step of calculating the window and simply calculate based on the date_lookback. Here's a toy example.
I've used for loops to do this, but they are very slow.
library(dplyr)
library(zoo)
date_lookback <- 10 #days to look back for rolling calcs
df <- data.frame(label = c(rep("a",5),rep("b",5)),
date = as.Date(c("2017-01-02","2017-01-20",
"2017-01-21","2017-01-30","2017-01-31","2017-01-05",
"2017-01-08","2017-01-09","2017-01-10","2017-01-11")),
data = c(790,493,718,483,825,186,599,408,108,666),stringsAsFactors = FALSE) %>%
mutate(.,
cut_date = date - date_lookback, #calcs based on sample since this date
dyn_win = c(1,1,2,3,3,1,2,3,4,5), ##!! need to calculate this vector??
roll_mean = rollapply(data, align = "right", width = dyn_win, mean),
roll_sd = rollapply(data, align = "right", width = dyn_win, sd))
These are the roll_mean and roll_sd results I'm looking for:
> df
label date data cut_date dyn_win roll_mean roll_sd
1 a 2017-01-02 790 2016-12-23 1 790.0000 NA
2 a 2017-01-20 493 2017-01-10 1 493.0000 NA
3 a 2017-01-21 718 2017-01-11 2 605.5000 159.0990
4 a 2017-01-30 483 2017-01-20 3 564.6667 132.8847
5 a 2017-01-31 825 2017-01-21 3 675.3333 174.9467
6 b 2017-01-05 186 2016-12-26 1 186.0000 NA
7 b 2017-01-08 599 2016-12-29 2 392.5000 292.0351
8 b 2017-01-09 408 2016-12-30 3 397.6667 206.6938
9 b 2017-01-10 108 2016-12-31 4 325.2500 222.3921
10 b 2017-01-11 666 2017-01-01 5 393.4000 245.5928
Thanks in advance.
You could try explicitly referencing your dataset inside the dplyr call:
date_lookback <- 10 #days to look back for rolling calcs
df <- data.frame(label = c(rep("a",5),rep("b",5)),
date = as.Date(c("2017-01-02","2017-01-20",
"2017-01-21","2017-01-30","2017-01-31","2017-01-05",
"2017-01-08","2017-01-09","2017-01-10","2017-01-11")),
data = c(790,493,718,483,825,186,599,408,108,666),stringsAsFactors = FALSE)
df %>%
group_by(date,label) %>%
mutate(.,
roll_mean = mean(ifelse(df$date >= date-date_lookback & df$date <= date & df$label == label,
df$data,NA),na.rm=TRUE),
roll_sd = sd(ifelse(df$date >= date-date_lookback & df$date <= date & df$label == label,
df$data,NA),na.rm=TRUE))
Related
does anyone know if it is possible to use the na.approx function to interpolate depending on a varying timeframe ?
Let's suggest we have a df like (the real df has over 5'000 rows):
Date, Value
2022-05-01, 6
2022-05-02, 5
2022-05-03, NA
2022-05-06, NA
2022-05-07, 14
2022-05-08, 15
2022-05-09, NA
2022-05-10, 67
I want to conduct an linear interpolation depending on the date range. For example the two NA's at beginning: 1) 14-5 = 9, 2) Counting the days from 2022-05-02 until 2022-05-06 = 5 days, so we divide 3) 9/5 = 1.8.
Value for NA at 2022-05-03 is 6.8 and for 2022-05-06 is 8.6.
Second example at 2022-05-09: 1) 67-15 = 52, 2) 2022-05-08 until 2022-05-10 = 3 days, 3) 52/3 = 17.33333. Value for NA at 2022-05-09 is 32.33333 (= 15 + 17.33333)
Is this possible to conduct it with the na.approx function? If not, how can I approach this?
Using the data frame DF defined reproducibly in the Note at the end, we see that what is asked for, i.e. linear interpolation with respect to Date, is what you get (after correcting the calculations in the question) if you apply na.approx to a zoo series:
library(zoo)
z <- read.zoo(DF)
na.approx(z)
## 2022-05-01 2022-05-02 2022-05-03 2022-05-06 2022-05-07 2022-05-08 2022-05-09
## 6.0 5.0 6.8 12.2 14.0 15.0 41.0
## 2022-05-10
## 67.0
or in terms of the original data frame we can use the x= argument of na.approx to specify that interpolation is with respect to Date.
DF$Date <- as.Date(DF$Date)
transform(DF, Value = na.approx(Value, Date, na.rm = FALSE))
## Date Value
## 1 2022-05-01 6.0
## 2 2022-05-02 5.0
## 3 2022-05-03 6.8
## 4 2022-05-06 12.2
## 5 2022-05-07 14.0
## 6 2022-05-08 15.0
## 7 2022-05-09 41.0
## 8 2022-05-10 67.0
Suggest you review the documentation using ?na.approx from R.
Note
Lines <- "Date, Value
2022-05-01, 6
2022-05-02, 5
2022-05-03, NA
2022-05-06, NA
2022-05-07, 14
2022-05-08, 15
2022-05-09, NA
2022-05-10, 67"
DF <- read.csv(text = Lines, strip.white = TRUE)
I can do it with a bit of a slog, but I may need some help with the date diffs. For the first case there's 5 days between 02/05 & 07/05. In the second there's 2 days, not 3 between 08/05 & 10/05. Have I missed something? :)
Code below:
# get data into required shape, and using data.table package
df <- read.table(text="
Date, Value
2022-05-01, 6
2022-05-02, 5
2022-05-03, NA
2022-05-06, NA
2022-05-07, 14
2022-05-08, 15
2022-05-09, NA
2022-05-10, 67
", header=T)
library(data.table)
library(zoo)
library(lubridate)
dt <- as.data.table(df)
dt[, Date := lubridate::ymd(gsub(",","",`Date.`))]
setorder(dt, Date)
# first step, fill in to get the starting value
dt[, Value2 := zoo::na.locf0(Value)]
# group together the rows, only really interested in the NA ones,
# ensuring they are grouped together. rleid makes a group where it finds new values
dt[, Group := rleid(is.na(Value))]
# find the value after the NA
dt[, ValueNext := shift(Value2, n=1, type="lead")]
# find the dates before and after the NA period
dt[, DatePre := shift(Date, n=1, type="lag")]
dt[, DateNext := shift(Date, n=1, type="lead")]
# find the differences in the values & dates
dt[, ValueDiff := ValueNext[.N]-Value2[1], by=Group]
dt[, DateDiff := as.integer(DateNext[.N]-DatePre[1]), by=Group]
# divide through to get the addition
dt[, ValueAdd := ValueDiff/DateDiff]
# by group, use cumulative sum to add to the starting value
dt[, ValueOut := Value2+cumsum(ValueAdd), by=Group]
# we only care about NA groups, so revert back to original value for other
# cases
dt[!is.na(Value), ValueOut := Value]
# check the NA rows
# ! only difference is I get 2 as the date diff for 2022-05-09, not 3
dt[is.na(Value),]
# Final output
dt[, .(Date, Value, ValueOut)]
I am trying to get my existing observations to 10 min intervals in R.
I did this:
data3$date= ceiling_date(as.POSIXct(data3$betdate), unit = "10 minutes")
data3 %>% group_by(date, prov) %>%
summarise(cant=n())
But the problem with this code it is that if there is no observation for one interval, the interval will not appear in the output data, which have a lot of sense because there are no observations with the date in that interval. So i need to capture the information about that intervals that does not have observations registred. Any ideas? Already thanks to all of you.
See a simplified example of #Limey's comment, using just months and data.table
# set up fake data
set.seed(1000)
library(lubridate)
# create sequence, and save it as a data.frame so it has a header
months <- seq(ymd("2022-01-01"), ymd("2022-06-01"), by = "month")
# create fake data, and remove some rows
dat <- data.frame(month = months, values = sample(100:200, length(months)))
dat <- dat[-sample(1:length(months),3),]
dat
# month values
#1 2022-01-01 167
#4 2022-04-01 150
#6 2022-06-01 128
here we perform the merge and see the NAs representing missing observations
library(data.table)
setDT(dat)
months_listed <- data.frame(month = seq(min(dat$month), max(dat$month), by = "month"))
setDT(months_listed)
merge.data.table(months_listed, dat, by = "month", all.x = T)
# month values
#1: 2022-01-01 167
#2: 2022-02-01 NA
#3: 2022-03-01 NA
#4: 2022-04-01 150
#5: 2022-05-01 NA
#6: 2022-06-01 128
I want to split the line when the variable contain different YEAR,
also split the col : "Price" with evenly divided by the numbers of date appear
--> count (" ; ") +1
There is a table with the variable that is not yet be splitted.
# Dataset call df
Price Date
500 2016-01-01
400 2016-01-03;2016-01-09
1000 2016-01-04;2017-09-01;2017-08-10;2018-01-01
25 2016-01-04;2017-09-01
304 2015-01-02
238 2018-01-02;2018-02-02
Desire Outlook
# Targeted df
Price Date
500 2016-01-01
400 2016-01-03;2016-01-09
250 2016-01-04
250 2017-09-01
250 2017-08-10
250 2018-01-01
12.5 2016-01-04
12.5 2017-09-01
304 2015-01-02
238 2018-01-02;2018-02-02
Once the variable contains different year is defined , below is the operation
have to do .(It is just a example .)
mutate(Price = ifelse(DIFFERENT_DATE_ROW,
as.numeric(Price) / (str_count(Date,";")+1),
as.numeric(Price)),
Date = ifelse(DIFFERENT_DATE_ROW,
strsplit(as.character(Date),";"),
Date)) %>%
unnest()
I meet some constraints that cannot use dplyr's function "if_else" because
else NO operation cannot be recognized .Only ifelse work properly.
How to find out there is differences of the year in one variables to
PROVOKE the split line & split price calculations ?
so far the operation to split the element like
unlist(lapply(unlist(strsplit(df1$noFDate[8],";")),FUN = year))
cannot solve the problem.
I am beginner of coding , please feel free to change all operation above with considering the real data have over 2 million rows and 50 cols.
This might not be the most efficient one but can be used to get the required answer.
#Get the row indices which we need to separate
inds <- sapply(strsplit(df$Date, ";"), function(x)
#Format the date into year and count number of unique values
#Return TRUE if number of unique values is greater than 1
length(unique(format(as.Date(x), "%Y"))) > 1
)
library(tidyverse)
library(stringr)
#Select those indices
df[inds, ] %>%
# divide the price by number of dates in that row
mutate(Price = Price / (str_count(Date,";") + 1)) %>%
# separate `;` delimited values in separate rows
separate_rows(Date, sep = ";") %>%
# bind the remaining rows as it is
bind_rows(df[!inds,])
# Price Date
#1 250.0 2016-01-04
#2 250.0 2017-09-01
#3 250.0 2017-08-10
#4 250.0 2018-01-01
#5 12.5 2016-01-04
#6 12.5 2017-09-01
#7 500.0 2016-01-01
#8 400.0 2016-01-03;2016-01-09
#9 304.0 2015-01-02
#10 238.0 2018-01-02;2018-02-02
A bit cumbersome but you could do:
d_new = lapply(1:nrow(dat),function(x) {
a = dat[x,]
b = unlist(strsplit(as.character(a$Date),";"))
l = length(b)
if (l==1) check = 0 else check = ifelse(var(as.numeric(strftime(b,"%Y")))==0,0,1)
if (check==0) {
a
} else {
data.frame(Date = b, Price = rep(a$Price / l,l))
}
})
do.call(rbind,d_new)
I have a data frame in R in the following format:
(The dates are in the wrong format but I can change them fairly easily).
Now, I was wondering how I can perform operations on the data frame between certain dates - for example, say I want to find the average price for the day 5/18/2012, and then I want to find the average price for 5/19/2012, and then similarly for 5/20/2012, how would I go about doing so? Thanks in advance.
EDIT: One idea I did have was to use the identical(x,y) function to compare two dates, however since it is a very large data frame (about 300,000 rows) I'd prefer a more efficient way :)
You can try to group by date and do the average something like that :
library(dplyr);
data %>% group_by(RecordDate) %>% summarise(av = mean(Price));
You can use aggregate.
x <- Sys.time()
y <- seq(from = x, to = x + 5 * 3600*24, by = "day")
xy <- data.frame(date = rep(y, each = 5),
value = rnorm(length(y)))
aggregate(value ~ date, data = xy, FUN = mean)
date value
1 2017-01-28 10:07:29 0.2921081
2 2017-01-29 10:07:29 0.9039815
3 2017-01-30 10:07:29 0.5616696
4 2017-01-31 10:07:29 0.9297463
5 2017-02-01 10:07:29 0.5149972
6 2017-02-02 10:07:29 0.4353255
> aggregate(value ~ date, data = xy, FUN = length)
date value
1 2017-01-28 10:07:29 5
2 2017-01-29 10:07:29 5
3 2017-01-30 10:07:29 5
4 2017-01-31 10:07:29 5
5 2017-02-01 10:07:29 5
6 2017-02-02 10:07:29 5
I have the following dataframes:
AllDays
2012-01-01
2012-01-02
2012-01-03
...
2015-08-18
Leases
StartDate EndDate
2012-01-01 2013-01-01
2012-05-07 2013-05-06
2013-09-05 2013-12-01
What I want to do is, for each date in the allDays dataframe, calculate the number of leases that are in effect. e.g. if there are 4 leases with start date <= 2015-01-01 and end date >= 2015-01-01, then I would like to place a 4 in that dataframe.
I have the following code
for (i in 1:nrow(leases))
{
occupied = seq(leases$StartDate[i],leases$EndDate[i],by="days")
occupied = occupied[occupied < dateOfInt]
matching = match(occupied,allDays$Date)
allDays$Occupancy[matching] = allDays$Occupancy[matching] + 1
}
which works, but as I have about 5000 leases, it takes about 1.1 seconds. Does anyone have a more efficient method that would require less computation time?
Date of interest is just the current date and is used simply to ensure that it doesn't count lease dates in the future.
Using seq is almost surely inefficient--imagine you had a lease in your data that's 10000 years long. seq will take forever and return 10000*365-1 days that don't matter to us. We then have to use %in% which also makes the same number of unnecessary comparisons.
I'm not sure the following is the best approach (I'm convinced there's a fully vectorized solution) but it gets closer to the heart of the problem.
Data
set.seed(102349)
days<-data.frame(AllDays=seq(as.Date("2012-01-01"),
as.Date("2015-08-18"),"day"))
leases<-data.frame(StartDate=sample(days$AllDays,5000L,T))
leases$EndDate<-leases$StartDate+round(rnorm(5000,mean=365,sd=100))
Approach
Use data.table and sapply:
library(data.table)
setDT(leases); setDT(days)
days[,lease_count:=
sapply(AllDays,function(x)
leases[StartDate<=x&EndDate>=x,.N])][]
AllDays lease_count
1: 2012-01-01 5
2: 2012-01-02 8
3: 2012-01-03 11
4: 2012-01-04 16
5: 2012-01-05 18
---
1322: 2015-08-14 1358
1323: 2015-08-15 1358
1324: 2015-08-16 1360
1325: 2015-08-17 1363
1326: 2015-08-18 1359
This is exactly the problem where foverlaps shines: subsetting a data.frame based upon another data.frame (foverlaps seems to be tailored for that purpose).
Based on #MichaelChirico's data.
setkey(days[, AllDays1:=AllDays,], AllDays, AllDays1)
setkey(leases, StartDate, EndDate)
foverlaps(leases, days)[, .(lease_count=.N), AllDays]
# user system elapsed
# 0.114 0.018 0.136
# #MichaelChirico's approach
# user system elapsed
# 0.909 0.000 0.907
Here is a brief explanation on how it works by #Arun, which got me started with the data.table.
Without your data, I can't test whether or not this is faster, but it gets the job done with less code:
for (i in 1:nrow(AllDays)) AllDays$tally[i] = sum(AllDays$AllDays[i] >= Leases$Start.Date & AllDays$AllDays[i] <= Leases$End.Date)
I used the following to test it; note that the relevant columns in both data frames are formatted as dates:
AllDays = data.frame(AllDays = seq(from=as.Date("2012-01-01"), to=as.Date("2015-08-18"), by=1))
Leases = data.frame(Start.Date = as.Date(c("2013-01-01", "2012-08-20", "2014-06-01")), End.Date = as.Date(c("2013-12-31", "2014-12-31", "2015-05-31")))
An alternative approach, but I'm not sure it's faster.
library(lubridate)
library(dplyr)
AllDays = data.frame(dates = c("2012-02-01","2012-03-02","2012-04-03"))
Lease = data.frame(start = c("2012-01-03","2012-03-01","2012-04-02"),
end = c("2012-02-05","2012-04-15","2012-07-11"))
# transform to dates
AllDays$dates = ymd(AllDays$dates)
Lease$start = ymd(Lease$start)
Lease$end = ymd(Lease$end)
# create the range id
Lease$id = 1:nrow(Lease)
AllDays
# dates
# 1 2012-02-01
# 2 2012-03-02
# 3 2012-04-03
Lease
# start end id
# 1 2012-01-03 2012-02-05 1
# 2 2012-03-01 2012-04-15 2
# 3 2012-04-02 2012-07-11 3
data.frame(expand.grid(AllDays$dates,Lease$id)) %>% # create combinations of dates and ranges
select(dates=Var1, id=Var2) %>%
inner_join(Lease, by="id") %>% # join information
rowwise %>%
do(data.frame(dates=.$dates,
flag = ifelse(.$dates %in% seq(.$start,.$end,by="1 day"),1,0))) %>% # create ranges and check if the date is in there
ungroup %>%
group_by(dates) %>%
summarise(N=sum(flag))
# dates N
# 1 2012-02-01 1
# 2 2012-03-02 1
# 3 2012-04-03 2
Try the lubridate package. Create an interval for each lease. Then count the lease intervals which each date falls in.
# make some data
AllDays <- data.frame("Days" = seq.Date(as.Date("2012-01-01"), as.Date("2012-02-01"), by = 1))
Leases <- data.frame("StartDate" = as.Date(c("2012-01-01", "2012-01-08")),
"EndDate" = as.Date(c("2012-01-10", "2012-01-21")))
library(lubridate)
x <- new_interval(Leases$StartDate, Leases$EndDate, tzone = "UTC")
AllDays$NumberInEffect <- sapply(AllDays$Days, function(a){sum(a %within% x)})
The Output
head(AllDays)
Days NumberInEffect
1 2012-01-01 1
2 2012-01-02 1
3 2012-01-03 1
4 2012-01-04 1
5 2012-01-05 1
6 2012-01-06 1