capri_tables.R

#' Get market balances with seleceted commodities (long names / short names).
#'
#' @param df market balance.
#' @param select_products A list of commodities for which the market balances should be derived.
#' @param products all rows in the capri data from dimdefs.xml
#'
#' @return A selected market balance.
#' @export
#'
#'
filter_market_balance <- function(df, select_products, products){

  # products: 2 key, 3 itemName, 9 color
  balance_detailed <- left_join(df, products %>% select(c(key, itemName, color)), by = c(".i4" = "key"))

  # rename new variable
  colnames(balance_detailed)[13] <- "Commodities"
  colnames(balance_detailed)[1] <- "key"

  balance_detailed$Commodities <- sub("\\[.*?\\]", "", balance_detailed$Commodities)

  balance_detailed <- balance_detailed %>%
    select(key,supply:Commodities) %>%
    select(-interv_ch) %>%
    select(-nettrade)


  if (nrow(product_list %>% filter( label %in% select_products )) == 0){
    balance_detailed <- balance_detailed %>% filter (key %in% select_products)}else {balance_detailed <- balance_detailed %>% filter (Commodities %in% select_products)}


  selected_market <- balance_detailed %>%
    # filter (Commodities %in% select_products)%>%
    mutate(Commodities = ifelse(Commodities!="Destilled dried grains from bio-ethanol processing",Commodities,"DDG")) %>%
    select(-key)

  return (selected_market)
}

#' Calculate the absolute and percentage changes between baseline and scenario.
#' @param b basline.
#' @param s Scenario.
#' @param supply_details Boolean. If TRUE, input the Farm|Supply details tables, otherwise detailed balance tables. Default is FALSE.
#' @return a data frame.
#'
#' @export
#'
#'
cal_diff_percentage_change <- function(b,s,supply_details= FALSE){
  # b = bs
  # s = sc

  # if ("product" %in% colnames(b)){
  #   b <- b %>% select(-Commodities) %>% mutate(Commodities = product) %>% select(-product)
  #   s <- s %>% select(-Commodities) %>% mutate(Commodities = product) %>% select(-product)
  # }


    diff_all <- bind_rows(b, s) %>%
        # evaluate following calls for each value in the rowname column
        group_by(Commodities) %>%
        # add all non-grouping variables
      dplyr::summarise(across(.cols = everything(), .fns = diff, .names = "diff_{col}"), .groups = 'drop') %>%
      distinct(.keep_all = TRUE )



    percent = data.frame(Commodities = b$Commodities) %>% as_tibble()


    for (i in 1:(ncol(s)-1)){
      percent <- bind_cols(round(s[i]/b[i] *100-100, 1), percent)
      #volumn <- bind_cols(round(sum(oil_cake_market_Scenario[i,1:7]) / sum(oil_cake_market_baseline[i,1:7])*100-100, 1), percent)
    }

    if (supply_details== FALSE){
      percent$volume <- NA
      for (i in 1:nrow(s)) percent$volume[i] <- (sum(s[i,1:(ncol(s)-1)])/sum(b[i,1:(ncol(s)-1)])*100-100)}



    all <-  full_join(diff_all, percent)
    all[,2:ncol(s)] <- round(all[, 2:ncol(s)], 1)
    if (supply_details){return(all)}

  all <- all[, c("Commodities",
                 "diff_supply", "supply",
                 "diff_human_cons", "human_cons",
                 "diff_processing","processing",
                 "diff_biofuels","biofuels",
                 "diff_feed","feed",
                 "diff_imports","imports",
                 "diff_exports","exports","volume")]

  setnames(all, new = c("Commodities",
                        "Production", "Production%",
                        "Human_Cons.", "Human_cons%",
                        "Processing","Processing%",
                        "Biofuels","Biofuels%",
                        "Feed","Feed%",
                        "Imports","Imports%",
                        "Exports","Exports%",
                        "Market volume"))



  all <- rapply(all, f=function(x) ifelse(is.nan(x),"-",x), how="replace" )

  all[, c(2:16)] <- sapply(all[, c(2:16)], as.numeric)
  all <- all %>% mutate_if(is.numeric, round, digits = 1)

  # all <- rapply(all, f=function(x) ifelse(is.na(x),"-",x), how="replace" )
  return(all)
}

