#' @title  A general function to compute one or more price indices
#'
#' @description This function returns a value or values of the selected price indices. 
#' @param data The user's data frame with information about sold products. It must contain columns: \code{time} (as Date in format: year-month-day,e.g. '2020-12-01'), \code{prices} (as positive numeric) and \code{prodID} (as numeric, factor or character). A column \code{quantities} (as positive numeric) is also essential even if the selected index is an unweighted formula (unit values are calculated). 
#' @param start The base period (as character) limited to the year and month, e.g. "2019-12".
#' @param end The research period (as character) limited to the year and month, e.g. "2020-04".
#' @param formula A vector of character strings indicating price index formulas that are to be calculated. To see available options please use the link: \code{\link{PriceIndices}}.
#' @param window A vector of integers. Each element of the vector defines the length of the time window of the corresponding multilateral index.
#' @param splice A vector of character strings. Each element of the vector indicates the splicing method is to be used for the corresponding multilateral index. Available values of vector elements are: "movement", "window","half","mean" and their additional variants: "window_published", "half_published" and "mean_published".
#' @param base The vector of prior periods used in the Young- or Lowe-type price indices or hybrid/geohybrid index. Each element of the vector (as character) must be limited to the year and month, e.g. "2020-01".
#' @param sigma The vector of elasticity of substitution parameters used in the Lloyd-Moulton, AG Mean or GEKS-LM indices (as numeric).
#' @param r The vector of non-zero parameters used in the quadratic mean of order r quantity / price index or in the GEKS-QM index (as numeric).
#' @param interval A logical value indicating whether the function is to provide price indices comparing the research period defined by \code{end} to the base period defined by \code{start} (then \code{interval} is set to FALSE) or all fixed base indices are to be presented (the fixed base month is defined by \code{start}).
#' @param names A vector of strings indicating names of indices which are to be used in the resulting data frame.
#' @rdname price_indices
#' @return This general function returns a value or values of the selected price indices. If the \code{interval} parameter is set to TRUE, then it returns a data frame where its first column indicates dates and the remaining columns show corresponding values of all selected price indices. The function does not take into account aggregating over outlets or product subgroups (to consider these types of aggregating, please use the \code{\link{final_index}} function).   
#' @examples 
#' \donttest{price_indices(milk, 
#'          start="2018-12",end="2019-12",
#'          formula=c("geks","ccdi","hybrid","fisher",
#'          "QMp","young","geksl_fbew"),
#'          window=c(13,13),
#'          base=c("2019-03","2019-03"),
#'          r=c(3),interval=TRUE)}
#' \donttest{price_indices(milk, 
#'          start="2018-12",end="2019-12",
#'          formula=c("geks","ccdi","hybrid","fisher",
#'          "QMp","young","geksl_fbew"),
#'          window=c(13,13),
#'          base=c("2019-03","2019-03"),
#'          r=c(3),interval=FALSE)}
#' @export

