Good day,
This is a continuation question to this post
Here are some dummy data:
Date <- as.POSIXct(c('2018-03-20 11:52:25', '2018-03-22 12:01:44', '2018-03-20 12:05:25', '2018-03-20 12:10:40', '2018-03-20 12:12:51 ', '2018-03-21 2:01:23', '2018-03-21 2:45:01', '2018-03-21 3:30:00', '2018-03-21 3:45:00', '2018-03-21 5:00:00', '2018-03-21 5:45:00'))
Sites<-c(4, 4, 4, 6, 6, 7, 7, 4, 4, 6, 6)
Individual<-c("A", "A", "A", "A", "A", "A", "A", "A", "A", "A","A")
data<-data.frame(Individual, Date, Sites)
Individual Date Sites
A 2018-03-20 11:52:25 4
A 2018-03-22 12:01:44 4
A 2018-03-20 12:05:25 4
A 2018-03-20 12:10:40 6
A 2018-03-20 12:12:51 6
A 2018-03-21 02:01:23 7
A 2018-03-21 02:45:01 7
A 2018-03-21 03:30:00 4
A 2018-03-21 03:45:00 4
A 2018-03-21 05:00:00 6
A 2018-03-21 05:45:00 6
Basically, I would like R to tell me how much time is spent at each site. The data above, have repeating instances at sites and I would like R to tease out the repetitions and add the time differences for each.
I have tried the following code:
data.summary<-data %>%
group_by(Individual, Sites) %>%
summarise(time_spent = max(Date)-min(Date))
But this will take a time difference from just the minimum date at that site and the maximum date at the site, not accounting for instances of repetition, or times that the individual is at other sites.
Digging further into the dummy data, the summarize code says that individual A spent 2 days at site 4. However that individual left site 4 and reentered the site at a later date and should have a total time at site 4 of 28 minutes. How can I get R to reflect repetitive entries for that site?
Date1<-as.POSIXct("2018-03-20 11:52:25") # First instance at site 4
Date2<-as.POSIXct("2018-03-20 12:05:25") # Last time A spent at site 4 before leaving
difftime(Date2, Date1, units="mins")
# time diff = 13 minutes
# Second instance at site 4
Date3<-as.POSIXct("2018-03-21 03:30:00") # Second instance at site 4
Date4<-as.POSIXct("2018-03-21 03:45:00") # Last time A spent at site 4
difftime(Date4, Date3, units="mins")
# time diff= 15 mins
Thanks!
EDIT: I'm finding an issue with dplyr summarise, where extra time is being added. Here are dummy data:
Dates<-as.POSIXct(c("2018-04-09 16:59:03",
"2018-04-09 18:27:23",
"2018-04-09 17:01:20",
"2018-04-09 17:41:17"))
Individual<-c("A","A","A","A")
Site<-c("40","40","40", "40")
data<-data.frame(Dates, Individual, Site)
I want to summarize the time spent at site 40, with the minimum time stamp at this site subtracted from the maximum time stamp at the site
data %>%
group_by(Individual) %>%
arrange(Dates) %>%
group_by(Individual, Site) %>%
summarise(time_spent = max(Dates) - min(Dates))
# A tibble: 1 x 3
# Groups: Individual [?]
Individual Site time_spent
<fct> <fct> <time>
1 A 40 1.472222 hours
This says the total time spent at this site is 1.47 hours. However, when I manually get a time difference I get an entirely different value.
maxtime<-("2018-04-09 17:41:17")
mintime<-("2018-04-09 16:59:03")
difftime(maxtime, mintime, units="hours")
# Time difference of 0.7038889 hours
The actual time at site 40 is 0.70 hours. I'm not quite sure what summarise is referencing, or why extra time is being added.
EDIT 2: Okay, this looks like a units issue! Here is more reproducible data:
Dates<-as.POSIXct(c("2018-04-09 16:43:44","2018-03-20 11:52:25", "2018-04-09 16:59:03",
"2018-04-09 18:27:23",
"2018-04-09 17:01:20",
"2018-04-09 17:41:17"))
Individual<-c("A","A","A","A", "A","A")
Site<-c("38","38", "40","40","40", "40")
data<-data.frame(Dates, Individual, Site)
Dates Individual Site
1 2018-04-09 16:43:44 A 38
2 2018-03-20 11:52:25 A 38
3 2018-04-09 16:59:03 A 40
4 2018-04-09 18:27:23 A 40
5 2018-04-09 17:01:20 A 40
6 2018-04-09 17:41:17 A 40
data %>%
group_by(Individual) %>%
arrange(Dates) %>%
group_by(Individual, Site) %>%
summarise(time_spent = max(Dates) - min(Dates))
# A tibble: 2 x 3
# Groups: Individual [?]
Individual Site time_spent
<fct> <fct> <time>
1 A 38 20.202303 days
2 A 40 1.472222 days
Here, it says time spent at site 40 is 1.47 days, but this should be hours! According to manually finding time differences below:
maxtime<-("2018-04-09 18:27:23")
mintime<-("2018-04-09 16:59:03")
difftime(maxtime, mintime, units="hours")
# Time difference of 1.472222 hours
How can I correct this units issue? Instead of displaying hours intermixed with days, I would like R to calculate the time for all sites in days.
EDITED SOLUTION: after some trial and error this is what ended up working. This uses a function from data.table so you'll need to have that installed.
Step 1: create a unique ID for all site observations (by site), ordered by Date
data %>%
arrange(Individuals, Dates) %>%
mutate(rle_id = data.table::rleid(Sites))
Dates Individuals Sites rle_id
1 2018-03-20 11:52:25 A 38 1
2 2018-04-09 16:43:44 A 38 1
3 2018-04-09 16:59:03 A 40 2
4 2018-04-09 17:01:20 A 40 2
5 2018-04-09 17:41:17 A 40 2
6 2018-04-09 18:27:23 A 40 2
7 2018-03-20 11:52:25 B 4 3
8 2018-03-20 12:05:25 B 4 3
9 2018-03-20 12:10:40 B 6 4
10 2018-03-20 12:12:51 B 6 4
11 2018-03-21 02:01:23 B 7 5
12 2018-03-21 02:45:01 B 7 5
13 2018-03-21 03:30:00 B 4 6
14 2018-03-21 03:45:00 B 4 6
15 2018-03-21 05:00:00 B 6 7
16 2018-03-21 05:45:00 B 6 7
17 2018-03-22 12:01:44 B 4 8
You could get the relid using something in base like what I have pasted below, but it is probably much slower (and harder to understand)
data <- data[order(data$Dates),]
rle_lengths <- rle(data$Sites)$lengths
unlist(Map(rep, 1:length(rle_lengths), rle_lengths))
[1] 1 2 2 3 3 4 4 5 5 6 6 7 8 9 9 9 9
vs.
data.table::rleid(data$Sites)
[1] 1 2 2 3 3 4 4 5 5 6 6 7 8 9 9 9 9
Step 2: get the time for individual A and B at each site. If we did not specify the units in difftime, it will do the calculation on individual units and display a common unit. E.g., 1.5 hours becomes 1.5 days if there is a someone there for several days.
data %>%
arrange(Individuals, Dates) %>%
mutate(rle_id = data.table::rleid(Sites)) %>%
group_by(Individuals, rle_id, Sites) %>%
summarise(time_spent = difftime(max(Dates), min(Dates), units = "days"))
# A tibble: 8 x 4
# Groups: Individuals, rle_id [8]
Individuals rle_id Sites time_spent
<fct> <int> <dbl> <time>
1 A 1 38 20.202303241 days
2 A 2 40 0.061342593 days
3 B 3 4 0.009027778 days
4 B 4 6 0.001516204 days
5 B 5 7 0.030300926 days
6 B 6 4 0.010416667 days
7 B 7 6 0.031250000 days
8 B 8 4 0.000000000 days
Step 3 (full solution): collapse across sites
data %>%
arrange(Individuals, Dates) %>%
mutate(rle_id = data.table::rleid(Sites)) %>%
group_by(Individuals, rle_id, Sites) %>%
summarise(time_spent = difftime(max(Dates), min(Dates), units = "days")) %>%
group_by(Individuals, Sites) %>%
summarise(time_spent_new = sum(time_spent))
# A tibble: 5 x 3
# Groups: Individuals [2]
Individuals Sites time_spent_new
<fct> <dbl> <time>
1 A 38 20.20230324 days
2 A 40 0.06134259 days
3 B 4 0.01944444 days
4 B 6 0.03276620 days
5 B 7 0.03030093 days
Data
Date <-as.POSIXct(c("2018-04-09 16:43:44","2018-03-20 11:52:25", "2018-04-09 16:59:03",
"2018-04-09 18:27:23","2018-04-09 17:01:20", "2018-04-09 17:41:17",
'2018-03-20 11:52:25', '2018-03-22 12:01:44', '2018-03-20 12:05:25',
'2018-03-20 12:10:40', '2018-03-20 12:12:51 ', '2018-03-21 2:01:23',
'2018-03-21 2:45:01', '2018-03-21 3:30:00', '2018-03-21 3:45:00',
'2018-03-21 5:00:00', '2018-03-21 5:45:00'))
Individual<-c(rep("A", 6), rep("B", 11))
Site<-c(38, 38, 40, 40, 40, 40, 4, 4, 4, 6, 6, 7, 7, 4, 4, 6, 6)
data<-data.frame(Dates = Date, Individuals = Individual, Sites = Site)
Related
In my longitudinal data set, each row represents a time period of observation for each person, and each row is bounded by a start and end date. The rows are numbered ('episode'), and contain many row-specific variables (eg, 'edu_level') that I need to retain throughout the following steps.
I created a new date variable, hx_start, which can relate to the start and end date of each row of data in 1 of 3 ways (below). For each scenario, I need to edit (splice) the existing row of data accordingly, using dplyr:
1. Between a given row's start and end date (ie, as it does for persons 2 and 4)
In this case, I want to splice the existing row into two new ones, so that the date of
hx_start is the start date of one of the rows. The other row would retain the original row's
start date and its end date would be one day before the date of hx_start.
2. On the same date as someone's row start date (ie, person 1)
In this case, no change is needed.
3. On the same date as someone's row end date (ie, person 3)
Same as #1: I need to splice the existing row into two new ones, so that the date of hx_start
is the start date of one of the rows. The other row would retain the original row's
start date and its end date would be one day before the date of hx_start.
So far, I have created a new data set that has 2 duplicates of each row, assuming that I will need to edit up to 2 rows per existing row, and then drop the originals (or retain only the original, in the case of person 1). Importantly, I need a way to carry forward all of the other variables from the original row to all new rows without naming them all, if possible (there are many in my real data set).
#Load packages
library(lubridate)
#>
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:base':
#>
#> date, intersect, setdiff, union
#Create data set
person <- c(1, 2, 3, 4)
episode <- c(33, 50, 65, 70)
start <- c('2013-01-01', '2010-01-21', '2009-09-18', '2010-05-26')
end <- c('2013-06-04', '2010-06-19', '2009-12-31', '2010-12-24')
hx_start <- c('2013-01-01', '2010-03-09', '2009-12-31', '2010-07-04')
edu_level <- c(2, 3, 2, 1)
#Populate data frame
d <- cbind(person, episode, start, hx_start, end, edu_level)
d <- as.data.frame(d)
#Format dates and add to data frame
d$start <- as.Date(start, format = '%Y-%m-%d')
d$end <- as.Date(end, format = '%Y-%m-%d')
d$hx_start <- as.Date(hx_start, format = '%Y-%m-%d')
#Create 2 duplicates of this row for each person
d1 <- d[rep(seq_len(nrow(d)), each = 3), ]
d1
#> person episode start hx_start end edu_level
#> 1 1 33 2013-01-01 2013-01-01 2013-06-04 2
#> 1.1 1 33 2013-01-01 2013-01-01 2013-06-04 2
#> 1.2 1 33 2013-01-01 2013-01-01 2013-06-04 2
#> 2 2 50 2010-01-21 2010-03-09 2010-06-19 3
#> 2.1 2 50 2010-01-21 2010-03-09 2010-06-19 3
#> 2.2 2 50 2010-01-21 2010-03-09 2010-06-19 3
#> 3 3 65 2009-09-18 2009-12-31 2009-12-31 2
#> 3.1 3 65 2009-09-18 2009-12-31 2009-12-31 2
#> 3.2 3 65 2009-09-18 2009-12-31 2009-12-31 2
#> 4 4 70 2010-05-26 2010-07-04 2010-12-24 1
#> 4.1 4 70 2010-05-26 2010-07-04 2010-12-24 1
#> 4.2 4 70 2010-05-26 2010-07-04 2010-12-24 1
Created on 2022-03-23 by the reprex package (v2.0.0)
You can do this by creating a small helper function. I've done this using data.table formatting
library(data.table)
f <- function(s,m,e) {
if(m>s) return(list("start" = c(m,s),"hx_start" = c(m,m),"end" = c(e,m-1)))
if(m == s) return (list("start" = s,"hx_start" = m,"end" =e))
}
setDT(d)[,!c(3:5)][d[ ,f(start,hx_start,end), by=person], on=.(person)]
Output:
person episode edu_level start hx_start end
1: 1 33 2 2013-01-01 2013-01-01 2013-06-04
2: 2 50 3 2010-03-09 2010-03-09 2010-06-19
3: 2 50 3 2010-01-21 2010-03-09 2010-03-08
4: 3 65 2 2009-12-31 2009-12-31 2009-12-31
5: 3 65 2 2009-09-18 2009-12-31 2009-12-30
6: 4 70 1 2010-07-04 2010-07-04 2010-12-24
7: 4 70 1 2010-05-26 2010-07-04 2010-07-03
Notice that:
For person 2,4, one row now has hx_start as the start date, and the other row has the original start date, while the end date is one day before the hx_start date.
For person 1, there has been no change
For person 3, one row now has hx_start as the start date, and the other row has the original start date, while the end date is one day before the hx_start date.
Tidyverse option (also uses function above)
inner_join(
d %>% select(-c(start,hx_start,end)),
d %>%
rowwise() %>%
summarize(person = max(person),
dates = list(f(start,hx_start,end))) %>%
unnest_wider(dates) %>%
unnest(cols=everything()),
by = "person"
)
Output:
person episode edu_level start hx_start end
1: 1 33 2 2013-01-01 2013-01-01 2013-06-04
2: 2 50 3 2010-03-09 2010-03-09 2010-06-19
3: 2 50 3 2010-01-21 2010-03-09 2010-03-08
4: 3 65 2 2009-12-31 2009-12-31 2009-12-31
5: 3 65 2 2009-09-18 2009-12-31 2009-12-30
6: 4 70 1 2010-07-04 2010-07-04 2010-12-24
7: 4 70 1 2010-05-26 2010-07-04 2010-07-03
I have a database containing a list of events. Each event has an associated start date, and a date when the event ended or was completed, eg:
dataset <- tibble(
eventid = sample(1:100, 25, replace=TRUE),
start_date = sample(seq(as.Date('2011/01/01'), as.Date('2012/01/01'), by="day"), 25),
completed_date = sample(seq(as.Date('2012/01/01'), as.Date('2014/01/01'), by="day"), 25)
)
> dataset
# A tibble: 25 x 3
eventid start_date completed_date
<int> <date> <date>
1 57 2011-01-14 2013-01-07
2 97 2011-01-21 2011-03-03
3 58 2011-01-26 2011-02-05
4 25 2011-03-22 2013-07-20
5 8 2011-04-20 2012-07-16
6 81 2011-04-26 2013-03-04
7 42 2011-05-02 2012-01-16
8 77 2011-05-03 2012-08-14
9 78 2011-05-21 2013-09-26
10 49 2011-05-22 2013-01-04
# ... with 15 more rows
>
I am trying to produce a rolling "snapshot" of how many tasks were pending a different points in time, e.g. month by month. Expected result:
# A tibble: 25 x 2
month count
<date> <int>
1 2011-01-01 0
2 2011-02-01 3
3 2011-03-01 2
4 2011-04-01 2
5 2011-05-01 4
6 2011-06-01 8
I have attempted to group my variables using group_by(period=floor_date(start_date,"month")), but I'm a bit stuck and would appreciate a pointer in the right direction!
I would prefer a solution using dplyr if possible.
Thanks!
You can expand rows for each month included in the range of dates with map2 from purrr. map2 will iterate over multiple inputs simultaneously. In this case, it will iterate through the start and end dates at the same time.
In each iteration, if will create a monthly sequence using seq (or seq.Date) from start to end month (determined from floor_date). The result is nested for each row of data (since one row can have multiple months in the sequence). So, unnest is needed afterwards.
The transmute will add a new variable called month_year (and drop the old ones) and use substr to extract the year and month only (no day). This is the first through seventh character of the date.
Then, you can group_by the month-year and count up the number of pending projects for each month_year.
I included set.seed to reproduce from data below.
library(dplyr)
library(tidyr)
library(purrr)
library(lubridate)
dataset %>%
mutate(month = map2(floor_date(start_date, "month"),
floor_date(completed_date, "month"),
seq.Date,
by = "month")) %>%
unnest(month) %>%
transmute(month_year = substr(month, 1, 7)) %>%
group_by(month_year) %>%
summarise(count = n())
Output
month_year count
<chr> <int>
1 2011-01 1
2 2011-02 3
3 2011-03 9
4 2011-04 10
5 2011-05 13
6 2011-06 15
7 2011-07 16
8 2011-08 18
9 2011-09 19
10 2011-10 20
# … with 22 more rows
If you want to exclude the completed month (except when start month and completed month are the same, if that can exist), you can subtract 1 month from the sequence of months created. In this case, you can use pmax so that if both start and end months are the same, it will still count the month).
Here is the modified mutate with map2:
mutate(month = map2(floor_date(start_date, "month"),
pmax(floor_date(completed_date, "month") - 1, floor_date(start_date, "month")),
seq.Date,
by = "month"))
Data
set.seed(123)
dataset <- tibble(
eventid = sample(1:100, 25, replace=TRUE),
start_date = sample(seq(as.Date('2011/01/01'), as.Date('2012/01/01'), by="day"), 25),
completed_date = sample(seq(as.Date('2012/01/01'), as.Date('2014/01/01'), by="day"), 25)
)
So I have some data with a time stamp, and for each row, I want to count the number of rows that fall within a certain time window. For example, if I have the data below with a time stamp in h:mm (column ts), I want to count the number of rows that occur from that time stamp to five minutes in the past (column count). The first n rows that are less than five minutes from the first data point should be NAs.
ts data count
1:01 123 NA
1:02 123 NA
1:03 123 NA
1:04 123 NA
1:06 123 5
1:07 123 5
1:10 123 3
1:11 123 4
1:12 123 4
This is straightforward to do with a for loop, but I've been trying to implement with the apply() family and have not yet found any success. Any suggestions?
EDIT: modified to account for the potential for multiple readings per minute, raised in comment.
Data with new mid-minute reading:
library(dplyr)
df %>%
# Take the text above and convert to datetime
mutate(ts = lubridate::ymd_hms(paste(Sys.Date(), ts))) %>%
# Count how many observations per minute
group_by(ts_min = lubridate::floor_date(ts, "1 minute")) %>%
summarize(obs_per_min = sum(!is.na(data))) %>%
# Add rows for any missing minutes, count as zero observations
padr::pad(interval = "1 min") %>%
replace_na(list(obs_per_min = 0)) %>%
# Count cumulative observations, and calc how many in window that
# begins 5 minutes ago and ends at end of current minute
mutate(cuml_count = cumsum(obs_per_min),
prior_cuml = lag(cuml_count) %>% tidyr::replace_na(0),
in_window = cuml_count - lag(prior_cuml, 5)) %>%
# Exclude unneeded columns and rows
select(-cuml_count, -prior_cuml) %>%
filter(obs_per_min > 0)
Output (now reflects add'l reading at 1:06:30)
# A tibble: 12 x 3
ts_min obs_per_min in_window
<dttm> <dbl> <dbl>
1 2018-09-26 01:01:00 1 NA
2 2018-09-26 01:02:00 1 NA
3 2018-09-26 01:03:00 1 NA
4 2018-09-26 01:04:00 1 NA
5 2018-09-26 01:06:00 2 6
6 2018-09-26 01:07:00 1 6
7 2018-09-26 01:10:00 1 4
8 2018-09-26 01:11:00 1 5
9 2018-09-26 01:12:00 1 4
I am trying to get a count of active clients per month, using data that has a start and end date to each client's episode. The code I am using I can't work out how to count per month, rather than per every n days.
Here is some sample data:
Start.Date <- as.Date(c("2014-01-01", "2014-01-02","2014-01-03","2014-01-03"))
End.Date<- as.Date(c("2014-01-04", "2014-01-03","2014-01-03","2014-01-04"))
Make sure the dates are dates:
Start.Date <- as.Date(Start.Date, "%d/%m/%Y")
End.Date <- as.Date(End.Date, "%d/%m/%Y")
Here is the code I am using, which current counts the number per day:
library(plyr)
count(Reduce(c, Map(seq, start.month, end.month, by = 1)))
which returns:
x freq
1 2014-01-01 1
2 2014-01-02 2
3 2014-01-03 4
4 2014-01-04 2
The "by" argument can be changed to be however many days I want, but problems arise because months have different lengths.
Would anyone be able to suggest how I can count per month?
Thanks a lot.
note: I now realize that for my example data I have only used dates in the same month, but my real data has dates spanning 3 years.
Here's a solution that seems to work. First, I set the seed so that the example is reproducible.
# Set seed for reproducible example
set.seed(33550336)
Next, I create a dummy data frame.
# Test data
df <- data.frame(Start_date = as.Date(sample(seq(as.Date('2014/01/01'), as.Date('2015/01/01'), by="day"), 12))) %>%
mutate(End_date = as.Date(Start_date + sample(1:365, 12, replace = TRUE)))
which looks like,
# Start_date End_date
# 1 2014-11-13 2015-09-26
# 2 2014-05-09 2014-06-16
# 3 2014-07-11 2014-08-16
# 4 2014-01-25 2014-04-23
# 5 2014-05-16 2014-12-19
# 6 2014-11-29 2015-07-11
# 7 2014-09-21 2015-03-30
# 8 2014-09-15 2015-01-03
# 9 2014-09-17 2014-09-26
# 10 2014-12-03 2015-05-08
# 11 2014-08-03 2015-01-12
# 12 2014-01-16 2014-12-12
The function below takes a start date and end date and creates a sequence of months between these dates.
# Sequence of months
mon_seq <- function(start, end){
# Change each day to the first to aid month counting
day(start) <- 1
day(end) <- 1
# Create a sequence of months
seq(start, end, by = "month")
}
Right, this is the tricky bit. I apply my function mon_seq to all rows in the data frame using mapply. This gives the months between each start and end date. Then, I combine all these months together into a vector. I format this vector so that dates just contain months and years. Finally, I pipe (using dplyr's %>%) this into table which counts each occurrence of year-month and I cast as a data frame.
data.frame(format(do.call("c", mapply(mon_seq, df$Start_date, df$End_date)), "%Y-%m") %>% table)
This gives,
# . Freq
# 1 2014-01 2
# 2 2014-02 2
# 3 2014-03 2
# 4 2014-04 2
# 5 2014-05 3
# 6 2014-06 3
# 7 2014-07 3
# 8 2014-08 4
# 9 2014-09 6
# 10 2014-10 5
# 11 2014-11 7
# 12 2014-12 8
# 13 2015-01 6
# 14 2015-02 4
# 15 2015-03 4
# 16 2015-04 3
# 17 2015-05 3
# 18 2015-06 2
# 19 2015-07 2
# 20 2015-08 1
# 21 2015-09 1
I have a set of data regarding amounts of something users with unique IDs used between in a data.frame in r.
ID start date end date amount
1 1-15-2012 2-15-2012 6000
1 2-15-2012 3-25-2012 4000
1 3-25-2012 5-26-2012 3000
1 5-26-2012 6-13-2012 1000
2 1-16-2012 2-27-2012 7000
2 2-27-2012 3-18-2012 2000
2 3-18-2012 5-23-2012 3000
....
10000 1-12-2012 2-24-2012 12000
10000 2-24-2012 3-11-2012 22000
10000 3-11-2012 5-27-2012 33000
10000 5-27-2012 6-10-2012 5000
The time series for each ID starts and ends at inconsistent times, and contain an inconsistent number of observations. However, they are all formatted in the above manner; the start and end dates are Date objects.
I would like to standardize the breakdowns for each ID to a monthly time series, with data points at the start of each month, weighing the observed amount numbers which happen to straddle two or more months accordingly.
In other words, I would like to turn this series into something like
ID start date end date amount
1 1-1-2012 2-1-2012 3096 = 6000 * 16/31
1 2-1-2012 3-1-2012 4339 = 6000*15/31+4000*14/39
1 3-1-2012 4-1-2012 etc
....
1 6-1-2012 7-1-2012 etc
2 1-1-2012 2-1-2012 etc
2 2-1-2012 3-1-2012 etc
2 3-1-2012 4-1-2012 etc
2 4-1-2012 5-1-2012 etc
2 5-1-2012 6-1-2012 etc
....
10000 1-1-2012 2-1-2012 etc
....
10000 6-1-2012 7-1-2012 etc
Where the value for ID 1 between 2/1/12 and 3/1/12 is calculated by weighing the number of days in the 1-15-2012 to 2-15-2012 observation that land in February (15 days / 31 days) with the amount in that observation span (6000) with the number of days in the 2-15 to 3-25 observation span that fall in February (14 days/ 39 days, as 2012 was a leap year) times the amount in that observation span (4000), yielding 6000*15/31+4000*14/39 = 4339. This should be done for each ID time series. We do not consider the case where the observation periods all fit into one month; but if they are spread out over more than two months they should be split up over that number of months with the appropriate weighings.
I'm rather new to r and could certainly use some help on this!
Here is using native R:
#The data
df=read.table(text='ID start_date end_date amount
1 1-15-2012 2-15-2012 6000
1 2-15-2012 3-25-2012 4000
1 3-25-2012 5-26-2012 3000
1 5-26-2012 6-13-2012 1000
2 1-16-2012 2-27-2012 7000
2 2-27-2012 3-18-2012 2000
2 3-18-2012 5-23-2012 3000
10000 1-12-2012 2-24-2012 12000
10000 2-24-2012 3-11-2012 22000
10000 3-11-2012 5-27-2012 33000
10000 5-27-2012 6-10-2012 5000',
header=T,row.names = NULL,stringsAsFactors =FALSE)
df[,2]=as.Date(df[,2],"%m-%d-%Y")
df[,3]=as.Date(df[,3],"%m-%d-%Y")
df1=data.frame(n=1:length(df$ID),ID=df$ID)
df1$startm=as.Date(levels(cut(df[,2],"month"))[cut(df[,2],"month")],"%Y-%m-%d")
df1$endm=as.Date(levels(cut(df[,3],"month"))[cut(df[,3],"month")],"%Y-%m-%d")
df1=df1[,-1]
#compute days in month and total days
df$dayin=as.numeric((df1$endm-1)-df$start_date)
df$daytot=as.numeric(df$end_date-df$start_date)
#separate amount this month and next month
df$ammt=df$amount*df$dayin/df$daytot
df$ammt.1=df$amount*(df$daytot-df$dayin)/df$daytot
#using by compute new amount
df1$amount=do.call(c,
by(df[,c("ammt","ammt.1")],df$ID,function(d)d[,1]+c(0,d[-nrow(d),2]))
)
df1
> df1
ID startm endm amount
1 1 2012-01-01 2012-02-01 3096.774
2 1 2012-02-01 2012-03-01 4339.123
3 1 2012-03-01 2012-05-01 4306.038
4 1 2012-05-01 2012-06-01 1535.842
5 2 2012-01-01 2012-02-01 2500.000
6 2 2012-02-01 2012-03-01 4700.000
7 2 2012-03-01 2012-05-01 3754.545
8 10000 2012-01-01 2012-02-01 5302.326
9 10000 2012-02-01 2012-03-01 13572.674
10 10000 2012-03-01 2012-05-01 36553.571
11 10000 2012-05-01 2012-06-01 13000.000
To solve this I think the easiest way is to break it down into two problems.
How can I get a daily breakdown of the figures I'm interested in? This is my assumption based on the information you provided above.
How do I group by a date range and summarise to what I'm interested in?
For the following example, I will use the data set which I created using the code below:
df <- data.frame(
id=c(1,1,1,1,2,2,2),
start_date=as.Date(c("1-15-2012",
"2-15-2012",
"3-25-2012",
"5-26-2012",
"1-16-2012",
"2-27-2012",
"3-18-2012"), "%m-%d-%Y"),
end_date=as.Date(c("2-15-2012",
"3-25-2012",
"5-26-2012",
"6-13-2012",
"2-27-2012",
"3-18-2012",
"5-23-2012"), "%m-%d-%Y"),
amount=c(6000,
4000,
3000,
1000,
7000,
2000,
3000)
)
1. Provide daily figures
To provide the daily figures, firstly we get the daily contribution:
df$daily_contribution = df$amount/as.numeric(df$end_date - df$start_date)
Then, we will expand the date range using the start and end dates. There are a couple ways which you can do it, but seeing that you apply the dplyr tag, using the dplyr way we have:
library(dplyr)
df <- df %>%
rowwise() %>%
do(data.frame(id=.$id,
date=as.Date(seq(from=.$start_date, to=(.$end_date), by="day")),
daily_contribution=.$daily_contribution))
which has some output which looks like this:
Source: local data frame [285 x 3]
Groups: <by row>
id date daily_contribution
1 1 2012-01-15 193.5484
2 1 2012-01-16 193.5484
3 1 2012-01-17 193.5484
4 1 2012-01-18 193.5484
5 1 2012-01-19 193.5484
6 1 2012-01-20 193.5484
7 1 2012-01-21 193.5484
8 1 2012-01-22 193.5484
9 1 2012-01-23 193.5484
10 1 2012-01-24 193.5484
.. .. ... ...
2. Create a grouping variable
Next we create some kind of grouping variable that we're interested in. I've used lubridate for ease to get the month and year of the dates:
library(lubridate)
df$mnth=month(df$date)
df$yr=year(df$date)
Now with all of this we can easily use dplyr to summarise our information by the dates as required.
df %>%
group_by(id, mnth, yr) %>%
summarise(amount=sum(daily_contribution))
with output:
Source: local data frame [11 x 4]
Groups: id, mnth
id mnth yr amount
1 1 1 2012 3290.3226
2 1 2 2012 4441.6873
3 1 3 2012 2902.8122
4 1 4 2012 1451.6129
5 1 5 2012 1591.3978
6 1 6 2012 722.2222
7 2 1 2012 2666.6667
8 2 2 2012 4800.0000
9 2 3 2012 2436.3636
10 2 4 2012 1363.6364
11 2 5 2012 1045.4545
To get it precisely in the format you specified:
df %>% rowwise() %>%
mutate(start_date=as.Date(ISOdate(yr, mnth, 1)),
end_date=as.Date(ISOdate(yr, mnth+1, 1))) %>%
select(id, start_date, end_date, amount)
with output:
Source: local data frame [11 x 4]
Groups: <by row>
id start_date end_date amount
1 1 2012-01-01 2012-02-01 3290.3226
2 1 2012-02-01 2012-03-01 4441.6873
3 1 2012-03-01 2012-04-01 2902.8122
4 1 2012-04-01 2012-05-01 1451.6129
5 1 2012-05-01 2012-06-01 1591.3978
6 1 2012-06-01 2012-07-01 722.2222
7 2 2012-01-01 2012-02-01 2666.6667
8 2 2012-02-01 2012-03-01 4800.0000
9 2 2012-03-01 2012-04-01 2436.3636
10 2 2012-04-01 2012-05-01 1363.6364
11 2 2012-05-01 2012-06-01 1045.4545
as needed.
note: I can see from your example, that you have, 3096 = 6000 * 16/31 and 4339 = 6000*15/31+4000*14/39, but for the first one, as an example, you have 15 of Jan to 31 of Jan which is 17 days if the date range is inclusive. You can trivially alter this information if required.
Here's a solution using plyr and reshape. The numbers aren't the same as what you provided, so I may have misunderstood your intent though this seems to meet your stated goal (weighted average of amount by month).
df$index <- 1:nrow(df) #Create a unique index number
#Format the dates from factors to dates
df$start.date <- as.Date(df$start.date, format="%m/%d/%Y")
df$end.date <- as.Date(df$end.date, format="%m/%d/%Y")
library(plyr); library(reshape) #Load the libraries
#dlaply = (d)ataframe to (l)ist using (ply)r
#Subset on dataframe by "index" and perform a function on each subset called "X"
#Create a list containing:
# ID, each day from start to end date, amount recorded over that day
df2 <- dlply(df, .(index), function(X) {
ID <- X$ID #Keep the ID value
n.days <- as.numeric(difftime( X$end.date, X$start.date )) #Calculate time difference in days, report the result as a number
day <- seq(X$start.date, X$end.date, by="days") #Sequence of days
amount.per.day <- X$amount/n.days #Amount for that day
data.frame(ID, day, amount.per.day) #Last line is the output
})
#Change list back into data.frame
df3 <- ldply(df2, data.frame) #ldply = (l)ist to (d)ataframe using (ply)r
df3$mon <- as.numeric(format(df3$day, "%m")) #Assign a month to all dates
#Summarize by each ID and month: add up the daily amounts
ddply(df3, .(ID, mon), summarise, amount = sum(amount.per.day))
# ID mon amount
# 1 1 1 3290.3226
# 2 1 2 4441.6873
# 3 1 3 2902.8122
# 4 1 4 1451.6129
# 5 1 5 1591.3978
# 6 1 6 722.2222
# 7 2 1 2666.6667
# 8 2 2 4800.0000
# 9 2 3 2436.3636
# 10 2 4 1363.6364
# 11 2 5 1045.4545
Incidentally, for future posts, you can get faster answers if you provide the code to replicate your data. If your code is somewhat complicated, you can use dput(yourdata).
HTH!