GitLab at IIASA

capri_tables.R 5.58 KiB
Newer Older
Xinxin Yang's avatar
Xinxin Yang committed
## functions:

#' load balance market and split into cake oil market and others.
#'
#' @param df balance market.
#'
#' @return A List includes two data frames.
#' @export
#'
#'
market_balance <- function(df){

  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",
Xinxin Yang's avatar
Xinxin Yang committed
                          "Sunflower seed oil",
Xinxin Yang's avatar
Xinxin Yang committed
                          "Soya cake",
                          "Sunflowe seed cake",
                          "Rape seed cake",
                          "Destilled dried grains from bio-ethanol processing",
                          "Pulses",
                          "Bio ethanol")

  oil_cake_market <- balance_detailed %>%
    filter (Commodities %in% oil_cake_market_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 (list(oil_cake_market,other))
}

#' calculates the absolute and percentage changes between baseline and scenario.
#' @param b basline.
#' @param s Scenario.
#' @return a data frame.
#'
#' @export
#'
#'
output_df <- 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)
}
#'makes Beautiful Tables
#'
#'
#' @param tbl A tbl data frame.
#' @param subtit Subtitle.
#' @return a beautiful table.
#' @export
nicetable <- function(tbl,subtit){
  #tbl <- other
  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)}else{tbl <- tbl}

  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 = html("1,000t,<br>abs"),
      "Production%" = html("%"),
      Human_Cons. = html("1,000t,<br>abs"),
      "Human_cons%" = html("%"),
      Processing = html("1,000t,<br>abs"),
      "Processing%" = html("%"),
      Biofuels = html("1,000t,<br>abs"),
      "Biofuels%" = html("%"),
      Feed = html("1,000t,<br>abs"),
      "Feed%" = html("%"),
      Imports = html("1,000t,<br>abs"),
      "Imports%" = html("%"),
      Exports = html("1,000t,<br>abs"),
      "Exports%" = html("%"),
      "Market volume" = 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)
}