price_indices <-
  function(data,
  start,
  end,
  formula = c(),
  window = c(),
  splice = c(),
  base = c(),
  sigma = c(),
  r=c(),
  interval = FALSE,
  names=c())
  {
  aformula <-
  c(
  "jevons",
  "dutot",
  "carli",
  "cswd",
  "harmonic",
  "bmw",
  "dikhanov",
  "ybmd",
  "laspeyres",
  "paasche",
  "fisher",
  "tornqvist",
  "geolaspeyres",
  "geopaasche",
  "drobisch",
  "marshall_edgeworth",
  "walsh",
  "bialek",
  "banajree",
  "davies",
  "stuvel",
  "palgrave",
  "geary_khamis",
  "lehr",
  "vartia",
  "sato_vartia",
  "lloyd_moulton",
  "agmean",
  "young",
  "geoyoung",
  "lowe",
  "geolowe",
  "geowalsh",
  "theil1",
  "theil2",
  "walsh_vartia",
  "hlc",
  "QMq",
  "QMp",
  "IQMp",
  "chQMq",
  "chQMp",
  "chIQMp",
  "value_index",
  "unit_value_index",
  "chjevons",
  "chdutot",
  "chcarli",
  "chcswd",
  "chharmonic",
  "chdikhanov",
  "chbmw",
  "chybmd",
  "chlaspeyres",
  "chpaasche",
  "chfisher",
  "chtornqvist",
  "chgeolaspeyres",
  "chgeopaasche",
  "chdrobisch",
  "chmarshall_edgeworth",
  "chwalsh",
  "chbialek",
  "chbanajree",
  "chdavies",
  "chstuvel",
  "chpalgrave",
  "chgeary_khamis",
  "chlehr",
  "chvartia",
  "chsato_vartia",
  "chlloyd_moulton",
  "chagmean",
  "chyoung",
  "chgeoyoung",
  "chlowe",
  "chgeolowe",
  "chgeowalsh",
  "chtheil1",
  "chtheil2",
  "chwalsh_vartia",
  "chhlc",
  "geks",
  "wgeks",
  "geksj",
  "geksw",
  "ccdi",
  "gk",
  "tpd",
  "utpd",
  "geks_splice",
  "wgeks_splice",
  "geksj_splice",
  "geksw_splice",
  "ccdi_splice",
  "gk_splice",
  "tpd_splice",
  "utpd_splice",
  "geks_fbew",
  "geks_fbmw",
  "wgeks_fbew",
  "wgeks_fbmw",
  "geksj_fbew",
  "geksj_fbmw",
  "geksw_fbew",
  "geksw_fbmw",
  "ccdi_fbew",
  "ccdi_fbmw",
  "gk_fbew",
  "gk_fbmw",
  "tpd_fbew",
  "tpd_fbmw",
  "utpd_fbew",
  "utpd_fbmw",
  "hybrid",
  "geohybrid",
  "chhybrid",
  "chgeohybrid",
  "SPQ",
  "geksl",
  "wgeksl",
  "geksl_splice",
  "wgeksl_splice",
  "geksl_fbew",
  "wgeksl_fbew",
  "geksl_fbmw",
  "wgeksl_fbmw",
  "geksgl",
  "wgeksgl",
  "geksgl_splice",
  "wgeksgl_splice",
  "geksgl_fbew",
  "wgeksgl_fbew",
  "geksgl_fbmw",
  "wgeksgl_fbmw",
  "geksaqu",
  "wgeksaqu",
  "geksaqu_splice",
  "wgeksaqu_splice",
  "geksaqu_fbew",
  "wgeksaqu_fbew",
  "geksaqu_fbmw",
  "wgeksaqu_fbmw",
  "geksaqi",
  "wgeksaqi",
  "geksaqi_splice",
  "wgeksaqi_splice",
  "geksaqi_fbew",
  "wgeksaqi_fbew",
  "geksaqi_fbmw",
  "wgeksaqi_fbmw",
  "geksgaqi",
  "wgeksgaqi",
  "geksgaqi_splice",
  "wgeksgaqi_splice",
  "geksgaqi_fbew",
  "wgeksgaqi_fbew",
  "geksgaqi_fbmw",
  "wgeksgaqi_fbmw",
  "geksiqm","geksiqm_splice","geksiqm_fbmw","geksiqm_fbew",
  "geksqm","geksqm_splice","geksqm_fbmw","geksqm_fbew",
  "gekslm","gekslm_splice","gekslm_fbmw","gekslm_fbew" 
  )
  for (index in formula) if (!(index %in% aformula))
  stop ("There is a typo in the index name")
  
  if (length(names)>0) if (!(length(names)==length(formula))) stop ("Parameters 'formula' and 'names' must have the same length!")
  
  #indices for increasing parameters:
  inc_splice<-c("geks_splice","wgeks_splice",
  "geksj_splice","geksw_splice","ccdi_splice",
  "gk_splice","tpd_splice","utpd_splice","geksl_splice","wgeksl_splice",
  "geksgl_splice","wgeksgl_splice","geksaqu_splice",
  "wgeksaqu_splice","geksaqi_splice","wgeksaqi_splice",
  "geksgaqi_splice","wgeksgaqi_splice")
  
  inc_window<-c("geks","wgeks","geksj","geksw","ccdi",
  "gk","tpd","utpd","geksl","wgeksl","geksgl","wgeksgl",
  "geksaqu","wgeksaqu","geksaqi","wgeksaqi",
  "geksgaqi","wgeksgaqi")
  
  inc_base<-c("young","geoyoung","lowe","geolowe","hybrid","geohybrid","chyoung","chgeoyoung","chlowe","chgeolowe","chhybrid","chgeohybrid")
  
  inc_sigma<-c("lloyd_moulton","agmean","chlloyd_moulton","chagmean","gekslm_fbew","gekslm_fbmw")
  
  inc_r<-c("QMq","QMp","IQMp","chQMq","chQMp","chIQMp","geksqm_fbew","geksqm_fbmw","geksiqm_fbew","geksiqm_fbmw")
  
  inc_window_sigma<-c("gekslm")
  
  inc_splice_sigma<-c("gekslm_splice")
  
  inc_window_r<-c("geksqm","geksiqm")
  
  inc_splice_r<-c("geksqm_splice","geksiqm_splice")
  
  considered_indices<-c(inc_splice,inc_window,inc_base,
  inc_sigma,inc_r,inc_window_sigma,inc_splice_sigma,
  inc_window_r,inc_splice_r)  
  
  #testing parameters
  ok_window<-0
  ok_splice<-0
  ok_base<-0
  ok_sigma<-0
  ok_r<-0
  for (index in formula) {
    if (index %in% inc_splice) {
      ok_window<-ok_window+1 
      ok_splice<-ok_splice+1}
    if (index %in% inc_splice_sigma) {
      ok_window<-ok_window+1
      ok_splice<-ok_splice+1
      ok_sigma<-ok_sigma+1}
    if (index %in% inc_splice_r) {
      ok_window<-ok_window+1
      ok_splice<-ok_splice+1
      ok_r<-ok_r+1}
    if (index %in% inc_window_sigma) {
      ok_window<-ok_window+1
      ok_sigma<-ok_sigma+1}
    if (index %in% inc_window_r) {
      ok_window<-ok_window+1
      ok_r<-ok_r+1}
    if (index %in% inc_window) {
      ok_window<-ok_window+1}
    if (index %in% inc_base) {
      ok_base<-ok_base+1}
    if (index %in% inc_sigma) {
      ok_sigma<-ok_sigma+1}
    if (index %in% inc_r) {
      ok_r<-ok_r+1}
    }  
    if (!((length(window)==ok_window) & (length(splice)==ok_splice) & (length(base)==ok_base) & (length(sigma)==ok_sigma) & (length(r)==ok_r))) stop("The number of needed parameters is not correct!") 
#taking the index parameters  
  p_window<-c()
  l_window<-1
  p_splice<-c()
  l_splice<-1
  p_base<-c()
  l_base<-1
  p_sigma<-c()
  l_sigma<-1
  p_r<-c()
  l_r<-1
  for (index in formula) {
    if (!(index %in% considered_indices)) {
      p_window<-c(p_window, 13)
      p_splice<-c(p_splice, "movement")
      p_base<-c(p_base, start)
      p_sigma<-c(p_sigma, 0.7)
      p_r<-c(p_r, 2)}
    if (index %in% inc_splice) {
      p_window<-c(p_window, window[l_window])
      l_window<-l_window+1
      p_splice<-c(p_splice, splice[l_splice])
      l_splice<-l_splice+1
      p_base<-c(p_base, start)
      p_sigma<-c(p_sigma, 0.7)
      p_r<-c(p_r, 2)}
    if (index %in% inc_splice_sigma) {
      p_window<-c(p_window, window[l_window])
      l_window<-l_window+1
      p_splice<-c(p_splice, splice[l_splice])
      l_splice<-l_splice+1
      p_base<-c(p_base, start)
      p_sigma<-c(p_sigma, sigma[l_sigma])
      l_sigma<-l_sigma+1
      p_r<-c(p_r, 2)}
    if (index %in% inc_splice_r) {
      p_window<-c(p_window, window[l_window])
      l_window<-l_window+1
      p_splice<-c(p_splice, splice[l_splice])
      l_splice<-l_splice+1
      p_base<-c(p_base, start)
      p_sigma<-c(p_sigma, 0.7)
      p_r<-c(p_r, r[l_r])
      l_r<-l_r+1}
    if (index %in% inc_window_sigma) {
      p_window<-c(p_window, window[l_window])
      l_window<-l_window+1
      p_splice<-c(p_splice, "movement")
      p_base<-c(p_base, start)
      p_sigma<-c(p_sigma, sigma[l_sigma])
      l_sigma<-l_sigma+1
      p_r<-c(p_r, 2)}
    if (index %in% inc_window_r) {
      p_window<-c(p_window, window[l_window])
      l_window<-l_window+1
      p_splice<-c(p_splice, "movement")
      p_base<-c(p_base, start)
      p_sigma<-c(p_sigma, 0.7)
      p_r<-c(p_r, r[l_r])
      l_r<-l_r+1}                         
    if (index %in% inc_window) {
      p_window<-c(p_window, window[l_window])
      l_window<-l_window+1
      p_splice<-c(p_splice, "movement")
      p_base<-c(p_base, start)
      p_sigma<-c(p_sigma, 0.7)
      p_r<-c(p_r, 2)}
    if (index %in% inc_base) {
      p_window<-c(p_window, 13)
      p_splice<-c(p_splice, "movement")
      p_base<-c(p_base, base[l_base])
      l_base<-l_base+1
      p_sigma<-c(p_sigma, 0.7)
      p_r<-c(p_r, 2)}
    if (index %in% inc_sigma) {
      p_window<-c(p_window, 13)
      p_splice<-c(p_splice, "movement")
      p_base<-c(p_base, start)
      p_sigma<-c(p_sigma, sigma[l_sigma])
      l_sigma<-l_sigma+1
      p_r<-c(p_r, 2)}
    if (index %in% inc_r) {
      p_window<-c(p_window, 13)
      p_splice<-c(p_splice, "movement")
      p_base<-c(p_base, start)
      p_sigma<-c(p_sigma, 0.7)
      p_r<-c(p_r, r[l_r])
      l_r<-l_r+1}
     }
   #main body  
   results_list<-list()
   if (interval==FALSE) {for (form in 1:length(formula))
     {results_list<-append(results_list, price_index(data, start, end, 
                                     formula[form], 
                                     window=p_window[form],
                                     splice=p_splice[form],
                                     base=p_base[form],
                                     sigma=p_sigma[form],
                                     r=p_r[form],
                                     interval=FALSE))
    } 
   if (length(names)>0) df<-data.frame(price_index=names, value=unlist(results_list))
   else df<-data.frame(price_index=formula, value=unlist(results_list))
   return(df)
  }
  else
  {
  for (form in 1:length(formula))
     {
  dfs<-price_index(data, start, end, 
                                     formula[form], 
                                     window=p_window[form],
                                     splice=p_splice[form],
                                     base=p_base[form],
                                     sigma=p_sigma[form],
                                     r=p_r[form],
                                     interval=TRUE)
  if (length(names)>0) colnames(dfs)[2]<-names[form]   
  results_list<-append(results_list, dfs[2])
  }
  results_list<-dplyr::bind_rows(results_list)
  start<-paste(start, "-01", sep="")
  start<-as.Date(start)
  end<-paste(end, "-01", sep="")
  end<-as.Date(end)
  time <- seq.Date(from = start, to = end, by = "month")
  time <- format(time, format = "%Y-%m")
  df<-cbind(time, results_list)
  df$time<-as.character(df$time)
  return (df)
  }
  } 


