InvMgmt:

Documented in matrixRet replNA tidyRet

#' @export
combineRet <- function(..., freq = 'm', method = c('tidy', 'matrix'), na_rpl = 0,
                       comm_start = TRUE, comm_end = TRUE, input_list = FALSE) {

  method <- tolower(method[1])
  retl <- list(...)
  if (input_list) {
    retl <- retl[[1]]
  }
  if (length(retl) == 1) {
    warning('Only one return data.frame found. Returning input as is.')
    return(retl[[1]])
  }
  comb <- lapply(retl, checkRet) %>%
    truncAtCommon(comm_start, comm_end) %>%
    lapply(changeFreq, freq = freq) %>%
    reduce(full_join, by = 'date') %>%
    mutate_at(vars(-date), replNA, na_rpl = na_rpl)
  if (method == 'tidy') {
    comb <- comb %>%
      gather('asset', 'ret', -date) %>%
      mutate(asset = factor(asset, unique(asset)))
  }
  return(comb)
}


#' @title Utility to replace missing values
#'
#' @param x vector of numeric values
#' @param na_rpl value to replace missing NA values in x
#'
#' @return \code{x} vector with \code{NA} values replaced by \code{na_rpl} values
#'
#' @export
replNA <- function(x, na_rpl) {

  x[is.na(x)] <- na_rpl
  return(x)
}


#' @title Tidy up returns
#'
#' @details Converts returns from column organization (matrix-like) to tidy
#' organization.
#'
#' @param ret data.frame of returns organized by columns
#' @param na_repl logical or numeric value to replace NA values
#'
#' @return data.frame containing tidy returns
#'
#' @export
tidyRet <- function(ret, na_repl = 0) {

  ret %>%
    checkRet() %>%
    pivot_longer(cols = -date, values_to = 'ret', names_to = 'asset') %>%
    replace_na(list(ret = na_repl)) %>%
    mutate(asset = factor(asset, unique(asset)))
}


#' @title Pivot tidy returns wider to organize by column (matrix-like)
#'
#' @param tidy_ret data.frame of returns in tidy format
#' @param na_repl logical or numeric value to replace NA values
#'
#' @return data.frame organized by columns
#'
#' @export
matrixRet <- function(tidy_ret, na_repl = 0) {

  tidy_ret %>%
    pivot_wider(names_from = 'asset', values_from = 'ret') %>%
    replace(is.na(.), na_repl)
}


#' @title Check return or price time-series
#'
#' @family return time-series
#'
#' @param ret time-series data.frame or tibble
#' @param arrange_date boolean to sort time-series by date in ascending order
#'
#' @details \code{ret} is a data.frame or tibble of time-series data with dates
#' in the first column labeled 'date'. This function will check to see if the
#' time-series is in the proper structure. If the the time-series is not
#' properly structured this function will attempt to force the correct
#' structure.
#'
#' @return Properly specified time-series as data.frame or tibble or return
#' an error message if the time-series cannot be properly specified.
#'
#' @export
checkRet <- function(ret, arrange_date = TRUE, is_tidy = FALSE) {

  if (is_tidy) {
    if (!identical(colnames(ret), c('date', 'asset', 'return'))) {
      warning('colnames of ret are not dates, asset, return')
      colnames(ret) <- c('date', 'asset', 'return')
    }
    if (!'Date' %in% class(ret[[1]])) {
      ret[[1]] <- as.Date(ret[[1]])
    }
    if (!any(c('factor', 'character') %in% class(ret[[2]]))) {
      ret[[2]] <- as.character(ret[[2]])
    }
    if (!'numeric' %in% class(ret[[3]])) {
      ret[[3]] <- as.numeric(ret[[3]])
    }
    return(ret)
  }
  if (!'Date' %in% class(ret[[1]])) {
    warning('First column in time-series needs to be date observations.')
    try(dt <- as.Date(ret[[1]]))
    if (class(dt) == 'try-error') {
      stop('could not convert first column of time-series to date')
    } else {
      ret[[1]] <- dt
    }
  }
  if (colnames(ret)[1] != 'date') {
    warning('renaming time_series first column \'date\'')
    colnames(ret)[1] <- 'date'
  }
  if (arrange_date) {
    ret <- ret %>%
      arrange(date)
  }
  return(ret)
}


