---
title: "Analogs based on large scale for downscaling"
author: "M. Carmen Alvarez-Castro (CMCC, Italy)"
date: "August 2020"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteEngine{knitr::knitr}
  %\VignetteIndexEntry{Analogs}
  %\usepackage[utf8]{inputenc}
---

<!--
```{r, echo = FALSE}
knitr::opts_chunk$set(eval = FALSE)
```
-->
## Downscaling seasonal forecast data using Analogs

In this example, the seasonal temperature forecasts, initialized in november, will be used to perform a downscaling in the iberian peninsula temperature using the glosea5 seasonal forecasting system from the Met Office, by computing Analogs in Sea level pressure data (SLP) in a larger region (North Atlantic). The first step will be to load the data we want to downscale (i.e. glosea5) in the large region (i.e North Atlantic) for temperature (predictand) and SLP (predictor) and same variables and region for a higher resolution data (ERA5). In a second step we will interpolate the model to the resolution of ERA5. In a third step we will find the analogs using one of the three criterias. In a four step we will get the downscaled dataset in the region selected (local scale, in this case Spain)

## 1. Introduction of the function

For instance if we want to perform a temperature donwscaling in Spain for November we will get a daily series of temperature with 1 analog per day, the best analog. How we define the best analog for a certain day? This function offers three options for that:

(1) The day with the minimum Euclidean distance in a large scale field: using i.e. pressure or geopotencial height as variables and North Atlantic region as large scale region.  The Atmospheric circulation pattern in the North Atlantic (LargeScale) has an important role in the climate in Spain (LocalScale). The function will find a day with the most similar pattern in atmospheric circulation in the database (obs, slp in ERA5) to the day of interest (exp,slp in model). Once the date of the best analog is found, the function takes the associated temperature to that day (obsVar, t2m in ERA5), with a subset of the region of interest (Spain)

