This commit is contained in:
Martin Folkerts 2024-07-02 16:51:55 +02:00
parent 1f194c5670
commit d9fafcea43
13 changed files with 123 additions and 69 deletions

View file

@ -33,7 +33,7 @@ if [ -z "$end_date" ] || [ -z "$data_dir" ] || [ -z "$offset" ]; then
exit 1
fi
echo 2_CI_data_prep.R $end_date $offset $data_dir
echo mosaic_creation.R $end_date $offset $data_dir
cd ../r_app
Rscript 2_CI_data_prep.R $end_date $offset $data_dir
Rscript mosaic_creation.R $end_date $offset $data_dir

View file

@ -6,9 +6,6 @@ for arg in "$@"; do
--filename=*)
filename="${arg#*=}"
;;
--weeks_ago=*)
weeks_ago="${arg#*=}"
;;
--report_date=*)
report_date="${arg#*=}"
;;
@ -23,14 +20,13 @@ for arg in "$@"; do
done
# Check if required arguments are set
if [ -z "$filename" ] || [ -z "$weeks_ago" ] || [ -z "$report_date" ] || [ -z "$data_dir" ]; then
echo "Missing arguments. Use: build_reports.sh --filename=hello.txt --weeks_ago=3 --report_date=2020-01-01 --data_dir=chemba"
if [ -z "$filename" ] || [ -z "$report_date" ] || [ -z "$data_dir" ]; then
echo "Missing arguments. Use: build_reports.sh --filename=hello.txt --report_date=2020-01-01 --data_dir=chemba"
exit 1
fi
# Script logic here
echo "Filename: $filename"
echo "Weeks ago: $weeks_ago"
echo "Report date: $report_date"
echo "Data directory: $data_dir"

View file