#' Makes a beautiful table for the market balances.
#'
#'
#' @param tbl A tbl data frame.
#' @param subtit A character vector.
#' @return a beautiful table.
#' @export
nicetable_market_balances <- function(tbl,subtit){
if ("Wheat" %in% tbl$Commodities) {
    cereals <- tbl %>%
      filter( Commodities %in% c("Wheat", "Barley", "Grain maize", "Other cereals")) %>%
      add_column(group = "cereals")

    meat <- tbl %>%
      filter( !(Commodities %in% c("Wheat", "Barley", "Grain maize", "Other cereals"))) %>%
      add_column(group = "meat, sugar...")

    tbl <- bind_rows(cereals, meat)}
  ncol_tbl <- ncol(tbl)
  nicetb <- tbl %>%
    gt(rowname_col = "Commodities", groupname_col = "group") %>%
    fmt_number(columns = 2:ncol_tbl, decimals = 1) %>%
    fmt_missing(
      columns = 2:ncol_tbl,
      missing_text = "-"
    ) %>%
    #fmt_number(columns = c("Production%"), decimals = 1) %>%
    tab_spanner(label = "Production", columns = matches("Production")) %>%
    tab_spanner(label = "Human Cons.", columns = matches("Human_cons")) %>%
    tab_spanner(label = "Processing", columns = matches("Processing")) %>%
    tab_spanner(label = "Biofuels", columns = matches("Biofuels")) %>%
    tab_spanner(label = "Feed", columns = matches("Feed")) %>%
    tab_spanner(label = "Imports", columns = matches("Imports")) %>%
    tab_spanner(label = "Exports", columns = matches("Exports")) %>%
    tab_source_note(md("`-` indicate very small values")) %>%
    cols_label(
      Production = gt::html("1,000t,<br>abs"),
      "Production%" = gt::html("%"),
      Human_Cons. = gt::html("1,000t,<br>abs"),
      "Human_cons%" = gt::html("%"),
      Processing = gt::html("1,000t,<br>abs"),
      "Processing%" = gt::html("%"),
      Biofuels = gt::html("1,000t,<br>abs"),
      "Biofuels%" = gt::html("%"),
      Feed = gt::html("1,000t,<br>abs"),
      "Feed%" = gt::html("%"),
      Imports = gt::html("1,000t,<br>abs"),
      "Imports%" = gt::html("%"),
      Exports = gt::html("1,000t,<br>abs"),
      "Exports%" = gt::html("%"),
      "Market volume" = gt::html("<b>Market<br>volume</b>")
    )%>%
    tab_header(
      title = md("Absolute and percentage changes in elements of the market balance for the EU"),
      subtitle = md(subtit)) %>%
    # tab_source_note(
    #   source_note = md("GGD:Destilled dried grains from bio-ethanol processing")
    # ) %>%
    cols_width(Commodities ~ px(150)) %>%
    tab_footnote(
      locations = cells_column_labels("Market volume"),
      footnote = md("Imports + Production")
    )

  return(nicetb)
}


#'makes Beautiful Table for the farm supply details
#'
#'
#' @param tbl A tbl data frame.
#' @param subtit A character vector, subtitle for the output table.
#' @param vector_list Vector List in abs_col  <- c("diff_supply", "diff_yield", "diff_level","diff_gross_value_added")
#' per_col <- c("supply", "yield", "level","gross_value_added", "volume")
#' "all", ""
#' @param abs A num.
#' @param percent_change a num
#' @return a beautiful table.
#' @export
nicetable_supply_details <- function(tbl, subtit, vector_list, abs = 5, percent_change = 1){

  tbl <- tbl %>% mutate(diff_supply = diff_supply/1000)


  # abs
  abs_col  <- c("diff_supply", "diff_yield", "diff_level","diff_gross_value_added")
  per_col <- c("supply", "yield", "level","gross_value_added")


  if(vector_list[1]== "all") vector_list <- c(abs_col,per_col)



  for (vector in vector_list){
    if (vector %in% abs_col) tbl <- tbl %>% filter(.data[[vector ]] > abs | .data[[vector ]] < -abs )
    else if (vector %in% per_col) tbl <- tbl %>% filter(.data[[vector ]] > percent_change | .data[[vector ]] < -percent_change )
    else {message("wrong vector, no rows will be dropped!!!")}

   }

  nicetb <- tbl %>%
    gt(rowname_col = "Commodities", groupname_col = "group") %>%
    fmt_number(columns = diff_supply:gross_value_added, decimals = 1) %>%
    fmt_missing(
      columns = diff_supply:gross_value_added,
      missing_text = "-"
    ) %>%
    # #fmt_number(columns = c("Production%"), decimals = 1) %>%
    tab_spanner(label = "Supply", columns = matches("supply")) %>%
    tab_spanner(label = "Yield", columns = matches("yield")) %>%
    tab_spanner(label = "Level", columns = matches("level")) %>%
    tab_spanner(label = "Gross value added", columns = matches("gross")) %>%
    cols_label(
      diff_supply = gt::html("1,000t,<br>abs"),
      supply = gt::html("%"),
      diff_yield = gt::html("1,000g,<br>abs"),
      yield = gt::html("%"),
      diff_level = gt::html("1,000ha,<br>abs"),
      level = gt::html("%"),
      diff_gross_value_added = gt::html("Euro/ha,<br>abs"),
      gross_value_added = gt::html("%")
    )%>%
    tab_source_note(md("`-` indicate missing values")) %>%
    tab_header(
      title = md("Absolute and percentage changes in elements of the supply details for the EU"),
      subtitle = md(subtit)) %>%
    # tab_source_note(
    #   source_note = md("GGD:Destilled dried grains from bio-ethanol processing")
    # ) %>%
    cols_width(Commodities ~ px(150)) %>%
    tab_footnote(
      locations = cells_column_spanners("Supply"),
      footnote = md("Yield * Level"))

  return(nicetb)

}