lapiLoading <- function(){
  #div(
  #  tags$div(id="lapiloading", class="modal-dialog lapi-loading",
  #    tags$div(class='modal-content',
        tags$div(class="lds-ring", tags$div(),tags$div(),tags$div(),tags$div())
  #    )
  #  ),
  #  tags$script("$('#lapiloading').modal().focus()")
  #)
}

row2object <- function(row, unbox = F) { 
  
  lapply(split(row, 1:nrow(row)), as.data.frame) %>% unname -> l1
  
  if(unbox) {
    l1 <- l1  %>% lapply(.,unbox)
  }
  
  return(l1)
  
}

convert_to_lapichart <- function(series, title, xlab, ylab, unidade, colors) {
  
  
  if(!is.null(colors)){
    list(title = unbox(title),
         yaxis = list(label = unbox(ylab)),
         xaxis = list(label = unbox(xlab)),
         unidade = unbox(unidade),
         series =   series %>% left_join(colors)
    ) %>% toJSON  
  } else {
    list(title = unbox(title),
         yaxis = list(label = unbox(ylab)),
         xaxis = list(label = unbox(xlab)),
         unidade = unbox(unidade),
         series =   series #%>% left_join(colors)
    ) %>% toJSON
  }
}

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


# calc_regua <- function(data, top) {
#   
#   calc_quant(x = data$VALOR, top = top) -> quants
#   
#   quants %>% 
#     dplyr::select(-q70) %>% 
#     bind_cols(
#       tibble(
#         hpd = ifelse(top == "MAIOR",
#                      calc_max_hpd(data$VALOR),
#                      calc_min_hpd(data$VALOR)
#         ),
#         q70 = data %>% filter(VALOR >= quants$q70) %>% pull(VALOR) %>% mean(., na.rm = T),
#         ref = data %>% filter(ref == 1) %>% pull(VALOR) %>% mean(., na.rm = T),
#         media = mean(data$VALOR, 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_regua2 <- function(valor, ref, top, unidade) {
#   
#   calc_quant(x = valor, top = top) -> quants
#   
#   quants %>% 
#     dplyr::select(-q70) %>% 
#     bind_cols(
#       tibble(
#         hpd = ifelse(top == "MAIOR",
#                      calc_max_hpd(valor),
#                      calc_min_hpd(valor)
#         ),
#         q70 = valor[valor>quants$q70] %>% mean(., na.rm = T),
#         ref = valor[ref == 1] %>% mean(., na.rm = T),
#         media = mean(valor, na.rm=T)
#       )
#     ) %>% 
#     # mutate_all(function(x) ifelse(data$unidade[1] == "%", x*100, x)) %>% 
#     # mutate_all(round, digits = data$casas[1]) %>% 
#     mutate(unidade = unidade) %>% 
#     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)
  })
}

pred_boot<-function(boot,bootMed,dados){
  
rowSums(t(t(boot[complete.cases(boot),][,-which(colnames(boot)=="(Intercept)")]) * as.numeric(dados %>% select(`VALOR MÉDIO DE VENDA`, `GMD GLOBAL (Kg)`, `LOTAÇÃO GLOBAL UA/HA`, `DESEMBOLSO CAB/MÊS`))))+boot[complete.cases(boot),][,which(colnames(boot)=="(Intercept)")]-> pred
  as.numeric(hdi(pred))->int
  mean(pred,na.rm=T)->media
  sum(bootMed[-1] * as.numeric(dados %>% select(`VALOR MÉDIO DE VENDA`, `GMD GLOBAL (Kg)`, `LOTAÇÃO GLOBAL UA/HA`, `DESEMBOLSO CAB/MÊS`)))+bootMed[1]->pred_med
  
  return(tibble(low=int[1],up=int[2],int_media=media,boot_media=pred_med))
}


qual_cluster <- function(data_cluster,amostra){
  
  data_cluster %>% 
    dplyr::select(valormdiodevenda,gmdglobalkg,lotaoglobaluaha,desembolsocabms,clust) %>% 
    .[complete.cases(.),] %>% 
    split(.$clust) %>% 
    purrr::map(~kmeans(x=.,center=1)) %>% 
    purrr::map("centers") %>% 
    purrr::map(~as.data.frame(.)) %>% 
    do.call("rbind",.)->cluster_kmean
  
  which.min(sqrt(rowSums(do.call("rbind",apply(cluster_kmean[,-5],1,"-",amostra)))^2))->resp
  return(as.numeric(resp))
}


sum_keyvars <- function(data) {
  data %>% 
    select(ropse, valormediovenda, gmd, lotacao, desembolso) %>% 
    summarise_all(.funs = median, na.rm = T)
}



navbarPageWithText <- function(..., text) {
  navbar <- navbarPage(...)
  textEl <- tags$p(class = "navbar-text", text)
  navbar[[3]][[1]]$children[[1]] <- htmltools::tagAppendChild(
    navbar[[3]][[1]]$children[[1]], textEl)
  navbar
}

navbarPageWithEl <- function(..., el, crumbs = NULL) {
  navbar <- navbarPage(title = ..., position = 'fixed-top', collapsible = T)
  navbar[[3]][[1]]$children[[1]]$children[[2]]$children[[1]] <- htmltools::tagAppendChild(navbar[[3]][[1]]$children[[1]]$children[[2]]$children[[1]], tags$li(el, class = 'push-right'))
  if(!is.null(crumbs))
    navbar[[3]][[1]] <- htmltools::tagAppendChild(navbar[[3]][[1]], lapiBreadCrumbs(c(crumbs)))
  navbar
}
