1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
####################################
# 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