updated create_report.sh to have borders option
This commit is contained in:
parent
f6c05a89fe
commit
ad2f41482f
|
|
@ -15,6 +15,9 @@ for arg in "$@"; do
|
||||||
--data_dir=*)
|
--data_dir=*)
|
||||||
data_dir="${arg#*=}"
|
data_dir="${arg#*=}"
|
||||||
;;
|
;;
|
||||||
|
--borders=*)
|
||||||
|
borders="${arg#*=}"
|
||||||
|
;;
|
||||||
*)
|
*)
|
||||||
echo "Unknown option: $arg"
|
echo "Unknown option: $arg"
|
||||||
exit 1
|
exit 1
|
||||||
|
|
@ -23,8 +26,8 @@ for arg in "$@"; do
|
||||||
done
|
done
|
||||||
|
|
||||||
# Check if required arguments are set
|
# Check if required arguments are set
|
||||||
if [ -z "$filename" ] || [ -z "$report_date" ]|| [ -z "$mail_day" ] || [ -z "$data_dir" ]; then
|
if [ -z "$filename" ] || [ -z "$report_date" ]|| [ -z "$borders" ] || [ -z "$mail_day" ] || [ -z "$data_dir" ]; then
|
||||||
echo "Missing arguments. Use: build_reports.sh --filename=hello.txt --report_date=2020-01-01 --mail_day=Friday --data_dir=chemba"
|
echo "Missing arguments. Use: build_reports.sh --filename=hello.txt --report_date=2020-01-01 --mail_day=Friday --data_dir=chemba --borders=TRUE"
|
||||||
exit 1
|
exit 1
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
|
@ -33,6 +36,7 @@ echo "Filename: $filename"
|
||||||
echo "Report date: $report_date"
|
echo "Report date: $report_date"
|
||||||
echo "Mail day: $mail_day"
|
echo "Mail day: $mail_day"
|
||||||
echo "Data directory: $data_dir"
|
echo "Data directory: $data_dir"
|
||||||
|
echo "Borders: $borders"
|
||||||
|
|
||||||
if [ "$(uname)" == "Darwin" ]; then
|
if [ "$(uname)" == "Darwin" ]; then
|
||||||
# Commando's voor Mac
|
# Commando's voor Mac
|
||||||
|
|
@ -44,4 +48,4 @@ elif [ "$(uname)" == "Linux" ]; then
|
||||||
else
|
else
|
||||||
echo "Onbekend systeem"
|
echo "Onbekend systeem"
|
||||||
fi
|
fi
|
||||||
Rscript -e "rmarkdown::render('CI_report_dashboard_planet.Rmd', output_file='$filename', params=list(ref='$ref', report_date='$report_date', data_dir='$data_dir'))"
|
Rscript -e "rmarkdown::render('CI_report_dashboard_planet.Rmd', output_file='$filename', params=list(ref='$ref', report_date='$report_date', data_dir='$data_dir', borders='$borders'))"
|
||||||
|
|
@ -5,6 +5,7 @@ params:
|
||||||
report_date: "2024-04-18"
|
report_date: "2024-04-18"
|
||||||
data_dir: "Sony"
|
data_dir: "Sony"
|
||||||
mail_day: "Wednesday"
|
mail_day: "Wednesday"
|
||||||
|
borders: TRUE
|
||||||
output:
|
output:
|
||||||
# html_document:
|
# html_document:
|
||||||
# toc: yes
|
# toc: yes
|
||||||
|
|
@ -22,6 +23,7 @@ editor_options:
|
||||||
# output_file <- params$output_file
|
# output_file <- params$output_file
|
||||||
report_date <- params$report_date
|
report_date <- params$report_date
|
||||||
mail_day <- params$mail_day
|
mail_day <- params$mail_day
|
||||||
|
borders <- params$borders
|
||||||
#
|
#
|
||||||
#
|
#
|
||||||
# # Activeer de renv omgeving
|
# # Activeer de renv omgeving
|
||||||
|
|
@ -260,30 +262,46 @@ subchunkify <- function(g, fig_height=7, fig_width=5) {
|
||||||
cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE))
|
cat(knitr::knit(text = knitr::knit_expand(text = sub_chunk), quiet = TRUE))
|
||||||
}
|
}
|
||||||
|
|
||||||
create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week, age){
|
create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week, age, borders = FALSE){
|
||||||
tm_shape(pivot_raster, unit = "m")+
|
map <- tm_shape(pivot_raster, unit = "m") +
|
||||||
tm_raster(breaks = c(0,0.5,1,2,3,4,5,6,7,Inf), palette = "RdYlGn",legend.is.portrait = legend_is_portrait ,midpoint = NA) +
|
tm_raster(breaks = c(0,0.5,1,2,3,4,5,6,7,Inf), palette = "RdYlGn",legend.is.portrait = legend_is_portrait ,midpoint = NA) +
|
||||||
tm_layout(main.title = paste0("\nMax CI week ", week,"\n", age, " weeks old"),
|
tm_layout(main.title = paste0("\nMax CI week ", week,"\n", age, " weeks old"),
|
||||||
main.title.size = 0.7, legend.show = show_legend) # +
|
main.title.size = 0.7, legend.show = show_legend)
|
||||||
# tm_shape(pivot_shape) +
|
|
||||||
# tm_borders(lwd = 3) + tm_text("sub_field", size = 1/2) +
|
if (borders) {
|
||||||
# tm_shape(pivot_spans) + tm_borders(lwd = 0.5, alpha=0.5)
|
map <- map +
|
||||||
|
tm_shape(pivot_shape) +
|
||||||
|
tm_borders(lwd = 3) +
|
||||||
|
tm_text("sub_field", size = 1/2) +
|
||||||
|
tm_shape(pivot_spans) +
|
||||||
|
tm_borders(lwd = 0.5, alpha = 0.5)
|
||||||
|
}
|
||||||
|
|
||||||
|
return(map)
|
||||||
}
|
}
|
||||||
|
|
||||||
create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week_1, week_2, age){
|
create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend = F, legend_is_portrait = F, week_1, week_2, age, borders = TRUE){
|
||||||
tm_shape(pivot_raster, unit = "m")+
|
map <- tm_shape(pivot_raster, unit = "m") +
|
||||||
tm_raster(breaks = c(-3,-2,-1,0,1,2, 3), palette = "RdYlGn",legend.is.portrait = legend_is_portrait ,midpoint = 0, title = "CI difference") +
|
tm_raster(breaks = c(-3,-2,-1,0,1,2,3), palette = "RdYlGn",legend.is.portrait = legend_is_portrait, midpoint = 0, title = "CI difference") +
|
||||||
tm_layout(main.title = paste0("CI change week ", week_1, "- week ",week_2, "\n", age," weeks old"),
|
tm_layout(main.title = paste0("CI change week ", week_1, " - week ", week_2, "\n", age, " weeks old"),
|
||||||
main.title.size = 0.7, legend.show = show_legend) # +
|
main.title.size = 0.7, legend.show = show_legend)
|
||||||
# tm_shape(pivot_shape) +
|
|
||||||
# tm_borders(lwd = 3) + tm_text("sub_field", size = 1/2) +
|
if (borders) {
|
||||||
# tm_shape(pivot_spans) + tm_borders(lwd = 0.5, alpha=0.5)
|
map <- map +
|
||||||
|
tm_shape(pivot_shape) +
|
||||||
|
tm_borders(lwd = 3) +
|
||||||
|
tm_text("sub_field", size = 1/2) +
|
||||||
|
tm_shape(pivot_spans) +
|
||||||
|
tm_borders(lwd = 0.5, alpha = 0.5)
|
||||||
|
}
|
||||||
|
|
||||||
|
return(map)
|
||||||
}
|
}
|
||||||
|
|
||||||
ci_plot <- function(pivotName){
|
ci_plot <- function(pivotName){
|
||||||
# pivotName = "1.1"
|
# pivotName = "1.1"
|
||||||
pivotShape <- AllPivots0 %>% terra::subset(field %in% pivotName) %>% st_transform(crs(CI))
|
pivotShape <- AllPivots0 %>% terra::subset(field %in% pivotName) %>% st_transform(crs(CI))
|
||||||
age <- harvesting_data %>% dplyr::filter(field %in% pivotName) %>% dplyr::select(age) %>% unique()
|
age <- harvesting_data %>% dplyr::filter(field %in% pivotName) %>% sort("year") %>% tail(., 1) %>% dplyr::select(age) %>% unique() %>% pull() %>% round()
|
||||||
|
|
||||||
AllPivots2 <- AllPivots0 %>% dplyr::filter(field %in% pivotName)
|
AllPivots2 <- AllPivots0 %>% dplyr::filter(field %in% pivotName)
|
||||||
|
|
||||||
|
|
@ -300,13 +318,13 @@ ci_plot <- function(pivotName){
|
||||||
|
|
||||||
joined_spans2 <- AllPivots0 %>% st_transform(crs(pivotShape)) %>% dplyr::filter(field %in% pivotName) #%>% unique() %>% st_crop(., pivotShape)
|
joined_spans2 <- AllPivots0 %>% st_transform(crs(pivotShape)) %>% dplyr::filter(field %in% pivotName) #%>% unique() %>% st_crop(., pivotShape)
|
||||||
|
|
||||||
CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2, show_legend= T, legend_is_portrait = T, week = week_minus_2, age = age -2)
|
CImap_m2 <- create_CI_map(singlePivot_m2, AllPivots2, joined_spans2, show_legend= T, legend_is_portrait = T, week = week_minus_2, age = age -2, borders = borders)
|
||||||
CImap_m1 <- create_CI_map(singlePivot_m1, AllPivots2, joined_spans2, show_legend= F, legend_is_portrait = F, week = week_minus_1, age = age -1)
|
CImap_m1 <- create_CI_map(singlePivot_m1, AllPivots2, joined_spans2, show_legend= F, legend_is_portrait = F, week = week_minus_1, age = age -1, borders = borders)
|
||||||
CImap <- create_CI_map(singlePivot, AllPivots2, joined_spans2, show_legend= F, legend_is_portrait = F, week = week, age = age )
|
CImap <- create_CI_map(singlePivot, AllPivots2, joined_spans2, show_legend= F, legend_is_portrait = F, week = week, age = age, borders = borders)
|
||||||
|
|
||||||
|
|
||||||
CI_max_abs_last_week <- create_CI_diff_map(abs_CI_last_week,AllPivots2, joined_spans2, show_legend = T, legend_is_portrait = T, week_1 = week, week_2 = week_minus_1, age = age)
|
CI_max_abs_last_week <- create_CI_diff_map(abs_CI_last_week,AllPivots2, joined_spans2, show_legend = T, legend_is_portrait = T, week_1 = week, week_2 = week_minus_1, age = age, borders = borders)
|
||||||
CI_max_abs_three_week <- create_CI_diff_map(abs_CI_three_week, AllPivots2, joined_spans2, show_legend = T, legend_is_portrait = T, week_1 = week, week_2 = week_minus_3, age = age)
|
CI_max_abs_three_week <- create_CI_diff_map(abs_CI_three_week, AllPivots2, joined_spans2, show_legend = T, legend_is_portrait = T, week_1 = week, week_2 = week_minus_3, age = age, borders = borders)
|
||||||
|
|
||||||
tst <- tmap_arrange(CImap_m2, CImap_m1, CImap,CI_max_abs_last_week, CI_max_abs_three_week, nrow = 1)
|
tst <- tmap_arrange(CImap_m2, CImap_m1, CImap,CI_max_abs_last_week, CI_max_abs_three_week, nrow = 1)
|
||||||
|
|
||||||
|
|
@ -319,57 +337,60 @@ ci_plot <- function(pivotName){
|
||||||
}
|
}
|
||||||
|
|
||||||
cum_ci_plot <- function(pivotName){
|
cum_ci_plot <- function(pivotName){
|
||||||
# pivotName <- "4042903"
|
|
||||||
# Generate a sequence of dates for the last 12 months
|
# pivotName = "1.1"
|
||||||
|
data_ci <- CI_quadrant %>% filter(field == pivotName)
|
||||||
|
|
||||||
|
if (nrow(data_ci) == 0) {
|
||||||
|
return(cum_ci_plot2(pivotName)) # Return an empty data frame if no data is found
|
||||||
|
}
|
||||||
|
|
||||||
|
data_ci2 <- data_ci %>% mutate(CI_rate = cumulative_CI/DOY,
|
||||||
|
week = week(Date))%>% group_by(field) %>%
|
||||||
|
mutate(mean_rolling10 = rollapplyr(CI_rate , width = 10, FUN = mean, partial = TRUE))
|
||||||
|
|
||||||
|
date_preperation_perfect_pivot <- data_ci2 %>% group_by(season) %>% summarise(min_date = min(Date),
|
||||||
|
max_date = max(Date),
|
||||||
|
days = max_date - min_date)
|
||||||
|
|
||||||
|
|
||||||
|
unique_seasons <- unique(date_preperation_perfect_pivot$season)
|
||||||
|
|
||||||
|
g <- ggplot(data= data_ci2 %>% filter(season %in% unique_seasons)) +
|
||||||
|
facet_wrap(~season, scales = "free_x") +
|
||||||
|
geom_line( aes(Date, mean_rolling10, col = sub_field, group = sub_field)) +
|
||||||
|
labs(title = paste("14 day rolling MEAN CI rate - Pivot ", pivotName))+
|
||||||
|
theme_minimal() +
|
||||||
|
theme(axis.text.x = element_text(angle = 60, hjust = 1),
|
||||||
|
legend.justification=c(1,0), legend.position = c(1, 0),
|
||||||
|
legend.title = element_text(size = 8),
|
||||||
|
legend.text = element_text(size = 8)) +
|
||||||
|
guides(color = guide_legend(nrow = 2, byrow = TRUE))
|
||||||
|
|
||||||
|
subchunkify(g, 3.2, 10)
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
cum_ci_plot2 <- function(pivotName){
|
||||||
end_date <- Sys.Date()
|
end_date <- Sys.Date()
|
||||||
start_date <- end_date %m-% months(11) # 11 months ago from end_date
|
start_date <- end_date %m-% months(11) # 11 months ago from end_date
|
||||||
date_seq <- seq.Date(from = start_date, to = end_date, by = "month")
|
date_seq <- seq.Date(from = start_date, to = end_date, by = "month")
|
||||||
midpoint_date <- start_date + (end_date - start_date) / 2
|
midpoint_date <- start_date + (end_date - start_date) / 2
|
||||||
# Create the empty plot
|
|
||||||
g <- ggplot() +
|
g <- ggplot() +
|
||||||
scale_x_date(limits = c(start_date, end_date), date_breaks = "1 month", date_labels = "%m-%Y") +
|
scale_x_date(limits = c(start_date, end_date), date_breaks = "1 month", date_labels = "%m-%Y") +
|
||||||
scale_y_continuous(limits = c(0, 4)) +
|
scale_y_continuous(limits = c(0, 4)) +
|
||||||
labs(title = paste("14 day rolling MEAN CI rate - field ", pivotName),
|
labs(title = paste("14 day rolling MEAN CI rate - Field ", pivotName),
|
||||||
x = "Date", y = "CI Rate") +
|
x = "Date", y = "CI Rate") +
|
||||||
theme(axis.text.x = element_text(angle = 60, hjust = 1),
|
theme(axis.text.x = element_text(angle = 60, hjust = 1),
|
||||||
legend.justification = c(1, 0), legend.position = c(1, 0),
|
legend.justification = c(1, 0), legend.position = c(1, 0),
|
||||||
legend.title = element_text(size = 8),
|
legend.title = element_text(size = 8),
|
||||||
legend.text = element_text(size = 8)) +
|
legend.text = element_text(size = 8)) +
|
||||||
annotate("text", x = midpoint_date, y = 2, label = "No data available", size = 6, hjust = 0.5)
|
annotate("text", x = midpoint_date, y = 2, label = "No data available", size = 6, hjust = 0.5)
|
||||||
|
|
||||||
subchunkify(g, 3.2, 10)
|
subchunkify(g, 3.2, 10)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
cum_ci_plot2 <- function(pivotName){
|
|
||||||
|
|
||||||
# pivotName = "1.1"
|
|
||||||
data_ci <- CI_quadrant %>% filter(field == pivotName)
|
|
||||||
data_ci2 <- data_ci %>% mutate(CI_rate = cumulative_CI/DOY,
|
|
||||||
week = week(Date))%>% group_by(field) %>%
|
|
||||||
mutate(mean_rolling10 = rollapplyr(CI_rate , width = 10, FUN = mean, partial = TRUE)) #%>%
|
|
||||||
|
|
||||||
date_preperation_perfect_pivot <- data_ci2 %>% group_by(season) %>% summarise(min_date = min(Date),
|
|
||||||
max_date = max(Date),
|
|
||||||
days = max_date - min_date)
|
|
||||||
|
|
||||||
unique_seasons <- unique(date_preperation_perfect_pivot$season)
|
|
||||||
|
|
||||||
|
|
||||||
g <- ggplot(data= data_ci2) +
|
|
||||||
geom_line( aes(Date, mean_rolling10, col = sub_field)) +
|
|
||||||
# geom_line(data= perfect_pivot, aes(Date , mean_rolling10, col = "Model CI (p5.1 Data 2022, \n date x axis is fictive)"), lty="11",size=1) +
|
|
||||||
labs(title = paste("14 day rolling MEAN CI rate - Pivot ", pivotName))+
|
|
||||||
# scale_y_continuous(limits=c(0.5,3), breaks = seq(0.5, 3, 0.5))+
|
|
||||||
scale_x_date(date_breaks = "1 month", date_labels = "%m-%Y") +
|
|
||||||
theme(axis.text.x = element_text(angle = 60, hjust = 1),
|
|
||||||
legend.justification=c(1,0), legend.position = c(1, 0),
|
|
||||||
legend.title = element_text(size = 8),
|
|
||||||
legend.text = element_text(size = 8)) +
|
|
||||||
guides(color = guide_legend(nrow = 2, byrow = TRUE))
|
|
||||||
subchunkify(g, 3.2, 10)
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
```
|
```
|
||||||
|
|
||||||
```{r eval=FALSE, fig.height=7.2, fig.width=10, message=FALSE, warning=FALSE, include=FALSE}
|
```{r eval=FALSE, fig.height=7.2, fig.width=10, message=FALSE, warning=FALSE, include=FALSE}
|
||||||
|
|
@ -425,15 +446,13 @@ tm_shape(CI, unit = "m")+
|
||||||
# pivots <- AllPivots_merged %>% filter(pivot != c("1.1", "1.17"))
|
# pivots <- AllPivots_merged %>% filter(pivot != c("1.1", "1.17"))
|
||||||
# pivots_estate <- AllPivots_merged %>% filter(pivot %in% c("1.1", "1.2", "1.7")) %>% filter(pivot != "1.17")
|
# pivots_estate <- AllPivots_merged %>% filter(pivot %in% c("1.1", "1.2", "1.7")) %>% filter(pivot != "1.17")
|
||||||
|
|
||||||
|
AllPivots_merged <- AllPivots0 %>% dplyr::group_by(field) %>% summarise()
|
||||||
|
|
||||||
walk(AllPivots0$field, ~ {
|
walk(AllPivots_merged$field, ~ {
|
||||||
# cat("# Hello!!!")
|
|
||||||
cat("\n") # Add an empty line for better spacing
|
cat("\n") # Add an empty line for better spacing
|
||||||
ci_plot(.x)
|
ci_plot(.x)
|
||||||
cat("\n")
|
cat("\n")
|
||||||
# cum_ci_plot(.x)
|
cum_ci_plot(.x)
|
||||||
# cat("\n")
|
|
||||||
cum_ci_plot2(.x)
|
|
||||||
})
|
})
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
|
||||||
BIN
r_app/Rplots.pdf
BIN
r_app/Rplots.pdf
Binary file not shown.
Loading…
Reference in a new issue