#' @title  A general function to compute a final price index
#'
#' @description This function returns a value (or values) of the selected final price index for the selected type of aggregation of partial results. 
#' @param data The user's data frame with information about sold products. It must contain columns: \code{time} (as Date in format: year-month-day,e.g. '2020-12-01'), \code{prices} (as positive numeric), \code{quantities} (as positive numeric) and \code{prodID} (as numeric, factor or character). A column \code{retID} (as numeric, factor or character) is also essential if the aggregation over outlets is considered. A column with grouping variable (as numeric, factor or character - indicated by the \code{by} parameter) is essential if the aggregation over product subgroups is considered. 
#' @param start The base period (as character) limited to the year and month, e.g. "2019-12".
#' @param end The research period (as character) limited to the year and month, e.g. "2020-04".
#' @param formula The character string indicating the price index formula is to be calculated. To see available options please use the link: \code{\link{PriceIndices}}.
#' @param window The length of the time window if the multilateral index is selected (as positive integer: typically multilateral methods are based on the 13-month time window).
#' @param splice A character string indicating the splicing method (if the multilateral splicing index is selected). Available options are: "movement", "window","half","mean" and their additional variants: "window_published", "half_published" and "mean_published". 
#' @param base The prior period used in the Young- or Lowe-type price indices (as character) limited to the year and month, e.g. "2020-01".
#' @param sigma The elasticity of substitution parameter used in the Lloyed-Moulton, AG Mean or GEKS-LM indices (as numeric).
#' @param r The non-zero parameter used in the quadratic mean of order r quantity / price index or in the GEKS-QM index (as numeric).
#' @param outlets A logical parameter indicating whether the aggregation over outlets (defined by \code{retID} column) should be done.
#' @param groups A logical parameter indicating whether the aggregation over product subgroups (indicated by 'by' parameter) should be done.
#' @param by A character string which indicates a column name for creating product subgroups.
#' @param aggr The formula used for aggregating partial index results (available values are: "arithmetic", "geometric", "laspeyres", "paasche", "fisher", "tornqvist").
#' @param interval A logical value indicating whether the function is to provide price indices comparing the research period defined by \code{end} to the base period defined by \code{start} (then \code{interval} is set to FALSE) or all fixed base indices are to be presented (the fixed base month is defined by \code{start}).
#' @rdname final_index
#' @return This general function returns a value or values of the selected final price index for the selected type of aggregation of partial results. If the \code{interval} parameter is set to TRUE, then it returns a data frame where its first column indicates dates and the remaining columns show corresponding values of all selected price indices.    
#' @examples 
#' \donttest{final_index(coffee, start = "2018-12", end = "2019-12", 
#'          formula = "fisher", groups = TRUE, outlets = FALSE, 
#'          aggr = "tornqvist", by = "description")}
#' \donttest{final_index(milk, start = "2018-12", end = "2019-12", 
#'          formula = "fisher", groups = TRUE, outlets = TRUE, 
#'          aggr = "laspeyres", by = "description", 
#'          interval = TRUE)}
#' @export

