R/Tbl.R

In alejandro-sotolongo/InvTools:

#' @title Constituent contribution to portfolio return
#'
#' @param port Portfolio Object
#' @param date_start starting date for return attribution
#' @param date_end ending date for return attribution
#'
#' @export
contrToRet <-function(port, date_start = NA, date_end = NA) {
  if (is.na(date_start)) {
    date_start <- as.Date('0000-01-01')
  }
  if (is.na(date_end)) {
    date_end <- Sys.Date()
  }
  asset_index <- port$reb$asset_index
  if (is.null(asset_index)) {
    stop('portRebal() has not been run yet, create portfolio time_series by
         running portRebal() before assesing asset contribution to return')
  }
  before_start <- asset_index$date >= date_start
  if (sum(before_start) == 0) {
    stop('last date in asset time-series is before date_start')
  }
  num_seq <- 1:length(before_start)
  before_index <- min(num_seq[before_start]) - 1
  before_index <- max(before_index, 1)
  asset_index <- asset_index[before_index:nrow(asset_index), ] %>%
    filter(date <= date_end)
  asset_ret <- port$prepRet()
  asset_ret <- asset_ret %>%
    filter(date >= date_start) %>%
    filter(date <= date_end)
  port_index <- port$reb$port_index
  port_index <- port_index[before_index:nrow(port_index), ] %>%
    filter(date_end <= date_end)
  contr_mat <- asset_index[1:(nrow(asset_index) - 1), 2:ncol(asset_ret)] *
    asset_ret[, 2:ncol(asset_ret)]
  contr_tbl <- tibble(date = asset_ret$date, contr_mat) %>%
    filter(date >= date_start) %>%
    filter(date <= date_end)
  contr <- apply(contr_tbl[, -1], 2, sum, na.rm = TRUE) / port_index$value[1]
  resid <- port_index$value[nrow(port_index)] /
    port_index$value[1] - 1 - sum(contr)
  res <- c(contr, resid)
  names(res) <- c(
    sapply(port$asset_list, '[[', 'meta')['provider_id', ] %>% unlist(),
    'resid')
  return(res)
}

#' @title Table: constituent contribution to portfolio return
#'
#' @param port Portfolio object
#' @param win vector of calendar periods to set range of return contribution
#' @param asof As of or ending date for range of return contribution
#'
#' @return list containing numeric and character formatted table
#'
#' @details The return contribution analysis is conducted on current funds that
#' have a non-zero weight. If there is a rebalance during the period or the
#' portfolio has fees there will likely be a residual or difference between the
#' sum of the assets' contribution to return and the total portfolio return.
#'
#' @export
tblContrToRet <- function(port,
                          xwin = c('dtd', 'wtd', 'mtd', 'qtd', 'ytd', 'ttm'),
                          asof = Sys.Date()) {
  port$checkMetaData()
  is_current <- port$reb$hist_wgt[nrow(port$reb$hist_wgt),
                                  2:ncol(port$reb$hist_wgt)] != 0
  asset_list <- port$asset_list[is_current]
  asset_nm <- sapply(asset_list, '[[', 'meta')['name', ] %>% unlist()
  date_start <- sapply(xwin, calTime, asof) %>%
    as.Date(origin = '1970-01-01')
  ctr <- sapply(date_start, contrToRet, port = port, date_end = asof)
  ctr <- ctr[is_current, ]
  port_ret <- sapply(xwin, calRet, asset_list = list(port), asof = asof)
  resid = port_ret - colSums(ctr)
  ctr <- rbind(ctr, resid, port_ret)
  colnames(ctr) <- toupper(colnames(ctr))
  ctr_num <- as_tibble(ctr) %>%
    add_column(Name = c(asset_nm, 'Residual', 'Total Allocation'), .before = 1)
  ctr_fmt <- ctr_num
  ctr_fmt[, -1] <- apply(ctr_num[, -1], 2, fPercent)
  res <- list()
  res$num <- ctr_num
  res$fmt <- ctr_fmt
  return(res)
}

#' @title Table: portfolio constituent beta(s)
#'
#' @param port Portfolio object
#' @param bench_list List of benchmark(s) as Asset or Portfolio objects
#'
#'
#' @export
tblPortBeta <- function(port, bench_list, rf, freq = 'd', n_obs = 63,
                        bench_lbl = NULL) {
  port$checkMetaData()
  if (!'list' %in% class(bench_list)) {
    bench_list <- list(bench_list)
  }
  is_current <- port$reb$hist_wgt[nrow(port$reb$hist_wgt),
                                  2:ncol(port$reb$hist_wgt)] > 0
  asset_list <- port$asset_list[is_current]
  asset_nm <- sapply(asset_list, '[[', 'meta')['name', ] %>% unlist()
  if (is.null(bench_lbl)) {
    bench_nm <- sapply(bench_list, '[[', 'meta')['name', ] %>% unlist()
  } else {
    bench_nm <- bench_lbl
  }
  asset_list_net <- lapply(c(asset_list, bench_list), netRiskFree, rf = rf)
  ret <- assetToRet(asset_list_net, freq)
  xcov <- cov(ret[, 2:ncol(ret)], use = 'pairwise.complete.obs')
  xcor <- cor(ret[, 2:ncol(ret)], use = 'pairwise.complete.obs')
  n_asset <- length(asset_list)
  bench_start <- n_asset + 1
  bench_var_diag <- diag(xcov)[bench_start:nrow(xcov)]
  xbeta <- matrix(nrow = n_asset, ncol = length(bench_list))
  r2 <- xbeta
  for (i_asset in 1:n_asset) {
    icov <- xcov[bench_start:nrow(xcov), i_asset]
    xbeta[i_asset, ] <- icov / bench_var_diag
    r2[i_asset, ] <- xcor[bench_start:nrow(xcor), i_asset]^2
  }
  colnames(xbeta) <- bench_nm
  beta_num <- as_tibble(xbeta) %>%
    add_column(Name = asset_nm, .before = 1)
  colnames(r2) <- bench_nm
  r2_num <- as_tibble(r2) %>%
    add_column(Name = asset_nm, .before = 1)
  beta_fmt <- beta_num
  beta_fmt[, 2:ncol(beta_fmt)] <- apply(beta_num[, 2:ncol(beta_num)], 2, fNum)
  r2_fmt <- r2_num
  r2_fmt[, 2:ncol(r2_fmt)] <- apply(r2_num[, 2:ncol(r2_num)], 2, fPercent)
  res <- list()
  res$beta_num <- beta_num
  res$beta_fmt <- beta_fmt
  res$r2_num <- r2_num
  res$r2_fmt <- r2_fmt
  return(res)
}

#' @export
tblAssetBeta <- function(asset_list, bench_list, rf, freq = 'd', n_obs = 63,
                         bench_lbl = NULL, asset_lbl = NULL) {
  if (is.null(asset_lbl)) {
    asset_nm <- sapply(asset_list, '[[', 'meta')['name', ] %>% unlist()
  } else {
    asset_nm <- asset_lbl
  }
  if (is.null(bench_lbl)) {
    bench_nm <- sapply(bench_list, '[[', 'meta')['name', ] %>% unlist()
  } else {
    bench_nm <- bench_lbl
  }
  asset_list_net <- lapply(c(asset_list, bench_list), netRiskFree, rf = rf)
  ret <- assetToRet(asset_list_net, freq)
  xcov <- cov(ret[, 2:ncol(ret)], use = 'pairwise.complete.obs')
  xcor <- cor(ret[, 2:ncol(ret)], use = 'pairwise.complete.obs')
  n_asset <- length(asset_list)
  bench_start <- n_asset + 1
  bench_var_diag <- diag(xcov)[bench_start:nrow(xcov)]
  xbeta <- matrix(nrow = n_asset, ncol = length(bench_list))
  r2 <- xbeta
  for (i_asset in 1:n_asset) {
    icov <- xcov[bench_start:nrow(xcov), i_asset]
    xbeta[i_asset, ] <- icov / bench_var_diag
    r2[i_asset, ] <- xcor[bench_start:nrow(xcor), i_asset]^2
  }
  colnames(xbeta) <- bench_nm
  beta_num <- as_tibble(xbeta) %>%
    add_column(Name = asset_nm, .before = 1)
  colnames(r2) <- bench_nm
  r2_num <- as_tibble(r2) %>%
    add_column(Name = asset_nm, .before = 1)
  beta_fmt <- beta_num
  beta_fmt[, 2:ncol(beta_fmt)] <- apply(beta_num[, 2:ncol(beta_num)], 2, fNum)
  r2_fmt <- r2_num
  r2_fmt[, 2:ncol(r2_fmt)] <- apply(r2_num[, 2:ncol(r2_num)], 2, fPercent)
  res <- list()
  res$beta_num <- beta_num
  res$beta_fmt <- beta_fmt
  res$r2_num <- r2_num
  res$r2_fmt <- r2_fmt
  return(res)
}


#' @export
netRiskFree <- function(asset, rf) {
  if ('list' %in% class(asset)) {
    asset <- asset[[1]]
    warning('asset argument is a list, trying to take the first slot')
  }
  if (is.null(asset$meta$rf_net)) {
    stop('asset$meta$rf_net not set')
  }
  if (asset$meta$freq != rf$meta$freq) {
    stop('asset freq and rf freq are not the same')
  }
  if (asset$meta$rf_net == 0) {
    return(asset)
  } else {
    asset_out <- asset$clone(deep = FALSE)
    ret <- left_join(asset$time_series, rf$time_series, by = 'date')
    comm_start <- max(asset$time_series$date[1], rf$time_series$date[1])
    ret <- ret %>%
      filter(date >= comm_start)
    ret[is.na(ret[, 3]), 3] <- 0
    ret[, 2] <- ret[, 2] - ret[, 3]
    asset_out$time_series <- ret[, 1:2]
    return(asset_out)
  }
}

#' @export
tblPortSd <- function(port, bench = NULL, freq = 'w',
                      xwin = c('qtd', 'ytd', 'ttm', '3 yr', '5 yr', '10 yr'),
                      asof = Sys.Date()) {
  port$checkMetaData()
  if (!'list' %in% class(bench)) {
    bench <- list(bench)
  }
  is_current <- port$reb$hist_wgt[nrow(port$reb$hist_wgt),
                                  2:ncol(port$reb$hist_wgt)] > 0
  asset_list <- port$asset_list[is_current]
  nm <- sapply(asset_list, '[[', 'meta')['name', ] %>% unlist()
  if (is.null(bench[[1]])) {
    asset_list <- c(port, asset_list)
    nm <- c(port$meta$name, nm)
  } else {
    asset_list <- c(port, bench, asset_list)
    bench_nm <- sapply(bench, '[[', 'meta')['name', ] %>% unlist()
    nm <- c(port$meta$name, bench_nm, nm)
  }
  cal_sd <- sapply(xwin, calSd, freq = freq, asset_list = asset_list,
                   asof = asof)
  cal_sd <- as_tibble(cal_sd) %>%
    add_column(Name = nm, .before = 1)
  colnames(cal_sd)[2:ncol(cal_sd)] <- toupper(colnames(cal_sd)[2:ncol(cal_sd)])
  cal_sd_fmt <- cal_sd
  cal_sd_fmt[, 2:ncol(cal_sd)] <- apply(cal_sd[, 2:ncol(cal_sd)], 2, fPercent)
  res <- list()
  res$num <- cal_sd
  res$fmt <- cal_sd_fmt
  return(res)
}

#' @title Table Portfolio and Constituent Returns
#'
#' @param port Portfolio Object
#' @param bench Optional Assset or Portfolio Object benchmark
#' @param asof as of date for returns
#'
#' @export
tblPortRet <- function(port, bench = NULL,
                       xwin = c('dtd', 'wtd', 'mtd', 'qtd', 'ytd'),
                       asof = Sys.Date()) {
  port$checkMetaData()
  if (!'list' %in% class(bench)) {
    bench <- list(bench)
  }
  is_current <- port$reb$hist_wgt[nrow(port$reb$hist_wgt),
                                  2:ncol(port$reb$hist_wgt)] > 0
  asset_list <- port$asset_list[is_current]
  nm <- sapply(asset_list, '[[', 'meta')['name', ] %>% unlist()
  if (is.null(bench)) {
    asset_list <- c(port, asset_list)
    nm <- c(port$meta$name, nm)
  } else {
    asset_list <- c(port, bench, asset_list)
    bench_nm <- sapply(bench, '[[', 'meta')['name', ] %>% unlist()
    nm <- c(port$meta$name, bench_nm, nm)
  }
  cal_ret <- sapply(xwin, calRet,
                asset_list = asset_list, asof = asof)
  cr <- as_tibble(cal_ret) %>%
    add_column(Name = nm, .before = 1)
  colnames(cr)[2:ncol(cr)] <- toupper(colnames(cr)[2:ncol(cr)])
  cr_fmt <- cr
  cr_fmt[, 2:ncol(cr)] <- apply(cr[, 2:ncol(cr)], 2, fPercent)
  res <- list()
  res$num <- cr
  res$fmt <- cr_fmt
  return(res)
}

#' @export
tblFundPerf <- function(fund, bench, rf, freq = 'm', date_start = NULL,
                        date_end = NULL, fund_lbl = NULL, bench_lbl = NULL) {
  if (is.null(date_start)) {
    date_start <- as.Date('0000-01-01')
  }
  if (is.null(date_end)) {
    date_end <- Sys.Date()
  }
  if (is.null(fund_lbl)) {
    fund_lbl <- fund$meta$name
  }
  if (!'list' %in% class(bench)) {
    bench <- list(bench)
  }
  if (is.null(bench_lbl)) {
    bench_lbl <- sapply(bench, '[[', 'meta')['provider_id', ]
  }
  asset <- c(fund, bench, rf)
  ret <- assetToRet(asset, freq) %>%
    filter(date >= date_start) %>%
    filter(date <= date_end)
  comm_incept <- ret$date[1]
  if (comm_incept > date_start) {
    warning('common inception is ', comm_incept)
  }
  ret <- ret %>%
    replace(is.na(.), 0)
  end_col <- ncol(ret) - 1
  rf_col <- ncol(ret)
  ann_ret <- annRet(ret[, 1:end_col], freq = freq)
  ann_sd <- apply(ret[, 2:end_col], 2, sd, na.rm = TRUE) *
    sqrt(freqToScale(freq))
  sharpe <- sharpeRatio(ret[, 1:end_col], rf = ret[, c(1, rf_col)], freq = freq)
  max_dd <- maxDrawdown(ret[, 1:end_col])
  te <- rep(NA, end_col - 1)
  ir <- te
  cr <- matrix(nrow = 2, ncol = end_col - 1)
  for (i in 3:end_col) {
    te[i - 1] <- trackingError(ret[, 1:2], ret[, c(1, i)], freq = freq)
    ir[i - 1] <- infoRatio(ret[, 1:2], ret[, c(1, i)], freq = freq)
    cr[, i - 1] <- captureRatio(ret[, 1:2], ret[c(1, i)])
  }
  nup <- apply(ret[, 2:end_col], 2, nUpDown, direct = 'up')
  ndown <- apply(ret[, 2:end_col], 2, nUpDown, direct = 'down')
  omega <- omegaRatio(ret[, 1:end_col])
  sortino <- sortinoRatio(ret[, 1:end_col], rf = ret[, c(1, rf_col)],
                          freq = freq)
  res_num <- tibble(
    `Annualized Return` = ann_ret,
    Volatility = ann_sd,
    `Sharpe Ratio` = sharpe,
    `Sortino Ratio` = sortino,
    `Omega Ratio` = omega,
    `Max Drawdown` = max_dd,
    `Tracking Error` = te,
    `Info Ratio` = ir,
    `Up Capture` = cr[1, ],
    `Down Capture` = cr[2, ],
    `Up Periods` = nup,
    `Down Periods ` = ndown
  )
  res_fmt <- res_num %>%
    mutate(`Annualized Return` = fPercent(`Annualized Return`),
           Volatility = fPercent(Volatility),
           `Sharpe Ratio` = fNum(`Sharpe Ratio`),
           `Sortino Ratio` = fNum(`Sortino Ratio`),
           `Omega Ratio` = fNum(`Omega Ratio`),
           `Max Drawdown` = fPercent(`Max Drawdown`),
           `Tracking Error` = fPercent(`Tracking Error`),
           `Info Ratio` = fNum(`Info Ratio`),
           `Up Capture` = fPercent(`Up Capture`),
           `Down Capture` = fPercent(`Down Capture`))
  res_fmt <- t(res_fmt) %>%
    as.data.frame()
  colnames(res_fmt) <- c(fund_lbl, bench_lbl)
  res_fmt <- add_column(res_fmt, Estimate = rownames(res_fmt), .before = 1)
  colnames(res_fmt)[1] <- paste0('Estimate (from ', tolower(freqToStr(freq)),
                                   ' frequency)')
  rownames(res_fmt) <- NULL
  res <- list()
  res$num <- res_num
  res$fmt <- res_fmt
  return(res)
}

#' @export
tblQuantile <- function(asset, freq,
                        q = c(0.025, 0.05, 0.10, 0.25, 0.5, 0.75, 0.95),
                        lbl = NULL) {
  ret <- assetToRet(asset, freq)
  qtl <- apply(ret[, 2:ncol(ret)], 2, quantile, probs = q, na.rm = TRUE)
  tbl <- as_tibble(qtl) %>%
    add_column(Percentile = fPercent(q), .before = 1)
  if (is.null(lbl)) {
    lbl <- sapply(asset, '[[', 'meta')['provider_id', ]
  }
  freq_str <- freqToStr(freq)
  colnames(tbl)[2:ncol(tbl)] <- lbl
  tbl_fmt <- tbl %>%
    mutate_at(vars(-Percentile), fPercent)
  colnames(tbl_fmt)[1] <- paste0('Percentile (', freq_str, ')')
  res <- list()
  res$num <- tbl
  res$fmt <- tbl_fmt
  return(res)
}


#' @title Forefront Multi-variate regression for multiple y variables
#'
#' @param asset_list list of Asset / Portfolio objects for y variables
#' @param factor_list list of Asset / Portfolio objects for x variables
#' @param cash Asset object for risk-free proxy
#' @param freq Time-series frequency (all time-series will be converted to
#'   this frequency)
#'
#' @export
ffaReg <- function(asset_list, factor_list, cash, freq = 'w') {

  # multivariate linear regression for multiple y variables
  # asset_list = list of asset / portfolio objects (y variables)
  # factor_list = list of factor asset objects (x variables)
  # cash = cash asset object for rf in regression
  # freq = data frequency, weekly by default

  # net risk free from y (asset) and x (factor) variables
  mult <- freqToScale(freq)
  asset_list <- changeAssetFreq(asset_list, freq)
  factor_list <- changeAssetFreq(factor_list, freq)
  cash <- changeAssetFreq(list(cash), freq)
  cash <- cash[[1]]
  asset_list_rf <- list()
  for (i in 1:length(asset_list)) {
    asset_list_rf[[i]] <- netRiskFree(asset_list[[i]], rf = cash)
  }
  factor_list_rf <- list()
  for (i in 1:length(factor_list)) {
    factor_list_rf[[i]] <- netRiskFree(factor_list[[i]], rf = cash)
  }

  # use asset and factor names as labels for tables
  asset_lbl <- sapply(asset_list, '[[', 'meta')['name', ] %>% unlist()
  factor_lbl <- sapply(factor_list, '[[', 'meta')['name', ] %>% unlist()

  # loop through each asset and run a regression against the factor model,
  # regression results are stored in the fit list
  fit <- list()
  for (i in 1:length(asset_list_rf)) {
    regdat_lst <- lapply(c(asset_list_rf[i], factor_list_rf), '[[', 'time_series')
    regdat <- Reduce(function(x, y) full_join(x, y, by = 'date'), regdat_lst) %>%
      select(-date)
    colnames(regdat) <- c('asset', factor_lbl)
    fit[[i]] <- lm(asset ~ ., data = regdat)
  }

  # wrangle regression summary into FFA regression format for presenting
  fit_s <- lapply(fit, summary)
  reg_summ <- lapply(fit_s, broom::tidy) %>%
    lapply('[[', 'estimate') %>%
    do.call(what = 'rbind') %>%
    cbind(data.frame(Name = asset_lbl)) %>%
    cbind(sapply(fit_s, '[[', 'adj.r.squared'))
  colnames(reg_summ) <- c('Resid.', factor_lbl, 'Name', 'Adj. R-squared')
  reg_summ_num <- reg_summ %>%
    select('Name', !! factor_lbl, everything()) %>%
    mutate(Resid.  = Resid. * mult)
  reg_summ_fmt <- reg_summ_num %>%
    mutate_at(factor_lbl, ~formatC(., digits = 2, format = 'f')) %>%
    mutate_at(c('Resid.', 'Adj. R-squared'), ~fPercent(.))
  t_stat <- lapply(fit, broom::tidy) %>%
    lapply('[[', 'statistic') %>%
    do.call(what = 'rbind') %>%
    cbind(data.frame(Name = asset_lbl))
  colnames(t_stat) <- c('Resid.', factor_lbl, 'Name')
  t_stat <- t_stat %>%
    select('Name', !! factor_lbl, everything())
  cov_factor <- fit[[1]]$model %>% select(!! factor_lbl) %>% cov()
  fact_risk_list <- list()
  for(i_asset in 1:length(asset_list_rf)) {
    y_var <- var(fit[[i_asset]]$model$asset)
    x_beta <- reg_summ_num %>% select(!! factor_lbl) %>%
      slice(i_asset) %>%
      as.numeric()
    fact_risk_list[[i_asset]] <- t(factRiskWgt(x_beta, cov_factor, y_var))
  }
  fact_risk_num <- do.call('rbind', fact_risk_list) %>%
    as.data.frame() %>%
    mutate(Resid. = 1 - apply(., 1, sum)) %>%
    add_column(Name = asset_lbl, .before = 1)
  fact_risk_fmt <- fact_risk_num %>%
    mutate_at(vars(-Name), ~fPercent(.))

  res <- list()
  res$reg_summ_num <- reg_summ_num
  res$reg_summ_fmt <- reg_summ_fmt
  res$fit <- fit
  res$t_stat <- t_stat
  res$fact_risk_num <- fact_risk_num
  res$fact_risk_fmt <- fact_risk_fmt

  return(res)
}

#' @export
fflaRepFund <- function(ffla, tick, tick_ex, ex_mu, ex_sd, fmu, fsd, bench,
                        bench_lbl, factor_list, rf, fact_lbl) {
  out <- list()
  fund <-  ts$genAsset(tick)
  fund_ex <- ts$genAsset(tick_ex)
  lbl <- c(fund$meta$name, bench_lbl)
  lbl_ex <- c(fund_ex$meta$name, bench_lbl)
  rf <- ts$genAsset('SPBDUB3T Index')
  incept <- fund$time_series$date[1]
  out$cc_ex <- coneChart(changeTimeSeriesFreq(fund_ex$time_series, 'm'),
                         ex_mu, ex_sd, 'm') +
    geom_vline(xintercept = incept, color = 'darkgrey') +
    annotate('label', x = incept, y = 0, label = paste0('Incept. ', incept),
             size = 2, color = 'darkgrey')
  res <- tblFundPerf(fund_ex, bench, rf, fund_lbl = lbl_ex[1],
                     bench_lbl = lbl_ex[2:length(lbl_ex)])
  out$kbl_perf_ex <- kable(res$fmt, align = 'c') %>%
    kable_styling(latex_options = 'striped', font_size = 9) %>%
    row_spec(0, bold = TRUE) %>%
    column_spec(1, width = '2.5cm') %>%
    column_spec(2:ncol(res$fmt), width = '2cm')
  res <- tblQuantile(c(fund_ex, bench), freq = 'm', lbl = lbl_ex)
  out$kbl_quant_ex <- kable(res$fmt, align = 'c') %>%
    kable_styling(latex_options = 'striped', font_size = 9) %>%
    row_spec(0, bold = TRUE) %>%
    column_spec(1, width = '2.5cm') %>%
    column_spec(2:ncol(res$fmt), width = '2cm')
  fund_ts <- changeTimeSeriesFreq(fund$time_series, 'w')
  out$cc <- coneChart(fund_ts, fmu, fsd, 'w')
  res <- tblFundPerf(fund, bench, rf, freq = 'w')
  out$kbl_perf <- kable(res$fmt, align = 'c') %>%
    kable_styling(latex_options = 'striped', font_size = 9) %>%
    row_spec(0, bold = TRUE) %>%
    column_spec(1, width = '2.5cm') %>%
    column_spec(2:ncol(res$fmt), width = '2cm')
  res <- tblQuantile(c(fund, bench), freq = 'w', lbl = lbl)
  out$kbl_quant <- kable(res$fmt, align = 'c') %>%
    kable_styling(latex_options = 'striped', font_size = 9) %>%
    row_spec(0, bold = TRUE) %>%
    column_spec(1, width = '2.5cm') %>%
    column_spec(2:ncol(res$fmt), width = '2cm')
  out$dpd <- denPlot(fund$time_series, 'd', 5)
  out$dpw <- denPlot(fund$time_series, 'w', 13)
  out$dpm <- denPlot(fund$time_series, 'm', 12)
  asset_list <- c(fund, ffla, bench)
  out$rp <- regPlot(asset_list, factor_list, rf, 'w', fact_lbl, plot_lbl = TRUE) +
    theme(axis.text.x = element_text(size = 8))
  return(out)
}

#' @export
genAssetFromExcel <- function(excel_file, name, provider_id, freq, mult = 1,
                              rf_net = TRUE, data_type = 'RETURN') {
  time_series <- readxl::read_excel(excel_file)
  time_series <- checkTimeSeries(time_series)
  asset <- Asset$new(check_meta = FALSE)
  asset$assignMinMetaData(name = name, provider_id = provider_id, freq = freq,
                          mult = mult, rf_net = rf_net, data_type = data_type)
  asset$time_series <- time_series
  return(asset)
}

#' @export
backfillTimeSeries <- function(ret, ret_backfill, freq = 'm') {
  ret <- changeTimeSeriesFreq(ret, freq)
  ret_backfill <- changeTimeSeriesFreq(ret_backfill, freq)
  dat <- full_join(ret, ret_backfill, by = 'date')
  is_na_x <- is.na(dat$value.x)
  dat$value.x[is_na_x] <- dat$value.y[is_na_x]
  dat <- dat[, 1:2]
  colnames(dat) <- c('date', 'value')
  dat <- arrange(dat, date)
  return(dat)
}