#' @title Check frequency character
#'
#' @param freq character of d, w, m, q, or a to symbolize daily, weekly,
#' monthly, quarterly, or annual frequency
#'
#' @return upppercase frequency character or error if misspecified
#'
#' @export
checkFreq <- function(freq) {

  freq <- toupper(freq)
  if (!freq %in% c('D', 'W', 'M', 'Q', 'A')) {
    stop('freq misspecified, must be \'D\', \'W\', \'M\', \'Q\', or \'A\'')
  }
  return(freq)
}


#' @title Convert frequency character to numeric scaler
#'
#' @param freq @seealso [checkFreq()]
#'
#' @return scaler
#'
#' @export
freqToScale <- function(freq) {

  freq <- checkFreq(freq)
  switch(
    toupper(freq),
    D = 252,
    W = 52,
    M = 12,
    Q = 4,
    A = 1
  )
}


#' @title Calculate mode
#'
#' @param x vector or 1-d array
#'
#' @return mode of vector `x`
#'
#' @export
xmode <- function(x) {

  ux <- unique(x)
  ux[which.max(tabulate(match(x, ux)))]
}


#' @title Guess time-series frequency
#'
#' @param ret time-series in a data.frame or tibble
#'
#' @export
guessFrequency <- function(ret) {

  ret <- checkRet(ret)
  p <- lubridate::int_diff(ret$date) %>%
    xmode() %>%
    as.numeric()
  if (p == 86400) {
    return('D')
  } else if(p == 604800) {
    return('W')
  } else if(p == 2678400) {
    return('M')
  } else if (p == 7948800) {
    return('Q')
  } else if (p > 7948800) {
    return('A')
  } else {
    return('could not guess frequency')
  }
}


#' @title Convert price (level) into return (percent change)
#'
#' @family return time-series
#'
#' @param price time-series of prices in a data.frame or tibble
#'
#' @seealso \code{checkRet} for details
#'
#' @return return time-series
#'
#' @importFrom tidyr fill
#'
#' @export
priceToRet <- function(price) {

  price <- checkRet(price)
  calcDelta <- function(x) x / lag(x, 1) - 1
  ret <- price %>%
    tidyr::fill(-date) %>% # replace missing values with last value
    mutate_at(vars(-date), calcDelta) %>%
    slice(2:nrow(price))
  return(ret)
}


#' @title Convert return (% change) to price (level)
#'
#' @family return time-series
#'
#' @param ret time-series of prices in a data.frame or tibble
#'
#' @seealso \code{checkRet} for details
#'
#' @return price time-series
#'
#' @export
retToPrice <- function(ret) {

    ret <- checkRet(ret)
  addOne <- function(x) x + 1
  price <- ret %>%
    replace(is.na(.), 0) %>%
    mutate_at(vars(-date), addOne) %>%
    mutate_at(vars(-date), cumprod)
  return(price)
}


#' @title Get inception of time-series
#'
#' @family return time-series
#'
#' @param ret time-series of prices in a data.frame or tibble
#'
#' @return inception date
#'
#' @export
getIncept <- function(ret) {

  min(ret$date)
}


#' @export
getEnd <- function(ret) {

  max(ret$date)
}


