Newer
Older
# Nuts Transformation
#'
#'
#'
#'
#'nuts heatmap output
#' @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).
#' @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
#' nuts.heatmap.group(str_data$info, "NUTS1")
nuts.heatmap.group <- function(fadn.data.info, group.by, countries = "all", onepage = FALSE){
#create DIR>plots ---
ifelse(!dir.exists(paste0(CurrentProjectDirectory,"/plot")),
dir.create(paste0(CurrentProjectDirectory,"/plot")), FALSE)
# dir.create(paste0(CurrentProjectDirectory,"/plot"), FALSE)
dir.create(paste0(CurrentProjectDirectory,"/plot/", "fadn_",
group.by,"_plots"),
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 ))
}
}