This one is driving me nuts. I have a large data.table with monthly stock data. Every June I assign every stock to one of 10 portfolios based on an accounting variable. I would like to carry forward the assigned portfolio variable to the next 11 month until each stock gets assigned to a new portfolio 1 to 10 in June next year. na.locf is basically what I'm looking for but I am running into 2 issues:
Some stocks lack sufficient accounting data the next year, so they shouldn't be assigned to a portfolio in that year (i.e. portfolio variable should stay NA). But of course na.locf keeps carrying forward the portfolio number until there is a new one.
Some stocks may get delisted after e.g. 3 months so they don't have another 11 month of data.
That's why I looking for a code that carries forward the last observation a maxium of 11 times until June next year (when there is a new portfolio number).
That's the na.locf solution right now with the 2 issues (PERMNO is the stock identifier):
COMPUSTAT_CRSP_IBES1[,
Portfolio_Monthly := na.locf(Portfolio_Monthly,
na.rm = FALSE),
by = PERMNO]
I tried to use rep but that didn't work at all:
COMPUSTAT_CRSP_IBES1[,
Portfolio_Monthly := if_else(!is.na(Portfolio_Monthly),
rep(Portfolio_Monthly, 11),
NA),
by = PERMNO]
Thank's for any hints!
You can create and/or use your fiscal year (June - May) as one of the group by criteria in your na.locf solution
#show data before calculations
data.frame(dat)
#demo FY calculation
dat[, FY := year(MONTH) + as.numeric(month(MONTH) >= 6)]
#actual code
dat[, Portfolio_Monthly := zoo::na.locf(Portfolio_Monthly, na.rm=FALSE),
by=list(PERMNO, year(MONTH) + as.numeric(month(MONTH) >= 6))]
#show results
data.frame(dat)
sample data:
library(data.table)
set.seed(0L)
dat <- data.table(PERMNO=rep(LETTERS[1:12], each=20),
MONTH=rep(seq(as.Date("2000-01-01"), by="1 month", length.out=20), 12),
Portfolio_Monthly=NA_real_)
for (i in sample(1:dat[,.N], 5)) {
set(dat, i, 3L, rnorm(1))
}
setorder(dat, PERMNO, MONTH)
Related
I have an unbalanced panel, in which I have certain observations (variable x) per ID and month. I am trying to calculate a 6-month-rolling average of x, but only every March. I know that with zoo, I can calculate the average every single time, but I think that is computationally expensive. I have a very large panel, so it would be better to define an index first and pass it to the function. Also, my panel is imbalanced, so sometimes I have all 6 past values at a given March, and sometimes I do not. If there is a minimum of 3 values available, I would still like to compute the average.
Here is some sample code and my solution so far:
library(data.table)
set.seed(1)
time=rep(seq(as.Date("2010-02-01"), length=42, by="1 month") - 1,2)
IDs=rep(letters[1:2],each=length(time))
DT <- data.table(time=time,
ID=IDs,
ind=rep(1:(2*length(time))),
row=1:(2*length(time)),
x=sample(2*length(time)))
DT
DT <- DT[!ind %in% c(11,12,26)]
DT
library(zoo)
DT[,movavg := if(length(x) >= 3){ rollapply(x, 6, sum, na.rm = FALSE,align = "right",fill = NA)}else{
rep(NA,length(x))
},by=ID]
DT
The target is to simply show for each March the corresponding moving average, which contains the past 6 observations. I don't mind if the original panel is kept, that is, only in March the results are shown, or if only the March values are extracted and nothing else is shown.
My code works, but it does the calculation every row/month. What I want it to do is to work only at a defined index. The issue is, as the panel is unbalanced, the distance between the Marches is not equally long. For example, it can be 12 months from one to another year, but it could be 10 months from the next to the following year when 2 observations are unfortunately missing. Can roll apply still be used? Any hints for data table or dplyr are highly appreciated.
If this code from the question gives what you want
DT[,movavg := if(length(x) >= 3){ rollapply(x, 6, sum, na.rm = FALSE,align = "right",fill = NA)}else{
rep(NA,length(x))
},by=ID]
then the first of these ran 2.8x faster and gave the same result and the second one using frollsum from data.table ran 4.8x faster.
DT[, movavg := rollsumr(x, 6, fill = NA), by = ID]
DT[, movavg := frollsum(x, 6), by = ID]
I have a data frame with data for each month of a 26 years period (1993 - 2019), which makes 312 rows in total.
Unfortunately, I had to lag the data, so each year goes now from July t to June t+1. So I can't just extract the year from the date.
Now, I want to exclude the 12-month data for each year in a separate data frame. My first Idea is to insert in the first column the year and use the lapply function to filter afterward.
For this, I created the following loop:
n <- 1
m <- 1993
for (a in 1:26) {
for (i in n:(n+11)) {
t.monthly.ret.lag[i,1] <- m
}
n <- n+1
m <- m+1
}
Unfortunately, R isn't naming the year in steps of 12. Instead, it is counting directly in steps of 1.
Does anyone know how to solve this or maybe know a better way of doing it?
y.first <- 1993
y.last <- 2019
month.col <- rep(c(7:12, 1:6), y.last-y.first+1)
year.col <- rep(c(y.first:y.last), each=length(month.name))
df <- data.frame(year=year.col, month=month.col)
This yields a dataframe with months and year correspondingly tagged, which further allows to use dplyr::group_by() and so on.
You could just create a 312 element long vector giving the year (and one giving the month) using rep() and seq(). Then you can attach them as additional columns to your data.frame or just use them as reference for month and year.
month = rep(seq(1:12),27)
year = c(matrix(rep(seq(1:27),12),ncol=27,byrow=T)+1992)
month = month[7:(length(month)-6)]
year = year[7:(length(year)-6)]
The month vector counts from 1 to 12, beginning at 6, the year vector repeats the year 12 times (the first and last only 6 times).
I've encountered this problem several times over the years so maybe I'm just misunderstanding something or somehow just being silly about this. I've met a wierd problem when doing a rolling average on irregular time series. A good overview of the available methods in packages and simple script is here: Calculating moving average in R
I may be misreading some of them, but I see an issue in dealing with irregular time series. For example the common method of Rolling means in the zoo package requires unique values for each data. But in this case this is not the rolling average, but a rolling average of averages per time unit - time units will less data points will have comparably more influence on the average than ones with more.
A true moving average seems to me to need to work not with aggregates, but with distributions for each calculated point.
Given that I have the following data frame or irregular values, how can I best create a moving average measure for each of the values.
df <- data.frame(year = c(rep(2000,3),rep(2001,1),rep(2004,4),rep(2005,3),+
rep(2006,3),rep(2007,1),rep(2008,2),rep(2009,6),rep(2010,8)),+
value1=rnorm(31), value2=rnorm(31), value3=rnorm(31))
I found an easy way to do it via subsetting that I'll post as an initial answer, but this works in limited circumstances and needs to be customized each time. I'm wondering what is a general solution. Also, if anyone is able to comment on the practices of using averages of averages vs averages of distributions in rolling means calculations, that would be extra helpful. Thanks!
Calcuations within a sliding or rolling window of an irregular time series can be solved by data.table's ability to aggregate in a non-equi join.
There are many similar questions, e.g., r calculating rolling average with window based on value (not number of rows or date/time variable) or Rolling regression on irregular time series.
However, this question is different and thus deserves an answer on its own. From OP's own answer it can be concluded that the OP is looking for a centred rolling window. In addition, the rolling mean is to be computed for several columns.
library(data.table)
cols <- c("value2", "value3")
setDT(df)[SJ(year = (min(year) + 2):(max(year) - 2))[, c("start", "end") := .(year - 2, year + 2)],
on = .(year >= start, year < end),
c(.(year = i.year), lapply(.SD, mean)), .SDcols = cols, by = .EACHI][, -(1:2)]
year value2 value3
1: 2002 0.57494219 -0.53001134
2: 2003 0.33925292 0.75541896
3: 2004 -0.05834453 0.23987209
4: 2005 0.17031099 0.13074666
5: 2006 0.05272739 0.09297215
6: 2007 -0.12935805 -0.38780964
7: 2008 0.19716437 -0.11587017
The result is identical to OP's own result rmeans.
Data
set.seed(123) # ensure reproducible sample data
df <- data.frame(
year = rep(2000:2010, c(3, 1, 0, 0, 4, 3, 3, 1, 2, 6, 8)),
value1 = rnorm(31), value2 = rnorm(31), value3 = rnorm(31))
So here is the simple subsetting I came up with. Could be helpful if anyone finds themselves finding the same issues:
df <- data.frame(year = c(rep(2000,3),rep(2001,1),rep(2004,4),rep(2005,3), +
rep(2006,3),rep(2007,1),rep(2008,2),rep(2009,6),rep(2010,8)), +
value1=rnorm(31), value2=rnorm(31), value3=rnorm(31))
rmeans <- data.frame()
for (i in (min(df$year)+2):(max(df$year)-2)){
rmeans <- rbind(rmeans, data.frame(year=i,as.data.frame.list(colMeans(df +
[df$year>=(i-2)&df$year<(i+2),-c(1,2)]))))
}
I am trying to extract all dates except for the last five days from a zoo dataset into a single object.
This question is somewhat related to How do I subset the last week for every month of a zoo object in R?
You can reproduce the dataset with this code:
set.seed(123)
price <- rnorm(365)
data <- cbind(seq(as.Date("2013-01-01"), by = "day", length.out = 365), price)
zoodata <- zoo(data[,2], as.Date(data[,1]))
For my output, I'm hoping to get a combined dataset of everything except the last five days of each month. For example, if there are 20 days in the first month's data and 19 days in the second month's, I only want to subset the first 15 and 14 days of data respectively.
I tried using the head() function and the first() function to extract the first three weeks, but since each month will have a different amount of days according to month or leap year months, it's not ideal.
Thank you.
Here are a few approaches:
1) as.Date Let tt be the dates. Then we compute a Date vector the same length as tt which has the corresponding last date of the month. We then pick out those dates which are at least 5 days away from that:
tt <- time(zoodata)
last.date.of.month <- as.Date(as.yearmon(tt), frac = 1)
zoodata[ last.date.of.month - tt >= 5 ]
2) tapply/head For each month tapply head(x, -5) to the data and then concatenate the reduced months back together:
do.call("c", tapply(zoodata, as.yearmon(time(zoodata)), head, -5))
3) ave Define revseq which given a vector or zoo object returns sequence numbers in reverse order so that the last element corresponds to 1. Then use ave to create a vector ix the same length as zoodata which assigns such reverse sequence numbers to the days of each month. Thus the ix value for the last day of the month will be 1, for the second last day 2, etc. Finally subset zoodata to those elements corresponding to sequence numbers greater than 5:
revseq <- function(x) rev(seq_along(x))
ix <- ave(seq_along(zoodata), as.yearmon(time(zoodata)), FUN = revseq)
z <- zoodata[ ix > 5 ]
ADDED Solutions (1) and (2).
Exactly the same way as in the answer to your other question:
Split dataset by month, remove last 5 days, just add a "-":
library(xts)
xts.data <- as.xts(zoodata)
lapply(split(xts.data, "months"), last, "-5 days")
And the same way, if you want it on one single object:
do.call(rbind, lapply(split(xts.data, "months"), last, "-5 days"))
I have a data frame with 275 different stations and 43 years seasonal data (October to next April, no need for May to Sept data)and 6 variables, here is a small example of the data frame with only one variable called value:
data <- data.frame(station=rep(1,6), year=rep(1969,6), month=c(10,10,10,10,11,11),day=c(1,8,16,24,1,9),value=c(1:6))
What I need is to fill the gap of day with daily date(eg:1:8) and the value of each row the average of the 8 days, it would be look like:
data1 <- data.frame(station=rep(1,40), year=rep(1969,40), month=c(rep(10,31),rep(11,9)),day=c(1:31,1:9),value=rep(c(1/7,2/8,3/8,4/8,5/8,6/8),c(7,8,8,8,8,1)))
I wrote some poor code and searched around the site, but unfortunately didn't work out, please help or better ideas would be appreciated.
station.date <- as.Date(with(data, paste(year, month, day, sep="-")))
for (i in 1:length(station.date)){
days <- as.numeric(station.date[i+1]-station.date[i]) #not working
data <- within(data, days <- c(days,1))
}
rows <- rep(1:nrow(data), times=data[ ,data$days])
rows <- ifelse(rows > 10, 0, rows) #get rid of month May to Sept
data <- data[rows, ]
data <- within(data, value1 <- value/days)
data <- within(data, dd <- ?) #don't know to change the repeated days to real days
I wrote some code that does the same things as your example, but probably You have to modyfi it in order to handle whole data set. I wasn't sure what to do with the last observation. Eventually I made a special case for it. If it should be divided by different number, You need just to replace 8 inside values <- c(values, tail(data$value, 1) / 8)
with that number. Moreover if you have all 275 stations in one data.frame, I think the best idea would be to split it, transform it separately and than cbind it.
data <- data.frame(station=rep(1,6), year=rep(1969,6), month=c(10,10,10,10,11,11),day=c(1,8,16,24,1,9),value=c(1:6))
station.date <- as.Date(with(data, paste(year, month, day, sep="-")))
d <- as.numeric(diff(station.date))
range <- sum(d) + 1
# create dates
dates <- seq(station.date[1], by = "day", length = range)
# create values
values <- unlist(sapply(1:length(d), function(i){
rep(data$value[i] / d[i] , d[i])
}))
# adding last observation
values <- c(values, tail(data$value, 1) / 8)
# create new data frame
data2 <- data.frame(station = rep(1, range),
year = as.numeric(format(dates, "%Y")),
month = as.numeric(format(dates, "%m")),
day = as.numeric(format(dates, "%d")),
value = values)
It could probably be optimised in some way, however I hope it helps too. Note how I extract year, month and day from dates.