#' @title Change time-series frequency
#'
#' @family return time-series
#'
#' @param ret time-series in a data.frame or tibble
#' @param freq frequency character
#' @param data_type ret or price
#'
#' @details \code{changeFreq} converts a price or return time-series to a higher
#' latency frequency (e.g., daily to monthly). Use the first character of the
#' desired frequency. \code{data_type} is specified as either
#' ret or price depending on if the time-series are % changes or levels.
#'
#' @return higher latency time-series
#'
#' @export
changeFreq <- function(ret, freq, data_type = c('return', 'level')) {

  time_series <- checkRet(ret)
  data_type <- tolower(data_type[1])
  if (!data_type %in% c('return', 'level')) {
    stop('data_type must be return or level')
  }
  freq <- checkFreq(freq)
  if (freq == 'D') {
    return(time_series)
  }
  if (data_type == 'return') {
    time_series <- retToPrice(time_series)
  }
  date <- time_series$date
  new_date <- switch(
    freq,
    D = paste0(lubridate::day(date), '-', lubridate::year(date)),
    W = paste0(lubridate::isoweek(date), '-', lubridate::year(date)),
    M = paste0(lubridate::month(date), '-', lubridate::year(date)),
    Q = paste0(lubridate::quarter(date), '-', lubridate::year(date)),
    A = paste0(lubridate::year(date), '-', lubridate::year(date)),
  )
  time_series <- time_series %>%
    mutate(new_date = new_date) %>%
    group_by(new_date) %>%
    filter(date == max(date)) %>%
    ungroup() %>%
    select(-new_date)
  if (data_type == 'return') {
    time_series <- priceToRet(time_series)
  }
  if (freq %in% c('M', 'Q', 'A')) {
    time_series <- time_series %>%
      mutate(date = lubridate::ceiling_date(date, unit = 'months') - 1)
  }
  return(time_series)
}


#' @title Excess return
#'
#' @param ret time-series in a data.frame or tibble
#' @param rf time-series in a data.frame or tibble
#' @param na_fill optional parameter to fill missing values
#'
#' @details \code{excessRet} subtracts the \code{rf} time-series from the
#' \code{ret} time-series. \code{rf} can be a risk-free rate or benchmark
#' depending on the desired result. Leave \code{na_fill} as NULL to leave
#' missing values.
#'
#' @return time-series of `ret` that is net of the `rf` time-series
#'
#' @export
excessRet <- function(ret, rf, freq) {

  colnames(rf)[2] <- '.rf'
  combineRet(ret, rf, freq = freq, method = 'matrix') %>%
    mutate_at(.vars = vars(-date), .funs = list(~. - .rf)) %>%
    select(-.rf)
}


#' @title Find common first and last dates for two time-series data.frames
#'
#' @param x data.frame of returns with dates in first column
#' @param y data.frame of returns with dates in the first column
#'
#' @details x and y must be matrix-like data.frames organized by columns with
#' dates in ascending order
#'
#' @return an array with start and end dates
#'
#' @export
dateTrunc <- function(x, y) {

  date_start <- min(x$date[1], y$date[1])
  date_end <- max(x$date[nrow(x)], y$date[nrow(y)])
  c(date_start, date_end)
}


#' @title Download time-series from Tiingo
#'
#' @param ticker symbol to download, e.g., aapl
#' @param t_api your Tiingo API key, see details
#' @param try_mode boolean to use \code{try} when downloading
#'
#' @details Time-series is downloaded from Tiingo, an online data library for
#' publically traded stocks, ETFs, and mutual funds - www.tiingo.com. You can
#' sign up for a free account and get an API key. This function returns the
#' dates and percent change (return) of the adjusted close (price adjusted
#' for dividends and other corporate actions).
#'
#' @return Time-series of total returns
#'
#' @importFrom jsonlite read_json
#'
#' @export
downloadTiingo <- function(ticker, t_api, try_mode = TRUE) {

  t_url <- paste0('https://api.tiingo.com/tiingo/daily/',
                  ticker,
                  '/prices?startDate=1970-01-01',
                  '&endDate=', Sys.Date(),
                  '&token=', t_api)
  if (try_mode) {
    dat <- try(jsonlite::read_json(t_url))
    if ('try-error' %in% class(dat))
      return(NULL)
  } else {
    dat <- jsonlite::read_json(t_url)
  }
  date_vec <- sapply(dat, '[[', 'date') %>%
    as.Date()
  price_vec <- sapply(dat, '[[', 'adjClose')
  if (try_mode) {
    price <- try(data.frame(date_vec, price_vec))
    if ('try-error' %in% class(dat))
      return(NULL)
  } else {
    price <- data.frame(date_vec, price_vec)
  }
  colnames(price) <- c('date', ticker)
  ret <- priceToRet(price)
  return(ret)
}


