# Inequality measures: Gini, top share, percentile ratio

.parse_perc <- function(p) {
  m <- regmatches(p, regexec("^p([0-9.]+)p([0-9.]+)$", p))[[1L]]
  if (!length(m)) return(NULL)
  list(lo = as.numeric(m[2L]) / 100, hi = as.numeric(m[3L]) / 100)
}

.filter_data <- function(data, variable, country) {
  variable <- .resolve_var(data, variable)
  d <- data[data$variable == variable, ]
  if (!is.null(country)) d <- d[d$country %in% country, ]
  if (!nrow(d)) stop("No data after filtering.", call. = FALSE)
  d
}

#' Compute Gini coefficient from a share series
#'
#' Requires an \code{"s"} (share) series with \code{pXpY} percentile codes
#' covering the full distribution.
#'
#' @param data A \code{wid_df} with share series.
#' @param variable Variable code filter.
#' @param country Country code filter.
#' @return A \code{data.frame} with columns \code{country}, \code{year},
#'   and \code{gini} (numeric, 0-1).
#' @examples
#' d <- data.frame(
#'   country = rep("US", 3L), year = rep("2020", 3L),
#'   variable = rep("sptinc992j", 3L),
#'   percentile = c("p0p50", "p50p90", "p90p100"),
#'   value = c(0.20, 0.40, 0.40), age = "992", pop = "j",
#'   stringsAsFactors = FALSE
#' )
#' class(d) <- c("wid_df", "data.frame")
#' wid_gini(d)
#' @export
wid_gini <- function(data, variable = NULL, country = NULL) {
  .check(data, series_type = "s")
  d      <- .filter_data(data, variable, country)
  bounds <- lapply(d$percentile, .parse_perc)
  ok     <- !vapply(bounds, is.null, logical(1L))
  if (any(!ok))
    warning(sum(!ok), " row(s) dropped: unparseable percentile codes.", call. = FALSE)
  d <- d[ok, ]; bounds <- bounds[ok]
  d$lo <- vapply(bounds, `[[`, numeric(1L), "lo")
  d$hi <- vapply(bounds, `[[`, numeric(1L), "hi")
  do.call(rbind, lapply(split(d, list(d$country, d$year), drop = TRUE), function(g) {
    g <- g[order(g$lo), ]
    B <- sum(cumsum(g$value - g$value / 2) * (g$hi - g$lo))
    data.frame(country = g$country[1L], year = g$year[1L], gini = 1 - 2 * B,
               stringsAsFactors = FALSE)
  }))
}

#' Top income or wealth share
#'
#' @param data A \code{wid_df} with share series.
#' @param top Top fraction, e.g. 0.1 = top 10\\%.
#' @param variable Variable code filter.
#' @param country Country code filter.
#' @return A \code{data.frame} with columns \code{country}, \code{year},
#'   \code{top} (the requested fractile), and \code{share} (numeric).
#' @examples
#' d <- data.frame(
#'   country = "US", year = "2020", variable = "sptinc992j",
#'   percentile = "p99p100", value = 0.19, age = "992", pop = "j",
#'   stringsAsFactors = FALSE
#' )
#' class(d) <- c("wid_df", "data.frame")
#' wid_top_share(d, top = 0.01)
#' @export
wid_top_share <- function(data, top = 0.1, variable = NULL, country = NULL) {
  .check(data, series_type = "s")
  d      <- .filter_data(data, variable, country)
  target <- sprintf("p%gp100", (1 - top) * 100)
  out    <- d[d$percentile == target, c("country", "year", "value")]
  if (!nrow(out))
    stop("No percentile '", target, "' found. Ensure perc includes '", target, "'.",
         call. = FALSE)
  out$top <- top
  names(out)[3L] <- "share"
  out[c("country", "year", "top", "share")]
}

#' Percentile threshold ratio (e.g. P90/P10)
#'
#' @param data A \code{wid_df} with threshold (\code{"t"}) series.
#' @param numerator Upper percentile code, e.g. \code{"p90"}.
#' @param denominator Lower percentile code, e.g. \code{"p10"}.
#' @param variable Variable code filter.
#' @param country Country code filter.
#' @return A \code{data.frame} with columns \code{country}, \code{year},
#'   and \code{ratio} (numeric: numerator threshold divided by denominator threshold).
#' @examples
#' d <- data.frame(
#'   country = rep("US", 2L), year = rep("2020", 2L),
#'   variable = rep("tptinc992j", 2L),
#'   percentile = c("p90", "p10"), value = c(200000, 10000),
#'   age = "992", pop = "j", stringsAsFactors = FALSE
#' )
#' class(d) <- c("wid_df", "data.frame")
#' wid_percentile_ratio(d)
#' @export
wid_percentile_ratio <- function(data, numerator = "p90", denominator = "p10",
                                 variable = NULL, country = NULL) {
  .check(data, series_type = "t")
  d   <- .filter_data(data, variable, country)
  num <- d[d$percentile == numerator,   c("country", "year", "value")]
  den <- d[d$percentile == denominator, c("country", "year", "value")]
  m   <- merge(num, den, by = c("country", "year"), suffixes = c(".n", ".d"))
  if (!nrow(m))
    stop("No matching country/year for ", numerator, "/", denominator, ".",
         call. = FALSE)
  data.frame(country = m$country, year = m$year,
             ratio = m$value.n / m$value.d, stringsAsFactors = FALSE)
}