GitLab at IIASA

nuts_converter.R 3.82 KiB
Newer Older
# Nuts Transformation

#'
#'
#'
#'
#'nuts heatmap output
Xinxin Yang's avatar
Xinxin Yang committed
#' @param group.by a charater vector of regional classification: "REGION" (FADN REGION with 3 numbers),
#'  "NUTS1", "NUTS2" or "NUTS3" (A NUTS code begins with 2 letter code referencing the country, as abbr. in
#'   the EU's Interinstitutional Style Guide).
Xinxin Yang's avatar
Xinxin Yang committed
#' @param fadn.data.info fadn info data
#' @param countries a character vector with 3 letter codes of countries:
#'  "DEU" for germany, "BEL" for belgium. if "all" is included, all countries are loaded and plotted.
#' @author Yang
#' @describeIn
#' @export
#' @examples
Xinxin Yang's avatar
Xinxin Yang committed
#' ## NOT run:
#' nuts.heatmap.group(str_data$info, "NUTS1")
Xinxin Yang's avatar
Xinxin Yang committed
#' ## End (NOT run)
nuts.heatmap.group <- function(fadn.data.info, group.by, countries = "all", onepage = FALSE){
  #create DIR>plots ---
Xinxin Yang's avatar
Xinxin Yang committed
  ifelse(!dir.exists(paste0(CurrentProjectDirectory,"/plot")),
         dir.create(paste0(CurrentProjectDirectory,"/plot")), FALSE)
Xinxin Yang's avatar
Xinxin Yang committed
  # dir.create(paste0(CurrentProjectDirectory,"/plot"), FALSE)
  # create group folder ---
  dir.create(paste0(CurrentProjectDirectory,"/plot/", "fadn_",
                    group.by,"_plots"),
Xinxin Yang's avatar
Xinxin Yang committed
             showWarnings = FALSE)
  if(countries ==  "all") countries <- unique(fadn.data.info$COUNTRY)


  for (country in countries){
    heatmap_data <- fadn.data.info %>%
      filter(COUNTRY == country) %>%
      count(.data[[group.by]],YEAR) %>%
      arrange(YEAR) %>%
      # pivot_wider(names_from = YEAR,values_from=n) %>%
      mutate(across(3:last_col(),function(x)ifelse(is.na(x),0,1)))
    # pivot_longer(c(`2004`:`2018` ), names_to = "YEAR", values_to = "n")

    heatmap_data <- data.frame(lapply(heatmap_data,as.character))
    path_png <- paste0(CurrentProjectDirectory,"/plot/","fadn_",group.by,"_plots/")
    if (group.by == "NUTS3" && NROW(heatmap_data$NUTS3 %>% unique()) >100 )  {
      text.size = 3
    } else{text.size = 11}
    p <- heatmap_data %>% ggplot(aes(YEAR, .data[[group.by]], fill= n)) + geom_tile() +
      theme() +
      ggtitle(country) +
      xlab("YEAR") +
      ylab(group.by) +
      # theme_bw() +
      theme(axis.text.y = element_text(size = text.size),legend.position="none")
    # multiple plots in one page
    p_name <- country
    ggsave(plot = p ,
           filename = paste0(path_png, country,".png"),
           width = 18, height = 8)
    assign(p_name, heatmap_data %>% ggplot ( aes(YEAR,.data[[group.by]], fill= n)) +
             geom_tile() +
             theme(legend.position="none",
                   axis.text.y = element_text(size = text.size),
                   axis.text.x = element_text(angle = 45)) +
             ggtitle(country))
  if(onepage== TRUE) {
  png(paste0(path_png,"all_countries.png"), width = 1080, height =1080, units = "px" )
  # plots <- list(NED, BEL, BGR, CYP, CZE,DAN,DEU,ELL,ESP,EST,FRA,HUN,IRE,ITA,LTU,LUX,LVA,MLT,OST,POL,POR,ROU,SUO,SVE,SVK,SVN,UKI,HRV)
  # mulp <-
  multiplot(NED, BEL, BGR, CYP, CZE,DAN,DEU,ELL,ESP,EST,FRA,HUN,IRE,ITA,LTU,LUX,LVA,MLT,OST,POL,POR,ROU,SUO,SVE,SVK,SVN,UKI,HRV, cols=5)
  dev.off()}
  # ggsave(plot = mulp ,
  #        filename = paste0(path_png,"all_countries.png"),
  #        width = 18, height = 8)
multiplot <- function(..., plotlist=NULL, cols) {
  require(grid)

  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)
  numPlots = length(plots)
  # Make the panel
  plotCols = cols                          # Number of columns of plots
  plotRows = ceiling(numPlots/plotCols) # Number of rows needed, calculated from # of cols

  # Set up the page
  grid.newpage()
  pushViewport(viewport(layout = grid.layout(plotRows, plotCols)))
  vplayout <- function(x, y)
    viewport(layout.pos.row = x, layout.pos.col = y)

  # Make each plot, in the correct location
  for (i in 1:numPlots) {
    curRow = ceiling(i/plotCols)
    curCol = (i-1) %% plotCols + 1
    print(plots[[i]], vp = vplayout(curRow, curCol ))
  }



}