final_index <-
  function(data=data.frame(),
  start=c(),
  end=c(),
  formula=c(),
  window=c(),
  splice=c(),
  base=c(),
  sigma=c(),
  r=c(),
  outlets=FALSE,
  groups=FALSE,
  by=c(),
  aggr = "fisher",
  interval=FALSE
  )
  {
  if (length(formula)==0) stop("The specification of the price index formula has not been provided!")
  if (length(formula)>1) stop("Only one formula for the final price index should be provided!")
  if (start==end) return (1)
  if (interval==FALSE) 
    return(final_index2(data, start, end, formula, window, splice, base, sigma, r, outlets, groups, by, aggr))   
  if (interval==TRUE) {
  start_<-paste(start, "-01", sep="")
  start_<-as.Date(start_)
  end_<-paste(end, "-01", sep="")
  end_<-as.Date(end_)
  time <- seq.Date(from = start_, to = end_, by = "month")
  time <- format(time, format = "%Y-%m")
  result<-c(1)
  for (i in 2:length(time)) 
    result<-c(result, final_index2(data, start, as.character(time[i]), formula, window, splice, base, sigma, r, outlets, groups, by, aggr))
  df<-data.frame(time, result)
  df$time<-as.character(df$time)
  colnames(df)<-c("time", paste("final ", formula))
  return (df)
  }  
  }

