# 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}
Xinxin Yang's avatar
Xinxin Yang committed

    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
Xinxin Yang's avatar
Xinxin Yang committed



    ggsave(plot = p ,
           filename = paste0(path_png, country,".png"),
           width = 18, height = 8)
Xinxin Yang's avatar
Xinxin Yang committed


    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)
}
Xinxin Yang's avatar
Xinxin Yang committed

multiplot <- function(..., plotlist=NULL, cols) {
  require(grid)

  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)
Xinxin Yang's avatar
Xinxin Yang committed

  numPlots = length(plots)
Xinxin Yang's avatar
Xinxin Yang committed

  # 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 ))
  }



}
#' this function related to converting NUTS between different NUTS version in both directions.
#'
#' @param data FADN data
#' @param countries the three letters code (e.g. "DEU") or "all".
#' If "all" is included, all available countries are loaded.
#' @param NUTS.Year a numeric vector, the year of NUTS (2003,2006,2010,2013,2016).
#' @export
#' @examples
#' ## NOT run:
#' NUTS.convert.all(str_data$info, "DEU", 2016)
#' NUTS.convert.all(str_data$info, "all", 2016)
#' NUTS.convert.all(str_data$info, c("DEU","POL","UKI"), 2016)
#' ## End (NOT run)

NUTS.convert.all<- function(data, countries, NUTS.Year){
  # data = test_data
  # data = test_data
  # countries = c("ELL", special_countries)
  # NUTS.Year = 2003
  NUTS.Year.eurostat <- c("2003", "2006", "2010", "2013", "2016")
  keep_columns_data <- c(colnames(data), "NUTS1_final", "NUTS2_final")
  years = unique(data$YEAR)
  # selected COUNTRY-YEAR in data

  # if (!NUTS.Year %in% years){warning(NUTS.Year, " was not found in your given data")}
  if (!NUTS.Year %in% NUTS.Year.eurostat){
    warning(NUTS.Year, " was not found in NUTS versions! \nPls give the following NUTS versions:\n2003 2006, 2010, 2013 or 2016.")
    return("Please give the following NUTS versions: 2003 2006, 2010, 2013 or 2016")}


  if("all"%in%countries) {countries= unique(data$COUNTRY)}

  # nuts2
  filtered.nuts.trans_left <- nuts2.trans %>%
    separate(version, sep="To", c("from", "to"), extra = "drop", fill = "left" ) %>%
    filter( to <=NUTS.Year | is.na(to)) %>% filter(COUNTRY %in% countries)

  filtered.nuts.trans_right <- nuts2.trans %>%
    separate(version, sep="To", c("from", "to"), extra = "drop", fill = "left" ) %>%
    filter( to >NUTS.Year ) %>% filter(COUNTRY %in% countries)

  # nuts3
  filtered.nuts3.trans_left <- nuts3.trans %>%
    separate(version, sep="To", c("from", "to"), extra = "drop", fill = "left" ) %>%
    filter( to <=NUTS.Year | is.na(to)) %>% filter(COUNTRY %in% countries)

  filtered.nuts3.trans_right <- nuts3.trans %>%
    separate(version, sep="To", c("from", "to"), extra = "drop", fill = "left" ) %>%
    filter( to >NUTS.Year ) %>% filter(COUNTRY %in% countries)


  # filtered.countries <- filtered.nuts.trans_left$COUNTRY %>% unique()

  special_countries <- c("SVN","HUN","POL","SUO","LTU","IRE","UKI")


  data_recoded <- data %>% filter(COUNTRY %in% countries & !COUNTRY %in% special_countries)

  if (nrow(data_recoded)!=0){recoded = TRUE}else{recoded = FALSE}


  data_rest <- data %>% filter(COUNTRY %in% countries & COUNTRY %in% special_countries)
  if (nrow(data_rest)!=0){special = TRUE} else {special = FALSE}

  recoded_c <- c(unique(data_recoded$COUNTRY))
  # data_rest %>% select(COUNTRY) %>% unique()
  # recoded
  if(recoded == TRUE){
    cat("Countries: ", recoded_c,"\nConverting......\n")
    # old to new ......
    ## as we have at maximum two changes of NUTS regulation, we left join two times
    test_data_nuts2 <- data_recoded %>%
      left_join(filtered.nuts.trans_left, by = c( "NUTS2", "COUNTRY"))
    test_data_nuts2 <- test_data_nuts2 %>%
      left_join(filtered.nuts.trans_left, by = c("NUTS2_new"="NUTS2", "COUNTRY"))
    ## Now we generate the final NUTS2 regulation based on the left joins
    recoded_final <- test_data_nuts2 %>%
      mutate(NUTS2_final=case_when(
        is.na(NUTS2_new) & is.na(NUTS2_new.y) ~ NUTS2,
        !is.na(NUTS2_new) & is.na(NUTS2_new.y) ~ NUTS2_new,
        TRUE ~ NUTS2_new.y
      )) %>% select(-contains(".x"),-contains(".y"), -NUTS2_new)


    # new to old ......
    new2old_1 <- recoded_final %>%
      left_join(filtered.nuts.trans_right, by = c( "NUTS2"= "NUTS2_new", "COUNTRY"))