(2) Same that (1) but in this case we will search for analogs in the local scale (Spain) instead o large scale (North Atlantic. Once the date of the best analog is found, the function takes the associated temperature to that day (obsVar, t2m in ERA5), with a subset of the region of interest (Spain)
(3) Same that (2) but here we will serach for analogs with higher correlation at local scale (spain) and instead of using SLP we will use t2m. 


In particular the _Analogs Method_  use a nonlinear approach that follows (**Analogs**; Yiou et al. 2013) 

An efficient implementation of Analogs is provided for CSTools by the `CST_Analogs()` function. 

### 1. Preliminary setup

In order to run the examples in this vignette, the *CSTools* package and some other support R packages need to be loaded by running:

```{r}
install.packages('CSTools')
library(CSTools)
```
### 2.- Load data using CST_Load
The parameters defined are the initializing month and the variables:


```{r cars}
mth = '11'
temp = 'tas'
slp = 'psl'
```


The simulations available for this model cover the period 1993-2012. For ERA 5 from 1979-present days. So, the starting and ending dates can be defined by running the following lines:


```r
ini <- 1993
fin <- 2012
start <- as.Date(paste(ini, mth, "01", sep = ""), "%Y%m%d")
end <- as.Date(paste(fin, mth, "01", sep = ""), "%Y%m%d")
dateseq <- format(seq(start, end, by = "year"), "%Y%m%d")
``` 


The grid in which all data will be interpolated should be also specified. The observational dataset used in this example is the Era5. 


```r
grid <- "256x128"
obs <- "era5"
```

Using the `CST_Load` function from **CSTool package**, the data available in our data store can be loaded. The following lines show how this function can be used. Here, the data is loaded from a previous saved `.RData` file:
Ask nuria.perez at bsc.es for the data to run the recipe.

```r
require(zeallot)
 
glosea5 <- list(path = '/esnas/exp/glosea5/specs-seasonal_i1p1/$STORE_FREQ$_mean/$VAR_NAME$-allmemb/$VAR_NAME$_$START_DATE$.nc')

 c(exp_T, obs_T) %<-% 
   CST_Load(var = temp, exp = list(glosea5),
     obs = obs, sdates = dateseq, leadtimemin = 2, leadtimemax = 4,
     latmin = 25, latmax = 75, lonmin = -80, lonmax = 50, output = 'lonlat',
     nprocs = 1, storefreq = "monthly", sampleperiod = 1, nmember = 9,
     method = "bilinear", grid = paste("r", grid, sep = ""))

c(exp_P, obs_P) %<-% 
   CST_Load(var = slp,  exp = list(glosea5),
     obs = obs, sdates = dateseq, leadtimemin = 2, leadtimemax = 4,
     latmin = 25, latmax = 75, lonmin = -80, lonmax = 50, output = 'lonlat',
     nprocs = 1, storefreq = "monthly", sampleperiod = 1, nmember = 9,
     method = "bilinear", grid = paste("r", grid, sep = ""))
#save(exp_T, obs_T, exp_P, obs_P, file = "./tas_psl_toydata.RData")         

# Or use the following line to load the file provided in .RData format:
load(file = "./tas_psl_toydata.RData")
```

There should be four new elements loaded in the R working environment: `exp_T`, `obs_T`, `exp_P` and `obs_P`. The first two elements correspond to the experimental and observed data for temperature and the other are the equivalent for the sLP data. It's possible to check that they are of class `sd2v_cube` by running:


```
class(exp_T)
class(obs_T)
class(exp_P)
class(obs_P)
```

Loading the data using `CST_Load` allows to obtain two lists, one for the experimental data and another for the observe data, with the same elements and compatible dimensions of the data element:


```
> dim(exp_T$data)
dataset  member   sdate   ftime     lat     lon 
      1       9      21       3      35      64
> dim(obs_T$data)
dataset  member   sdate   ftime     lat     lon 
      1       1      21       3      35      64
```

Latitudes and longitudes of the common grid can be saved after the interpolation:


```r
Lat <- exp_T$lat
Lon <- exp_T$lon
```
### 2.- Load data using the example data

CSTools object `exp`, contains an element `exp$data` with dimensions:
```{r}  
dim(exp$data)
#dataset  member   sdate   ftime     lat     lon 
#      1       6       3      31       4      4 
```

There are 6 ensemble members available in the data set, 3 starting dates and 31 forecast times, which refer to daily values in the month of March following starting dates on November 1st in the years 2010, 2011, 2012. 


### 3.- Downscaling using analogs and exp$data
This is an example on how it works the exclusion of time when we search for analogs. For instance we will search for analogs of 1 June 2020 but we are not interested in getting analogs in the nearest days of our day of interest so then we exclude them with "excludeTime" expresed in number of days centered on the dag of interest. In our example if we exclude 5 days around 01-06-2020 we will exclude analogs from 26-06-2019 to 06-06-2020. 
```{r} 
#example exclusion of time 
time_ana= paste(1:10, rep("06", 10), rep("2020", 10), sep = "-")
dd=01
mm="06"
yy=2020
time_ana=paste(dd, mm, yy, sep = "-")
time_obsL <- paste(rep(1:30,28), rep("06", 28*30), sort(rep(1993 : 2020,30)), sep = "-")
excludeTime <- 5
sameTime=which(time_obsL %in% time_ana)
time_ref <- c(time_obsL[1:(sameTime-excludeTime)],
              time_obsL[(sameTime+excludeTime):length(time_obsL)])
time_ana
time_obsL
time_ref
```
#----------------------------------------------------------------------------
# Criteria 1: Large Scale pattern
#----------------------------------------------------------------------------
```{r} 
LargeScale<- Analogs(expL=expSLP, obsL=obsref, time_obsL=time_obsSLP[timeref],
                     return_list=FALSE)
#check
str(LargeScale)
#plot
layout(matrix(1:2,1,2,byrow=T))
# reference day
field=expSLP/100
image.plot(lon,sort(lat),matrix(field,length(lon),length(lat)),
           main=paste0("expSLP  ",time_obsSLP[1]),xlab="",ylab="",zlim=c(960,1040))
world(xlim=range(lon),ylim=range(lat),lwd=2,interior=FALSE,add=TRUE)
# best analog large scale
ana=LargeScale$AnalogsField/100
image.plot(lon,sort(lat),matrix(ana,length(lon),length(lat)),
           main=paste0("Analog  ",LargeScale$AnalogsInfo$Dates),xlab="",ylab="",zlim=c(960,1040))
world(xlim=range(lon),ylim=range(lat),lwd=2,interior=FALSE,add=TRUE)
```
#----------------------------------------------------------------------------
# Criteria 2: Local Scale pattern (distance)
#----------------------------------------------------------------------------
LocalDist<- Analogs(expL=expSLP, obsL=obsref, time_obsL=time_obsSLP[timeref],
                     criteria="Local_dist",lonVar=as.vector(lon),
                     latVar=as.vector(lat),nAnalogs = 10, region=c(10,20,40,50),
                     return_list=TRUE)
#check
str(LocalDist)
#plot
layout(matrix(1:3,1,3,byrow=T))
# reference day
field=expSLP/100
image.plot(lon,sort(lat),matrix(field,length(lon),length(lat)),
           main=paste0("expSLP  ",time_obsSLP[1]),xlab="",ylab="",zlim=c(960,1040))
world(xlim=range(lon),ylim=range(lat),lwd=2,interior=FALSE,add=TRUE)
# best analog large scale pattern
ana=LargeScale$AnalogsField/100
image.plot(lon,sort(lat),matrix(ana,length(lon),length(lat)),
           main=paste0("Analog  ",LargeScale$AnalogsInfo$Dates),xlab="",ylab="",zlim=c(960,1040))
world(xlim=range(lon),ylim=range(lat),lwd=2,interior=FALSE,add=TRUE)
# best analog local scale pattern
ana.dist=LocalDist$AnalogsField/100
image.plot(lon,sort(lat),matrix(ana.dist,length(lon),length(lat)),
           main=paste0("Analog  ",LocalDist$AnalogsInfo$Dates[1]),xlab="",ylab="",zlim=c(960,1040))
world(xlim=range(lon),ylim=range(lat),lwd=2,interior=FALSE,add=TRUE)
```
#----------------------------------------------------------------------------
# Criteria 3: Local Scale (correlation)
#----------------------------------------------------------------------------
```{r} 
LocalScale<- Analogs(expL=expSLP, obsL=obsref, time_obsL=time_obsSLP[timeref],
                     criteria="Local_corr",lonVar=as.vector(lon),
                     latVar=as.vector(lat),nAnalogs = 10, region=c(10,20,40,50),
                     return_list=TRUE)
#check
str(LocalScale)
#plot
layout(matrix(1:4,2,2,byrow=T))
# reference day
field=expSLP/100
image.plot(lon,sort(lat),matrix(field,length(lon),length(lat)),
           main=paste0("expSLP  ",time_obsSLP[1]),xlab="",ylab="",zlim=c(960,1040))
world(xlim=range(lon),ylim=range(lat),lwd=2,interior=FALSE,add=TRUE)
# best analog large scale pattern
ana=LargeScale$AnalogsField/100
image.plot(lon,sort(lat),matrix(ana,length(lon),length(lat)),
           main=paste0("Analog  ",LargeScale$AnalogsInfo$Dates),xlab="",ylab="",zlim=c(960,1040))
world(xlim=range(lon),ylim=range(lat),lwd=2,interior=FALSE,add=TRUE)
# best analog local scale pattern 
ana.dist=LocalDist$AnalogsField/100
image.plot(lon,sort(lat),matrix(ana.dist,length(lon),length(lat)),
           main=paste0("Analog  ",LocalDist$AnalogsInfo$Dates[1]),xlab="",ylab="",zlim=c(960,1040))
world(xlim=range(lon),ylim=range(lat),lwd=2,interior=FALSE,add=TRUE)

# best analog local scale 
ana.cor=LocalScale$AnalogsField/100
image.plot(lon,sort(lat),matrix(ana.cor,length(lon),length(lat)),
           main=paste0("Analog  ",LocalScale$AnalogsInfo$Dates[1]),xlab="",ylab="",zlim=c(960,1040))
world(xlim=range(lon),ylim=range(lat),lwd=2,interior=FALSE,add=TRUE)
```
#examples
expSLP <- rnorm(1:20)
dim(expSLP) <- c(lat = 4, lon = 5)
obsSLP <- c(rnorm(1:180),expSLP*1.2)
dim(obsSLP) <- c(lat = 4, lon = 5, time = 10)
time_obsSLP <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-")
downscale_field <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP)
str(downscale_field)

expSLP <- rnorm(1:20)
dim(expSLP) <- c(lat = 4, lon = 5)
obsSLP <- c(rnorm(1:180),expSLP*2)
dim(obsSLP) <- c(lat = 4, lon = 5, time = 10)
time_obsSLP <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-")
obs.pr <- c(rnorm(1:200)*0.001)
dim(obs.pr)=dim(obsSLP)
downscale_field <- Analogs(expL=expSLP, obsL=obsSLP, 
                           obsVar=obs.pr,
                           time_obsL=time_obsSLP)
str(downscale_field)

### 4. Other tests
```{r}  
expSLP <- rnorm(1:20)
dim(expSLP) <- c(lat = 4, lon = 5)
obsSLP <- c(rnorm(1:780),expSLP)
dim(obsSLP) <- c(lat = 4, lon = 5, time = 10,member=4)
time_obsSLP <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-")
obs.tas <- c(rnorm(1:800)*0.001)
dim(obs.tas)=dim(obsSLP)
downscale_field <- Analogs(expL=expSLP, obsL=obsSLP, 
                          obsVar=obs.tas,
                          time_obsL=time_obsSLP)
str(downscale_field)
layout(matrix(1:2,1,2,byrow=T))
image(expSLP,main="expSLP")
image(downscale_field$AnalogsFields,
main=paste0("Best_Analog pr",downscale_field$DatesAnalogs))

```