#' @title  A general function to compute a resultatnt bilateral price index on the basis of partial price indices
#'
#' @description This function returns the resultant price index based on partial price indices, the system of weights from the base and current periods, and taking into account the aggregation formula specified by the user. 
#' @param w0 A vector of positive weights from the base period that sum to one.
#' @param wt A vector of positive weights from the current period that sum to one.
#' @param subindices A numeric vector of partial indices.
#' @param aggr The formula used for aggregating partial index results (available values are: "arithmetic", "geometric", "laspeyres", "paasche", "fisher", "tornqvist").
#' @rdname resultant_index
#' @return This function returns the resultant bilateral price index based on partial price indices, the system of weights from the base and current periods (if needed), and taking into account the aggregation formula specified by the user. The user can apply the following formulas to aggregate partial indices: the unweighted arithmetic mean, the unweighted geometric mean, the Laspeyres index formula, the Paasche index formula, the Fisher index formula, and the Törnqvist index formula. The aggregation formula is selected using the \code{aggr} parameter. 
#' @examples 
#' resultant_index(w0 = c(0.4, 0.4, 0.2), 
#' subindices = c(1.1, 0.95, 1.12), aggr = "laspeyres")
#' resultant_index(w0 = c(0.4, 0.4, 0.2), wt = c(0.35, 0.5, 0.15), 
#' subindices = c(1.1, 0.95, 1.12), aggr = "fisher")
#' @export

