
library(startR)
library(psych)
library(multiApply)
library(CSTools)
library(s2dv)
library(lubridate)

setwd("/esarchive/scratch/nperez/git/Flor/WildFires/")
# -----------------------------------------------------------------
######## DATES WILDFIRES:
# -----------------------------------------------------------------
fires <- read.table('EFFIS02.csv', sep = ',', skip = 1)
colnames(fires) <- c('N', 'date', 'country', 'area_ha', 'place', 'province',
                     'yearseason', 'fireid', 'ID')
scores1 <- scores2 <- scores3 <- scores4 <- scores5 <- NULL
weights1 <- weights2 <- weights3 <- weights4 <- weights5 <- NULL
# -----------------------------------------------------------------
# Wildfires until 500 ha:
wf_500 <- subset(fires, area_ha < 500)
wf_500_dates <- sort(unique(as.Date(wf_500$date, "%Y-%m-%d")))

# Create vector of positions:
day <- day(wf_500_dates)
month <- month(wf_500_dates)
year <- year(wf_500_dates)-2005
wf_500_pos <- (year - 1) * 12 * 31 + (month - 1) * 31 + day

# -----------------------------------------------------------------
# Wildfires until 1000 ha:
wf_1000 <- subset(fires, area_ha >= 500 & area_ha < 1000)
wf_1000_dates <- sort(unique(as.Date(wf_1000$date, "%Y-%m-%d")))

day <- day(wf_1000_dates)
month <- month(wf_1000_dates)

year <- year(wf_1000_dates)-2005
wf_1000_pos <- (year - 1) * 12 * 31 + (month - 1) * 31 + day

# -----------------------------------------------------------------
# Wildfires until 2500 ha:
wf_2500 <- subset(fires, area_ha >= 1000 & area_ha < 2500)
wf_2500_dates <- sort(unique(as.Date(wf_2500$date, "%Y-%m-%d")))

day <- day(wf_2500_dates)
month <- month(wf_2500_dates)
year <- year(wf_2500_dates)-2005
wf_2500_pos <- (year - 1) * 12 * 31 + (month - 1) * 31 + day

# -----------------------------------------------------------------
# Wildfires greater than 2500 ha:
wf_68000 <- subset(fires, area_ha >= 2500)
wf_68000_dates <- sort(unique(as.Date(wf_68000$date, "%Y-%m-%d")))

day <- day(wf_68000_dates)
month <- month(wf_68000_dates)
year <- year(wf_68000_dates)-2005
wf_68000_pos <- (year - 1) * 12 * 31 + (month - 1) * 31 + day

# -----------------------------------------------------------------
# Wildfires all dates:
wf_dates <- sort(unique(as.Date(fires$date, "%Y-%m-%d")))

day <- day(wf_dates)
month <- month(wf_dates)
year <- year(wf_dates)-2005
wf_pos <- (year - 1) * 12 * 31 + (month - 1) * 31 + day


# -----------------------------------------------------------------
# Datasets!
# compute PCA and calculate cumulated variance to choose the num of comp
# -----------------------------------------------------------------
# -----------------------------------------------------------------
# Choose the variable:
varname = c('psl', 'g500', 'ta850', 'ta1000', 'hur700', 'hur950')
name = c('PSL', 'Z500', 'T850', 'T1000', 'H700', 'H950')

ncomp <- list(psl = rep(11, 5),
              g500 = rep(11, 5),
              ta850 = c(25, 25, 23, 21, 25),
              ta1000 = c(39, 35, 32, 29, 39),
              hur700 = c(72, 60, 53, 43, 73),
              hur950 = c(59, 46, 39, 32, 60))
