check_rules.R

####################################
# nuts rules


# fadn nuts2 heatmap############################
# fadn nuts2 heatmap

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



}
countries <- unique(str_data$info$COUNTRY)

# heatmap function
heatmap.group <- function(group.by) {
  for (country in countries){
  heatmap_data <- str_data$info %>%
    filter(COUNTRY == country) %>%
    count({{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))

  if (NROW(heatmap_data$NUTS3 %>% unique()) >100 )  {
    text.size = 3
  } else{text.size = 11}


  p <- heatmap_data %>% ggplot(aes(YEAR, {{group.by}}, fill= n)) + geom_tile() +
    theme(legend.position="none") +
    ggtitle(country)+ theme(axis.text.y = element_text(size = text.size))
  #
  # p_name <- country
  #
  # assign(p_name, heatmap_data %>% ggplot ( aes(YEAR,NUTS2, fill= n)) + geom_tile() +
  #          theme(legend.position="none") +
  #          ggtitle(country))
  # ggsave(plot = p ,
  #        filename = paste0(CurrentProjectDirectory,"/plot/","fadn_",deparse(substitute(group.by)),"_rules/",country,".png"),
  #        width = 18, height = 8)


  ggsave(plot = p ,
         filename = paste0(CurrentProjectDirectory,"/plot/","fadn_",deparse(substitute(group.by)),"_plots/",country,".png"),
         width = 18, height = 8)



  }
}

heatmap.group(REGION)
heatmap.group(NUTS1)
heatmap.group(NUTS2)
heatmap.group(NUTS3)

# multiple plots

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)
ggsave(plot = mulp ,
       filename = paste0(CurrentProjectDirectory,"/plots/animal/num_farms/nuts2/nuts2_rules/","all.png"),
       width = 18, height = 8)

#check nuts function###########################################

check.nuts <- function (data, country, year, group.by, export.EXCEL = FALSE){

  nuts2Excel <-  paste0(CurrentProjectDirectory,"/plots/","fadn_",deparse(substitute(group.by)),"_rules/excel/")

  export.name = paste0(country,".",deparse(substitute(group.by)),".",year[1])

  assign(export.name, data %>%
           filter(YEAR %in% year & COUNTRY == country) %>%
           select({{group.by}}, COUNTRY) %>% distinct() %>%  mutate(value = 1) )
  # envir = parent.frame()
  # )
  # print(get(export.name))
  if (deparse(substitute(group.by)) == 'REGION') export.EXCEL= FALSE
  if(export.EXCEL){
    write.xlsx(as.data.frame(get(export.name)),
               paste0(nuts2Excel, deparse(substitute(group.by)),"_", country,year[1],".xlsx"),
               row.names = FALSE)}
  return (get(export.name))

}

# nuts2 ##################################################
# DEU #######################################################################

deu.version07 <- str_data$info %>%
  filter(YEAR == 2007 & COUNTRY == "DEU") %>%
  select(NUTS2, COUNTRY) %>% distinct()%>%
  rename_with(.fn =  ~paste0(., "_version07"), .cols = NUTS2)
write.xlsx(as.data.frame(deu.version07), paste0(nuts2File,"deu.version07.xlsx"), sheetName = "NUTS2", row.names = FALSE)

deu.version08_09 <- str_data$info %>%
  filter(YEAR %in% c(2008:2009) & COUNTRY == "DEU") %>%
  select(NUTS2, COUNTRY) %>% distinct()%>%
  rename_with(.fn =  ~paste0(., "_version08_09"), .cols = NUTS2)
write.xlsx(as.data.frame(deu.version08_09), paste0(nuts2File,"deu.version08_09.xlsx"), sheetName = "NUTS2", row.names = FALSE)


# version 2010-2018
deu.version10_18 <- str_data$info %>%
  filter(YEAR %in% c(2010:2018) & COUNTRY == "DEU") %>%
  select(NUTS2, COUNTRY) %>% distinct()%>%
  rename_with(.fn =  ~paste0(., "_version10_18"), .cols = NUTS2)
write.xlsx(as.data.frame(deu.version10_18), paste0(nuts2File,"deu.version10_18.xlsx"), sheetName = "NUTS2", row.names = FALSE)

# version: 2007
#..................................
# DEE1, DEE2, DEE3 merged into DEEO

# version: 2008-2009
#..........................
# DEE2 merged into DEE0

# version 2008-2009 -> 2010-2018
#............................
# DE41, DE41 merged into DE40
#............................
# Leipzig reccalculation by NSI
# DED5 new region
# DED3 boundary shift
#........................
# chemnitz reccalculation by NSI
# DED1 boundary shift
# DED4 new region
#..........................



# summary NUT2 level change .......................
str_data$info %>%
  filter(COUNTRY == "DEU") %>%
  mutate(NUTS2=case_when(
  NUTS2 %in% c("DEE1","DEE2","DEE3") ~ "DEE0",
  NUTS2 %in% c("DE41","DE42") ~ "DE40",
  NUTS2 %in% c("DED1") ~ "DED4",
  NUTS2 %in% c("DED3") ~ "DED5",
  TRUE ~ NUTS2))  %>% count(NUTS2,YEAR) %>%
  arrange(YEAR) %>%
  mutate(across(3:last_col(),function(x)ifelse(is.na(x),0,1))) %>% ggplot ( aes(YEAR,NUTS2, fill= n)) + geom_tile() +
  theme(legend.position="none")
# CZE ##################################################
# no chnange............................

cze.version07_13 <- str_data$info %>%
  filter(YEAR %in% c(2007:2013) & COUNTRY == "CZE") %>%
  select(NUTS2, COUNTRY) %>% distinct()%>%
  rename_with(.fn =  ~paste0(., "_version07_13"), .cols = NUTS2)

write.xlsx(as.data.frame(cze.version07_13), paste0(nuts2File,"cze.version07_13.xlsx"), sheetName = "NUTS2", row.names = FALSE)

cze.version14_18 <- str_data$info %>%
  filter(YEAR %in% c(2014:2018) & COUNTRY == "CZE") %>%
  select(NUTS2, COUNTRY) %>% distinct()%>%
  rename_with(.fn =  ~paste0(., "_version14_18"), .cols = NUTS2)
write.xlsx(as.data.frame(cze.version14_18), paste0(nuts2File,"cze.version14_18.xlsx"), sheetName = "NUTS2", row.names = FALSE)
# ELL ##################################################

ell.version07_09 <- str_data$info %>%
  filter(YEAR %in% c(2007:2009) & COUNTRY == "ELL") %>%
  select(NUTS2, COUNTRY) %>% distinct()
write.xlsx(as.data.frame(ell.version07_09), paste0(nuts2File,"ell.version07_09.xlsx"), sheetName = "NUTS2", row.names = FALSE)

ell.version10_18 <- str_data$info %>%
  filter(YEAR %in% c(2010:2018) & COUNTRY == "ELL") %>%
  select(NUTS2, COUNTRY) %>% distinct()

#.......................
# version  2003