Есть ли более эффективный способ рассчитать ежемесячные значения портфеля из портфелей клиентов? - PullRequest
0 голосов
/ 07 июля 2019

Следующие два фрейма данных являются фрагментом данных, с которыми я сейчас работаю. df1 содержит историю инвесторов (разделенную идентификатором) с количеством акций из разных продуктов, которыми они владеют. Каждый раз, когда происходит изменение количества акций, создается новая запись. df2 содержит цены, соответствующие товарам.

Я пытаюсь рассчитать ежемесячные значения портфеля для всех клиентов в течение их инвестиционного периода.
Вот воспроизводимый пример df1 и df2:

library(dplyr)
library(lubridate)
library(timeDate)

#create df1 customer portfolio history 
id <- c("1","1","1","1","2","2","2","3","3","3","3","3")
df1 <- data.frame(id)
df1$start <- as.Date(c("2012-03-11", "2012-04-17","2012-05-09", "2012-05-11", "2012-11-17","2012-12-09",
"2013-01-21", "2011-06-27","2012-07-02", "2012-07-21", "2012-09-03","2012-09-16"))
df1$end <- as.Date(c("2012-05-08", "2012-05-21","2012-06-11", "2012-11-16", "2012-12-08","2013-01-20",
"2013-02-03", "2011-07-01","2012-09-15", "2012-09-02", "2012-09-20","2012-09-16"))
df1$product <- c("a","b","a","b","b","b","b","c","c","a","a","c")
df1$amount <- as.numeric(c("5","12","7","11","3","8","6","4","1","16","17","9"))

#create df2 with corresponding Prices 
date <- seq.Date(from = as.Date("2011-05-01"), to = as.Date("2013-02-01"), by = "month")
df2 <- data.frame(date)
df2$product <- "a"
date <- seq.Date(from = as.Date("2012-04-01"), to = as.Date("2013-02-01"), by = "month")
date <- data.frame(date)
date$product <- "b"
df2 <- rbind(df2,date)
date <- seq.Date(from = as.Date("2011-06-01"), to = as.Date("2012-09-01"), by = "month")
date <- data.frame(date)
date$product <- "c"
df2 <- rbind(df2,date)
df2$price <- as.numeric(sample(100, size = nrow(df2), replace = TRUE))
df2$date <- as.Date(timeLastDayInMonth(df2$date))

Я закончил тем, что распространял данные своих инвесторов в широком формате и искусственно добавлял строку с датой в конце каждого месяца. Затем я продолжил делать то же самое с моими ценовыми данными, присоединился и к другим, и в конечном итоге вычислил значения портфеля с помощью rowSums.

Вот мой код для фреймов данных выше:

#convert to wide data
df1 <- df1 %>%
spread(product, amount, fill = NA, convert = FALSE) 
colnames(df1)[4:6] <- paste("xxx", colnames(df1[,c(4:6)]), sep = "_")    

#add end of month observations to data frame
seq <- df1 %>%
  group_by(id) %>%
  summarize(start= floor_date(AddMonths(min(start),-1), "month"),end=max(end)) %>%
  group_by(rn=row_number()) %>%
  do(data.frame(id=.$id, datum=seq(.$start,.$end,by="1 month"))) %>%
  ungroup() %>%
  select(-rn)

seq <- seq %>%
  group_by(id) %>%
  mutate(start = as.Date(timeLastDayInMonth(datum))) %>%
  ungroup() %>%
  select(-2)

df1 <- full_join(df1,seq, by = c("id","start"))
df1 <- df1[with(df1, order(id, start)),]

#create grouping variable and filter all end of month data
df1<- df1 %>%
  group_by(id) %>%
  mutate(grp = as.numeric(as.Date(start)- as.Date(timeLastDayInMonth(start))))

df1 <- df1 %>% 
  group_by(id) %>% 
  fill(4:6, .direction = "down")

df1 <- filter(df1, grp == 0)

na_sub <- function(x) { x[is.na(x)] <- 0; x }
df1 <- df1 %>%
  select(-end, -grp) %>%
  na_sub()

#Join both wide dataframes and calculate monthly portfoliovalues
df2 <- df2 %>%
  spread(product, price, fill = NA, convert = FALSE) 
colnames(df2)[2:4] <- paste("yyy", colnames(df2[,c(2:4)]), sep = "_")
names(df2)[names(df2) == "date"] <- "start"

df1 <- left_join(df1, df2, by = "start") 

df1$portfoliovalue <- rowSums(select(df1, starts_with("xxx_")) * select(df1, starts_with("yyy_")), na.rm = TRUE)

