#!/usr/bin/env Rscript
rm(list=ls()); gc();

### Creation date: 3rd October 2022
# Author: N. Pérez-Zanón
# Refer CSTools package and manuscript when using it.
# ----------------------------------------

library(CSTools)
library(s2dv)
library(ragg)
library(multiApply)
library(startR)
library(sf)
library(rgeos)
library(multiApply)
library(lubridate)
library(ClimProjDiags)
library(ggplot2)

working_dir <- "/esarchive/scratch/nperez/git/Flor/ArticXchange/"
output_dir <- "/esarchive/scratch/nperez/ArticXChange/round_table/"
setwd(working_dir)

obs_path <- list(name = "FMI",
            path = "/esarchive/obs/fmi/climgrid/weekly_mean/$var$_f24h/$var$_$sdate$$month$$day$.nc")

mask_fmi <- readRDS(paste0(working_dir, "masks/FMI_Herding_mask.RDS"))
polys <- unique(as.vector(mask_fmi$mask))[-1]
dim(polys) <- c(poly = length(polys))

mask.file_4 <- paste0('region_exploration/LAU/LAU_RG_01M_2020_4326.shp')
shp_4 <- rgdal::readOGR(mask.file_4)
shp_4 <- subset(shp_4, CNTR_CODE == "FI")
## shp_herding <- subset(shp_4, as.numeric(LAU_ID) %in% polys) # R4.1 used to work
# R3.6.1:
shp_herding <- subset(shp_4, LAU_ID %in% sprintf("%03d", polys))

 # Assess forecast from 1 to 3 months in advance
# PARAMETERS TO CHANGE:
# 5th of May 2004; 19th April 2004; 28th April 2014; 5th May 2014
year <- 2014
mes <- 5
monday <- 5
#months <- c('05', '06', '07')
ref_period_ini <- 1993
ref_period_end <- 2021

# Load the reference for the hindcaast period:
tas_ref <- Start(dat = obs_path,
             var = 'tas',
             sdate = as.character(ref_period_ini:ref_period_end),
             month = sprintf("%02d", mes),
             day = sprintf("%02d", monday),
             time = 'all',
             y = 'all',
             x = 'all',
             synonims = list(y = c('y', 'lat', 'latitude'),
                             x = c('x', 'lon', 'longitude')),
             return_vars = list(y = NULL, x = NULL, time = 'sdate'),
             retrieve = TRUE)
time <- attributes(tas_ref)$Variable$common$time
ys <- attributes(tas_ref)$Variable$common$y
xs <- attributes(tas_ref)$Variable$common$x

# By polygons
tas_polys <- Apply(list(tas_ref, mask_fmi$mask, polys), 
                   target_dims = list(c('x', 'y'), c('x', 'y'), NULL),
                   function(x, y, z) {
                     mean(x[which(y == z)], na.rm = TRUE)},
                   ncores = 6)$output1

tas_polys <- tas_polys - 273.15
tas_polys <- tas_polys[1,1, , , , ,
                   match(shp_herding@data$LAU_ID, sprintf("%03d", polys))]


# selection by weeks:

p10 <- Apply(tas_polys, target_dims = 'sdate',
                    fun = function(x) {quantile(x, 0.10)})$output1
p90 <- Apply(tas_polys, target_dims = 'sdate',
                    fun = function(x) {quantile(x, 0.90)})$output1
p33 <- Apply(tas_polys, target_dims = 'sdate',
                    fun = function(x) {quantile(x, 0.33)})$output1
p66 <- Apply(tas_polys, target_dims = 'sdate',
                    fun = function(x) {quantile(x, 0.66)})$output1
tas_year <- Subset(tas_polys, along = 'sdate', 
                        indices = which(ref_period_ini:ref_period_end == year))

save_numbers <- c(p10 = mean(p10), p33 = mean(p33), p66 = mean(p66), p90 = mean(p90))
write.table(round(save_numbers, 2),
            file = paste0(output_dir, "FMI_", ref_period_ini, "-", ref_period_end, 
                          "_week", mes, "-", monday,
                   "_Observed_percentiles_Herding.csv"), col.names = FALSE)

