InvTools:

#' @export
Portfolio <- R6::R6Class(
  classname = 'Portfolio',
  inherit = Asset,
  public = list(
    asset_list = NULL,
    meta = NULL,
    time_series = NULL,
    reb = NULL,

    initialize = function(
        asset_list = NA,
        meta = NA,
        time_series= NA,
        reb_wgt = NA,
        reb_freq = NA,
        date_start = NA,
        date_end = NA,
        t_cost = NA,
        ann_fee = NA) {

      self$asset_list <- asset_list
      self$meta <- meta
      self$time_series <- time_series
      self$reb$reb_wgt <- reb_wgt
      self$reb$reb_freq <- reb_freq
      self$reb$t_cost <- t_cost
      self$reb$date_end <- date_end
      self$reb$date_start <- date_start
      self$reb$ann_fee <- ann_fee
    },

    prepRebWgt = function(
        reb_wgt_vec = NA,
        date_start = NA,
        date_end = NA,
        freq = c('m', 'q', 'a')) {

      # prepare time-series of rebalance weights from constant weight vector
      #
      # paramters:
      # reb_wgt_vec = vector of weights to periodically rebalance back to
      # incept_date = inception date to truncate time-series
      # date_end = ending date to truncate time-series
      # freq = frequency to rebalance

      freq <- freq[1] %>% toupper()
      if (is.na(date_start)) {
        if (is.na(self$reb$date_start)) {
          warnings('port$reb$date_start not set, defaulting to 2005-01-01')
          date_start <- as.Date('2005-01-01')
        } else {
          date_start <- self$reb$date_start
        }
      }
      if (is.na(date_end)) {
        if (is.na(self$reb$date_end)) {
          date_end <- Sys.Date()
        } else {
          date_end <- self$reb$date_end
        }
      }
      if (is.na(reb_wgt_vec)) {
        reb_wgt_vec <- as.matrix(self$reb$reb_wgt[1, ])
      }
      d <- data.frame(date = seq.Date(from = date_start, to = date_end,
                                      by = 'days'))
      reb_wgt_mat <- matrix(reb_wgt_vec, ncol = length(reb_wgt_vec),
                            nrow = nrow(d),
                            byrow = TRUE)
      d <- cbind(d, reb_wgt_mat)
      if (freq == 'M') {
        d <- d %>%
          mutate(xdate = paste0(lubridate::month(date), '-',
                                lubridate::year(date)))
      }
      if (freq == 'Q') {
        d <- d %>%
          mutate(xdate = paste0(lubridate::quarter(date), '-',
                                lubridate::year(date)))
      }
      if (freq == 'A') {
        d <- d %>%
          mutate(xdate  = lubridate::year(date))
      }
      d <- d %>%
        group_by(xdate) %>%
        filter(date == max(date)) %>%
        ungroup() %>%
        select(-xdate)
      return(d)
    },

    prepRet = function(trunc_at_date_start = TRUE, fill_na = 0) {

      # prep return matrix from asset list
      #
      # parameters:
      # trunc_at_common_start = truncate returns at earliest start date
      # fill_na = value to fill missing returns, use NULL to leave missing values

      ret_list <- lapply(self$asset_list, '[[', 'time_series')
      ret <- Reduce(function(x, y) full_join(x, y, by = 'date'), ret_list)
      if (trunc_at_date_start) {
        if (is.na(self$reb$date_start)) {
          warning('date start not set, defaulting to 2005-01-01')
          date_start <- as.Date('2005-01-01')
        }
        else {
          date_start <- self$reb$date_start
        }
        ret <- ret %>% filter(date >= date_start)
      }
      if (!is.null(fill_na)) {
        ret <- ret %>%
          replace(is.na(.), 0)
      }
      return(ret %>% arrange(date))
    },

    portRebal = function(ret_df = NA, reb_wgt = NA, t_cost = NA,
                         reb_freq = NA, ret_freq = NA) {

      if (is.na(reb_freq)) {
        reb_freq <- self$reb$reb_freq
        if (is.na(reb_freq)) {
          warning('rebalance frequency not set, setting to annual')
          reb_freq <- 'A'
        }
      }
      if (is.na(ret_df)) {
        ret_df <- self$prepRet()
      }
      if (is.na(reb_wgt)) {
        reb_wgt <- self$prepRebWgt(freq = reb_freq)
      }
      if (is.na(self$reb$ann_fee)) {
        warning('annual fee not set, setting to 0')
        self$reb$ann_fee <- 0
      }
      n_assets <- ncol(ret_df) - 1
      n_obs <- nrow(ret_df)
      if (colnames(ret_df[1]) != 'date') {
        warning('\'ret_df\' is not standardized. Trying to force by naming
                first column \'date\'')
        colnames(ret_df)[1] <- 'date'
      }
      if (colnames(reb_wgt[1]) != 'date') {
        warning('\'reb_wgt\' is not standardized. Trying to force by naming
                first column \'date\'')
        colnames(ret_df)[1] <- 'date'
      }
      ret_df <- ret_df %>%
        replace(is.na(.), 0)
      reb_wgt <- reb_wgt %>%
        replace(is.na(.), 0)
      ret_dt <- ret_df %>% select(date)
      reb_wgt_dt <- reb_wgt %>% select(date)
      ret_mat <- ret_df %>% select(-date)
      reb_wgt_mat <- reb_wgt %>% select(-date)
      if (is.na(t_cost)) {
        t_cost <- rep(0, n_assets)
      }
      if (length(t_cost) == 1) {
        t_cost <- rep(t_cost, length(n_assets))
      }
      init_cap <- 100
      asset_index <- matrix(0, nrow = n_obs + 1, ncol = n_assets)
      asset_index[1, ] <- as.numeric(reb_wgt_mat[1, ]) * init_cap
      port_index <- matrix(0, nrow = n_obs + 1, ncol = 1)
      port_index[1, 1] <- init_cap
      j <- 1
      for (i in 1:n_obs) {
        rebal_dt <- ret_dt$date[i] >= reb_wgt_dt$date[j]
        if (is.na(rebal_dt)) {
          rebal_dt <- FALSE
        }
        if (rebal_dt) {
          adj_w <- as.numeric(reb_wgt_mat[j, ]) - t_cost
          asset_index[i, ] <- adj_w * port_index[i, ]
          j <- j + 1
        }
        asset_index[i + 1, ] <- asset_index[i, ] *
          ((1 + as.numeric(ret_mat[i, ])))
        pl <- sum(asset_index[i + 1, ]) - sum(asset_index[i, ])
        port_index[i + 1, 1] <- port_index[i, 1] + pl
      }
      hist_wgt_mat <- asset_index / apply(asset_index, 1, sum)
      hist_wgt <- as_tibble(
        cbind(
          date = c(ret_dt$date[1] - 1, ret_dt$date),
          hist_wgt_mat)) %>%
        mutate(date = as.Date(date, origin = '1970-01-01'))
      port_index <- as_tibble(
        cbind(
          date = c(ret_dt$date[1] - 1, ret_dt$date),
          value = as.numeric(port_index))) %>%
        mutate(date = as.Date(date, origin = '1970-01-01')) %>%
        arrange(date)
      asset_index <- as_tibble(
        cbind(date = c(ret_dt$dat[1] - 1, ret_dt$date),
        value = asset_index)) %>%
        mutate(date = as.Date(date, origin = '1970-01-01')) %>%
        arrange(date)
      port_ret <- port_index %>%
        mutate(value = value / lag(value, 1) - 1)
      if (self$reb$ann_fee != 0) {
        if (is.na(ret_freq)) {
          ret_freq <- 'M'
          warning('return frequency is not specified, setting to monthly for
                  annual fee deduction')
        }
        port_ret <- netFee(port_ret, self$annual_fee, ret_freq = ret_freq)
      }
      self$time_series <- port_ret[2:nrow(port_ret), ]
      self$reb$asset_ret <- ret_mat
      self$reb$hist_wgt <- hist_wgt
      self$reb$asset_index <- asset_index
      self$reb$port_index <- port_index
    }
  )
)

#' @title Create Portfolio Object from Excel Template
#'
#' @param excel_file full file name of Excel file
#' @param tickstore TickStore Object
#' @param reb_freq optional frebalance frequency if using a vector of weights
#' instead of a matrix
#' @param ret_freq return frequency of portfolio
#'
#' @export
portFromExcel <- function(excel_file, tickstore, reb_freq = 'Q',
                          ret_freq = 'D') {
  port <- Portfolio$new()
  xldata <- readxl::read_excel(excel_file)
  tick <- colnames(xldata)[2:ncol(xldata)]
  asset_list <- lapply(tick, tickstore$genAsset)
  date_vec <- xldata[[1]][6:nrow(xldata)] %>%
    as.numeric() %>%
    as.Date(origin = '1899-12-30')
  reb_wgt <- xldata[6:nrow(xldata), 2:ncol(xldata)] %>%
    add_column(date = date_vec, .before = 1)
  if (nrow(reb_wgt) == 1) {

  }
  port$asset_list <- asset_list
  port$reb$reb_wgt <- reb_wgt
  port$reb$date_start <- date_vec[1]
  port$reb$date_end <- Sys.Date()
  port$portRebal(reb_wgt = reb_wgt, ret_freq = ret_freq)
  port$assignMinMetaData(name = 'Port', provider_id = 'Port', freq = ret_freq,
                         mult = 1, rf_net = TRUE, data_type = 'RETURN')
  return(port)
}

portFromAssetList <- function(asset_list, reb_wgt = NULL, reb_freq = 'Q',
                              ret_freq = 'D') {
  port <- Portfolio$new()
}