fpemreporting: fpemreporting

#' Data set of weights for aggregation of samples
#'
#' @param runcodes \emph{'Vector'} A vector of country codes in the order of the coutnry runs
#' @param union \emph{'Character string'} "Y" for women in union
#' @param first_year \emph{'Numeric'}
#' @param last_year \emph{'Numeric'}
#'
#' @return \emph{'Data.frame'} A data set with weights and divisions
#' @export
#'
get_weightdata <- function(runcodes, union, first_year, last_year) {
  popcount <- fpemdata::get_population_counts()
  recode <- fpemdata:::get_legacy()
  df <- popcount %>% dplyr::left_join(recode)
  df <- df %>% dplyr::filter(division_numeric_code %in% runcodes) %>%
    dplyr::filter(is_in_union == union) %>%
    dplyr::filter(mid_year <= last_year) %>%
    dplyr::filter(mid_year >= first_year)
  colnames(df) <- colnames(df) %>% tolower()
  df <- df %>% dplyr::rename(popct = population_count) %>% dplyr::rename(major_area = "major area")
  temp <- df
  # weight_r_ct for aggregating countries to region
  temp <- temp %>%
    dplyr::group_by(region, mid_year) %>%
    dplyr::mutate(poprt = sum(popct))
  temp <- temp %>%
    dplyr::mutate(weight_r_ct = popct/poprt)
  # weight_m_ct for aggregating countries to major area
  temp <- temp %>%
    dplyr::group_by(region, mid_year) %>%
    dplyr::mutate(popmt = sum(popct))
  temp <- temp %>%
    dplyr::mutate(weight_m_ct = popct/popmt)
  # weight_w_ct for aggregating countries to world
  temp <- temp %>%
    dplyr::group_by(mid_year) %>%
    dplyr::mutate(popwt = sum(popct))
  temp <- temp %>%
    dplyr::mutate(weight_w_ct = popct/popwt)
  weightdata <- temp %>% dplyr::select(division_numeric_code,
                                     region,
                                     major_area,
                                     mid_year,
                                     weight_r_ct,
                                     weight_m_ct,
                                     weight_w_ct)
  return(weightdata)
}



  #' Weight samples
#'
#' @inheritParams fpem_calculate_results
#' @param weights \emph{'Vector'} A vector of weights selected from \code{\link[fpemreporting:get_weightdata]{fpemreporting::get_weightdata}}
#' @export
#'
#' @return \emph{'Numeric array'} An array of samples of dimension chains x samples x years x proportions
#'
#' @examples
weight_samples <- function(posterior_samples, weights) {
  weighted_samples <- weights*aperm(posterior_samples, c(1,3,4,2))
  weighted_samples <- aperm(weighted_samples, c(1,4,2,3))
  return(weighted_samples)
}


# load("/home/greggu/Downloads/post_samps_combine.rda")
# ?fpemreporting::get_weightdata()
# ?fpemreporting::weight_samples()
# weightdata <- get_weightdata(runcodes = divisions$division_numeric_code, union = "Y", first_year = first_year, last_year = last_year)
# #major area examples ... is similar for region, make sure to use proper weight for aggregation level
# ma <- divisions$`Major area` %>% unique
## post_samps_combine <- post_samps_combine[,,1:41,]#getting 1990:2030 of your samps#not sure if this is correct
# for (m in ma) {
#   divtemp <- divisions %>% filter(`Major area` == m)
#   weightdatatemp <- weightdata %>% filter(major_area == m)
#   samps <- post_samps_combine[divtemp$index,,,]
#   weighted_samples <- weight_samples(samples = samps, weights = weightdatatemp$weight_m_ct) #eventually replace with dynamic NSA if this is a function
#   samps <- apply(weighted_samples, 2:4, sum) # add this to weighting function?
#   samps <- array(samps, dim = c(1,dim(samps))) #the weird format required for normal post processing
#   assign(paste0("samps_", tolower(m)), samps)
# }

# create unit to aggregate on
# run weightdata function (needs to also output some element with unit of aggregation)
# run weight_sample wrapper which entails ...
# INPUTS
# unique number of units to loop over
# samples
# possible indexing for order of runs ... tbd
# FUNCTION
# create sample list samplist <- ls()
# loop
# filter on each unit
# apply weights sum
# rearrange dim
# store in list of samples
# OUT
# samples