library(startR)

obs_path <- '/esarchive/exp/monarch-dustclim/3hourly/$var$/$var$_$date$03_av_an.nc'

date <- '20131229'

data <- Start(dataset = obs_path,
              var = 'od550du',
              lev = 'all', # lev = 'first',
              date = date,
              time = 'all',
              rlat = 'all',
              rlon = 'all',
              retrieve = FALSE)

data <- Start(dataset = obs_path,
              var = 'od550du',
              lev = 'all',
              date = date,
              time = 'all',
              rlat = 'all',
              rlon = 'all',
              return_vars = list(lev = NULL, time = NULL,
                                 rlat = NULL, rlon = NULL,
                                 lat = NULL, lon = NULL),
              retrieve = TRUE, num_procs = 1)
lat <- attributes(data)$Variables$common$lat
lon <- attributes(data)$Variables$common$lon
rlat <- attributes(data)$Variables$common$rlat
rlon <- attributes(data)$Variables$common$rlon


# Plot irregular grid:
library(sf)
map <- data[1,1,1,1,1,,]
library(ggplot2)
dim(map)
map <- data.frame(rlat = rep(rlat, length(rlon)),
                 rlon = sort(rep(rlon, length(rlat))), datos = as.vector(map))
dat_map <- st_as_sf(map, coords = c("rlon", "rlat"), crs = 4326)
x <- lwgeom::st_transform_proj(dat_map, c(st_crs(4326)$proj4string, "+proj=ob_tran +o_proj=longlat +o_lon_p=-160 +o_lat_p=55 +lon_0=180 +to_meter=0.01745329"))
plot(x)
#data(wrld_simpl, package = "maptools")
#w = st_as_sf(wrld_simpl)
plot(x)
#plot(st_geometry(w), xlim = c(-20, 60), ylim = c(0, 80)) # very slow :C
#plot(x, add = T)

#sf::plot(x, axes = TRUE)
bbox <- st_bbox(x)
borders <- st_as_sf(maps::map('world', plot = FALSE, fill = TRUE))
st_crs(x) = NA # ?! (!)
st_crs(x) = 4326
library(ggplot2)
ggplot() + geom_sf(data=x, aes(color=datos)) + geom_sf(data = borders, fill=NA, colour="black") + coord_sf(xlim = bbox[c(1,3)],ylim = bbox[c(2,4)])

dim(data)
range(data)
names(attributes(data))
names(attributes(data)$Variables)             
names(attributes(data)$Variables$common) 
attributes(data)$Variables$dat1
attributes(data)$Variables$common$rlat
lat <- attributes(data)$Variables$common$lat
lon <- attributes(data)$Variables$common$lon
> range(rlat)
Error: object 'rlat' not found
> range(attributes(data)$Variables$common$rlat)
[1] -35  35
> range(attributes(data)$Variables$common$rlon)
[1] -51  51
> range(lon)
[1] -61.66294 101.66295

attributes(data)$Variables$common$rlon
attributes(data)$Variables$common$lev
attributes(data)$Variables$common$time


# --------------------------
data2 <- drop(data)

all(data[1,1,1,1,,,] == data2)

library(s2dv)
# MeanDims, Corr(), RMS(), EOF(), Reorder(
data3 <- Reorder(data2, c('time', 'rlon', 'rlat')) 
library(ClimProjDiags)
# WeightedMeans, Subset()
data3 <- Subset(data3, along = 'time', indices= c(1,3,5,7))

# apply, lapply 
library(multiApply)
weights <- data2[1,,]*0.1
data <- Apply(data = list(data2, weights), target_dims = list(c('rlat', 'rlon'), c('rlat', 'rlon')), fun = function(x, y) {x+y})$output1

data <- Apply(data = list(data2, weights), target_dims = list(c('rlat', 'rlon'), c('rlat', 'rlon')), fun = function(x, y) {return(list(x+y, x-y))}, ncores = 4)
#

#data <- time = 10*365,
#SplitDims(data, 'time', 'monthly') 

PromYPerc <- function(data, probs = c(0.25, 0.95)) {
  # data: time -> 8*365*10
  prom <- mean(data, na.rm = TRUE)
  perc <- quantile(data, probs = probs)
  sd <- sd(data, na.rm = TRUE)
  return(list(prom = prom, perc = perc, sd = sd))
}

stats <- Apply(data = data2, target_dims = 'time', fun = PromYPerc,
               probs = seq(0, 1, 0.25), ncores = 4)
str(stats)

##### ------
startR - Compute()

library(startR)
obs_path <- '/esarchive/exp/monarch-dustclim/3hourly/$var$/$var$_$date$03_av_an.nc'

date <- '20131229'

data <- Start(dataset = obs_path,
              var = 'od550du',
              lev = 'all', # lev = 'first',
              date = date,
              time = 'all',
              rlat = 'all',
              rlon = 'all',
              retrieve = FALSE)
# merge_across_dims
Stats <- function(data, probs = seq(0, 1, 0.25)) {
  # data: time -> 8*365*10
 # split time dim?
  prom <- mean(data, na.rm = TRUE)
  perc <- quantile(data, probs = probs)
  sd <- sd(data, na.rm = TRUE)
  stats <- c(prom, sd, as.vector(perc)) 
  return(stats)
}
stats <- Apply(data = data2, target_dims = 'time', fun = Stats,
              ncores = 4)

step1 <- Step(fun = Stats,
               target_dims = c('time'),
               output_dims = 'stats')
  
wf1 <- AddStep(data, step1)
  
## locally
  res1 <- Compute(wf1,
              chunks = list(rlon = 2, rlat = 2))
# To explore:
# threads_compute
# cluster

map <- array(rnorm(701*1021), c(rlat = 701, rlon = 1021))
rlon <- seq(-51, 51, 0.1)
rlat <- seq(-35, 35, 0.1)
map <- data.frame(rlat = rep(rlat, length(rlon)),
                 rlon = sort(rep(rlon, length(rlat))), datos = as.vector(map))
library(sf)
dat_map <- st_as_sf(map, coords = c("rlon", "rlat"), crs = 4326)
x <- lwgeom::st_transform_proj(dat_map, c(st_crs(4326)$proj4string, "+proj=ob_tran +o_proj=longlat +o_lon_p=-160 +o_lat_p=55 +lon_0=180 +to_meter=0.01745329"))
plot(x)
#data(wrld_simpl, package = "maptools")
#w = st_as_sf(wrld_simpl)
#∑plot(x)
#plot(st_geometry(w), xlim = c(-20, 60), ylim = c(0, 80)) # very slow :C
#plot(x, add = T)

#sf::plot(x, axes = TRUE)
bbox <- st_bbox(x)
borders <- st_as_sf(maps::map('world', plot = FALSE, fill = TRUE))
st_crs(x) = NA # ?! (!)
st_crs(x) = 4326
library(ggplot2)
ggplot() + 
geom_sf(data=x, aes(color=datos)) + 
scale_color_gradient2(midpoint=mean(data), low="blue", mid="white",
                     high="red", space ="Lab" ) +
geom_sf(data = borders, fill=NA, colour="black") + coord_sf(xlim = bbox[c(1,3)],ylim = bbox[c(2,4)])