#' @title Download data from FRED
#'
#' @param ticker symbol of time-series
#' @param try_mode boolean to use \code{try} when downloading
#'
#' @details Downloads time-series from St. Louis Fed's online library
#' https://fred.stlouisfed.org/
#'
#' @return time-series
#'
#' @export
downloadFRED <- function(ticker, try_mode = TRUE) {

  tmp <- tempfile()
  f_url <- paste0('https://fred.stlouisfed.org/series/',
                 ticker,
                 '/downloaddata/',
                 ticker,
                 '.csv')
  if (try_mode) {
    getdat <- try(download.file(f_url, destfile = tmp))
    if ('try-error' %in% class(getdat)) {
      stop(paste0('could not download ', ticker))
    }
  }
  dat <- read.csv(tmp, na.string = '.')
  colnames(dat) <- c('date', ticker)
  return(dat)
}


#' @title Download from French's datalibrary
#'
#' @return list with 5 fama-french factors, momentum, and 12 industries
#'
#' @export
downloadFrench <- function() {

  tmp <- tempfile()
  base_url <- 'http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/'
  ff_url <- paste0(base_url, 'F-F_Research_Data_5_Factors_2x3_daily_CSV.zip')
  mo_url <- paste0(base_url, 'F-F_Momentum_Factor_daily_CSV.zip')
  indstry_url <- paste0(base_url, '12_Industry_Portfolios_daily_CSV.zip')
  download.file(ff_url, destfile = tmp)
  uzfile <- unzip(tmp)
  cleanFrenchRet <- function(x) {
    x <- gsub('  ', '', x)
    x <- gsub(' ', '', x)
    x <- as.numeric(x)
    x[x >= 99.99] <- NA
    x[x <= -99.99] <- NA
    x / 100
  }
  ff <- read.csv(uzfile, skip = 2) %>%
    mutate(X = as.Date(as.character(X), format = '%Y%m%d')) %>%
    mutate_at(vars(-X), cleanFrenchRet) %>%
    checkRet()
  download.file(mo_url, tmp)
  uzfile <- unzip(tmp)
  mo <- read.csv(uzfile, skip = 12) %>%
    mutate(X = as.Date(as.character(X), format = '%Y%m%d')) %>%
    mutate_at(vars(-X), cleanFrenchRet) %>%
    checkRet()
  download.file(indstry_url, tmp)
  uzfile <- unzip(tmp)
  indstry <- read.csv(uzfile, skip = 9, stringsAsFactors = FALSE) %>%
    mutate(X = as.Date(as.character(X), format = '%Y%m%d')) %>%
    mutate_at(vars(-X), cleanFrenchRet) %>%
    checkRet()
  res <- list()
  res$ff <- ff
  res$mo <- mo
  res$indstry <- indstry
  return(res)
}


#' @title Download from Shiller's datalibrary
#'
#' @return data.frame with time-series organized by columns
#'
#' @export
downloadShiller <- function() {

  tmp <- tempfile()
  s_url <- 'http://www.econ.yale.edu/~shiller/data/ie_data.xls'
  download.file(s_url, tmp)
  dat <- readxl::read_xls(tmp, sheet = 'Data', skip = 7)
  dt <- formatC(dat$Date, digits = 2, format = 'f')
  yr <- substr(dt, 1, 4)
  mo <- substr(dt, 6, 7)
  dy <- rep('01', length(mo))
  dt <- as.Date(paste(yr, mo, dy, sep = '-')) %>%
    lubridate::ceiling_date(unit = 'month') - 1
  dat$Date <- dt
  dat <- dat %>%
    mutate(TP = P + D) %>%
    mutate(Ret = TP / lag(TP, 1) - 1) %>%
    select(-Fraction)
  return(dat)
}