for (k in 1:length(varname)) {

if (varname[k] == 'psl') {
  path <- '/esarchive/recon/ecmwf/era5/daily_mean/$var$_f1h/$var$_$months$.nc'
} else {
  path <- '/esarchive/recon/ecmwf/era5/daily_mean/$var$_f1h-r1440x721cds/$var$_$months$.nc'
}
# Load the gridded data:
dates <- seq(ymd('20060101'), ymd('20181201'), by = 'month')
dates <- format(dates, "%Y%m") 
data <- Start(dataset = path,
             var = varname[k],
             months = dates,
             time = 'all',
             latitude = values(list(30, 70)),
             latitude_reorder = Sort(decreasing = FALSE),
             longitude = values(list(-40, 40)),
             longitude_reorder = CircularSort(-180, 180),
             transform = CDORemapper,
             transform_extra_cells = 2,
             transform_params = list(grid = 'r360x181',
                                     method = 'conservative',
                                     crop = c(-40, 40,
                                              30, 70)),
             transform_vars = c('latitude', 'longitude'),
             synonims = list(latitude = c('lat', 'latitude'),
                             longitude = c('lon', 'longitude')),
             return_vars = list(latitude = 'dataset',
                                longitude = 'dataset',
                                time = NULL),
             retrieve = TRUE)

time <- attributes(data)$Variables$common$time
lat <- attributes(data)$Variables$dat1$latitude
lon <- attributes(data)$Variables$dat1$longitude

# Apply latitudinal correction:
data <- multiApply::Apply(list(data), target_dims = 'latitude',
                          fun = function(x) {x * sqrt(cos(lat * pi / 180))})$output1
data <- Reorder(data, c('dataset', 'var', 'months', 'time', 'latitude', 'longitude'))

# Split by day of the year to compute the climatologies:
data <- SplitDim(data, 'months', indices = sort(rep(1:13, 12)))
names(dim(data)) <- c('dataset', 'var', 'month', 'day', 'lat', 'lon', 'year')

# Compute the climatologies:
data_clim <- MeanDims(data, dims = 'year')
# Compute the anomalies
data_anom <- data -  InsertDim(data_clim, posdim = 7, lendim = 13) 

# Get a matrix of time vs gridpoint
data_anom <- MergeDims(data_anom, merge_dims = c('day', 'month'))
data_anom <- MergeDims(data_anom, merge_dims = c('day', 'year'))
data_anom <- MergeDims(data_anom, merge_dims = c('lat', 'lon'),
                      rename = 'gridpoint')
# -----------------------------------------------------------------
# Fires until 500 ha
# Select the dates:
#data_500 <- data_anom[1, 1, wf_500_pos, ]

# Varimax:
#fit <- principal(data_500, nfactors = ncomp[[k]][1], rotate = "varimax",
#                 scores = TRUE)
#selected <- fit$scores #scores de las componentes seleccionadas
#colnames(selected) <- as.character(paste0(varname[k], 1:ncomp[[k]][1]))
#scores1 <- cbind(scores1, selected)
#weig <- fit$weights
#colnames(weig) <- as.character(paste0(varname[k], 1:ncomp[[k]][1]))
#weights1 <- cbind(weights1, weig)

# -----------------------------------------------------------------
# Fires until 1000 ha
#data_1000 <- data_anom[1, 1, wf_1000_pos, ]

#fit <- principal(data_1000, nfactors = ncomp[[k]][1], rotate = "varimax",
#                 scores = TRUE)
#selected <- fit$scores #scores de las componentes seleccionadas
#colnames(selected) <- as.character(paste0(varname[k], 1:ncomp[[k]][1]))
#scores2 <- cbind(scores2, selected)
#weig <- fit$weights
#colnames(weig) <- as.character(paste0(varname[k], 1:ncomp[[k]][1]))
#weights2 <- cbind(weights2, weig)

# -----------------------------------------------------------------
# Wildfires until 2500 ha:
data_2500 <- data_anom[1, 1, wf_2500_pos, ]

fit <- principal(data_2500, nfactors = ncomp[[k]][1], rotate = "varimax",
                 scores = TRUE)
selected <- fit$scores #scores de las componentes seleccionadas
colnames(selected) <- as.character(paste0(varname[k], 1:ncomp[[k]][1]))
scores3 <- cbind(scores3, selected)
weig <- fit$weights
colnames(weig) <- as.character(paste0(varname[k], 1:ncomp[[k]][1]))
weights3 <- cbind(weights3, weig)
}
# -----------------------------------------------------------------
# Wildfires greater than 2500 ha:
data_68000 <- data_anom[1, 1, wf_68000_pos, ]

fit <- principal(data_68000, nfactors = ncomp[[k]][1], rotate = "varimax",
                 scores = TRUE)
selected <- fit$scores #scores de las componentes seleccionadas
colnames(selected) <- as.character(paste0(varname[k], 1:ncomp[[k]][1]))
scores4 <- cbind(scores4, selected)
weig <- fit$weights
colnames(weig) <- as.character(paste0(varname[k], 1:ncomp[[k]][1]))
weights4 <- cbind(weights4, weig)

# -----------------------------------------------------------------
# Wildfires all dates:
data_all <- data_anom[1, 1, wf_pos, ]

fit <- principal(data_all, nfactors = ncomp[[k]][1], rotate = "varimax",
                 scores = TRUE)
selected <- fit$scores #scores de las componentes seleccionadas
colnames(selected) <- as.character(paste0(varname[k], 1:ncomp[[k]][1]))
scores5 <- cbind(scores5, selected)
weig <- fit$weights
colnames(weig) <- as.character(paste0(varname[k], 1:ncomp[[k]][1]))
weights5 <- cbind(weights5, weig)

# Example of plot
#png(paste0("/esarchive/scratch/nperez/git/Flor/WildFires/",
#    name, "/", name, "_all_Scree.png"),
#    type = 'cairo')
#plot(c, type = "lines", npcs = 20, main = paste(name, "all PCA Variance"),
#     col = "blue",
#     pch = 16)
#dev.off()
gc()
}

# -----------------------------------------------------------------
# write the summary to choose the number of components:
write.table(scores1,
            "/esarchive/scratch/nperez/git/Flor/WildFires/scores_500.csv",
            row.names = FALSE, sep = ',')
write.table(scores2,
            "/esarchive/scratch/nperez/git/Flor/WildFires/scores_1000.csv",
            row.names = FALSE, sep = ',')
write.table(scores3,
            "/esarchive/scratch/nperez/git/Flor/WildFires/scores_2500.csv",
            row.names = FALSE, sep = ',')
write.table(scores4,
            "/esarchive/scratch/nperez/git/Flor/WildFires/scores_68000.csv",
            row.names = FALSE, sep = ',')
write.table(scores5,
            "/esarchive/scratch/nperez/git/Flor/WildFires/scores_all.csv",
            row.names = FALSE, sep = ',')
write.table(weights1,
            "/esarchive/scratch/nperez/git/Flor/WildFires/weights_500.csv",
            row.names = FALSE, sep = ',')
write.table(weights2,
            "/esarchive/scratch/nperez/git/Flor/WildFires/weights_1000.csv",
            row.names = FALSE, sep = ',')
write.table(weights3,
            "/esarchive/scratch/nperez/git/Flor/WildFires/weights_2500.csv",
            row.names = FALSE, sep = ',')
write.table(weights4,
            "/esarchive/scratch/nperez/git/Flor/WildFires/weights_68000.csv",
            row.names = FALSE, sep = ',')
write.table(weights5,
            "/esarchive/scratch/nperez/git/Flor/WildFires/weights_all.csv",
            row.names = FALSE, sep = ',')