@ -31,7 +31,7 @@ public function __construct(Project $project)
public function handle(): void
{
$command = [
sprintf('%interpolate_growth_model.sh', base_path('../')),
sprintf('%s/interpolate_growth_model.sh', base_path('../')),
sprintf('--project_dir=%s', $this->project->download_path),
];

View file

@ -80,6 +80,10 @@ public static function handleFor(Project $project,Carbon $endDate, int $offset):
logger("ProjecMosaicGeneratorJob::handleFor(end_date: $endDate, offset: $offset): InvalidMosaic.");
return new NullJob();
}
$week = $endDate->clone()->next($project->mail_day)->week;
$year = $endDate->clone()->next($project->mail_day)->year;
/**
* @var ProjectMosaic $mosaic
*/
@ -89,11 +93,11 @@ public static function handleFor(Project $project,Carbon $endDate, int $offset):
'offset' => $offset,
],
[
'name' => sprintf('Period %s - %s', $endDate->format('Y-m-d'), $endDate->copy()->subDays($offset)->format('Y-m-d')),
'name' => sprintf('Week_%s_%s', $week, $year),
'path' => sprintf('%s/%s/%s',
$project->download_path,
'mosaics',
ProjectMosaic::getFilenameByPeriod($endDate,$offset)
sprintf('week_%s_%s.tif', $week, $year)
),
'end_date' => $endDate->format('Y-m-d'),
'offset' => $offset,

View file

@ -36,14 +36,11 @@ public function __construct(ProjectReport $projectReport, $sendMail = false)
public function handle()
{
// TODO check the changements due to migration
//$this->projectReport->weeksAgo();
$projectFolder = base_path('../');
$command = [
sprintf('%sbuild_report.sh', $projectFolder),
sprintf('--filename=%s', $this->projectReport->getFullPathName()),
sprintf('--weeks_ago=%s', $this->projectReport->weeksAgo()),
sprintf('--report_date=%s', $this->projectReport->getReportDate()),
sprintf('--data_dir=%s', $this->projectReport->project->download_path),
];

View file

@ -281,7 +281,7 @@ public function hasInvalidMosaicFor(Carbon $endDate,int $offset): bool
// parameters : $
// check if the mail day happens the day before mosaic -> good
$dayOfWeekIso = Carbon::parse($this->mail_day)->dayOfWeekIso;
$min_updated_at_date = $endDate
$min_updated_at_date = $endDate->copy()
->startOfWeek()
->addDays($dayOfWeekIso - 1)
->format('Y-m-d');
@ -296,7 +296,7 @@ public function hasInvalidMosaicFor(Carbon $endDate,int $offset): bool
public function scheduleReport(?Carbon $endDate = null, ?int $offset = null)
{
if($endDate->isFuture() || $endDate->isToday() || $offset <= 0){
if($endDate?->isFuture() || $endDate?->isToday() || $offset <= 0){
logger('EndDate is today or in the future.');
$endDate = null;
$offset = null;

View file

@ -29,12 +29,15 @@ class ProjectMosaic extends Model
public static function getFilenameByPeriod(Carbon $endDate, int $offset)
{
return sprintf('period_%s_%s.tif',(clone $endDate)->subdays($offset)->format('Y-m-d'),$endDate->format('Y-m-d'));
return sprintf('week_%s_%s.tif', (clone $endDate)->subdays($offset)->week, $endDate->year);
}
public static function projectMosaicNameFormat(Carbon $endDate, int $offset): string
{
return 'Period '.$endDate->copy()->subDays($offset)->toDateString().' - '.$endDate->toDateString();
return sprintf('Week_%s_%s',
$endDate->clone()->subDays($offset)->week,
$endDate->clone()->subDays($offset)->year
);
}
public function project()

View file

@ -165,7 +165,7 @@ public function when_getFileDownloadsFor_is_called_it_returns_a_collection_of_se
}
/** @test */
public function when_getMosaicsFor_is_called_it_returns_a_collection_of_seven_downloads_jobs()
public function when_getMosaicsFor_is_called_it_returns_a_collection_of_4_jobs()
{
/* @var Project $project */
$project = Project::create([
@ -178,6 +178,56 @@ public function when_getMosaicsFor_is_called_it_returns_a_collection_of_seven_do
collect($mosaics)->each(fn($job) => $this->assertInstanceOf(ProjectMosiacGeneratorJob::class, $job));
}
/** @test */
public function when_getMosaicsFor_is_called_it_returns_a_collection_of_4_jobs_with_correct_week_numbers()
{
/* @var Project $project */
$project = Project::create([
'name' => 'project_name',
'download_path' => 'project_download_path',
'mail_day' => 'Friday',
]);
$mosaics = $project->getMosaicsFor(new Carbon('2024-07-02'));
$this->assertCount(4, $mosaics);
collect($mosaics)->each(fn($job) => $this->assertInstanceOf(ProjectMosiacGeneratorJob::class, $job));
$this->assertEquals([
"Week_27_2024",
"Week_26_2024",
"Week_25_2024",
"Week_24_2024",
],
collect($mosaics)->map(function ($job) {
return $job->mosaic->name;
})->toArray());
}
/** @test */
public function when_getMosaicsFor_is_called_it_returns_a_collection_of_4_jobs_with_where_current_day_is_in_week_26_but_the_mail_day_is_in_week_27()
{
/* @var Project $project */
$project = Project::create([
'name' => 'project_name',
'download_path' => 'project_download_path',
'mail_day' => 'Friday',
]);
$mosaics = $project->getMosaicsFor(new Carbon('2024-06-28'));
$this->assertCount(4, $mosaics);
collect($mosaics)->each(fn($job) => $this->assertInstanceOf(ProjectMosiacGeneratorJob::class, $job));
$this->assertEquals([
"Week_27_2024",
"Week_26_2024",
"Week_25_2024",
"Week_24_2024",
],
collect($mosaics)->map(function ($job) {
return $job->mosaic->name;
})->toArray());
}
/** @test */
public function when_getReport_is_called_it_returns_a_jobs()
{
@ -234,7 +284,8 @@ public function when_friday_and_first_week_it_should_schedule($date, $day, $resu
$this->assertEquals($result, $project->shouldSchedule());
}
public static function scheduleDayProvider(){
public static function scheduleDayProvider()
{
return [
['date' => '2024-03-01', 'day' => 'Friday', 'result' => true],
['date' => '2024-03-02', 'day' => 'Saturday', 'result' => false],

View file

@ -3,7 +3,7 @@ params:
ref: "word-styles-reference-var1.docx"
output_file: CI_report.docx
report_date: "2024-04-18"
data_dir: "chemba"
data_dir: "Sony"
output:
# html_document:
# toc: yes
@ -70,10 +70,10 @@ source(here("r_app", "parameters_project.R"))
```{r week, message=FALSE, warning=FALSE, include=FALSE}
# week <- 5
#today = "2023-12-12"
today <- as.character(report_date)
week <- week(today)
week <- 25
today = "2024-06-21"
#today = as.character(Sys.Date())
@ -115,7 +115,7 @@ This PDF-dashboard shows the status of your fields on a weekly basis. We will sh
# remove_pivots <- c("1.1", "1.12", "1.8", "1.9", "1.11", "1.14")
CI_quadrant <- readRDS(here(cumulative_CI_vals_dir,"All_pivots_Cumulative_CI_quadrant_year_v2.rds"))# %>%
# rename(pivot_quadrant = Field)
# rename(pivot_quadrant = field)
CI <- brick(here(weekly_CI_mosaic, paste0("week_",week, "_", year, ".tif"))) %>% subset("CI")
CI_m1 <- brick(here(weekly_CI_mosaic, paste0("week_",week_minus_1, "_", year_1, ".tif"))) %>% subset("CI")
@ -140,16 +140,16 @@ AllPivots0 <- field_boundaries_sf
# pivots_dates <- readRDS(here(harvest_dir, "harvest_data_new"))
# pivots_dates$pivot <- factor(pivots_dates$pivot, levels = c("1.1", "1.2", "1.3", "1.4", "1.6", "1.7", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13", "1.14" , "1.16" , "1.17" , "1.18" ,"2.1", "2.2", "2.3" , "2.4", "2.5", "3.1", "3.2", "3.3", "4.1", "4.2", "4.3", "4.4", "4.5", "4.6", "5.1" ,"5.2", "5.3", "5.4", "6.1", "6.2", "DL1.1", "DL1.3"))
AllPivots <- merge(AllPivots0, harvesting_data, by = c("Field", "subField")) #%>%
#rename(Field = pivot, subField = pivot_quadrant) #%>% select(-pivot.y)
head(AllPivots)
#AllPivots <- merge(AllPivots0, harvesting_data, by = c("field", "sub_field")) #%>%
#rename(field = pivot, sub_field = pivot_quadrant) #%>% select(-pivot.y)
#head(AllPivots)
AllPivots_merged <- AllPivots %>% #dplyr::select(Field, subField, sub_area) %>% unique() %>%
group_by(Field) %>% summarise(sub_area = first(sub_area))
#AllPivots_merged <- AllPivots %>% #dplyr::select(field, sub_field, sub_area) %>% unique() %>%
# group_by(field) %>% summarise(sub_area = first(sub_area))
AllPivots_merged <- st_transform(AllPivots_merged, crs = proj4string(CI))
#AllPivots_merged <- st_transform(AllPivots_merged, crs = proj4string(CI))
pivot_names <- unique(CI_quadrant$Field)
#pivot_names <- unique(CI_quadrant$field)
```
@ -220,7 +220,7 @@ create_CI_map <- function(pivot_raster, pivot_shape, pivot_spans, show_legend =
tm_layout(main.title = paste0("\nMax CI week ", week,"\n", age, " weeks old"),
main.title.size = 0.7, legend.show = show_legend) +
tm_shape(pivot_shape) +
tm_borders(lwd = 3) + tm_text("subField", size = 1/2) +
tm_borders(lwd = 3) + tm_text("sub_field", size = 1/2) +
tm_shape(pivot_spans) + tm_borders(lwd = 0.5, alpha=0.5)
}
@ -230,16 +230,16 @@ create_CI_diff_map <- function(pivot_raster, pivot_shape, pivot_spans, show_lege
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) +
tm_shape(pivot_shape) +
tm_borders(lwd = 3) + tm_text("subField", size = 1/2) +
tm_borders(lwd = 3) + tm_text("sub_field", size = 1/2) +
tm_shape(pivot_spans) + tm_borders(lwd = 0.5, alpha=0.5)
}
ci_plot <- function(pivotName){
# pivotName = "1.1"
pivotShape <- AllPivots_merged %>% terra::subset(Field %in% pivotName) %>% st_transform(crs(CI))
age <- AllPivots %>% dplyr::filter(Field %in% pivotName) %>% st_drop_geometry() %>% dplyr::select(Age) %>% unique()
pivotShape <- AllPivots0 %>% terra::subset(field %in% pivotName) %>% st_transform(crs(CI))
age <- harvesting_data %>% dplyr::filter(field %in% pivotName) %>% dplyr::select(age) %>% unique()
AllPivots2 <- AllPivots %>% dplyr::filter(Field %in% pivotName)
AllPivots2 <- AllPivots0 %>% dplyr::filter(field %in% pivotName)
singlePivot <- CI %>% crop(., pivotShape) %>% mask(., pivotShape)
@ -250,9 +250,9 @@ ci_plot <- function(pivotName){
abs_CI_last_week <- last_week_dif_raster_abs %>% crop(., pivotShape) %>% mask(., pivotShape)
abs_CI_three_week <- three_week_dif_raster_abs %>% crop(., pivotShape) %>% mask(., pivotShape)
planting_date <- harvesting_data %>% dplyr::filter(Field %in% pivotName) %>% ungroup() %>% dplyr::select(Season_start) %>% unique()
planting_date <- harvesting_data %>% dplyr::filter(field %in% pivotName) %>% ungroup() %>% dplyr::select(season_start) %>% unique()
joined_spans2 <- joined_spans %>% 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_m1 <- create_CI_map(singlePivot_m1, AllPivots2, joined_spans2, show_legend= F, legend_is_portrait = F, week = week_minus_1, age = age -1)
@ -264,7 +264,7 @@ ci_plot <- function(pivotName){
tst <- tmap_arrange(CImap_m2, CImap_m1, CImap,CI_max_abs_last_week, CI_max_abs_three_week, nrow = 1)
cat(paste("## Pivot", pivotName, "-", age$Age[1], "weeks after planting/harvest", "\n"))
cat(paste("## Pivot", pivotName, "-", age, "weeks after planting/harvest", "\n"))
# cat("\n")
# cat('<h2> Pivot', pivotName, '- week', week, '-', age$Age, 'weeks after planting/harvest <h2>')
# cat(paste("# Pivot",pivots$pivot[i],"\n"))
@ -283,7 +283,7 @@ cum_ci_plot <- function(pivotName){
g <- ggplot() +
scale_x_date(limits = c(start_date, end_date), date_breaks = "1 month", date_labels = "%m-%Y") +
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") +
theme(axis.text.x = element_text(angle = 60, hjust = 1),
legend.justification = c(1, 0), legend.position = c(1, 0),
@ -297,9 +297,9 @@ cum_ci_plot <- function(pivotName){
cum_ci_plot2 <- function(pivotName){
# pivotName = "1.1"
data_ci <- CI_quadrant %>% filter(Field == pivotName)
data_ci <- CI_quadrant %>% filter(field == pivotName)
data_ci2 <- data_ci %>% mutate(CI_rate = cumulative_CI/DOY,
week = week(Date))%>% group_by(Field) %>%
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),
@ -310,7 +310,7 @@ cum_ci_plot2 <- function(pivotName){
g <- ggplot(data= data_ci2) +
geom_line( aes(Date, mean_rolling10, col = subField)) +
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))+
@ -338,7 +338,7 @@ tm_shape(RGB_raster, unit = "m") + tm_rgb(r=1, g=2, b=3, max.value = 255) +
tm_scale_bar(position = c("right", "top"), text.color = "white") +
tm_compass(position = c("right", "top"), text.color = "white") +
tm_shape(AllPivots)+ tm_borders( col = "white") +
tm_shape(AllPivots0)+ tm_borders( col = "white") +
tm_text("pivot_quadrant", size = .6, col = "white")
```
@ -351,8 +351,8 @@ tm_shape(CI, unit = "m")+
tm_scale_bar(position = c("right", "top"), text.color = "black") +
tm_compass(position = c("right", "top"), text.color = "black") +
tm_shape(AllPivots)+ tm_borders( col = "black") +
tm_text("subField", size = .6, col = "black")
tm_shape(AllPivots0)+ tm_borders( col = "black") +
tm_text("sub_field", size = .6, col = "black")
```
\newpage
@ -365,31 +365,34 @@ tm_shape(CI, unit = "m")+
tm_scale_bar(position = c("right", "top"), text.color = "black") +
tm_compass(position = c("right", "top"), text.color = "black") +
tm_shape(AllPivots)+ tm_borders( col = "black") +
tm_text("subField", size = .6, col = "black")
tm_shape(AllPivots0)+ tm_borders( col = "black") +
tm_text("sub_field", size = .6, col = "black")
```
\newpage
```{r plots_ci_estate, eval=FALSE, fig.height=3.8, fig.width=10, message=FALSE, warning=FALSE, include=FALSE, results='asis'}
```{r plots_ci_estate, eval=TRUE, fig.height=3.8, fig.width=10, message=FALSE,echo=FALSE, warning=FALSE, include=TRUE, results='asis'}
# # pivots <- AllPivots_merged %>% filter(pivot != c("1.1", "1.17"))
pivots_estate <- AllPivots_merged %>% filter(Field %in% c("6.2")) #, "1.2", "1.3", "1.4")) #, "1.6", "1.7", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13", "1.14" , "1.16" , "1.17" , "1.18" , "6.1", "6.2", "DL1.1", "DL1.3")) %>% filter(pivot != "1.17")
# pivots_estate <- AllPivots_merged %>% filter(field %in% c("6.2")) #, "1.2", "1.3", "1.4")) #, "1.6", "1.7", "1.8", "1.9", "1.10", "1.11", "1.12", "1.13", "1.14" , "1.16" , "1.17" , "1.18" , "6.1", "6.2", "DL1.1", "DL1.3")) %>% filter(pivot != "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")
walk(pivots_estate$Field, ~ {
cat("# Hello!!!")
walk(AllPivots0$field, ~ {
# cat("# Hello!!!")
cat("\n") # Add an empty line for better spacing
ci_plot(.x)
cat("\n")
# cum_ci_plot(.x)
# cat("\n")
cum_ci_plot2(.x)
})
```
```{r looping_over_sub_area, echo=FALSE, fig.height=3.8, fig.width=10, message=FALSE, warning=FALSE, results='asis', eval=TRUE}
pivots_grouped <- AllPivots_merged # %>%
```{r looping_over_sub_area, echo=FALSE, fig.height=3.8, fig.width=10, message=FALSE, warning=FALSE, results='asis', eval=FALSE}
pivots_grouped <- AllPivots0 # %>%
# group_by(sub_area) %>%
# arrange(sub_area) # Optional: arrange the groups alphabetically by sub_area
@ -401,7 +404,7 @@ print(" PRINT")
# cat("# Subgroup: ", subgroup, "\n") # Add a title for the subgroup
subset_data <- filter(pivots_grouped, sub_area == subgroup)
# cat("\\pagebreak")
walk(subset_data$Field, ~ {
walk(subset_data$field, ~ {
# cat("\n") # Add an empty line for better spacing
ci_plot(.x)
# cat("\n")
@ -463,13 +466,13 @@ ggplot(data= CI_all2%>% filter(season =="Data_2022"), aes(DOY, cumulative_CI, co
The below table shows estimates of the biomass if you would harvest them now.
```{r eval=FALSE, message=FALSE, warning=FALSE, include=FALSE}
CI_quadrant <- readRDS(here(cumulative_CI_vals_dir,"All_pivots_Cumulative_CI_quadrant_year_v2.rds")) %>%
rename( pivot_quadrant = Field)#All_pivots_Cumulative_CI.rds
rename( pivot_quadrant = field)#All_pivots_Cumulative_CI.rds
ggplot(CI_quadrant %>% filter(pivot %in% "1.11")) +
geom_line(aes(DOY, cumulative_CI, col = as.factor(season))) +
facet_wrap(~pivot_quadrant)
pivots_dates0 <- pivots_dates0 %>% ungroup() %>% unique() %>%
dplyr::select(Field, subField, Tcha_2021, Tcha_2022 ) %>%
dplyr::select(field, sub_field, Tcha_2021, Tcha_2022 ) %>%
pivot_longer(cols = c("Tcha_2021", "Tcha_2022"), names_to = "Tcha_Year", values_to = "Tcha") %>%
filter(Tcha > 50) %>%
mutate(season = as.integer(str_extract(Tcha_Year, "\\d+")))
@ -549,7 +552,7 @@ ggplot(pred_ffs_rf, aes(y = predicted_Tcha , x = Tcha , col = pivot )) +
labs(title = "Model trained and tested on historical results - RF")
ggplot(pred_rf_2023, aes(total_CI , predicted_Tcha_2023 , col = pivot )) +
geom_point() + labs(title = "2023 data (still to be harvested) - Fields over 300 days old")
geom_point() + labs(title = "2023 data (still to be harvested) - fields over 300 days old")
knitr::kable(pred_rf_2023)
```

Binary file not shown.

View file

@ -72,7 +72,7 @@ pivot_stats_long <- pivot_stats2 %>%
# pivot_select_model_Data_2023 <- harvesting_data %>% filter(year == 2023) %>% filter(!is.na(season_start)) %>% pull(sub_field)
pivot_select_model_Data_2024 <- harvesting_data %>% filter(year == 2024)%>% filter(!is.na(season_start)) %>% pull(sub_field)
print(pivot_select_model_Data_2024)
# pivots_dates_Data_2022 <- pivots_dates0 %>% filter(!is.na(season_end_2022))
# pivot_select_model_Data_2022 <- unique(pivots_dates_Data_2022$pivot_quadrant )
#

View file

@ -62,7 +62,7 @@ daily_vrt <- here(data_dir, "vrt")
harvest_dir <- here(data_dir, "HarvestData")
source("parameters_project.R")
source("utils_1.R")
source("mosaic_creation_utils.R")
dir.create(here(laravel_storage_dir))
dir.create(here(data_dir))

View file

@ -1,5 +1,5 @@
library('readxl')
#chemba
if(project_dir == "chemba"){
message("Yield data for Chemba")