resultant_index<-function(w0=c(), wt=c(), subindices=c(), aggr="fisher")
{
  final_value<-NULL
  #initial check
  if (length(subindices)==0) stop("The vector with subindices cannot be empty!")
  av_aggr<-c("arithmetic", "geometric", "laspeyres", "paasche", "fisher", "tornqvist")
  if (!(aggr %in% av_aggr)) stop("There is a wrong value of the aggr paramater!")
  if (aggr %in% c("fisher","tornqvist") & length(w0)*length(wt)==0) stop("Vectors w0 and wt cannot be empty!")
  if (aggr=="laspeyres" & length(w0)==0) stop("The base vector w0 cannot be empty!")
  if (aggr=="laspeyres" & length(w0)!=length(subindices)) stop("Vectors w0 and subindices must have the same length!")
  if (aggr=="paasche" & length(wt)!=length(subindices)) stop("Vectors wt and subindices must have the same length!")
  if (aggr %in% c("fisher","tornqvist") & ((length(w0)!=length(subindices)) | (length(wt)!=length(subindices)))) stop("Vectors w0, wt and subindices must have the same length!")
  if (aggr=="paasche" & length(wt)==0) stop("The current vector wt cannot be empty!")
  if (length(w0)>0 & (round(sum(w0),4)!=1)) stop("The sum of elements of w0 must be 1!")
  if (length(wt)>0 & (round(sum(wt),4)!=1)) stop("The sum of elements of wt must be 1!")
  #main body
  if (aggr=="arithmetic") final_value<-mean(subindices)
  if (aggr=="geometric")  final_value<-prod(subindices)^(1/length(subindices))
  if (aggr=="laspeyres") final_value<-sum(w0*subindices)
  if (aggr=="paasche") final_value<-1/(sum(wt*(1/subindices)))  
  if (aggr=="fisher") final_value<-(sum(w0*subindices)*(1/(sum(wt*(1/subindices)))))^0.5
  if (aggr=="tornqvist") final_value<-prod(subindices^((w0+wt)/2))
  return(final_value)
}


