library(coda)


calc_quant <- function(x, top) {
  if (top == "MAIOR") {
    quantile(x, probs = c(0.25, .5, .75), na.rm = T) %>% t %>% as_tibble %>% stats::setNames(object = .,nm = c('q25','q50','q75'))
  } else {
    quantile(x, probs = c(0.75, .5, .25), na.rm = T) %>% t %>% as_tibble %>% stats::setNames(object = .,nm = c('q25','q50','q75'))
  }
}

get_mean_extra_quantile <- function(x, prob) {
  if (prob >= .5) {
    mean(x[x >= quantile(x, probs = prob, na.rm = T)], na.rm = T)
  } else {
    mean(x[x <= quantile(x, probs = prob, na.rm = T)], na.rm = T)
  }
}


calc_regua <- function(data, top) {

  calc_quant(x = data$VALOR, top = top) %>% 
    bind_cols(
      tibble(
        hpd = ifelse(top == "MAIOR",
                     # calc_max_hpd(data$VALOR),
                     # calc_min_hpd(data$VALOR)
                     get_mean_extra_quantile(data$VALOR, .7),
                     get_mean_extra_quantile(data$VALOR, .3)
        ),
        ref = data %>% filter(ref == 1) %>% pull(VALOR) %>% mean(., na.rm = T)        
      )
    ) %>% 
    mutate_all(function(x) ifelse(data$unidade[1] == "%", x*100, x)) %>% 
    mutate_all(round, digits = data$casas[1]) %>% 
    mutate(unidade = data$unidade[1]) %>% 
    mutate(ini_simbol = ifelse(top == "MAIOR", "< ", "> "), fim_simbol = ifelse(top == "MAIOR", "> ", "< "))
}

calc_max_hpd <- function(x) {
  tryCatch({
    hpd <- suppressWarnings(HPDinterval(obj = as.mcmc(na.omit(x)),prob = .9))      
    return(hpd[2])
  }, error = function(e){
    return(NA)
  })
}

calc_min_hpd <- function(x) {
  tryCatch({
    hpd <- suppressWarnings(HPDinterval(obj = as.mcmc(na.omit(x)),prob = .9))      
    return(hpd[1])
  }, error = function(e){
    return(NA)
  })
}