observed_prob <- Apply(list(tas_year, p10, p33, p66, p90),
                       target_dims = NULL, fun =
                       function(x, p10,p33, p66, p90) {
                         if (x < p10) {
                           res <- 5
                         } else if (x < p33 & x >= p10) {
                           res <- 4
                         } else if (x < p66 & x >= p33) {
                           res <- 3
                         } else if (x < p90 & x >= p66) {
                           res <- 2
                         } else if (x > p90) { 
                           res <- 1
                         }
                         return(res)})$output1 

data_pol <- data.frame(data = as.vector(observed_prob), 
                       LAU_ID = shp_herding@data$LAU_ID)
  shp_data <- merge(shp_herding, data_pol, by.x="LAU_ID", by.y="LAU_ID")
# Magic lines below that converts SpatialPolygonsDataFrame to normal data frame
  shp_data@data$id <- rownames(shp_data@data)
  df.points <- fortify(shp_data, region = "id")
  df.df <- plyr::join(df.points, shp_data@data, by = "id")

library(sf)
library(ggplot2)
#library(ggplot2, lib.loc = .libPaths()[2])
library(RColorBrewer)
library(rgeos)

gusa <- map_data("world")

pals <- brewer.pal(9, 'Reds')[3:9]
pals <- c("#ffffb3",pals,'#525252')

brks <- 0:5

# From PlotForecastPDF
#colorFill <- c("#FF764D", "#b5b5b5", "#33BFD1") # AN, N, BN fill colors
#colorHatch <- c("indianred3", "deepskyblue3")
# Vitigeoss colors
colorFill <- c("#f40000", "#acb2b5", "#007be2")
colorHatch <- c("#ae0003", "#211b79")
# Subset region
lat_min <- 64#59
lat_max <- 71
lon_min <- 20
lon_max <- 31



p <- ggplot(data = df.df) +
  geom_polygon(aes(long, lat, group = group),fill = "lightgrey", data = gusa) +
        coord_map(projection = "stereographic",
                  xlim = c(lon_min, lon_max),
                  ylim = c(lat_min, lat_max)) +
       # geom_polygon(aes(x = long, y = lat, fill = cut(data, breaks = seq(-14, 18, 2)),
        geom_polygon(aes(x = long, y = lat, fill = cut(data,
                         breaks = seq(0, 5, 1)),
             group = group), color = "grey",size = 0.08) +
        geom_polygon(aes(x = long, y = lat, group = group), fill = NA,
                    color = "grey", size = 0.5, data = shp_herding) +
        theme_bw() +
        scale_fill_manual(values = rev(c("#211B79", "#007BE2", "#ACB2B5",
                                     "#F40000","#AE0003")),
                          labels = rev(c('Lower extreme (p10)', 
                                     'Below normal (p33)',
                                     'Normal (between p33-p66)',
                                     'Above normal (p66)',
                                     'Upper extreme (p90)')),
                          drop = FALSE, name = 'Category') +
        theme(panel.background = element_rect(fill = 'azure'),
              text = element_text(family = "Times")) +  # Colour of ocean
        xlab('Longitude') + ylab('Latitude') +
        scale_x_continuous(breaks = seq(-12, 45, 4),labels = waiver()) +
        scale_y_continuous(breaks = seq(32, 70, 4),labels = waiver()) +
        ggtitle(paste("Week starting on Monday", monday, month.name[mes], year))# +
        
#ggsave(paste0(output_dir, "Observed_weekly_categories_FMI_", year, "_",
#       mes, "_", monday, ".jpg"), height = 4, width = 5, dpi = 300)

# Nord3:
library(ragg)
agg_png(paste0(output_dir, "Observed_weekly_categories_FMI_", year, "_",
       mes, "_", monday, ".jpg"), width = 1000, height = 500, units = 'px',res = 144)
 p 
  dev.off()