#' @title Combine list of returns into one data.frame
#'
#' @param retl list of return time-series
#' @param trunc_incept truncate at common intercept
#' @param na_fill optional parameter to fill missing values
#'
#' @export
retListToDataframe <- function(retl, trunc_incept = TRUE, na_fill = NULL) {

  ret <- Reduce(function(x, y) full_join(x, y, by = 'date'), retl)
  if (trunc_incept) {
    incept <- sapply(retl, getIncept) %>%
      as.Date(origin = '1970-01-01') %>%
      max()
    ret <- ret %>% filter(date >= incept)
  }
  if (!is.null(na_fill)) {
    ret <- ret %>%
      replace(is.na(.), na_fill)
  }
  return(ret)
}


#' @title Create time-series of rebalance weights
#'
#' @param reb_wgt_vec numeric vector of rebalance weights
#' @param freq rebalance frequency
#' @param date_start starting date to create sequence of rebalance dates
#' @param date_end ending date to create sequence of rebalance dates
#'
#' @export
autoRebWgt <- function(reb_wgt_vec, freq = 'q', date_start = NA,
                       date_end = Sys.Date()) {

  freq <- checkFreq(freq)
  if (is.na(date_start)) {
    date_start <- as.Date('2005-01-01')
  }
  if (!is.numeric(reb_wgt_vec)) {
    warning('reb_wgt_vec is not a vector, trying to force')
    reb_wgt_vec <- as.vector(reb_wgt_vec)
  }
  day_vec <- seq.Date(from = date_start, to = date_end, by = 'days')
  reb_wgt_mat <- matrix(reb_wgt_vec, nrow = length(day_vec),
                        ncol = length(reb_wgt_vec), byrow = TRUE)
  reb_wgt <- data.frame(date = day_vec, reb_wgt_mat) %>%
    changeFreq(freq = freq, data_type = 'level') %>%
    filter(date >= date_start) %>%
    filter(date <= date_end)
  return(reb_wgt)
}