Код приводит к желаемому результату с ежемесячными значениями портфеля для каждого инвестора. Как я уже говорил, это фрагмент всех данных. К сожалению, у меня возникают проблемы, особенно с размером широких фреймов данных (поскольку они получают огромное количество столбцов из-за растущего числа продуктов). Это делает невозможным выполнение кода с большим набором данных. Можно ли сохранить данные в длинном формате для расчетов? Существуют ли пакеты, предлагающие процедуры для таких расчетов?

1 Ответ

0 голосов
/ 07 июля 2019

Возможно, некоторые функции в пакете PMwR могут помочь.(Раскрытие информации: я сопровождающий пакета.) С помощью PMwR вы можете создавать журналы (то есть потоки, изменения в позициях) и затем вычислять позиции.Например:

library("PMwR")
library("datetimeutils")
j <- journal(account    = rep(df1$id, 2),
             instrument = rep(df1$product, 2),
             amount     = c(df1$amount, -df1$amount),
             timestamp  = c(df1$start, df1$end))

month.ends <- nth_day(start = as.Date("2012-01-01"),
                      end   = as.Date("2012-12-31"),
                      n = "last", period = "month")

position(j, when = month.ends, use.account = TRUE)
##            1:a 1:b 2:b 3:a 3:c
## 2012-01-31   0   0   0   0   0
## 2012-02-29   0   0   0   0   0
## 2012-03-31   5   0   0   0   0
## 2012-04-30   5  12   0   0   0
## 2012-05-31   7  11   0   0   0
## 2012-06-30   0  11   0   0   0
## 2012-07-31   0  11   0  16   1
## 2012-08-31   0  11   0  16   1
## 2012-09-30   0  11   0   0   0
## 2012-10-31   0  11   0   0   0
## 2012-11-30   0   0   3   0   0
## 2012-12-31   0   0   3   0   0

Более подробная информация содержится в руководстве .

Обновление Когда вы вызываете position с аргументом whenВы получаете одну позицию для каждого значения в when.Простой способ добавить id состоит в том, чтобы перебрать идентификаторы, преобразовать позицию для каждого id в кадр данных и затем объединить эти кадры данных.(Нельзя напрямую звонить rbind, так как продукты могут отличаться для id.)

accounts <- unique(j$account)
for (a in accounts)
    if (a == accounts[1]) {
        result <- data.frame(timestamp = month.ends,
                             id = a,
                             position(j[j$account == a],
                                      when = month.ends))
    } else {
        result <- merge(result,
                        data.frame(timestamp = month.ends,
                                   id = a,
                                   position(j[j$account == a],
                                            when = month.ends)),
                        all = TRUE)
    }

result[is.na(result)] <- 0
result
##     timestamp id  a  b c
## 1  2012-01-31  1  0  0 0
## 2  2012-01-31  2  0  0 0
## 3  2012-01-31  3  0  0 0
## 4  2012-02-29  1  0  0 0
## 5  2012-02-29  2  0  0 0
## 6  2012-02-29  3  0  0 0
## 7  2012-03-31  1  5  0 0
## 8  2012-03-31  2  0  0 0
## 9  2012-03-31  3  0  0 0
## 10 2012-04-30  1  5 12 0
## 11 2012-04-30  2  0  0 0
## 12 2012-04-30  3  0  0 0
## 13 2012-05-31  1  7 11 0
## 14 2012-05-31  2  0  0 0
## 15 2012-05-31  3  0  0 0
## 16 2012-06-30  1  0 11 0
## 17 2012-06-30  2  0  0 0
## 18 2012-06-30  3  0  0 0
## 19 2012-07-31  1  0 11 0
## 20 2012-07-31  2  0  0 0
## 21 2012-07-31  3 16  0 1
## 22 2012-08-31  1  0 11 0
## 23 2012-08-31  2  0  0 0
## 24 2012-08-31  3 16  0 1
## 25 2012-09-30  1  0 11 0
## 26 2012-09-30  2  0  0 0
## 27 2012-09-30  3  0  0 0
## 28 2012-10-31  1  0 11 0
## 29 2012-10-31  2  0  0 0
## 30 2012-10-31  3  0  0 0
## 31 2012-11-30  1  0  0 0
## 32 2012-11-30  2  0  3 0
## 33 2012-11-30  3  0  0 0
## 34 2012-12-31  1  0  0 0
## 35 2012-12-31  2  0  8 0
## 36 2012-12-31  3  0  0 0
...