inst/examples/FADN_USE_CASE.R
View file @ 2017961e
...@@ -638,12 +638,13 @@ my.str.data$crops[ID %in% collected.common.id_str[,common_id], ...@@ -638,12 +638,13 @@ my.str.data$crops[ID %in% collected.common.id_str[,common_id],
VALUE_weighted=sum(VALUE*WEIGHT)), VALUE_weighted=sum(VALUE*WEIGHT)),
by=.(COUNTRY,YEAR,CROP,VARIABLE,ID)] by=.(COUNTRY,YEAR,CROP,VARIABLE,ID)]
##--------------------------------------------------------------- ##---------------------------------------------------------------
## Load fadn raw data and search the the number of common id for adjacent combination years ## Load fadn raw data and search the the number of common id for adjacent combination years
##--------------------------------------------------------------- ##---------------------------------------------------------------
# find all adjacent combinations in a list "find all adjacent combinations in a list"
myFun <- function(Data) { myFun <- function(Data) {
A <- lapply(1:(length(Data)), sequence) A <- lapply(1:(length(Data)), sequence)
B <- lapply(rev(lengths(A))-1L, function(x) c(0, sequence(x))) B <- lapply(rev(lengths(A))-1L, function(x) c(0, sequence(x)))
...@@ -652,7 +653,7 @@ myFun <- function(Data) { ...@@ -652,7 +653,7 @@ myFun <- function(Data) {
}), recursive = FALSE, use.names = FALSE) }), recursive = FALSE, use.names = FALSE)
} }
# add a string to the facet label text and split it in two lines "add a string to the facet label text and split it in two lines"
label_facet <- function(original_var, custom_name){ label_facet <- function(original_var, custom_name){
lev <- levels(as.factor(original_var)) lev <- levels(as.factor(original_var))
lab <- paste0(lev, " \n ",custom_name) lab <- paste0(lev, " \n ",custom_name)
...@@ -660,7 +661,7 @@ label_facet <- function(original_var, custom_name){ ...@@ -660,7 +661,7 @@ label_facet <- function(original_var, custom_name){
return(lab) return(lab)
} }
# multi-panel plots using facet_wrap() for dynamic choice "multi-panel plots using facet_wrap() for dynamic choice"
figure <- function(country, df, n){ figure <- function(country, df, n){
p = df %>% p = df %>%
...@@ -690,20 +691,26 @@ figure <- function(country, df, n){ ...@@ -690,20 +691,26 @@ figure <- function(country, df, n){
p p
} }
# raw data "load raw data and get the number of common id for selected countries over all exist adjacent combinations years.
output_common_id <- function(countires_list, saveExcel = TRUE, savePlots = TRUE){ then save the number of common id to an excel sheet and plot"
output_common_id <- function(countries_list, saveExcel = TRUE, excelname , savePlots = TRUE){
rds.dir = paste0(get.data.dir(),"/rds/") rds.dir = paste0(get.data.dir(),"/rds/")
plots.dir = paste0(get.data.dir(), "/plots/")
if (!dir.exists(plots.dir)) dir.create(plots.dir)
library(xlsx) library(xlsx)
library(openxlsx) library(openxlsx)
xlsx_file <- paste0(get.data.dir(), "/spool/" ,"fadn_common_id.xlsx")
xlsx_file_dir <- paste0(get.data.dir(), "/spool/")
outlist = list()
wb <- createWorkbook(xlsx_file) if (saveExcel==TRUE) {wb <- createWorkbook(paste0(xlsx_file_dir, excelname))}
for (country in countires_list){
outlist = list()
for (country in countries_list){
cat("Country:", country, '\n') cat("Country:", country, '\n')
...@@ -722,9 +729,7 @@ output_common_id <- function(countires_list, saveExcel = TRUE, savePlots = TRUE) ...@@ -722,9 +729,7 @@ output_common_id <- function(countires_list, saveExcel = TRUE, savePlots = TRUE)
data = load.fadn.raw.rds(countries = country, years = year_items) data = load.fadn.raw.rds(countries = country, years = year_items)
if (length(data) == 0) {cat(year_items, " not exist")} my.data[[name]] = data
else {my.data[[name]] = data}
} }
Big.Num.Common.id = list() Big.Num.Common.id = list()
...@@ -743,20 +748,12 @@ output_common_id <- function(countires_list, saveExcel = TRUE, savePlots = TRUE) ...@@ -743,20 +748,12 @@ output_common_id <- function(countires_list, saveExcel = TRUE, savePlots = TRUE)
DF$Years <- row.names(DF) DF$Years <- row.names(DF)
outlist[[country]] = DF outlist[[country]] = DF
#wb <- loadWorkbook(xlsx_file)
if (!(country %in% names(wb))) addWorksheet(wb, country)
#write a df to xlsx
# write.xlsx(DF,
# file= xlsx_file,
# sheetName = country,
# col.names= TRUE,
# row.names = FALSE,
# append = TRUE)
print("write")
writeData(wb,country, DF)
#}
if (!is.null(wb)) {
if (!(country %in% names(wb))) {
addWorksheet(wb, country)}
writeData(wb,country, DF)
}
if (savePlots == TRUE){ if (savePlots == TRUE){
library(ggplot2) library(ggplot2)
library(stringr) library(stringr)
...@@ -769,16 +766,22 @@ output_common_id <- function(countires_list, saveExcel = TRUE, savePlots = TRUE) ...@@ -769,16 +766,22 @@ output_common_id <- function(countires_list, saveExcel = TRUE, savePlots = TRUE)
else{p <- figure(country,DF, 20)} else{p <- figure(country,DF, 20)}
ggsave(plot = p, ggsave(plot = p,
filename = paste0(get.data.dir(), "/plots/",country ,"_plot.png"), filename = paste0(plots.dir,country ,"_plot.png"),
width = 18, height = 8)} width = 18, height = 8)
} }
saveWorkbook(wb, xlsx_file, overwrite = T) }
return(outlist) if (saveExcel == TRUE) {
saveWorkbook(wb, paste0(xlsx_file_dir, excelname), overwrite = T)
cat(excelname," is saved in ",xlsx_file_dir, "\n")}
if (savePlots == TRUE) cat("plots are saved in", plots.dir, "\n")
return(outlist)
} }
DF <- output_common_id(c("DEU","NED", "BEL")) # get all countires in fadn str data
countries = unique(my.str.data$info$COUNTRY)
ID_list <- output_common_id(countries_list = countries)
# get Germany: DEU and Kroatien: HRV
DEU_list <- output_common_id(c("HRV", "DEU"), saveExcel = TRUE, excelname = "HRV_DEU.xlsx", savePlots = TRUE)