capri_tables.R

## functions:

#' Get market balance with seleceted commodities (long mame).
#'
#' @param df balance market.
#' @param product_list A list of commodities for which the market balances should be derived.
#'
#' @return A selected market balance.
#' @export
#'
#'
filter_market_balance <- function(df, product_list){

  balance_detailed <- left_join(df, products[,c(2,3,9)], 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(supply:Commodities) %>%
    select(-interv_ch) %>%
    select(-nettrade)

  # oil_cake_market_list= c("Rape seed",
  #                         "Soya seed",
  #                         "Sunflower seed",
  #                         "Rape seed oil",
  #                         "Soya oil",
  #                         "Sunflower seed oil",
  #                         "Soya cake",
  #                         "Sunflowe seed cake",
  #                         "Rape seed cake",
  #                         "Destilled dried grains from bio-ethanol processing",
  #                         "Pulses",
  #                         "Bio ethanol")

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

  # other <- balance_detailed %>%
  #   filter (!(Commodities %in% oil_cake_market_list))

  return (selected_market)
}

#' calculates the absolute and percentage changes between baseline and scenario.
#' @param b basline.
#' @param s Scenario.
#' @return a data frame.
#'
#' @export
#'
#'
cal_percentage_change <- function(b,s){
  diff_all <- bind_rows(b, s) %>%
    # evaluate following calls for each value in the rowname column
    group_by(Commodities) %>%
    # add all non-grouping variables
    summarise(across(everything(), diff, .names = "diff_{col}"))
  # diff_all

  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)
  }
  percent$volume <- NA
  for (i in 1:nrow(s)) percent$volume[i] <- (sum(s[i,1:7])/sum(b[i,1:7])*100-100)

  all <- full_join(diff_all, percent)

  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" )

  return(all)
}

fun <- function(df, column, label)
{
  df %>%
    gt() %>%
    cols_label({{column}} := label)
}

#'makes Beautiful Tables
#'
#'
#' @param tbl A tbl data frame.
#' @param subtit A character vector.
#' @return a beautiful table.
#' @export
nicetable <- 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)}

  nicetb <- tbl %>%
    gt(rowname_col = "Commodities", groupname_col = "group") %>%
    fmt_number(columns = c(Production, Human_Cons.,Processing,Biofuels,Feed, Imports, Exports,"Market volume"), decimals = 1) %>%
    #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)
}