#' @title Combine assets into a portfolio time-series
#'
#' @family return time-series
#'
#' @param ret time-series in a data.frame or tibble
#' @param reb_wgt vector of rebalance weights or a data.frame containing a
#' time-series of rebalance dates and corresponding weights, if left as
#' \code{NA} an equal weighted assumption will be made
#' @param reb_freq a rebalance frequency to transform a rebalance vector into
#' a time-series of rebalance weights
#' @param ret_freq return frequency of the time-series containing asset returns
#' @param date_start inception date to truncate portfolio returns
#' @param date_end ending date to truncate portfolio returns
#' @param t_cost optional input for transactions costs
#'
#' @export
rebal <- function(ret, reb_wgt = NA, reb_freq = 'q', ret_freq = 'd',
                  date_start = NA, date_end = Sys.Date(), t_cost = NA) {

  n_assets <- ncol(ret) - 1
  n_obs <- nrow(ret)
  if (is.na(reb_wgt)) {
    reb_wgt <- rep(1 / n_assets, n_assets)
  }
  if (is.na(date_start)) {
    date_start <- as.Date('2005-01-01')
  }
  if (is.vector(reb_wgt)) {
    reb_wgt <- autoRebWgt(reb_wgt, reb_freq, date_start, date_end)
  }
  if (is.na(t_cost)) {
    t_cost <- rep(0, n_assets)
  }
  if (length(t_cost) == 1) {
    t_cost <- rep(t_cost, length(n_assets))
  }
  ret <- ret %>%
    changeFreq(ret_freq) %>%
    replace(is.na(.), 0)
  reb_wgt <- reb_wgt %>%
    replace(is.na(.), 0)
  ret_dt <- ret %>% select(date)
  reb_wgt_dt <- reb_wgt %>% select(date)
  ret_mat <- ret %>% select(-date)
  reb_wgt_mat <- reb_wgt %>% select(-date)
  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 <- data.frame(date = c(ret_dt$date[1] - 1, ret_dt$date),
                         hist_wgt_mat) %>%
    mutate(date = as.Date(date, origin = '1970-01-01'))
  port_index <- data.frame(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 <- data.frame(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)
  last_wgt <- hist_wgt[nrow(hist_wgt), 2:ncol(hist_wgt)] %>%
    as.numeric()
  is_curr <- last_wgt != 0
  curr_wgt <- last_wgt[is_curr]
  id <- colnames(ret)[2:ncol(ret)]
  curr_id <- id[is_curr]
  curr_df <- data.frame(Asset = curr_id, Wgt = curr_wgt)
  res <- list()
  res$time_series <- port_ret[2:nrow(port_ret), ]
  res$reb$curr_df <- curr_df
  res$reb$asset_ret <- data.frame(date = ret_dt, ret_mat)
  res$reb$hist_wgt <- hist_wgt
  res$reb$asset_index <- asset_index
  res$reb$port_index <- port_index
  return(res)
}


#' @title Net a constant fee from a time-series
#'
#' @param ret return time-series with dates in first column and values in the
#' second column
#' @param annual_fee annual_fee to deduct, e.g., 2% = 0.02
#' @param ret_freq return frequency
#'
#' @details The annual fee is scaled by the frequency and subtracted from each
#' observation in the time-series, i.e., (1 + annual_fee)^(1 / freq_scale) - 1
#'
#' @export
netFee <- function(ret, annual_fee, ret_freq = 'm') {

    mult <- freqToScale(ret_freq)
  fee_vec <- rep((1 + annual_fee)^(1 / mult) - 1, nrow(ret))
  ret[, 2] <- ret[, 2] - fee_vec
  return(ret)
}


#' @title Calendar time helper
#'
#' @param xwin calendar window
#' @param asof as of date
#'
#' @return beginning date of window
#'
#' @export
calTime <- function(xwin = c('dtd', 'wtd', 'mtd', 'qtd', 'ytd', 'ttm',
                             '3 yr', '5 yr', '10 yr', '20 yr', '30 yr'),
                    asof = Sys.Date()) {

  xwin <- xwin[1] %>% tolower()
  xyear <- lubridate::year(asof)
  xmon <- lubridate::month(asof)
  xday <- lubridate::day(asof)
  switch (xwin,
          dtd = asof,
          wtd = lubridate::floor_date(asof, 'week') + 1,
          mtd = lubridate::floor_date(asof, 'month'),
          qtd = lubridate::floor_date(asof, 'quarter'),
          ytd = lubridate::floor_date(asof, 'year'),
          ttm = paste0(xyear - 1, '-', xmon, '-', xday) %>% as.Date(),
          '3 yr' = paste0(xyear - 3, '-', xmon, '-', xday) %>% as.Date(),
          '5 yr' = paste0(xyear - 5, '-', xmon, '-', xday) %>% as.Date(),
          '10 yr' = paste0(xyear - 10, '-', xmon, '-', xday) %>% as.Date(),
          '20 yr' = paste0(xyear - 20, '-', xmon, '-', xday) %>% as.Date(),
          '30 yr' = paste0(xyear - 30, '-', xmon, '-', xday) %>% as.Date()
  )
}


#' @title Truncate return time-series
#'
#' @param ret data.frame containing returns
#' @param date_start date to filter out observations before this date
#' @param date_end date to filter out observations after this date
#'
#' @return data.frame of time-series with truncated dates
#'
#' @export
truncReturns <- function(ret, date_start = NULL, date_end = NULL) {

  if (!is.null(date_start)) {
    ret <- filter(ret, date >= date_start)
  }
  if (!is.null(date_end)) {
    ret <- filter(ret, date <= date_end)
  }
  return(ret)
}


#' @title Truncate a list of time-series based on common first and last dates
#'
#' @param ret_list list of data.frames containing time-series
#' @param date_start boolean to truncate all time-series at common inception
#' @param date_end boolean to truncate all time-series at common last date
#'
#' @return list of data.frames containing truncated time-series
#'
#' @export
truncAtCommon <- function(ret_list, date_start = TRUE, date_end = FALSE) {

  if (date_start) {
    date_start <- sapply(ret_list, getIncept) %>%
      as.Date(origin = '1970-01-01') %>%
      max()
  } else {
    date_start <- NULL
  }
  if (date_end) {
    date_end <- sapply(ret_list, getEnd) %>%
      as.Date(origin = '1970-01-01') %>%
      min()
  } else {
    date_end <- NULL
  }
  lapply(ret_list, truncReturns, date_start = date_start, date_end = date_end)
}