From 09696433b349077968d759941506c5c4fe2741cb Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Wed, 26 Jun 2019 12:14:17 +0200 Subject: [PATCH 01/43] Function for selection of large and local scales and to interpolate into a smaller grid --- LargeLocalScales.R | 54 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 LargeLocalScales.R diff --git a/LargeLocalScales.R b/LargeLocalScales.R new file mode 100644 index 00000000..1298843c --- /dev/null +++ b/LargeLocalScales.R @@ -0,0 +1,54 @@ +#'LargeLocalScale +#' +#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +#' +#'@description Select the large and the local scale and interpolate into a smaller-grid-size using cdo and daily data +#'from a model projection, seasonal model or reanalysis +#' +#'@param var variable name +#' directory the directory folder of your data +#' Namefilein name of your imput file +#' filesmallgrid file with small gridsize to be used as a reference grid for the interpolation +#' large.lonlat large scale longitude and latitude as lon1,lon2,lat1,lat2 +#' local.lonlat local scale longitude and latitude as lon1,lon2,lat1,lat2 +#' +#'@import +#' +#'@return netcdf for the large scale and netcdf for the local scale +#' in case you have selected interp=TRUE, netcdf interpolated for the large and local scales +#' +#' +#' #'@example +#' large.lonlat="-80,50,22,70 " +#' #local.lonlat="6,20,35,49 " #lon1,lon2,lat1,lat2 #italy +#' local.lonlat="-11,5,34,46 " #lon1,lon2,lat1,lat2 #spain +#' var="slp" +#' directory="~/Downloads/" +#' Namefilein="slp_NCEP_1990-2018_NA" +#' filesmallgrid="prate_ERA5_1990-2018_NA.nc" +#' #by default interpolation=TRUE +#' LargeLocalScale(large.lonlat,local.lonlat,var,Namefilein,directory,interp=TRUE) +#' #just to do an interpolation without selection of regions +#' remapnn(Namefilein,var,filesmallgrid,directory) + + + +# interpolate into a finnest grid using cdo +remapnn<-function(Namefilein,var,filesmallgrid,directory){ + fileout=paste(Namefilein,"Interp",sep="") + system(paste("cd ",directory,"; cdo griddes ",filesmallgrid," > smallgrid.txt",sep=(""))) + system(paste("cd ",directory,"; cdo remapnn,smallgrid.txt ",Namefilein,".nc ",fileout,".nc",sep=(""))) +} +# selecting region in cdo to create an netcdf +LargeLocalScale<-function(large.lonlat,local.lonlat,var,Namefilein,directory,interp=TRUE){ + Namefileout.large=paste(var,"Large",sep="") + Namefileout.local=paste(var,"Local",sep="") + system(paste("cd ",directory,"; cdo sellonlatbox,",large.lonlat,Namefilein,".nc ",Namefileout.large,".nc",sep=(""))) + system(paste("cd ",directory,"; cdo sellonlatbox,",local.lonlat,Namefilein,".nc ",Namefileout.local,".nc",sep=(""))) + if(interp==TRUE){ + # interpolate to the nearest neighbor using cdo + remapnn(Namefileout.large,var,filesmallgrid,directory) + remapnn(Namefileout.local,var,filesmallgrid,directory) + } +} + -- GitLab From b4f831be99f358b64e55fe67f56b33ab9901d3a8 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Wed, 26 Jun 2019 12:19:01 +0200 Subject: [PATCH 02/43] Reproducing time in model projections, seasonal forecast or reanalysis data --- ReproduceTime.R | 92 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 92 insertions(+) create mode 100644 ReproduceTime.R diff --git a/ReproduceTime.R b/ReproduceTime.R new file mode 100644 index 00000000..ae6d864e --- /dev/null +++ b/ReproduceTime.R @@ -0,0 +1,92 @@ +#'ReproduceTime +#' +#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +#' +#'@description Reproduce the time depending of the calendar days to be used for +#' model projections, seasonal forecast data and reanalysis +#' +#'@param ical numer of days in the calendar (ical=366 if it counts leap-years) +#' yr1 starting year of the study +#' yr2 last year of the study +#'@import +#' +#'@return time numerical value with the format yyyymmdd +#' conv.time combination in a list of months, years, and days of the period +#' +#'@example +# yr1=2005 +# yr2=2007 +# ical=366 +# seas=c(6,7,8,9,10,11) +# time=ReproduceTime(ical,yr1,yr2,seasonal=TRUE) + +# +is.leapyear=function(year){ + return(((year %% 4 == 0) & (year %% 100 != 0)) | (year %% 400 == 0)) +} +ReproduceTime=function(ical,yr1,yr2,seasonal=FALSE){ + if(ical==366){ + year=c() + month=c() + day=c() + monthdum=c(rep(1,31),rep(2,28),rep(3,31),rep(4,30),rep(5,31),rep(6,30), + rep(7,31),rep(8,31),rep(9,30),rep(10,31),rep(11,30),rep(12,31)) + monthdumB=c(rep(1,31),rep(2,29),rep(3,31),rep(4,30),rep(5,31),rep(6,30), + rep(7,31),rep(8,31),rep(9,30),rep(10,31),rep(11,30),rep(12,31)) + daydum=c((1:31),(1:28),(1:31),(1:30),(1:31),(1:30),(1:31),(1:31),(1:30),(1:31),(1:30),(1:31)) + daydumB=c((1:31),(1:29),(1:31),(1:30),(1:31),(1:30),(1:31),(1:31),(1:30),(1:31),(1:30),(1:31)) + yr=c(yr1:yr2) + bi=c(1:(yr2-yr1+1)) + for(i in 1:(yr2-yr1+1)){ + if (is.leapyear(yr[i])==TRUE){ + bi[i]=yr[i] + year=c(year,rep(yr[i],length=length(monthdumB))) + month=c(month,monthdumB) + day=c(day,daydumB) + } + else{ + bi[i]=NaN + year=c(year,rep(yr[i],length=length(monthdum))) + month=c(month,monthdum) + day=c(day,daydum)} + } + month=array(month[1:(length(month))]) + day=array(day[1:(length(day))]) + year=array(year[1:(length(year))]) + } + if(ical==365){ + year=c() + month=c() + day=c() + monthdum=c(rep(1,31),rep(2,28),rep(3,31),rep(4,30),rep(5,31),rep(6,30), + rep(7,31),rep(8,31),rep(9,30),rep(10,31),rep(11,30),rep(12,31)) + daydum=c((1:31),(1:28),(1:31),(1:30),(1:31),(1:30),(1:31),(1:31),(1:30),(1:31),(1:30),(1:31)) + yr=c(yr1:yr2) + for(i in 1:(yr2-yr1+1)){ + year=c(year,rep(yr[i],length=length(monthdum))) + month=c(month,monthdum) + day=c(day,daydum)} + month=array(month[1:(length(month))]) + day=array(day[1:(length(day))]) + year=array(year[1:(length(year))]) + } + if (ical==360){ + ndyear=360 + nmyear=12 + lmo=1:12 + nyear=yr2-yr1+1 + day=rep(1:30,times=nmyear*nyear) + month=rep(rep(lmo,each=30),times=nyear) + year=rep(yr1:yr2,each=ndyear) + } + time=array((year)*10000+month*100+day) + + if(seasonal==TRUE){ + ISEAS=which(month %in% seas) + time=time[ISEAS] + year=year[ISEAS] + month=month[ISEAS] + day=day[ISEAS] + } + return(list(year=year,month=month,day=day,time=time)) +}# end of reproduction of the time -- GitLab From 78a66a98aab620fbfc0c8a4c631b911ad4172a82 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Mon, 1 Jul 2019 13:03:30 +0200 Subject: [PATCH 03/43] Update LargeLocalScales.R --- LargeLocalScales.R | 73 ++++++++++++++++++++++++++++++---------------- 1 file changed, 48 insertions(+), 25 deletions(-) diff --git a/LargeLocalScales.R b/LargeLocalScales.R index 1298843c..4e4dd718 100644 --- a/LargeLocalScales.R +++ b/LargeLocalScales.R @@ -5,50 +5,73 @@ #'@description Select the large and the local scale and interpolate into a smaller-grid-size using cdo and daily data #'from a model projection, seasonal model or reanalysis #' -#'@param var variable name +#'@param var1 variable 1 name (i.e. SLP) +#' var2 variable 2 name (i.e. PRATE) #' directory the directory folder of your data -#' Namefilein name of your imput file +#' filein.large name of your imput file at large scale (i.e. SLP.nc) +#' filein.local name of your imput file at local scale (i.e. PRATE.nc) #' filesmallgrid file with small gridsize to be used as a reference grid for the interpolation #' large.lonlat large scale longitude and latitude as lon1,lon2,lat1,lat2 #' local.lonlat local scale longitude and latitude as lon1,lon2,lat1,lat2 #' -#'@import +#'@import cdo #' #'@return netcdf for the large scale and netcdf for the local scale #' in case you have selected interp=TRUE, netcdf interpolated for the large and local scales +#' a list with the output path and names #' #' -#' #'@example -#' large.lonlat="-80,50,22,70 " -#' #local.lonlat="6,20,35,49 " #lon1,lon2,lat1,lat2 #italy -#' local.lonlat="-11,5,34,46 " #lon1,lon2,lat1,lat2 #spain -#' var="slp" +#' #'@example 1 selection of large and local scales with interpolation (for predictors, models to be interpolated into a finner grid) +#' largeScale="-80,50,22,70 " +#' #localScale="6,20,35,49 " #lon1,lon2,lat1,lat2 #italy +#' localScale="-11,5,34,46 " #lon1,lon2,lat1,lat2 #spain +#' varname1="slp" +#' varname2="prate" #' directory="~/Downloads/" -#' Namefilein="slp_NCEP_1990-2018_NA" -#' filesmallgrid="prate_ERA5_1990-2018_NA.nc" +#' filein1="slp_CMCC_1990-2018" +#' filein2="prate_CMCC_1990-2018" +#' filesmallgrid="prate_ERA5_1990-2018.nc" #' #by default interpolation=TRUE -#' LargeLocalScale(large.lonlat,local.lonlat,var,Namefilein,directory,interp=TRUE) -#' #just to do an interpolation without selection of regions -#' remapnn(Namefilein,var,filesmallgrid,directory) +#' Scales=LargeLocalScale(largeScale,localScale,varname1,varname2,filein1,filein2,directory,interp=TRUE) +#' #'@example 2 just to do an interpolation without selection of regions +#' remapnn(filein1,varname1,filesmallgrid,directory) +#' #'@example 3 selection of large and local scales without interpolation (for predictands grid, ERA5, EOBS,etc..) +#' largeScale="-80,50,22,70 " +#' #localScale="6,20,35,49 " #lon1,lon2,lat1,lat2 #italy +#' localScale="-11,5,34,46 " #lon1,lon2,lat1,lat2 #spain +#' varname1="slp" +#' varname2="prate" +#' directory="~/Downloads/" +#' filein1="slp_ERA5_1990-2018" +#' filein2="prate_ERA5_1990-2018" +#' #by default interpolation=TRUE, here must be changed +#' Scales=LargeLocalScale(largeScale,localScale,varname1,varname2,filein1,filein2,directory,interp=FALSE) # interpolate into a finnest grid using cdo -remapnn<-function(Namefilein,var,filesmallgrid,directory){ - fileout=paste(Namefilein,"Interp",sep="") +remapnn<-function(filein.large,filein.local,filesmallgrid,directory){ + fileout.large=paste(filein.large,"Interp",sep="") + fileout.local=paste(filein.local,"Interp",sep="") system(paste("cd ",directory,"; cdo griddes ",filesmallgrid," > smallgrid.txt",sep=(""))) - system(paste("cd ",directory,"; cdo remapnn,smallgrid.txt ",Namefilein,".nc ",fileout,".nc",sep=(""))) + system(paste("cd ",directory,"; cdo remapnn,smallgrid.txt ",filein.large,".nc ",fileout.large,".nc",sep=(""))) + system(paste("cd ",directory,"; cdo remapnn,smallgrid.txt ",filein.local,".nc ",fileout.local,".nc",sep=(""))) + return(list(paste(directory,fileout.large,sep=""),paste(directory,fileout.local,sep=""))) } # selecting region in cdo to create an netcdf -LargeLocalScale<-function(large.lonlat,local.lonlat,var,Namefilein,directory,interp=TRUE){ - Namefileout.large=paste(var,"Large",sep="") - Namefileout.local=paste(var,"Local",sep="") - system(paste("cd ",directory,"; cdo sellonlatbox,",large.lonlat,Namefilein,".nc ",Namefileout.large,".nc",sep=(""))) - system(paste("cd ",directory,"; cdo sellonlatbox,",local.lonlat,Namefilein,".nc ",Namefileout.local,".nc",sep=(""))) - if(interp==TRUE){ +LargeLocalScale<-function(large.lonlat,local.lonlat,var1,var2,filein.large,filein.local,directory,interp=TRUE){ + Namefileout.large=paste(var1,"Large",sep="") + Namefileout.local=paste(var2,"Local",sep="") + system(paste("cd ",directory,"; cdo sellonlatbox,",large.lonlat,filein.large,".nc ",Namefileout.large,".nc",sep=(""))) + system(paste("cd ",directory,"; cdo sellonlatbox,",local.lonlat,filein.local,".nc ",Namefileout.local,".nc",sep=(""))) + if(interp==TRUE){ # interpolate to the nearest neighbor using cdo - remapnn(Namefileout.large,var,filesmallgrid,directory) - remapnn(Namefileout.local,var,filesmallgrid,directory) + x=remapnn(filein.large=Namefileout.large,filein.local=Namefileout.local,filesmallgrid,directory) + system(paste("cd ",directory,"; cdo sellonlatbox,",local.lonlat,x[[2]],".nc ",x[[2]],"2.nc",sep=(""))) + return(list(paste(directory,Namefileout.large,"Interp.nc",sep=""),paste(directory,Namefileout.local,"Interp2.nc",sep=""))) } -} + if(interp==FALSE){ + return(list(paste(directory,Namefileout.large,".nc",sep=""),paste(directory,Namefileout.local,".nc",sep=""))) + } +} -- GitLab From 7f829b1f6985f88f2a6508763b58d0fcef4ef583 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 2 Jul 2019 09:09:41 +0200 Subject: [PATCH 04/43] compute analogs based on minima distance of circulation (slp or z500) and maxima correlation to the field of interest (precipitation,temperature,etc). Still under development!!! --- CST_Analogs.R | 112 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 112 insertions(+) create mode 100644 CST_Analogs.R diff --git a/CST_Analogs.R b/CST_Analogs.R new file mode 100644 index 00000000..ee0c52eb --- /dev/null +++ b/CST_Analogs.R @@ -0,0 +1,112 @@ +#'CST_Analogs +#' +#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +#' adapted version of the method of Pascal Yiou \email{pascal.yiou@lsce.ipsl.fr} +#' +#'@description search for days with similar atmospheric conditions based on the large scale slp +# and the local scale (precipitation or Temperature) +#' +#'@param month month of the analog day +#' day day of the analog day +#' yr year of the analog day +#' mAnalog month or list of months to search for analogs +#'@import +#' +#'@return list best.corr.time.ana,best.dist.time.ana,selec.dist.time,selec.corr.time +#' list file.dat with a list of days with the format yyyymmdd ordered by best analog with the dist (minima) and corr (maxima) +#' plot preliminary plot of the best analog selected +#' +#'@example + +# month=01 +# day=18 +# yr=2013 +# mAnalog=c(01,02,09,10,11,12) #search analogs in these months +# Best.ana.number=3 # save me the three best analogs +# BestAnalogs=CST_Analogs(LargeSmodVar1=slp_cmcc,LocalSmodVar2=prate_cmcc,LargeSobsVar1=slp_ERA5,LocalSobsVar2=prate_ERA5, +# month,yr,day,mAnalog,Best.ana.number,excludeSameyr=TRUE) + +function(LargeSmodVar1,LocalSmodVar2,LargeSobsVar1,LocalSobsVar2, + month,yr,day,mAnalog,Best.ana.number,excludeSameyr=TRUE){ +analog.day=(10000*yr)+(100*month)+day +time=ReproduceTime(ical=366,yr1=1969,yr2=2018) +#determine position of the day to analog +analog.time=which(time$time==analog.day) +#selecting analogs from a certain month/season +iseas=which(time$month %in% mAnalog) +analog.seas=c() +analog.seas$time=time$time[iseas] +analog.seas$month=time$month[iseas] +analog.seas$day=time$day[iseas] +analog.seas$year=time$year[iseas] +ModLargeS=LargeSmodVar1[iseas,] +ModLocalS=LocalSmodVar2[iseas,] +ObsLargeS=LargeSobsVar1[iseas,] +ObsLocalS=LocalSobsVar2[iseas,] + +if(excludeSameyr==TRUE){ +#excluding days in the same year of the analog day +ExcludeAna=which(analog.seas$year %in% yr) +if(analog.seas$year==ExcludeAna){iseas=NaN} +length(ExcludeAna) +eseas=c(iseas[1:(ExcludeAna[1]-1)],iseas[(ExcludeAna[length(ExcludeAna)]+1):(length(iseas))]) +analog.seas$time=time$time[eseas] +analog.seas$month=time$month[eseas] +analog.seas$day=time$day[eseas] +analog.seas$year=time$year[eseas] +ModLargeS=LargeSmodVar1[eseas,] +ModLocalS=LocalSmodVar2[eseas,] +ObsLargeS=LargeSobsVar1[eseas,] +ObsLocalS=LocalSobsVar2[eseas,] +} + +# determine the number of best analogues + +i=1 +rms.reg=c() +cor.reg=c() +# search in the observations the best analog associated to the analog day in the model +for(i in 1:nrow(ModLargeS)){ + diff=t(ObsLargeS[i,]-LargeSmodVar1[analog.time,]) + diffi=diff^2 + rms=apply(diffi,1,sum,na.rm=TRUE) + dum=cor(ObsLocalS[i,],LocalSobsVar2[analog.time,], + method="spearman") + rms.reg=cbind(rms.reg,rms) + cor.reg=cbind(cor.reg,dum) +} +dist=as.numeric(sqrt(rms.reg/nrow(ModLargeS))/100) +dist.max=max(dist) +dist.min1=min(dist) +dist.min=order(dist) +corr.max=max(cor.reg) +corr.min=min(cor.reg) + +#### select best analogues based on highest correlation and minimun euclidean distance +# selec.corr1=which(cor.reg>0.8) +# selec.corr2=which(cor.reg<(-0.8)) +# selec.dist1=which(dist==0) +################################### this must be modified!!!! +#selection based on best distance +selec.dist=dist[dist.min] +selec.dist.time=analog.seas$time[dist.min] +selec.dist.corr=cor.reg[dist.min] +best.dist.ana=selec.dist[2:(Best.ana.number+1)] +best.dist.time.ana=selec.dist.time[2:(Best.ana.number+1)] +best.dist.corr.ana=selec.dist.corr[2:(Best.ana.number+1)] +best.dist.day.ana=dist.min[2:(Best.ana.number+1)] +#selec.corr=cor.reg[c(selec.corr1,selec.corr2)] +#selec.corr.dist=dist[c(selec.corr1,selec.corr2)] +#selec.corr.time=time[c(selec.corr1,selec.corr2)] + +# selection based on best correlation +selec.corr=order(cor.reg) +selec.corr.dist=dist[selec.corr] +selec.corr.time=analog.seas$time[selec.corr] +best.corr.ana=selec.corr[2:(Best.ana.number+1)] +best.corr.time.ana=selec.corr.time[2:(Best.ana.number+1)] +best.corr.dist.ana=selec.corr.dist[2:(Best.ana.number+1)] +best.corr.day.ana=selec.corr[2:(Best.ana.number+1)] + +return(list(best.corr.time.ana,best.dist.time.ana,selec.dist.time,selec.corr.time)) +} -- GitLab From cf7a46b72aeeb9a7145385d7d707f1d10cf77219 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 2 Jul 2019 09:19:35 +0200 Subject: [PATCH 05/43] Update CST_Analogs.R --- CST_Analogs.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/CST_Analogs.R b/CST_Analogs.R index ee0c52eb..06f458b2 100644 --- a/CST_Analogs.R +++ b/CST_Analogs.R @@ -10,6 +10,9 @@ #' day day of the analog day #' yr year of the analog day #' mAnalog month or list of months to search for analogs +#' yr1 first year of the total period of study +#' yr2 last year of the total period of study +#' ical number of days per year in the calendar (360,365,366) #'@import #' #'@return list best.corr.time.ana,best.dist.time.ana,selec.dist.time,selec.corr.time @@ -21,15 +24,18 @@ # month=01 # day=18 # yr=2013 +# ical=366 +# yr1=1993 +# yr2=2018 # mAnalog=c(01,02,09,10,11,12) #search analogs in these months # Best.ana.number=3 # save me the three best analogs # BestAnalogs=CST_Analogs(LargeSmodVar1=slp_cmcc,LocalSmodVar2=prate_cmcc,LargeSobsVar1=slp_ERA5,LocalSobsVar2=prate_ERA5, # month,yr,day,mAnalog,Best.ana.number,excludeSameyr=TRUE) function(LargeSmodVar1,LocalSmodVar2,LargeSobsVar1,LocalSobsVar2, - month,yr,day,mAnalog,Best.ana.number,excludeSameyr=TRUE){ + month,yr,day,mAnalog,Best.ana.number,yr1,yr2,ical,excludeSameyr=TRUE){ analog.day=(10000*yr)+(100*month)+day -time=ReproduceTime(ical=366,yr1=1969,yr2=2018) +time=ReproduceTime(ical,yr1,yr2) #determine position of the day to analog analog.time=which(time$time==analog.day) #selecting analogs from a certain month/season -- GitLab From 900c3701a08e686185d9177f149639454fa54885 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 2 Jul 2019 09:29:48 +0200 Subject: [PATCH 06/43] Update CST_Analogs.R --- CST_Analogs.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CST_Analogs.R b/CST_Analogs.R index 06f458b2..c52d4d47 100644 --- a/CST_Analogs.R +++ b/CST_Analogs.R @@ -30,9 +30,9 @@ # mAnalog=c(01,02,09,10,11,12) #search analogs in these months # Best.ana.number=3 # save me the three best analogs # BestAnalogs=CST_Analogs(LargeSmodVar1=slp_cmcc,LocalSmodVar2=prate_cmcc,LargeSobsVar1=slp_ERA5,LocalSobsVar2=prate_ERA5, -# month,yr,day,mAnalog,Best.ana.number,excludeSameyr=TRUE) +# month,yr,day,mAnalog,Best.ana.number,ical,yr1,yr2,excludeSameyr=TRUE) -function(LargeSmodVar1,LocalSmodVar2,LargeSobsVar1,LocalSobsVar2, +CST_Analogs=function(LargeSmodVar1,LocalSmodVar2,LargeSobsVar1,LocalSobsVar2, month,yr,day,mAnalog,Best.ana.number,yr1,yr2,ical,excludeSameyr=TRUE){ analog.day=(10000*yr)+(100*month)+day time=ReproduceTime(ical,yr1,yr2) -- GitLab From 6b32f93c76db68ee16c87ce25305b24092edd3d9 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 2 Jul 2019 09:39:08 +0200 Subject: [PATCH 07/43] Update CST_Analogs.R --- CST_Analogs.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/CST_Analogs.R b/CST_Analogs.R index c52d4d47..f42e2056 100644 --- a/CST_Analogs.R +++ b/CST_Analogs.R @@ -1,7 +1,10 @@ #'CST_Analogs #' #'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -#' adapted version of the method of Pascal Yiou \email{pascal.yiou@lsce.ipsl.fr} +#' adapted version of the method of Yiou et al 2013 +#'@reference Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, and M. Vrac, 2013 : +#' Ensemble reconstruction of the atmospheric column from surface pressure using analogues. +#' Clim. Dyn., 41, 1419-1437. \email{pascal.yiou@lsce.ipsl.fr} #' #'@description search for days with similar atmospheric conditions based on the large scale slp # and the local scale (precipitation or Temperature) -- GitLab From c66ade698952ed62244ec4ee8631a6dbef6456cd Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 2 Jul 2019 10:42:10 +0200 Subject: [PATCH 08/43] Update CST_Analogs.R --- CST_Analogs.R | 43 ++++++++++++++----------------------------- 1 file changed, 14 insertions(+), 29 deletions(-) diff --git a/CST_Analogs.R b/CST_Analogs.R index f42e2056..dfa02213 100644 --- a/CST_Analogs.R +++ b/CST_Analogs.R @@ -85,37 +85,22 @@ for(i in 1:nrow(ModLargeS)){ cor.reg=cbind(cor.reg,dum) } dist=as.numeric(sqrt(rms.reg/nrow(ModLargeS))/100) -dist.max=max(dist) -dist.min1=min(dist) -dist.min=order(dist) -corr.max=max(cor.reg) -corr.min=min(cor.reg) -#### select best analogues based on highest correlation and minimun euclidean distance -# selec.corr1=which(cor.reg>0.8) -# selec.corr2=which(cor.reg<(-0.8)) -# selec.dist1=which(dist==0) -################################### this must be modified!!!! #selection based on best distance -selec.dist=dist[dist.min] -selec.dist.time=analog.seas$time[dist.min] -selec.dist.corr=cor.reg[dist.min] -best.dist.ana=selec.dist[2:(Best.ana.number+1)] -best.dist.time.ana=selec.dist.time[2:(Best.ana.number+1)] -best.dist.corr.ana=selec.dist.corr[2:(Best.ana.number+1)] -best.dist.day.ana=dist.min[2:(Best.ana.number+1)] -#selec.corr=cor.reg[c(selec.corr1,selec.corr2)] -#selec.corr.dist=dist[c(selec.corr1,selec.corr2)] -#selec.corr.time=time[c(selec.corr1,selec.corr2)] - +dist.min=order(dist) +dist.order=c() +dist.order$dist.time=dist.min +dist.order$dist.day=analog.seas$time[dist.min] +dist.order$dist.min=dist[dist.min] +dist.order$dist.corr=cor.reg[dist.min] # selection based on best correlation -selec.corr=order(cor.reg) -selec.corr.dist=dist[selec.corr] -selec.corr.time=analog.seas$time[selec.corr] -best.corr.ana=selec.corr[2:(Best.ana.number+1)] -best.corr.time.ana=selec.corr.time[2:(Best.ana.number+1)] -best.corr.dist.ana=selec.corr.dist[2:(Best.ana.number+1)] -best.corr.day.ana=selec.corr[2:(Best.ana.number+1)] +corr.max=order(cor.reg) +corr.order=c() +corr.order$corr.time=corr.max +corr.order$corr.day=analog.seas$time[corr.max] +corr.order$corr.min=cor.reg[corr.max] +corr.order$corr.dist=dist[corr.max] -return(list(best.corr.time.ana,best.dist.time.ana,selec.dist.time,selec.corr.time)) +return(list(dist.order=dist.order,corr.order=corr.order)) +} } -- GitLab From 3c92568243ade6a575d73dcb28c353117482f827 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 2 Jul 2019 10:42:28 +0200 Subject: [PATCH 09/43] Update CST_Analogs.R --- CST_Analogs.R | 1 - 1 file changed, 1 deletion(-) diff --git a/CST_Analogs.R b/CST_Analogs.R index dfa02213..98bb76eb 100644 --- a/CST_Analogs.R +++ b/CST_Analogs.R @@ -103,4 +103,3 @@ corr.order$corr.dist=dist[corr.max] return(list(dist.order=dist.order,corr.order=corr.order)) } -} -- GitLab From 657c4f50e5391c9cc627a3ada2b18eedcce7ee5e Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 2 Jul 2019 12:16:02 +0200 Subject: [PATCH 10/43] Update CST_Analogs.R --- CST_Analogs.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CST_Analogs.R b/CST_Analogs.R index 98bb76eb..9dce020e 100644 --- a/CST_Analogs.R +++ b/CST_Analogs.R @@ -18,9 +18,9 @@ #' ical number of days per year in the calendar (360,365,366) #'@import #' -#'@return list best.corr.time.ana,best.dist.time.ana,selec.dist.time,selec.corr.time -#' list file.dat with a list of days with the format yyyymmdd ordered by best analog with the dist (minima) and corr (maxima) -#' plot preliminary plot of the best analog selected +#'@return list dist.order list (order of distance starting from the minimum) and corr.order list (order of correlation starting from the maxima) +#' list file.dat with a list of days with the format yyyymmdd ordered by best analog with the dist (minima) and corr (maxima) (no yet) +#' plot preliminary plot of the best analog selected (no yet) #' #'@example -- GitLab From 7e11f5182a065ee1f4e18a2367b58c0386974263 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Thu, 4 Jul 2019 21:47:57 +0200 Subject: [PATCH 11/43] Update CST_Analogs.R --- CST_Analogs.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/CST_Analogs.R b/CST_Analogs.R index 9dce020e..4323a769 100644 --- a/CST_Analogs.R +++ b/CST_Analogs.R @@ -36,7 +36,7 @@ # month,yr,day,mAnalog,Best.ana.number,ical,yr1,yr2,excludeSameyr=TRUE) CST_Analogs=function(LargeSmodVar1,LocalSmodVar2,LargeSobsVar1,LocalSobsVar2, - month,yr,day,mAnalog,Best.ana.number,yr1,yr2,ical,excludeSameyr=TRUE){ + month,yr,day,mAnalog,Best.ana.number,ical,yr1,yr2,excludeSameyr=TRUE){ analog.day=(10000*yr)+(100*month)+day time=ReproduceTime(ical,yr1,yr2) #determine position of the day to analog @@ -56,7 +56,7 @@ ObsLocalS=LocalSobsVar2[iseas,] if(excludeSameyr==TRUE){ #excluding days in the same year of the analog day ExcludeAna=which(analog.seas$year %in% yr) -if(analog.seas$year==ExcludeAna){iseas=NaN} +#if(analog.seas$year==ExcludeAna){iseas=NaN} length(ExcludeAna) eseas=c(iseas[1:(ExcludeAna[1]-1)],iseas[(ExcludeAna[length(ExcludeAna)]+1):(length(iseas))]) analog.seas$time=time$time[eseas] @@ -89,17 +89,17 @@ dist=as.numeric(sqrt(rms.reg/nrow(ModLargeS))/100) #selection based on best distance dist.min=order(dist) dist.order=c() -dist.order$dist.time=dist.min +dist.order$dist.time=eseas[dist.min] dist.order$dist.day=analog.seas$time[dist.min] dist.order$dist.min=dist[dist.min] dist.order$dist.corr=cor.reg[dist.min] # selection based on best correlation corr.max=order(cor.reg) corr.order=c() -corr.order$corr.time=corr.max +corr.order$corr.time=eseas[corr.max] corr.order$corr.day=analog.seas$time[corr.max] corr.order$corr.min=cor.reg[corr.max] corr.order$corr.dist=dist[corr.max] -return(list(dist.order=dist.order,corr.order=corr.order)) +return(list(analog.time=analog.time,dist.order=dist.order,corr.order=corr.order)) } -- GitLab From d624447fe3c4ef24f61fe77a3865df9d28d60a8f Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Wed, 2 Oct 2019 18:57:04 +0200 Subject: [PATCH 12/43] Apply version analogs --- CST_Analogs.R | 105 ------------------------ LargeLocalScales.R | 77 ------------------ R/CST_Analogs.R | 197 +++++++++++++++++++++++++++++++++++++++++++++ ReproduceTime.R | 92 --------------------- 4 files changed, 197 insertions(+), 274 deletions(-) delete mode 100644 CST_Analogs.R delete mode 100644 LargeLocalScales.R create mode 100644 R/CST_Analogs.R delete mode 100644 ReproduceTime.R diff --git a/CST_Analogs.R b/CST_Analogs.R deleted file mode 100644 index 4323a769..00000000 --- a/CST_Analogs.R +++ /dev/null @@ -1,105 +0,0 @@ -#'CST_Analogs -#' -#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -#' adapted version of the method of Yiou et al 2013 -#'@reference Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, and M. Vrac, 2013 : -#' Ensemble reconstruction of the atmospheric column from surface pressure using analogues. -#' Clim. Dyn., 41, 1419-1437. \email{pascal.yiou@lsce.ipsl.fr} -#' -#'@description search for days with similar atmospheric conditions based on the large scale slp -# and the local scale (precipitation or Temperature) -#' -#'@param month month of the analog day -#' day day of the analog day -#' yr year of the analog day -#' mAnalog month or list of months to search for analogs -#' yr1 first year of the total period of study -#' yr2 last year of the total period of study -#' ical number of days per year in the calendar (360,365,366) -#'@import -#' -#'@return list dist.order list (order of distance starting from the minimum) and corr.order list (order of correlation starting from the maxima) -#' list file.dat with a list of days with the format yyyymmdd ordered by best analog with the dist (minima) and corr (maxima) (no yet) -#' plot preliminary plot of the best analog selected (no yet) -#' -#'@example - -# month=01 -# day=18 -# yr=2013 -# ical=366 -# yr1=1993 -# yr2=2018 -# mAnalog=c(01,02,09,10,11,12) #search analogs in these months -# Best.ana.number=3 # save me the three best analogs -# BestAnalogs=CST_Analogs(LargeSmodVar1=slp_cmcc,LocalSmodVar2=prate_cmcc,LargeSobsVar1=slp_ERA5,LocalSobsVar2=prate_ERA5, -# month,yr,day,mAnalog,Best.ana.number,ical,yr1,yr2,excludeSameyr=TRUE) - -CST_Analogs=function(LargeSmodVar1,LocalSmodVar2,LargeSobsVar1,LocalSobsVar2, - month,yr,day,mAnalog,Best.ana.number,ical,yr1,yr2,excludeSameyr=TRUE){ -analog.day=(10000*yr)+(100*month)+day -time=ReproduceTime(ical,yr1,yr2) -#determine position of the day to analog -analog.time=which(time$time==analog.day) -#selecting analogs from a certain month/season -iseas=which(time$month %in% mAnalog) -analog.seas=c() -analog.seas$time=time$time[iseas] -analog.seas$month=time$month[iseas] -analog.seas$day=time$day[iseas] -analog.seas$year=time$year[iseas] -ModLargeS=LargeSmodVar1[iseas,] -ModLocalS=LocalSmodVar2[iseas,] -ObsLargeS=LargeSobsVar1[iseas,] -ObsLocalS=LocalSobsVar2[iseas,] - -if(excludeSameyr==TRUE){ -#excluding days in the same year of the analog day -ExcludeAna=which(analog.seas$year %in% yr) -#if(analog.seas$year==ExcludeAna){iseas=NaN} -length(ExcludeAna) -eseas=c(iseas[1:(ExcludeAna[1]-1)],iseas[(ExcludeAna[length(ExcludeAna)]+1):(length(iseas))]) -analog.seas$time=time$time[eseas] -analog.seas$month=time$month[eseas] -analog.seas$day=time$day[eseas] -analog.seas$year=time$year[eseas] -ModLargeS=LargeSmodVar1[eseas,] -ModLocalS=LocalSmodVar2[eseas,] -ObsLargeS=LargeSobsVar1[eseas,] -ObsLocalS=LocalSobsVar2[eseas,] -} - -# determine the number of best analogues - -i=1 -rms.reg=c() -cor.reg=c() -# search in the observations the best analog associated to the analog day in the model -for(i in 1:nrow(ModLargeS)){ - diff=t(ObsLargeS[i,]-LargeSmodVar1[analog.time,]) - diffi=diff^2 - rms=apply(diffi,1,sum,na.rm=TRUE) - dum=cor(ObsLocalS[i,],LocalSobsVar2[analog.time,], - method="spearman") - rms.reg=cbind(rms.reg,rms) - cor.reg=cbind(cor.reg,dum) -} -dist=as.numeric(sqrt(rms.reg/nrow(ModLargeS))/100) - -#selection based on best distance -dist.min=order(dist) -dist.order=c() -dist.order$dist.time=eseas[dist.min] -dist.order$dist.day=analog.seas$time[dist.min] -dist.order$dist.min=dist[dist.min] -dist.order$dist.corr=cor.reg[dist.min] -# selection based on best correlation -corr.max=order(cor.reg) -corr.order=c() -corr.order$corr.time=eseas[corr.max] -corr.order$corr.day=analog.seas$time[corr.max] -corr.order$corr.min=cor.reg[corr.max] -corr.order$corr.dist=dist[corr.max] - -return(list(analog.time=analog.time,dist.order=dist.order,corr.order=corr.order)) -} diff --git a/LargeLocalScales.R b/LargeLocalScales.R deleted file mode 100644 index 4e4dd718..00000000 --- a/LargeLocalScales.R +++ /dev/null @@ -1,77 +0,0 @@ -#'LargeLocalScale -#' -#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -#' -#'@description Select the large and the local scale and interpolate into a smaller-grid-size using cdo and daily data -#'from a model projection, seasonal model or reanalysis -#' -#'@param var1 variable 1 name (i.e. SLP) -#' var2 variable 2 name (i.e. PRATE) -#' directory the directory folder of your data -#' filein.large name of your imput file at large scale (i.e. SLP.nc) -#' filein.local name of your imput file at local scale (i.e. PRATE.nc) -#' filesmallgrid file with small gridsize to be used as a reference grid for the interpolation -#' large.lonlat large scale longitude and latitude as lon1,lon2,lat1,lat2 -#' local.lonlat local scale longitude and latitude as lon1,lon2,lat1,lat2 -#' -#'@import cdo -#' -#'@return netcdf for the large scale and netcdf for the local scale -#' in case you have selected interp=TRUE, netcdf interpolated for the large and local scales -#' a list with the output path and names -#' -#' -#' #'@example 1 selection of large and local scales with interpolation (for predictors, models to be interpolated into a finner grid) -#' largeScale="-80,50,22,70 " -#' #localScale="6,20,35,49 " #lon1,lon2,lat1,lat2 #italy -#' localScale="-11,5,34,46 " #lon1,lon2,lat1,lat2 #spain -#' varname1="slp" -#' varname2="prate" -#' directory="~/Downloads/" -#' filein1="slp_CMCC_1990-2018" -#' filein2="prate_CMCC_1990-2018" -#' filesmallgrid="prate_ERA5_1990-2018.nc" -#' #by default interpolation=TRUE -#' Scales=LargeLocalScale(largeScale,localScale,varname1,varname2,filein1,filein2,directory,interp=TRUE) - -#' #'@example 2 just to do an interpolation without selection of regions -#' remapnn(filein1,varname1,filesmallgrid,directory) - -#' #'@example 3 selection of large and local scales without interpolation (for predictands grid, ERA5, EOBS,etc..) -#' largeScale="-80,50,22,70 " -#' #localScale="6,20,35,49 " #lon1,lon2,lat1,lat2 #italy -#' localScale="-11,5,34,46 " #lon1,lon2,lat1,lat2 #spain -#' varname1="slp" -#' varname2="prate" -#' directory="~/Downloads/" -#' filein1="slp_ERA5_1990-2018" -#' filein2="prate_ERA5_1990-2018" -#' #by default interpolation=TRUE, here must be changed -#' Scales=LargeLocalScale(largeScale,localScale,varname1,varname2,filein1,filein2,directory,interp=FALSE) - -# interpolate into a finnest grid using cdo -remapnn<-function(filein.large,filein.local,filesmallgrid,directory){ - fileout.large=paste(filein.large,"Interp",sep="") - fileout.local=paste(filein.local,"Interp",sep="") - system(paste("cd ",directory,"; cdo griddes ",filesmallgrid," > smallgrid.txt",sep=(""))) - system(paste("cd ",directory,"; cdo remapnn,smallgrid.txt ",filein.large,".nc ",fileout.large,".nc",sep=(""))) - system(paste("cd ",directory,"; cdo remapnn,smallgrid.txt ",filein.local,".nc ",fileout.local,".nc",sep=(""))) - return(list(paste(directory,fileout.large,sep=""),paste(directory,fileout.local,sep=""))) -} -# selecting region in cdo to create an netcdf -LargeLocalScale<-function(large.lonlat,local.lonlat,var1,var2,filein.large,filein.local,directory,interp=TRUE){ - Namefileout.large=paste(var1,"Large",sep="") - Namefileout.local=paste(var2,"Local",sep="") - system(paste("cd ",directory,"; cdo sellonlatbox,",large.lonlat,filein.large,".nc ",Namefileout.large,".nc",sep=(""))) - system(paste("cd ",directory,"; cdo sellonlatbox,",local.lonlat,filein.local,".nc ",Namefileout.local,".nc",sep=(""))) - if(interp==TRUE){ - # interpolate to the nearest neighbor using cdo - x=remapnn(filein.large=Namefileout.large,filein.local=Namefileout.local,filesmallgrid,directory) - system(paste("cd ",directory,"; cdo sellonlatbox,",local.lonlat,x[[2]],".nc ",x[[2]],"2.nc",sep=(""))) - return(list(paste(directory,Namefileout.large,"Interp.nc",sep=""),paste(directory,Namefileout.local,"Interp2.nc",sep=""))) - } - if(interp==FALSE){ - return(list(paste(directory,Namefileout.large,".nc",sep=""),paste(directory,Namefileout.local,".nc",sep=""))) - } -} - diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R new file mode 100644 index 00000000..8efd4f98 --- /dev/null +++ b/R/CST_Analogs.R @@ -0,0 +1,197 @@ +#'CST_Analogs +#' +#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +#' adapted version of the method of Yiou et al 2013 +#' +#'@references Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, and M. Vrac, 2013 : +#' Ensemble reconstruction of the atmospheric column from surface pressure using analogues. +#' Clim. Dyn., 41, 1419-1437. \email{pascal.yiou@lsce.ipsl.fr} +#' +#'@description search for days with similar atmospheric conditions based on the large scale slp (or geopotential height) +# and the local scale (precipitation or Temperature) +#' +#'@param month month of the analog day +#' day day of the analog day +#' yr year of the analog day +#' mAnalog month or list of months to search for analogs +#'@import +#' +#'@return list best.corr.time.ana,best.dist.time.ana,selec.dist.time,selec.corr.time +#' list file.dat with a list of days with the format yyyymmdd ordered by best analog with the dist (minima) and corr (maxima) +#' plot preliminary plot of the best analog selected +#' yr1 first year of the total period of study +#' yr2 last year of the total period of study +#' ical number of days per year in the calendar (360,365,366) +#'@example + +# Analogs <- function(exp, obs) { +# if (!all(c('member', 'sdate') %in% names(dim(exp)))) { +# stop("Parameter 'exp' must have the dimensions 'member' and 'sdate'.") +# } +# +# if (!all(c('sdate') %in% names(dim(obs)))) { +# stop("Parameter 'obs' must have the dimension 'sdate'.") +# } +# +# if (any(is.na(exp))) { +# warning("Parameter 'exp' contains NA values.") +# } +# +# if (any(is.na(obs))) { +# warning("Parameter 'obs' contains NA values.") +# } +# +# target_dims_obs <- 'sdate' +# if ('member' %in% names(dim(obs))) { +# target_dims_obs <- c('member', target_dims_obs) +# } +# +# Analogs <- Apply(data = list(var_obs = obs, var_exp = exp), +# target_dims = list(target_dims_obs, c('member', 'sdate')), +# fun = .select)$output1 +# +# return(Analogs) +# } + +time_obsL <- as.Date(c("2005-01-01", "2005-02-01", "2005-03-01", + "2005-04-01", "2005-05-01")) +Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, + criteria = "Large_dist", + lon_local = NULL, lat_local = NULL, region = NULL, + nAnalogs = 1, return_list = FALSE) { + # checks + metric <- Select(expL = expL, obsL = obsL, expVar = expVar, obsVar = obsVar, + criteria = criteria, lon_local = lon_local, lat_local = lat_local, + region = region) + best <- Apply(list(metric), target_dims = 'time', fun = BestAnalog, + criteria = criteria, return = return_list) +} +#'@example +#'met <- Select(expL = expL, obsL = obsL) +#'pos <- BestAnalog(met) +BestAnalog <- function(metric, criteria = 'Large_dist', return_list = FALSE, + nAnalogs = 1) + if (criteria == 'Large_dist') { + metric1 <- metric$metric1 + pos1 <- metric$pos1 + if (return_list == FALSE) { + pos <- pos1[1] + } else { + pos <- pos1[1 : nAnalogs] + } + } else if (criteria== 'Local_dist') { + # pos1 <- c(7, 13, 5, 3, 6, 12, 10, 1, 8, 9, 11, 4, 2, 14) + # pos2 <- c(4, 8, 13, 6, 3, 1, 12, 5, 9, 7, 10, 2, 11, 14) + pos1 <- pos1[1 : nAnalogs] + pos2 <- pos2[1 : nAnalogs] + best <- match(pos1, pos2) + pos <- pos1[as.logical(best)] + pos <- pos[which(!is.na(pos))] + if (return_list == FALSE) { + pos <- pos[1] + } + } else if (criteria == 'Local_cor') { + pos1 <- pos1[1 : nAnalogs] + pos2 <- pos2[1 : nAnalogs] + best <- match(pos1, pos2) + pos <- pos1[as.logical(best)] + pos <- pos[which(!is.na(pos))] + # pos3 <- c(6, 11, 14, 3, 13, 7, 2, 5, 1, 12, 10, 9, 8, 4) + pos3 <- pos3[1 : nAnalogs] + best <- match(pos, pos3) + pos <- pos[order(best, decreasing = F)] + pos <- pos[which(!is.na(pos))] + if (return_list == FALSE) { + pos[1] + } + return(pos) +} + + +expL <- (1 + 2): (4 * 3 * 2 + 2) +dim(expL) <- c(lat = 4, lon = 3, time = 2) +obsL <- 1 : c(4 * 3 * 5) +dim(obsL) <- c(lat = 4, lon = 3, time = 5) +res = Select(expL, obsL) +expL <- (1 + 2): (8 * 10 * 2 + 2) +dim(expL) <- c(lat = 8, lon = 10, time = 2) +obsL <- 1 : c(8 * 10 * 5) +dim(obsL) <- c(lat = 8, lon = 10, time = 5) +lat_local <- lat <- seq(0, 19, 2.5) +lon_local <- lon <- seq(0, 23, 2.5) +res = Select(expL, obsL, criteria = "Local_dist", lon_local = lon, + lat_local = lat, + region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5 )) +# probar mas ejemplos con diferentes criterios, latitudes, longitudes +Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", + lon_local = NULL, lat_local = NULL, region = NULL) { + #check expL + #check obsL + #check obsVar + metric1 <- Apply(list(obsL), target_dims = list(c('lat', 'lon')), + fun = .select, expL, metric = "dist", + output_dims = c('time_exp'))$output1 + pos1 <- apply(metric1, 1, order) + metric1 <- apply(metric1, 1, sort) + + if (criteria == "Large_dist") { + return(list(metric1 = metric1, pos1 = pos1)) + } + if (criteria == "Local_dist" | criteria == "Local_cor") { + obs <- SelBox(obsL, lon = lon_local, lat = lat_local, region = region)$data + exp <- SelBox(expL, lon = lon_local, lat = lat_local, region = region)$data + metric2 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), + fun = .select, exp, metric = "dist")$output1 + pos2 <- apply(metric2, 1, order) + metric2 <- apply(metric2, 1, sort) + if (criteria == "Local_dist") { + return(list(metric1 = metric1, metric2 = metric2, + pos1 = pos1, pos2 = pos2)) + } + } + if (criteria == "Local_cor") { + obs <- SelBox(obsVar, lon = lon_local, lat = lat_local, region = region)$data + exp <- SelBox(expVar, lon = lon_local, lat = lat_local, region = region)$data + metric3 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), + fun = .select, exp, metric = "cor")$output1 + pos3 <- apply(metric3, 1, order, decreasing = TRUE) + metric3 <- apply(metric3, 1, sort) + return(list(metric1 = metric1, metric2 = metric2, metric3 = metric3, + pos1 = pos1, pos2 = pos2, pos3 = pos3)) + } + else { + stop("Parameter 'criteria' must to be one of the: 'Large_dist', ", + "'Local_dist','Local_cor'.") + } +} + +# data <- 1:(20 * 3 * 2 * 4) +# dim(data) <- c(lon = 20, lat = 3, time = 2, model = 4) +# lon <- seq(2, 40, 2) +# lat <- c(1, 5, 10) +# a <- SelBox(data = data, lon = lon, lat = lat, region = c(2, 20, 1, 5), +# londim = 1, latdim = 2, mask = NULL) +# str(a) + +#'@example +exp <- (1 + 2): (4 * 3 + 2) +dim(exp) <- c(lat = 4, lon = 3) +obs <- 1 : c(5 * 4 * 3) +dim(obs) <- c(time = 5, lat = 4, lon = 3) +res <- .select(exp, obs) +res +res <- .select(exp, obs, metric = 'cor') +dim(res) +.select <- function(exp, obs, metric = "dist") { + if (metric == "dist") { + #metric <- sum((obs - exp) ^ 2) + #metric <- apply(obs, "time", function(x) {sum((x - exp) ^ 2)}) + result <- Apply(list(obs), target_dims = list(c('lat', 'lon')), + fun = function(x) {sum((x - exp) ^ 2)})$output1 + } else if (metric == "cor") { + result <- Apply(list(obs), target_dims = list(c('lat', 'lon')), + fun = function(x) {cor(as.vector(x), as.vector(exp))})$output1 + } + result +} + diff --git a/ReproduceTime.R b/ReproduceTime.R deleted file mode 100644 index ae6d864e..00000000 --- a/ReproduceTime.R +++ /dev/null @@ -1,92 +0,0 @@ -#'ReproduceTime -#' -#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -#' -#'@description Reproduce the time depending of the calendar days to be used for -#' model projections, seasonal forecast data and reanalysis -#' -#'@param ical numer of days in the calendar (ical=366 if it counts leap-years) -#' yr1 starting year of the study -#' yr2 last year of the study -#'@import -#' -#'@return time numerical value with the format yyyymmdd -#' conv.time combination in a list of months, years, and days of the period -#' -#'@example -# yr1=2005 -# yr2=2007 -# ical=366 -# seas=c(6,7,8,9,10,11) -# time=ReproduceTime(ical,yr1,yr2,seasonal=TRUE) - -# -is.leapyear=function(year){ - return(((year %% 4 == 0) & (year %% 100 != 0)) | (year %% 400 == 0)) -} -ReproduceTime=function(ical,yr1,yr2,seasonal=FALSE){ - if(ical==366){ - year=c() - month=c() - day=c() - monthdum=c(rep(1,31),rep(2,28),rep(3,31),rep(4,30),rep(5,31),rep(6,30), - rep(7,31),rep(8,31),rep(9,30),rep(10,31),rep(11,30),rep(12,31)) - monthdumB=c(rep(1,31),rep(2,29),rep(3,31),rep(4,30),rep(5,31),rep(6,30), - rep(7,31),rep(8,31),rep(9,30),rep(10,31),rep(11,30),rep(12,31)) - daydum=c((1:31),(1:28),(1:31),(1:30),(1:31),(1:30),(1:31),(1:31),(1:30),(1:31),(1:30),(1:31)) - daydumB=c((1:31),(1:29),(1:31),(1:30),(1:31),(1:30),(1:31),(1:31),(1:30),(1:31),(1:30),(1:31)) - yr=c(yr1:yr2) - bi=c(1:(yr2-yr1+1)) - for(i in 1:(yr2-yr1+1)){ - if (is.leapyear(yr[i])==TRUE){ - bi[i]=yr[i] - year=c(year,rep(yr[i],length=length(monthdumB))) - month=c(month,monthdumB) - day=c(day,daydumB) - } - else{ - bi[i]=NaN - year=c(year,rep(yr[i],length=length(monthdum))) - month=c(month,monthdum) - day=c(day,daydum)} - } - month=array(month[1:(length(month))]) - day=array(day[1:(length(day))]) - year=array(year[1:(length(year))]) - } - if(ical==365){ - year=c() - month=c() - day=c() - monthdum=c(rep(1,31),rep(2,28),rep(3,31),rep(4,30),rep(5,31),rep(6,30), - rep(7,31),rep(8,31),rep(9,30),rep(10,31),rep(11,30),rep(12,31)) - daydum=c((1:31),(1:28),(1:31),(1:30),(1:31),(1:30),(1:31),(1:31),(1:30),(1:31),(1:30),(1:31)) - yr=c(yr1:yr2) - for(i in 1:(yr2-yr1+1)){ - year=c(year,rep(yr[i],length=length(monthdum))) - month=c(month,monthdum) - day=c(day,daydum)} - month=array(month[1:(length(month))]) - day=array(day[1:(length(day))]) - year=array(year[1:(length(year))]) - } - if (ical==360){ - ndyear=360 - nmyear=12 - lmo=1:12 - nyear=yr2-yr1+1 - day=rep(1:30,times=nmyear*nyear) - month=rep(rep(lmo,each=30),times=nyear) - year=rep(yr1:yr2,each=ndyear) - } - time=array((year)*10000+month*100+day) - - if(seasonal==TRUE){ - ISEAS=which(month %in% seas) - time=time[ISEAS] - year=year[ISEAS] - month=month[ISEAS] - day=day[ISEAS] - } - return(list(year=year,month=month,day=day,time=time)) -}# end of reproduction of the time -- GitLab From d15c7cf5c5bb8b59e50e2573ab8f0057b328c25a Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Thu, 3 Oct 2019 18:56:56 +0200 Subject: [PATCH 13/43] updating dimensions --- R/CST_Analogs.R | 88 +++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 71 insertions(+), 17 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 8efd4f98..62000372 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -67,12 +67,35 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = criteria, return = return_list) } #'@example +#'expL <- 1 : (8*10*2*6*7) +dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) +obsL <- 1 : (8*10*5) +dim(obsL) <- c(lat = 8, lon = 10, time = 5) #'met <- Select(expL = expL, obsL = obsL) +#'lat_local <- lat <- seq(0, 19, 2.5) +lon_local <- lon <- seq(0, 23, 2.5) +met = Select(expL, obsL, criteria = "Local_dist", lon_local = lon, + lat_local = lat, + region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5)) +#'dim(met$metric1) +#'str(met) +expL <- 1 : c(8*10*2) +dim(expL) <- c(lat = 8, lon = 10, time = 2) +obsL <- 1 : (8*10*5) +dim(obsL) <- c(lat = 8, lon = 10, time = 5) +met = Select(expL, obsL, criteria = "Local_dist", lon_local = lon, + lat_local = lat, + region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5)) #'pos <- BestAnalog(met) +#'pos <- BestAnalog(met, return_list = TRUE, nAnalogs = 2) +#'pos +res <- Apply(met, target_dims = 'time', fun = BestAnalog, criteria = 'Local_dist')$output1 + BestAnalog <- function(metric, criteria = 'Large_dist', return_list = FALSE, - nAnalogs = 1) + nAnalogs = 1) { + print(class(metric)) +print(length(metric)) if (criteria == 'Large_dist') { - metric1 <- metric$metric1 pos1 <- metric$pos1 if (return_list == FALSE) { pos <- pos1[1] @@ -82,8 +105,8 @@ BestAnalog <- function(metric, criteria = 'Large_dist', return_list = FALSE, } else if (criteria== 'Local_dist') { # pos1 <- c(7, 13, 5, 3, 6, 12, 10, 1, 8, 9, 11, 4, 2, 14) # pos2 <- c(4, 8, 13, 6, 3, 1, 12, 5, 9, 7, 10, 2, 11, 14) - pos1 <- pos1[1 : nAnalogs] - pos2 <- pos2[1 : nAnalogs] + pos1 <- metric$pos1[1 : nAnalogs] + pos2 <- metric$pos2[1 : nAnalogs] best <- match(pos1, pos2) pos <- pos1[as.logical(best)] pos <- pos[which(!is.na(pos))] @@ -91,13 +114,13 @@ BestAnalog <- function(metric, criteria = 'Large_dist', return_list = FALSE, pos <- pos[1] } } else if (criteria == 'Local_cor') { - pos1 <- pos1[1 : nAnalogs] - pos2 <- pos2[1 : nAnalogs] + pos1 <- metric$pos1[1 : nAnalogs] + pos2 <- metric$pos2[1 : nAnalogs] best <- match(pos1, pos2) pos <- pos1[as.logical(best)] pos <- pos[which(!is.na(pos))] # pos3 <- c(6, 11, 14, 3, 13, 7, 2, 5, 1, 12, 10, 9, 8, 4) - pos3 <- pos3[1 : nAnalogs] + pos3 <- metric$pos3[1 : nAnalogs] best <- match(pos, pos3) pos <- pos[order(best, decreasing = F)] pos <- pos[which(!is.na(pos))] @@ -105,9 +128,9 @@ BestAnalog <- function(metric, criteria = 'Large_dist', return_list = FALSE, pos[1] } return(pos) + } } - expL <- (1 + 2): (4 * 3 * 2 + 2) dim(expL) <- c(lat = 4, lon = 3, time = 2) obsL <- 1 : c(4 * 3 * 5) @@ -121,18 +144,24 @@ lat_local <- lat <- seq(0, 19, 2.5) lon_local <- lon <- seq(0, 23, 2.5) res = Select(expL, obsL, criteria = "Local_dist", lon_local = lon, lat_local = lat, - region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5 )) + region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5)) # probar mas ejemplos con diferentes criterios, latitudes, longitudes Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", lon_local = NULL, lat_local = NULL, region = NULL) { #check expL #check obsL #check obsVar + if (any(names(dim(expL)) == 'time')) { + names(dim(expL))[which(names(dim(expL)) == 'time')] <- 'time_exp' + } metric1 <- Apply(list(obsL), target_dims = list(c('lat', 'lon')), - fun = .select, expL, metric = "dist", - output_dims = c('time_exp'))$output1 - pos1 <- apply(metric1, 1, order) - metric1 <- apply(metric1, 1, sort) + fun = .select, expL, metric = "dist")$output1 + dim_time_obs <- which(names(dim(metric1)) == 'time') + margins <- c(1 : length(dim(metric1)))[-dim_time_obs] + pos1 <- apply(metric1, margins, order) + names(dim(pos1))[1] <- 'time' + metric1 <- apply(metric1, margins, sort) + names(dim(metric1))[1] <- 'time' if (criteria == "Large_dist") { return(list(metric1 = metric1, pos1 = pos1)) @@ -142,8 +171,11 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ exp <- SelBox(expL, lon = lon_local, lat = lat_local, region = region)$data metric2 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), fun = .select, exp, metric = "dist")$output1 - pos2 <- apply(metric2, 1, order) - metric2 <- apply(metric2, 1, sort) + margins <- c(1 : length(dim(metric2)))[-dim_time_obs] + pos2 <- apply(metric2, margins, order) + names(dim(pos2))[1] <- 'time' + metric2 <- apply(metric2, margins, sort) + names(dim(metric2))[1] <- 'time' if (criteria == "Local_dist") { return(list(metric1 = metric1, metric2 = metric2, pos1 = pos1, pos2 = pos2)) @@ -154,8 +186,11 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ exp <- SelBox(expVar, lon = lon_local, lat = lat_local, region = region)$data metric3 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), fun = .select, exp, metric = "cor")$output1 - pos3 <- apply(metric3, 1, order, decreasing = TRUE) - metric3 <- apply(metric3, 1, sort) + margins <- c(1 : length(dim(metric3)))[-dim_time_obs] + pos3 <- apply(metric3, margins, order, decreasing = TRUE) + names(dim(pos3))[1] <- 'time' + metric3 <- apply(metric3, margins, sort) + names(dim(metric3))[1] <- 'time' return(list(metric1 = metric1, metric2 = metric2, metric3 = metric3, pos1 = pos1, pos2 = pos2, pos3 = pos3)) } @@ -194,4 +229,23 @@ dim(res) } result } +# Add '_exp' label to experiment dimmension if they are not lat and lon but in common with obs: +expL <- 1 : (8*10*2*6*7) +dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) +obsL <- 1 : (8*10*5*3) +dim(obsL) <- c(lat = 8, lon = 10, time = 5, member = 3) +dimnames_exp <- names(dim(expL)) +#dimnames_exp <- dimnames_exp[-which(dimnames_exp == 'lat' | dimnames_exp == 'lon')] +dimnames_obs <- names(dim(obsL)) +#dimnames_obs <- dimnames_obs[-which(dimnames_obs == 'lat' | dimnames_obs == 'lon')] +which(dimnames_exp == dimnames_obs & dimnames_exp) +dimnames_exp[which(dimnames_exp == dimnames_obs)] <- paste0(dimnames_exp[which(dimnames_exp == dimnames_obs)], "_exp") +names(dim(expL)) <- dimnames_exp +repeat_names <- function(names_exp, names_obs) { + latlon_dim_exp <- which(names_exp == 'lat' | names_exp == 'lon') + latlon_dim_obs <- which(names_obs == 'lat' | names_obs == 'lon') + + dimnames_obs <- dimnames_obs[-which(dimnames_obs == 'lat' | dimnames_obs == 'lon')] + +} -- GitLab From cac44735bdba75955d135d7254543a5e7ab9a8b9 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Fri, 4 Oct 2019 13:08:40 +0200 Subject: [PATCH 14/43] updating documentation and name dimensions --- R/CST_Analogs.R | 197 ++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 176 insertions(+), 21 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 62000372..c1df272d 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -1,29 +1,135 @@ -#'CST_Analogs +#'@rdname CST_Analogs +#'@title Downscaling using Analogs based on large scale fields. #' #'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -#' adapted version of the method of Yiou et al 2013 +#'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} #' -#'@references Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, and M. Vrac, 2013 : -#' Ensemble reconstruction of the atmospheric column from surface pressure using analogues. -#' Clim. Dyn., 41, 1419-1437. \email{pascal.yiou@lsce.ipsl.fr} -#' -#'@description search for days with similar atmospheric conditions based on the large scale slp (or geopotential height) -# and the local scale (precipitation or Temperature) +#'@description This function perform a downscaling using Analogs. To compute +#'the analogs, the function search for days with similar large scale conditions +#'to downscaled fields in the local scale. +#'The large scale and the local scale regions are defined by the user. +#'The large scale is usually given by atmospheric circulation as sea level +#'pressure or geopotential height (Yiou et al, 2013) but the function gives the +#' possibility to use another field. The local scale will be usually given by +#' precipitation or Temperature, but might be another variable. +#' The analogs function will find the best analogs based in three criterias: +#' (1) Minimal distance in the large scale pattern (i.e. SLP) +#' (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal +#' distance in the local scale pattern (i.e. SLP). +#' (3) Minimal distance in the large scale pattern (i.e. SLP), minimal +#' distance in the local scale pattern (i.e. SLP) and maxima correlation in the +#' local variable to downscale (i.e Precipitation). +#' The search of analogs must be done in the longest dataset posible. This is +#' important since it is necessary to have a good representation of the +#' possible states of the field in the past, and therefore, to get better +#' analogs. Once the search of the analogs is complete, and in order to used the +#' three criterias the user can select a number of analogs nAnalogs to restrict +#' the selection of the best analogs in a short number of posibilities, the best +#' ones. By default this parameter will be 1. +#' This function has not constrains of specific regions, variables to downscale, +#' or data to be used (seasonal forecast data, climate projections data, +#' reanalyses data). +#' The regrid into a finner scale is done interpolating with CST_Load. +#' Then, this interpolation is corrected selecting the analogs in the large +#' and local scale in based of the observations. +#' The function is an adapted version of the method of Yiou et al 2013. +#'@references Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, +#' and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column +#' from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. +#' \email{pascal.yiou@lsce.ipsl.fr} +#'@param criteria different criteria to be used for the selection of analogs +#'if criteria = "Large_dist" +#'if criteria ="Local_dist" +#'if criteria ="Local_cor" +#'@param expL variable for the Large scale in the model (same variable +#'might be used in the local scale for criteria 2) +#'@param obsL variable for the large scale in the observations +#'@param expVar variable for the local scale in the model usually different +#'to the variable in expL +#'@param obsVar variable for the local scale in the observations usually +#'different to the variable in obsL +#'@param lon_local longitude in the local scale +#'@param lat_local latitude in the local scale +#'@param region region for the local scale +#'@param nAnalogs number of Analogs to be selected to apply the criterias (this +#'is not the necessary the number of analogs that the user can get) +#'@param return_list TRUE if you want to get a list with the best analogs FALSE +#'if not. +#'@param mAnalogs months for searching the analogs +#'@import multiapply +#'@import ClimProjDiags +#'@import s2dverification +#'@return list list with the best analogs (time, distance) +#'@return values values of a certain variable +#'@example #' -#'@param month month of the analog day -#' day day of the analog day -#' yr year of the analog day -#' mAnalog month or list of months to search for analogs -#'@import +#'@export +CST_Analogs <- function() + + + + + +#'@rdname Analogs +#'@title Search for analogs based on large scale fields. +#' +#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +#'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} +#' +#'@description This function search for days with similar large scale +#'conditions or similar large and local scale conditions. #' -#'@return list best.corr.time.ana,best.dist.time.ana,selec.dist.time,selec.corr.time -#' list file.dat with a list of days with the format yyyymmdd ordered by best analog with the dist (minima) and corr (maxima) -#' plot preliminary plot of the best analog selected -#' yr1 first year of the total period of study -#' yr2 last year of the total period of study -#' ical number of days per year in the calendar (360,365,366) +#'The large scale and the local scale regions are defined by the user. +#'The large scale is usually given by atmospheric circulation as sea level +#'pressure or geopotential height (Yiou et al, 2013) but the function gives the +#' possibility to use another field. For the local scale the user can select +#' any variable. +#' The analogs function will find the best analogs based in three criterias: +#' (1) Minimal distance in the large scale pattern (i.e. SLP) +#' (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal +#' distance in the local scale pattern (i.e. SLP). +#' (3) Minimal distance in the large scale pattern (i.e. SLP), minimal +#' distance in the local scale pattern (i.e. SLP) and maxima correlation in the +#' local variable to find the analog (i.e Precipitation). +#' Once the search of the analogs is complete, and in order to used the +#' three criterias the user can select a number of analogs nAnalogs to restrict +#' the selection of the best analogs in a short number of posibilities, the best +#' ones. By default this parameter will be 1. +#' This function has not constrains of specific regions, variables to find the +#' analogs, or data to be used (seasonal forecast data, climate projections +#' data, reanalyses data). +#' The input data might be interpolated or not. +#' The function is an adapted version of the method of Yiou et al 2013. +#'@references Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, +#' and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column +#' from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. +#' \email{pascal.yiou@lsce.ipsl.fr} +#'@param criteria different criteria to be used for the selection of analogs +#'if criteria = "Large_dist" +#'if criteria ="Local_dist" +#'if criteria ="Local_cor" +#'@param expL variable for the Large scale in the model (same variable +#'might be used in the local scale for criteria 2) +#'@param obsL variable for the large scale in the observations +#'@param expVar variable for the local scale in the model usually different +#'to the variable in expL +#'@param obsVar variable for the local scale in the observations usually +#'different to the variable in obsL +#'@param lon_local longitude in the local scale +#'@param lat_local latitude in the local scale +#'@param region region for the local scale +#'@param nAnalogs number of Analogs to be selected to apply the criterias (this +#'is not the necessary the number of analogs that the user can get) +#'@param return_list TRUE if you want to get a list with the best analogs FALSE +#'if not. +#'@import multiapply +#'@import ClimProjDiags +#'@import s2dverification +#'@return list list with the best analogs (time, distance) +#'@return values values of a certain variable #'@example - +#' +#'@export # Analogs <- function(exp, obs) { # if (!all(c('member', 'sdate') %in% names(dim(exp)))) { # stop("Parameter 'exp' must have the dimensions 'member' and 'sdate'.") @@ -63,8 +169,11 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, metric <- Select(expL = expL, obsL = obsL, expVar = expVar, obsVar = obsVar, criteria = criteria, lon_local = lon_local, lat_local = lat_local, region = region) - best <- Apply(list(metric), target_dims = 'time', fun = BestAnalog, + position_best <- Apply(list(metric), target_dims = 'time', fun = BestAnalog, criteria = criteria, return = return_list) + + time_obsL[position_best] + obsL[position_best,,,,] } #'@example #'expL <- 1 : (8*10*2*6*7) @@ -249,3 +358,49 @@ repeat_names <- function(names_exp, names_obs) { dimnames_obs <- dimnames_obs[-which(dimnames_obs == 'lat' | dimnames_obs == 'lon')] } +#'#This auxiliar function looks for replecated dimension names between two vectors. +#'# The repeated dimensions (different than 'lon' and 'lat') will be replaced in the first +#'# vector with the same name and extra label '_exp'. +#'# Example for 'time' and member' repeated dim in the same order of names +#'# dimension for 'expL' and 'obsL' +#'expL <- 1 : (8*10*2*6*7) +#'expL <- 1 :c(8*10*2*6*7) +#'dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) +#'obsL <- 1 : (8*10*5*3) +#'dim(obsL) <- c(lat = 8, time = 5, member = 3, lon = 10) +#'names_exp <- names(dim(expL)) +#'names_obs <- names(dim(obsL)) +#'replace_repeat_dimnames(names_exp, names_obs) +#'#[1] "lat" "lon" "time_exp" "member_exp" "sdate" +#' +#' Example for time and memeber repeated with different order +#'dim(obsL) <- c(lon = 10, member = 3, time = 5, lat = 8) +#'names_obs <- names(dim(obsL)) +#'replace_repeat_dimnames(names_exp, names_obs) +#'#[1] "lat" "lon" "time_exp" "member_exp" "sdate" +#' +#'# Example for no repeated names: +#'dim(obsL) <- c(lon = 10, time_obs = 5, member_obs = 3, lat = 8) +#'names_obs <- names(dim(obsL)) +#'replace_repeat_dimnames(names_exp, names_obs) +#'#[1] "lat" "lon" "time" "member" "sdate" +replace_repeat_dimnames <- function(names_exp, names_obs, lat_name = 'lat', lon_name = 'lon') { + if (!is.character(names_exp)) { + stop("Parameter 'names_exp' must be a vector of characters.") + } + if (!is.character(names_obs)) { + stop("Parameter 'names_obs' must be a vector of characters.") + } + + latlon_dim_exp <- which(names_exp == lat_name | names_exp == lon_name) + latlon_dim_obs <- which(names_obs == lat_name | names_obs == lon_name) + if (any(unlist(lapply(names_exp[-latlon_dim_exp], + function(x){x == names_obs[-latlon_dim_obs]})))) { + original_pos <- lapply(names_exp, function(x) which(x == names_obs[-latlon_dim_obs])) + original_pos <- lapply(pos,length) > 0 + names_exp[original_pos] <- paste0(names_exp[original_pos], "_exp") + } + return(names_exp) + ## Improvements: other dimensions to avoid replacement for more flexibility. +} + -- GitLab From 20e32c36fe99af069aa391a36623ca8fc93c88a8 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Fri, 4 Oct 2019 18:25:00 +0200 Subject: [PATCH 15/43] implementing CST_Analogs function --- R/CST_Analogs.R | 269 ++++++++++++++++++++++++++---------------------- 1 file changed, 147 insertions(+), 122 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index c1df272d..2b46fdbc 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -58,24 +58,37 @@ #'@param mAnalogs months for searching the analogs #'@import multiapply #'@import ClimProjDiags -#'@import s2dverification +#'@import abind #'@return list list with the best analogs (time, distance) #'@return values values of a certain variable #'@example -#' +#'expL <- lonlat_data$exp +#'obsL <- lonlat_data$obs +#'dim(obsL$data) <- c(dataset = 1, member = 1, time = 18, lat = 22, lon = 53) +#'expVar <- lonlat_prec$exp +#'obsVar <- lonlat_prec$obs +#'downscaledVar <- CST_Analogs(....) #'@export -CST_Analogs <- function() - - - +CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') + #checks + timevector <- obsL$Dates$start + region <- c(min(expVar$lon), max(expVar$lon), min(expVar$lat), max(expVar$lon)) + result <- Analogs(expL$data, obsL$data, time_obsL = timevector, + expVar = expVar$data, obsVar = obsVar$data, + criteria = criteria, + lon_local = expVar$lon, lat_local = expVar$lat, + region = region, nAnalogs = 1, return_list = FALSE) + obsVar$data <- result$AnalogsFields + result(obsVar) +} -#'@rdname Analogs -#'@title Search for analogs based on large scale fields. -#' -#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -#'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} -#' + #'@rdname Analogs + #'@title Search for analogs based on large scale fields. + #' + #'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} + #'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} + #' #'@description This function search for days with similar large scale #'conditions or similar large and local scale conditions. #' @@ -124,88 +137,112 @@ CST_Analogs <- function() #'if not. #'@import multiapply #'@import ClimProjDiags -#'@import s2dverification +#'@import abind #'@return list list with the best analogs (time, distance) #'@return values values of a certain variable #'@example #' -#'@export -# Analogs <- function(exp, obs) { -# if (!all(c('member', 'sdate') %in% names(dim(exp)))) { -# stop("Parameter 'exp' must have the dimensions 'member' and 'sdate'.") -# } -# -# if (!all(c('sdate') %in% names(dim(obs)))) { -# stop("Parameter 'obs' must have the dimension 'sdate'.") -# } -# -# if (any(is.na(exp))) { -# warning("Parameter 'exp' contains NA values.") -# } -# -# if (any(is.na(obs))) { -# warning("Parameter 'obs' contains NA values.") -# } -# -# target_dims_obs <- 'sdate' -# if ('member' %in% names(dim(obs))) { -# target_dims_obs <- c('member', target_dims_obs) -# } -# -# Analogs <- Apply(data = list(var_obs = obs, var_exp = exp), -# target_dims = list(target_dims_obs, c('member', 'sdate')), -# fun = .select)$output1 -# -# return(Analogs) -# } - -time_obsL <- as.Date(c("2005-01-01", "2005-02-01", "2005-03-01", - "2005-04-01", "2005-05-01")) +#'@export Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", lon_local = NULL, lat_local = NULL, region = NULL, nAnalogs = 1, return_list = FALSE) { # checks - metric <- Select(expL = expL, obsL = obsL, expVar = expVar, obsVar = obsVar, - criteria = criteria, lon_local = lon_local, lat_local = lat_local, - region = region) - position_best <- Apply(list(metric), target_dims = 'time', fun = BestAnalog, - criteria = criteria, return = return_list) + if (!all(c('lon', 'lat') %in% names(dim(expL)))) { + stop("Parameter 'expL' must have the dimensions 'lat' and 'lon'.") + } + + if (!all(c('lat', 'lon') %in% names(dim(obsL)))) { + stop("Parameter 'obsL' must have the dimension 'sdate'.") + } + + if (any(is.na(expL))) { + warning("Parameter 'exp' contains NA values.") + } + + if (any(is.na(obsL))) { + warning("Parameter 'obs' contains NA values.") + } - time_obsL[position_best] - obsL[position_best,,,,] + position <- Select(expL = expL, obsL = obsL, expVar = expVar, obsVar = obsVar, + criteria = criteria, lon_local = lon_local, lat_local = lat_local, + region = region)$position + best <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, + criteria = criteria, return_list = return_list, nAnalogs = nAnalogs) + Analogs_dates <- time_obsL[best] + dim(Analogs_dates) <- dim(best) + if (is.null(obsVar)) { + obsLocal <- SelBox(obsL, lon = lon_local, lat = lat_local, region = region) + Analogs_fields <- Subset(obsLocal, along = which(names(dim(obsLocal)) == 'time'), indices = best) + } else { + obsVar <- SelBox(obsVar, lon = lon_local, lat = lat_local, region = region) + Analogs_fields <- Subset(obsVar, along = which(names(dim(obsVar)) == 'time'), indices = best) + } + lon_dim <- which(names(dim(Analogs_fields)) == 'lon') + lat_dim <- which(names(dim(Analogs_fields)) == 'lat') + if (lon_dim < lat_dim) { + dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lon_dim, lat_dim)], dim(best)) + } else if (lat_dim > lon_dim) { + dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lat_dim, lon_dim)], dim(best)) + } else { + stop("Dimensions 'lat' and 'lon' not found.") + } + return(list(DatesAnalogs = Analogs_dates, AnalogsFields = Analogs_fields)) } #'@example -#'expL <- 1 : (8*10*2*6*7) +expL <- 1 : (8 * 10 * 2 * 6 * 7) dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) -obsL <- 1 : (8*10*5) +obsL <- 1 : (8 * 10 * 5) dim(obsL) <- c(lat = 8, lon = 10, time = 5) -#'met <- Select(expL = expL, obsL = obsL) -#'lat_local <- lat <- seq(0, 19, 2.5) +position <- Select(expL = expL, obsL = obsL)$position +dim(position) +pos <- BestAnalog(position) +pos +dim(pos) +res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Large_dist')$output1 + + +lat_local <- lat <- seq(0, 19, 2.5) lon_local <- lon <- seq(0, 23, 2.5) -met = Select(expL, obsL, criteria = "Local_dist", lon_local = lon, +position= Select(expL, obsL, criteria = "Local_dist", lon_local = lon, lat_local = lat, - region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5)) -#'dim(met$metric1) -#'str(met) -expL <- 1 : c(8*10*2) -dim(expL) <- c(lat = 8, lon = 10, time = 2) -obsL <- 1 : (8*10*5) -dim(obsL) <- c(lat = 8, lon = 10, time = 5) -met = Select(expL, obsL, criteria = "Local_dist", lon_local = lon, - lat_local = lat, - region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5)) -#'pos <- BestAnalog(met) -#'pos <- BestAnalog(met, return_list = TRUE, nAnalogs = 2) -#'pos -res <- Apply(met, target_dims = 'time', fun = BestAnalog, criteria = 'Local_dist')$output1 + region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5))$position +res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Local_dist')$output1 +res <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, criteria = 'Large_dist')$output1 -BestAnalog <- function(metric, criteria = 'Large_dist', return_list = FALSE, + + +BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, nAnalogs = 1) { - print(class(metric)) -print(length(metric)) +#ahora position es un array de 2 dimensiones: una para time_obs en la que estan ordenados los mapas de observaciones y otra de position de 1 a 3 con pos1,pos2 y pos3. + pos_dim <- which(names(dim(position)) == 'pos') + if (dim(position)[pos_dim] == 1) { + pos1 <- position + if (criteria != 'Large_dist') { + warning("Dimension 'pos' in parameter 'position' has length 1,", + " criteria 'Large_dist' will be used.") + criteria <- 'Large_dist' + } + } else if (dim(position)[pos_dim] == 2) { + pos1 <- Subset(position, along = pos_dim, indices = 1) + pos2 <- Subset(position, along = pos_dim, indices = 2) + if (criteria == 'Local_cor') { + warning("Dimension 'pos' in parameter 'position' has length 2,", + " criteria 'Local_dist' will be used.") + criteria <- 'Local_dist' + } + } else if (dim(position)[pos_dim] == 3) { + pos1 <- Subset(position, along = pos_dim, indices = 1) + pos2 <- Subset(position, along = pos_dim, indices = 2) + pos3 <- Subset(position, along = pos_dim, indices = 3) + if (criteria != 'Local_cor') { + warning("Parameter 'criteria' is set to", criteria, ".") + } + } else { + stop("Parameter 'position' has dimension 'pos' of different ", + "length than expected (from 1 to 3).") + } if (criteria == 'Large_dist') { - pos1 <- metric$pos1 if (return_list == FALSE) { pos <- pos1[1] } else { @@ -214,8 +251,8 @@ print(length(metric)) } else if (criteria== 'Local_dist') { # pos1 <- c(7, 13, 5, 3, 6, 12, 10, 1, 8, 9, 11, 4, 2, 14) # pos2 <- c(4, 8, 13, 6, 3, 1, 12, 5, 9, 7, 10, 2, 11, 14) - pos1 <- metric$pos1[1 : nAnalogs] - pos2 <- metric$pos2[1 : nAnalogs] + pos1 <- pos1[1 : nAnalogs] + pos2 <- pos2[1 : nAnalogs] best <- match(pos1, pos2) pos <- pos1[as.logical(best)] pos <- pos[which(!is.na(pos))] @@ -223,20 +260,20 @@ print(length(metric)) pos <- pos[1] } } else if (criteria == 'Local_cor') { - pos1 <- metric$pos1[1 : nAnalogs] - pos2 <- metric$pos2[1 : nAnalogs] + pos1 <- pos1[1 : nAnalogs] + pos2 <- pos2[1 : nAnalogs] best <- match(pos1, pos2) pos <- pos1[as.logical(best)] pos <- pos[which(!is.na(pos))] # pos3 <- c(6, 11, 14, 3, 13, 7, 2, 5, 1, 12, 10, 9, 8, 4) - pos3 <- metric$pos3[1 : nAnalogs] + pos3 <- pos3[1 : nAnalogs] best <- match(pos, pos3) pos <- pos[order(best, decreasing = F)] pos <- pos[which(!is.na(pos))] if (return_list == FALSE) { pos[1] } - return(pos) + return(pos) } } @@ -260,9 +297,7 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ #check expL #check obsL #check obsVar - if (any(names(dim(expL)) == 'time')) { - names(dim(expL))[which(names(dim(expL)) == 'time')] <- 'time_exp' - } + names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)), names(dim(obsL))) metric1 <- Apply(list(obsL), target_dims = list(c('lat', 'lon')), fun = .select, expL, metric = "dist")$output1 dim_time_obs <- which(names(dim(metric1)) == 'time') @@ -271,9 +306,10 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ names(dim(pos1))[1] <- 'time' metric1 <- apply(metric1, margins, sort) names(dim(metric1))[1] <- 'time' - if (criteria == "Large_dist") { - return(list(metric1 = metric1, pos1 = pos1)) + dim(metric1) <- c(dim(metric1), metric = 1) + dim(pos1) <- c(dim(pos1), pos = 1) + return(list(metric = metric1, position = pos1)) } if (criteria == "Local_dist" | criteria == "Local_cor") { obs <- SelBox(obsL, lon = lon_local, lat = lat_local, region = region)$data @@ -285,11 +321,14 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ names(dim(pos2))[1] <- 'time' metric2 <- apply(metric2, margins, sort) names(dim(metric2))[1] <- 'time' - if (criteria == "Local_dist") { - return(list(metric1 = metric1, metric2 = metric2, - pos1 = pos1, pos2 = pos2)) - } - } + if (criteria == "Local_dist") { + metric <- abind(metric1, metric2, along = length(dim(metric1)) + 1) + position <- abind(pos1, pos2, along = length(dim(pos1)) + 1) + names(dim(metric)) <- c(names(dim(metric1)), 'metric') + names(dim(position)) <- c(names(dim(pos1)), 'pos') + return(list(metric = metric, position = position)) + } + } if (criteria == "Local_cor") { obs <- SelBox(obsVar, lon = lon_local, lat = lat_local, region = region)$data exp <- SelBox(expVar, lon = lon_local, lat = lat_local, region = region)$data @@ -300,16 +339,19 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ names(dim(pos3))[1] <- 'time' metric3 <- apply(metric3, margins, sort) names(dim(metric3))[1] <- 'time' - return(list(metric1 = metric1, metric2 = metric2, metric3 = metric3, - pos1 = pos1, pos2 = pos2, pos3 = pos3)) - } + metric <- abind(metric1, metric2, metric3, along = length(dim(metric1)) + 1) + position <- abind(pos1, pos2, pos3, along = length(dim(pos1)) + 1) + names(dim(metric)) <- c(names(dim(metric1)), 'metric') + names(dim(position)) <- c(names(dim(pos1)), 'pos') + return(list(metric = metric, position = position)) + } else { stop("Parameter 'criteria' must to be one of the: 'Large_dist', ", "'Local_dist','Local_cor'.") } } -# data <- 1:(20 * 3 * 2 * 4) +# data <- 1:(20 * 3 * 2 * 4) # dim(data) <- c(lon = 20, lat = 3, time = 2, model = 4) # lon <- seq(2, 40, 2) # lat <- c(1, 5, 10) @@ -338,26 +380,6 @@ dim(res) } result } -# Add '_exp' label to experiment dimmension if they are not lat and lon but in common with obs: -expL <- 1 : (8*10*2*6*7) -dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) -obsL <- 1 : (8*10*5*3) -dim(obsL) <- c(lat = 8, lon = 10, time = 5, member = 3) -dimnames_exp <- names(dim(expL)) -#dimnames_exp <- dimnames_exp[-which(dimnames_exp == 'lat' | dimnames_exp == 'lon')] -dimnames_obs <- names(dim(obsL)) -#dimnames_obs <- dimnames_obs[-which(dimnames_obs == 'lat' | dimnames_obs == 'lon')] -which(dimnames_exp == dimnames_obs & dimnames_exp) -dimnames_exp[which(dimnames_exp == dimnames_obs)] <- paste0(dimnames_exp[which(dimnames_exp == dimnames_obs)], "_exp") -names(dim(expL)) <- dimnames_exp - -repeat_names <- function(names_exp, names_obs) { - latlon_dim_exp <- which(names_exp == 'lat' | names_exp == 'lon') - latlon_dim_obs <- which(names_obs == 'lat' | names_obs == 'lon') - - dimnames_obs <- dimnames_obs[-which(dimnames_obs == 'lat' | dimnames_obs == 'lon')] - -} #'#This auxiliar function looks for replecated dimension names between two vectors. #'# The repeated dimensions (different than 'lon' and 'lat') will be replaced in the first #'# vector with the same name and extra label '_exp'. @@ -386,21 +408,24 @@ repeat_names <- function(names_exp, names_obs) { #'#[1] "lat" "lon" "time" "member" "sdate" replace_repeat_dimnames <- function(names_exp, names_obs, lat_name = 'lat', lon_name = 'lon') { if (!is.character(names_exp)) { - stop("Parameter 'names_exp' must be a vector of characters.") + stop("Parameter 'names_exp' must be a vector of characters.") } if (!is.character(names_obs)) { - stop("Parameter 'names_obs' must be a vector of characters.") + stop("Parameter 'names_obs' must be a vector of characters.") } - + latlon_dim_exp <- which(names_exp == lat_name | names_exp == lon_name) latlon_dim_obs <- which(names_obs == lat_name | names_obs == lon_name) if (any(unlist(lapply(names_exp[-latlon_dim_exp], - function(x){x == names_obs[-latlon_dim_obs]})))) { + function(x){x == names_obs[-latlon_dim_obs]})))) { original_pos <- lapply(names_exp, function(x) which(x == names_obs[-latlon_dim_obs])) - original_pos <- lapply(pos,length) > 0 - names_exp[original_pos] <- paste0(names_exp[original_pos], "_exp") + original_pos <- lapply(original_pos, length) > 0 + names_exp[original_pos] <- paste0(names_exp[original_pos], "_exp") } return(names_exp) - ## Improvements: other dimensions to avoid replacement for more flexibility. +## Improvements: other dimensions to avoid replacement for more flexibility. } + + + -- GitLab From 6821747f011bc17c634077ab6924a90732257c32 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Fri, 4 Oct 2019 18:44:06 +0200 Subject: [PATCH 16/43] devtools doc creation git log q --- NAMESPACE | 5 +++ R/CST_Analogs.R | 62 +++++++++++++++--------------- man/Analogs.Rd | 84 +++++++++++++++++++++++++++++++++++++++++ man/CST_Analogs.Rd | 94 ++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 214 insertions(+), 31 deletions(-) create mode 100644 man/Analogs.Rd create mode 100644 man/CST_Analogs.Rd diff --git a/NAMESPACE b/NAMESPACE index ef0bfd71..e01a5c0f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Generated by roxygen2: do not edit by hand +export(Analogs) +export(CST_Analogs) export(CST_Anomaly) export(CST_BiasCorrection) export(CST_Calibration) @@ -14,8 +16,11 @@ export(PlotForecastPDF) export(PlotMostLikelyQuantileMap) export(RFSlope) export(RainFARM) +import(ClimProjDiags) +import(abind) import(ggplot2) import(multiApply) +import(multiapply) import(ncdf4) import(rainfarmr) import(s2dverification) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 2b46fdbc..d0a28777 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -61,15 +61,15 @@ #'@import abind #'@return list list with the best analogs (time, distance) #'@return values values of a certain variable -#'@example +#'@examples #'expL <- lonlat_data$exp #'obsL <- lonlat_data$obs #'dim(obsL$data) <- c(dataset = 1, member = 1, time = 18, lat = 22, lon = 53) #'expVar <- lonlat_prec$exp #'obsVar <- lonlat_prec$obs -#'downscaledVar <- CST_Analogs(....) +#'#downscaledVar <- CST_Analogs(....) #'@export -CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') +CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { #checks timevector <- obsL$Dates$start region <- c(min(expVar$lon), max(expVar$lon), min(expVar$lat), max(expVar$lon)) @@ -140,7 +140,7 @@ CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') #'@import abind #'@return list list with the best analogs (time, distance) #'@return values values of a certain variable -#'@example +#'@examples #' #'@export Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, @@ -189,26 +189,26 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, } return(list(DatesAnalogs = Analogs_dates, AnalogsFields = Analogs_fields)) } -#'@example -expL <- 1 : (8 * 10 * 2 * 6 * 7) -dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) -obsL <- 1 : (8 * 10 * 5) -dim(obsL) <- c(lat = 8, lon = 10, time = 5) -position <- Select(expL = expL, obsL = obsL)$position -dim(position) -pos <- BestAnalog(position) -pos -dim(pos) -res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Large_dist')$output1 +#'@examples +#'expL <- 1 : (8 * 10 * 2 * 6 * 7) +#'dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) +#'obsL <- 1 : (8 * 10 * 5) +#'dim(obsL) <- c(lat = 8, lon = 10, time = 5) +#'position <- Select(expL = expL, obsL = obsL)$position +#'dim(position) +#'pos <- BestAnalog(position) +#'pos +#'dim(pos) +#'res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Large_dist')$output1 -lat_local <- lat <- seq(0, 19, 2.5) -lon_local <- lon <- seq(0, 23, 2.5) -position= Select(expL, obsL, criteria = "Local_dist", lon_local = lon, - lat_local = lat, - region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5))$position -res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Local_dist')$output1 -res <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, criteria = 'Large_dist')$output1 +#'lat_local <- lat <- seq(0, 19, 2.5) +#'lon_local <- lon <- seq(0, 23, 2.5) +#'position= Select(expL, obsL, criteria = "Local_dist", lon_local = lon, +#' lat_local = lat, +#' region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5))$position +#'res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Local_dist')$output1 +#'res <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, criteria = 'Large_dist')$output1 @@ -359,15 +359,15 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ # londim = 1, latdim = 2, mask = NULL) # str(a) -#'@example -exp <- (1 + 2): (4 * 3 + 2) -dim(exp) <- c(lat = 4, lon = 3) -obs <- 1 : c(5 * 4 * 3) -dim(obs) <- c(time = 5, lat = 4, lon = 3) -res <- .select(exp, obs) -res -res <- .select(exp, obs, metric = 'cor') -dim(res) +#'@examples +#'exp <- (1 + 2): (4 * 3 + 2) +#'dim(exp) <- c(lat = 4, lon = 3) +#'obs <- 1 : c(5 * 4 * 3) +#'dim(obs) <- c(time = 5, lat = 4, lon = 3) +#'res <- .select(exp, obs) +#'res +#'res <- .select(exp, obs, metric = 'cor') +#'dim(res) .select <- function(exp, obs, metric = "dist") { if (metric == "dist") { #metric <- sum((obs - exp) ^ 2) diff --git a/man/Analogs.Rd b/man/Analogs.Rd new file mode 100644 index 00000000..e5518760 --- /dev/null +++ b/man/Analogs.Rd @@ -0,0 +1,84 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CST_Analogs.R +\name{Analogs} +\alias{Analogs} +\title{Search for analogs based on large scale fields.} +\usage{ +Analogs(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, + criteria = "Large_dist", lon_local = NULL, lat_local = NULL, + region = NULL, nAnalogs = 1, return_list = FALSE) +} +\arguments{ +\item{expL}{variable for the Large scale in the model (same variable +might be used in the local scale for criteria 2)} + +\item{obsL}{variable for the large scale in the observations} + +\item{expVar}{variable for the local scale in the model usually different +to the variable in expL} + +\item{obsVar}{variable for the local scale in the observations usually +different to the variable in obsL} + +\item{criteria}{different criteria to be used for the selection of analogs +if criteria = "Large_dist" +if criteria ="Local_dist" +if criteria ="Local_cor"} + +\item{lon_local}{longitude in the local scale} + +\item{lat_local}{latitude in the local scale} + +\item{region}{region for the local scale} + +\item{nAnalogs}{number of Analogs to be selected to apply the criterias (this +is not the necessary the number of analogs that the user can get)} + +\item{return_list}{TRUE if you want to get a list with the best analogs FALSE +if not.} +} +\value{ +list list with the best analogs (time, distance) + +values values of a certain variable +} +\description{ +This function search for days with similar large scale +conditions or similar large and local scale conditions. + +The large scale and the local scale regions are defined by the user. +The large scale is usually given by atmospheric circulation as sea level +pressure or geopotential height (Yiou et al, 2013) but the function gives the +possibility to use another field. For the local scale the user can select +any variable. +The analogs function will find the best analogs based in three criterias: +(1) Minimal distance in the large scale pattern (i.e. SLP) +(2) Minimal distance in the large scale pattern (i.e. SLP) and minimal +distance in the local scale pattern (i.e. SLP). +(3) Minimal distance in the large scale pattern (i.e. SLP), minimal +distance in the local scale pattern (i.e. SLP) and maxima correlation in the +local variable to find the analog (i.e Precipitation). +Once the search of the analogs is complete, and in order to used the +three criterias the user can select a number of analogs nAnalogs to restrict +the selection of the best analogs in a short number of posibilities, the best +ones. By default this parameter will be 1. +This function has not constrains of specific regions, variables to find the +analogs, or data to be used (seasonal forecast data, climate projections +data, reanalyses data). +The input data might be interpolated or not. +The function is an adapted version of the method of Yiou et al 2013. +} +\examples{ + +} +\references{ +Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, +and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column +from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. +\email{pascal.yiou@lsce.ipsl.fr} +} +\author{ +Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} + +Nuria Perez-Zanon \email{nuria.perez@bsc.es} +} diff --git a/man/CST_Analogs.Rd b/man/CST_Analogs.Rd new file mode 100644 index 00000000..e80991c5 --- /dev/null +++ b/man/CST_Analogs.Rd @@ -0,0 +1,94 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CST_Analogs.R +\name{CST_Analogs} +\alias{CST_Analogs} +\title{Downscaling using Analogs based on large scale fields.} +\usage{ +CST_Analogs(expL, obsL, expVar, obsVar, criteria = "Large_dist") +} +\arguments{ +\item{expL}{variable for the Large scale in the model (same variable +might be used in the local scale for criteria 2)} + +\item{obsL}{variable for the large scale in the observations} + +\item{expVar}{variable for the local scale in the model usually different +to the variable in expL} + +\item{obsVar}{variable for the local scale in the observations usually +different to the variable in obsL} + +\item{criteria}{different criteria to be used for the selection of analogs +if criteria = "Large_dist" +if criteria ="Local_dist" +if criteria ="Local_cor"} + +\item{lon_local}{longitude in the local scale} + +\item{lat_local}{latitude in the local scale} + +\item{region}{region for the local scale} + +\item{nAnalogs}{number of Analogs to be selected to apply the criterias (this +is not the necessary the number of analogs that the user can get)} + +\item{return_list}{TRUE if you want to get a list with the best analogs FALSE +if not.} + +\item{mAnalogs}{months for searching the analogs} +} +\value{ +list list with the best analogs (time, distance) + +values values of a certain variable +} +\description{ +This function perform a downscaling using Analogs. To compute +the analogs, the function search for days with similar large scale conditions +to downscaled fields in the local scale. +The large scale and the local scale regions are defined by the user. +The large scale is usually given by atmospheric circulation as sea level +pressure or geopotential height (Yiou et al, 2013) but the function gives the +possibility to use another field. The local scale will be usually given by +precipitation or Temperature, but might be another variable. +The analogs function will find the best analogs based in three criterias: +(1) Minimal distance in the large scale pattern (i.e. SLP) +(2) Minimal distance in the large scale pattern (i.e. SLP) and minimal +distance in the local scale pattern (i.e. SLP). +(3) Minimal distance in the large scale pattern (i.e. SLP), minimal +distance in the local scale pattern (i.e. SLP) and maxima correlation in the +local variable to downscale (i.e Precipitation). +The search of analogs must be done in the longest dataset posible. This is +important since it is necessary to have a good representation of the +possible states of the field in the past, and therefore, to get better +analogs. Once the search of the analogs is complete, and in order to used the +three criterias the user can select a number of analogs nAnalogs to restrict +the selection of the best analogs in a short number of posibilities, the best +ones. By default this parameter will be 1. +This function has not constrains of specific regions, variables to downscale, +or data to be used (seasonal forecast data, climate projections data, +reanalyses data). +The regrid into a finner scale is done interpolating with CST_Load. +Then, this interpolation is corrected selecting the analogs in the large +and local scale in based of the observations. +The function is an adapted version of the method of Yiou et al 2013. +} +\examples{ +expL <- lonlat_data$exp +obsL <- lonlat_data$obs +dim(obsL$data) <- c(dataset = 1, member = 1, time = 18, lat = 22, lon = 53) +expVar <- lonlat_prec$exp +obsVar <- lonlat_prec$obs +#downscaledVar <- CST_Analogs(....) +} +\references{ +Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, +and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column +from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. +\email{pascal.yiou@lsce.ipsl.fr} +} +\author{ +Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} + +Nuria Perez-Zanon \email{nuria.perez@bsc.es} +} -- GitLab From 1e209f844f3e833e7b57c7e714e7077e4b444758 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Fri, 4 Oct 2019 18:49:09 +0200 Subject: [PATCH 17/43] misspelled multiApply --- R/CST_Analogs.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index d0a28777..0677a8fc 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -56,7 +56,7 @@ #'@param return_list TRUE if you want to get a list with the best analogs FALSE #'if not. #'@param mAnalogs months for searching the analogs -#'@import multiapply +#'@import multiApply #'@import ClimProjDiags #'@import abind #'@return list list with the best analogs (time, distance) @@ -135,7 +135,7 @@ CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { #'is not the necessary the number of analogs that the user can get) #'@param return_list TRUE if you want to get a list with the best analogs FALSE #'if not. -#'@import multiapply +#'@import multiApply #'@import ClimProjDiags #'@import abind #'@return list list with the best analogs (time, distance) -- GitLab From 0ccea16d0597360df2aedd77f00e25a523d42aef Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Sat, 5 Oct 2019 14:24:10 +0200 Subject: [PATCH 18/43] adding import dplyr to the documentation --- R/CST_Analogs.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 0677a8fc..8b0c5cc6 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -59,6 +59,7 @@ #'@import multiApply #'@import ClimProjDiags #'@import abind +#'@import dplyr #'@return list list with the best analogs (time, distance) #'@return values values of a certain variable #'@examples @@ -137,6 +138,7 @@ CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { #'if not. #'@import multiApply #'@import ClimProjDiags +#'@import dplyr #'@import abind #'@return list list with the best analogs (time, distance) #'@return values values of a certain variable -- GitLab From d624b9d1781bc495035bf0c632ad9bdb77c40637 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 8 Oct 2019 13:37:39 +0200 Subject: [PATCH 19/43] removing lines to test auxiliary functions --- R/CST_Analogs.R | 97 ------------------------------------------------- 1 file changed, 97 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 8b0c5cc6..4c6c5e87 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -59,16 +59,8 @@ #'@import multiApply #'@import ClimProjDiags #'@import abind -#'@import dplyr #'@return list list with the best analogs (time, distance) #'@return values values of a certain variable -#'@examples -#'expL <- lonlat_data$exp -#'obsL <- lonlat_data$obs -#'dim(obsL$data) <- c(dataset = 1, member = 1, time = 18, lat = 22, lon = 53) -#'expVar <- lonlat_prec$exp -#'obsVar <- lonlat_prec$obs -#'#downscaledVar <- CST_Analogs(....) #'@export CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { #checks @@ -82,8 +74,6 @@ CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { obsVar$data <- result$AnalogsFields result(obsVar) } - - #'@rdname Analogs #'@title Search for analogs based on large scale fields. #' @@ -138,12 +128,9 @@ CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { #'if not. #'@import multiApply #'@import ClimProjDiags -#'@import dplyr #'@import abind #'@return list list with the best analogs (time, distance) #'@return values values of a certain variable -#'@examples -#' #'@export Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", @@ -191,32 +178,9 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, } return(list(DatesAnalogs = Analogs_dates, AnalogsFields = Analogs_fields)) } -#'@examples -#'expL <- 1 : (8 * 10 * 2 * 6 * 7) -#'dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) -#'obsL <- 1 : (8 * 10 * 5) -#'dim(obsL) <- c(lat = 8, lon = 10, time = 5) -#'position <- Select(expL = expL, obsL = obsL)$position -#'dim(position) -#'pos <- BestAnalog(position) -#'pos -#'dim(pos) -#'res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Large_dist')$output1 - - -#'lat_local <- lat <- seq(0, 19, 2.5) -#'lon_local <- lon <- seq(0, 23, 2.5) -#'position= Select(expL, obsL, criteria = "Local_dist", lon_local = lon, -#' lat_local = lat, -#' region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5))$position -#'res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Local_dist')$output1 -#'res <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, criteria = 'Large_dist')$output1 - - BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, nAnalogs = 1) { -#ahora position es un array de 2 dimensiones: una para time_obs en la que estan ordenados los mapas de observaciones y otra de position de 1 a 3 con pos1,pos2 y pos3. pos_dim <- which(names(dim(position)) == 'pos') if (dim(position)[pos_dim] == 1) { pos1 <- position @@ -278,22 +242,6 @@ BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, return(pos) } } - -expL <- (1 + 2): (4 * 3 * 2 + 2) -dim(expL) <- c(lat = 4, lon = 3, time = 2) -obsL <- 1 : c(4 * 3 * 5) -dim(obsL) <- c(lat = 4, lon = 3, time = 5) -res = Select(expL, obsL) -expL <- (1 + 2): (8 * 10 * 2 + 2) -dim(expL) <- c(lat = 8, lon = 10, time = 2) -obsL <- 1 : c(8 * 10 * 5) -dim(obsL) <- c(lat = 8, lon = 10, time = 5) -lat_local <- lat <- seq(0, 19, 2.5) -lon_local <- lon <- seq(0, 23, 2.5) -res = Select(expL, obsL, criteria = "Local_dist", lon_local = lon, - lat_local = lat, - region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5)) -# probar mas ejemplos con diferentes criterios, latitudes, longitudes Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", lon_local = NULL, lat_local = NULL, region = NULL) { #check expL @@ -352,24 +300,6 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ "'Local_dist','Local_cor'.") } } - -# data <- 1:(20 * 3 * 2 * 4) -# dim(data) <- c(lon = 20, lat = 3, time = 2, model = 4) -# lon <- seq(2, 40, 2) -# lat <- c(1, 5, 10) -# a <- SelBox(data = data, lon = lon, lat = lat, region = c(2, 20, 1, 5), -# londim = 1, latdim = 2, mask = NULL) -# str(a) - -#'@examples -#'exp <- (1 + 2): (4 * 3 + 2) -#'dim(exp) <- c(lat = 4, lon = 3) -#'obs <- 1 : c(5 * 4 * 3) -#'dim(obs) <- c(time = 5, lat = 4, lon = 3) -#'res <- .select(exp, obs) -#'res -#'res <- .select(exp, obs, metric = 'cor') -#'dim(res) .select <- function(exp, obs, metric = "dist") { if (metric == "dist") { #metric <- sum((obs - exp) ^ 2) @@ -382,32 +312,6 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ } result } -#'#This auxiliar function looks for replecated dimension names between two vectors. -#'# The repeated dimensions (different than 'lon' and 'lat') will be replaced in the first -#'# vector with the same name and extra label '_exp'. -#'# Example for 'time' and member' repeated dim in the same order of names -#'# dimension for 'expL' and 'obsL' -#'expL <- 1 : (8*10*2*6*7) -#'expL <- 1 :c(8*10*2*6*7) -#'dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) -#'obsL <- 1 : (8*10*5*3) -#'dim(obsL) <- c(lat = 8, time = 5, member = 3, lon = 10) -#'names_exp <- names(dim(expL)) -#'names_obs <- names(dim(obsL)) -#'replace_repeat_dimnames(names_exp, names_obs) -#'#[1] "lat" "lon" "time_exp" "member_exp" "sdate" -#' -#' Example for time and memeber repeated with different order -#'dim(obsL) <- c(lon = 10, member = 3, time = 5, lat = 8) -#'names_obs <- names(dim(obsL)) -#'replace_repeat_dimnames(names_exp, names_obs) -#'#[1] "lat" "lon" "time_exp" "member_exp" "sdate" -#' -#'# Example for no repeated names: -#'dim(obsL) <- c(lon = 10, time_obs = 5, member_obs = 3, lat = 8) -#'names_obs <- names(dim(obsL)) -#'replace_repeat_dimnames(names_exp, names_obs) -#'#[1] "lat" "lon" "time" "member" "sdate" replace_repeat_dimnames <- function(names_exp, names_obs, lat_name = 'lat', lon_name = 'lon') { if (!is.character(names_exp)) { stop("Parameter 'names_exp' must be a vector of characters.") @@ -415,7 +319,6 @@ replace_repeat_dimnames <- function(names_exp, names_obs, lat_name = 'lat', lon_ if (!is.character(names_obs)) { stop("Parameter 'names_obs' must be a vector of characters.") } - latlon_dim_exp <- which(names_exp == lat_name | names_exp == lon_name) latlon_dim_obs <- which(names_obs == lat_name | names_obs == lon_name) if (any(unlist(lapply(names_exp[-latlon_dim_exp], -- GitLab From 21b99669ef780a2f9178612b9960361a2694d25d Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 8 Oct 2019 13:42:13 +0200 Subject: [PATCH 20/43] updating libraries in the documentation --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index dfe40ba0..c4c4defc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -34,6 +34,7 @@ Imports: s2dverification, rainfarmr, multiApply, + ClimProjDiags, ncdf4, plyr, abind, @@ -53,4 +54,4 @@ VignetteBuilder: knitr License: Apache License 2.0 Encoding: UTF-8 LazyData: true -RoxygenNote: 5.0.0 +RoxygenNote: 6.1.1 -- GitLab From b418f985a472258b693a5a745edbbae60bf63487 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 8 Oct 2019 13:46:00 +0200 Subject: [PATCH 21/43] updating --- NAMESPACE | 1 - 1 file changed, 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index e01a5c0f..5858fac1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,7 +20,6 @@ import(ClimProjDiags) import(abind) import(ggplot2) import(multiApply) -import(multiapply) import(ncdf4) import(rainfarmr) import(s2dverification) -- GitLab From 5cd1dbc8c20702ad3fe9cd00b25129be06d7effb Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 8 Oct 2019 13:47:26 +0200 Subject: [PATCH 22/43] updating --- CST_Analogs_tests.R | 95 +++++++++++++++++++++++++++++++++++++++++++++ man/Analogs.Rd | 3 -- man/CST_Analogs.Rd | 8 ---- 3 files changed, 95 insertions(+), 11 deletions(-) create mode 100644 CST_Analogs_tests.R diff --git a/CST_Analogs_tests.R b/CST_Analogs_tests.R new file mode 100644 index 00000000..a976a21c --- /dev/null +++ b/CST_Analogs_tests.R @@ -0,0 +1,95 @@ +#'CST_Analogs examples and tests +#'@example +#'expL <- lonlat_data$exp +#'obsL <- lonlat_data$obs +#'dim(obsL$data) <- c(dataset = 1, member = 1, time = 18, lat = 22, lon = 53) +#'expVar <- lonlat_prec$exp +#'obsVar <- lonlat_prec$obs +#'#downscaledVar <- CST_Analogs(....) +#' +#' +#'@example +#'expL <- 1 : (8 * 10 * 2 * 6 * 7) +#'dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) +#'obsL <- 1 : (8 * 10 * 5) +#'dim(obsL) <- c(lat = 8, lon = 10, time = 5) +#'position <- Select(expL = expL, obsL = obsL)$position +#'dim(position) +#'pos <- BestAnalog(position) +#'pos +#'dim(pos) +#'res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Large_dist')$output1 + + +#'lat_local <- lat <- seq(0, 19, 2.5) +#'lon_local <- lon <- seq(0, 23, 2.5) +#'position= Select(expL, obsL, criteria = "Local_dist", lon_local = lon, +#' lat_local = lat, +#' region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5))$position +#'res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Local_dist')$output1 +#'res <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, criteria = 'Large_dist')$output1 +#' +#'#'@examples +#'exp <- (1 + 2): (4 * 3 + 2) +#'dim(exp) <- c(lat = 4, lon = 3) +#'obs <- 1 : c(5 * 4 * 3) +#'dim(obs) <- c(time = 5, lat = 4, lon = 3) +#'res <- .select(exp, obs) +#'res +#'res <- .select(exp, obs, metric = 'cor') +#'dim(res) +#' +#'@example +# expL <- (1 + 2): (4 * 3 * 2 + 2) +# dim(expL) <- c(lat = 4, lon = 3, time = 2) +# obsL <- 1 : c(4 * 3 * 5) +# dim(obsL) <- c(lat = 4, lon = 3, time = 5) +# res = Select(expL, obsL) +# expL <- (1 + 2): (8 * 10 * 2 + 2) +# dim(expL) <- c(lat = 8, lon = 10, time = 2) +# obsL <- 1 : c(8 * 10 * 5) +# dim(obsL) <- c(lat = 8, lon = 10, time = 5) +# lat_local <- lat <- seq(0, 19, 2.5) +# lon_local <- lon <- seq(0, 23, 2.5) +# res = Select(expL, obsL, criteria = "Local_dist", lon_local = lon, +# lat_local = lat, +# region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5)) +# probar mas ejemplos con diferentes criterios, latitudes, longitudes +#'@example +#'#This auxiliar function looks for replecated dimension names between two vectors. +#'# The repeated dimensions (different than 'lon' and 'lat') will be replaced in the first +#'# vector with the same name and extra label '_exp'. +#'# Example for 'time' and member' repeated dim in the same order of names +#'# dimension for 'expL' and 'obsL' +#'expL <- 1 : (8*10*2*6*7) +#'expL <- 1 :c(8*10*2*6*7) +#'dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) +#'obsL <- 1 : (8*10*5*3) +#'dim(obsL) <- c(lat = 8, time = 5, member = 3, lon = 10) +#'names_exp <- names(dim(expL)) +#'names_obs <- names(dim(obsL)) +#'replace_repeat_dimnames(names_exp, names_obs) +#'#[1] "lat" "lon" "time_exp" "member_exp" "sdate" +#' +#'@example +#' Example for time and memeber repeated with different order +#'dim(obsL) <- c(lon = 10, member = 3, time = 5, lat = 8) +#'names_obs <- names(dim(obsL)) +#'replace_repeat_dimnames(names_exp, names_obs) +#'#[1] "lat" "lon" "time_exp" "member_exp" "sdate" +#' +#'# Example for no repeated names: +#'dim(obsL) <- c(lon = 10, time_obs = 5, member_obs = 3, lat = 8) +#'names_obs <- names(dim(obsL)) +#'replace_repeat_dimnames(names_exp, names_obs) +#'#[1] "lat" "lon" "time" "member" "sdate" +#' +#' +# data <- 1:(20 * 3 * 2 * 4) +# dim(data) <- c(lon = 20, lat = 3, time = 2, model = 4) +# lon <- seq(2, 40, 2) +# lat <- c(1, 5, 10) +# a <- SelBox(data = data, lon = lon, lat = lat, region = c(2, 20, 1, 5), +# londim = 1, latdim = 2, mask = NULL) +# str(a) + diff --git a/man/Analogs.Rd b/man/Analogs.Rd index e5518760..12d30fe9 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -67,9 +67,6 @@ analogs, or data to be used (seasonal forecast data, climate projections data, reanalyses data). The input data might be interpolated or not. The function is an adapted version of the method of Yiou et al 2013. -} -\examples{ - } \references{ Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, diff --git a/man/CST_Analogs.Rd b/man/CST_Analogs.Rd index e80991c5..ccbb3319 100644 --- a/man/CST_Analogs.Rd +++ b/man/CST_Analogs.Rd @@ -73,14 +73,6 @@ Then, this interpolation is corrected selecting the analogs in the large and local scale in based of the observations. The function is an adapted version of the method of Yiou et al 2013. } -\examples{ -expL <- lonlat_data$exp -obsL <- lonlat_data$obs -dim(obsL$data) <- c(dataset = 1, member = 1, time = 18, lat = 22, lon = 53) -expVar <- lonlat_prec$exp -obsVar <- lonlat_prec$obs -#downscaledVar <- CST_Analogs(....) -} \references{ Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column -- GitLab From 713553ed5b6788fc22ae0addab38b5a0b7e853c7 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 8 Oct 2019 13:49:06 +0200 Subject: [PATCH 23/43] Delete CST_Analogs_tests.R --- CST_Analogs_tests.R | 95 --------------------------------------------- 1 file changed, 95 deletions(-) delete mode 100644 CST_Analogs_tests.R diff --git a/CST_Analogs_tests.R b/CST_Analogs_tests.R deleted file mode 100644 index a976a21c..00000000 --- a/CST_Analogs_tests.R +++ /dev/null @@ -1,95 +0,0 @@ -#'CST_Analogs examples and tests -#'@example -#'expL <- lonlat_data$exp -#'obsL <- lonlat_data$obs -#'dim(obsL$data) <- c(dataset = 1, member = 1, time = 18, lat = 22, lon = 53) -#'expVar <- lonlat_prec$exp -#'obsVar <- lonlat_prec$obs -#'#downscaledVar <- CST_Analogs(....) -#' -#' -#'@example -#'expL <- 1 : (8 * 10 * 2 * 6 * 7) -#'dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) -#'obsL <- 1 : (8 * 10 * 5) -#'dim(obsL) <- c(lat = 8, lon = 10, time = 5) -#'position <- Select(expL = expL, obsL = obsL)$position -#'dim(position) -#'pos <- BestAnalog(position) -#'pos -#'dim(pos) -#'res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Large_dist')$output1 - - -#'lat_local <- lat <- seq(0, 19, 2.5) -#'lon_local <- lon <- seq(0, 23, 2.5) -#'position= Select(expL, obsL, criteria = "Local_dist", lon_local = lon, -#' lat_local = lat, -#' region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5))$position -#'res <- Apply(list(position), target_dims = c('time','pos') , fun = BestAnalog, criteria = 'Local_dist')$output1 -#'res <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, criteria = 'Large_dist')$output1 -#' -#'#'@examples -#'exp <- (1 + 2): (4 * 3 + 2) -#'dim(exp) <- c(lat = 4, lon = 3) -#'obs <- 1 : c(5 * 4 * 3) -#'dim(obs) <- c(time = 5, lat = 4, lon = 3) -#'res <- .select(exp, obs) -#'res -#'res <- .select(exp, obs, metric = 'cor') -#'dim(res) -#' -#'@example -# expL <- (1 + 2): (4 * 3 * 2 + 2) -# dim(expL) <- c(lat = 4, lon = 3, time = 2) -# obsL <- 1 : c(4 * 3 * 5) -# dim(obsL) <- c(lat = 4, lon = 3, time = 5) -# res = Select(expL, obsL) -# expL <- (1 + 2): (8 * 10 * 2 + 2) -# dim(expL) <- c(lat = 8, lon = 10, time = 2) -# obsL <- 1 : c(8 * 10 * 5) -# dim(obsL) <- c(lat = 8, lon = 10, time = 5) -# lat_local <- lat <- seq(0, 19, 2.5) -# lon_local <- lon <- seq(0, 23, 2.5) -# res = Select(expL, obsL, criteria = "Local_dist", lon_local = lon, -# lat_local = lat, -# region = c(lonmin = 0, lonmax = 5, latmin = 0, latmax = 5)) -# probar mas ejemplos con diferentes criterios, latitudes, longitudes -#'@example -#'#This auxiliar function looks for replecated dimension names between two vectors. -#'# The repeated dimensions (different than 'lon' and 'lat') will be replaced in the first -#'# vector with the same name and extra label '_exp'. -#'# Example for 'time' and member' repeated dim in the same order of names -#'# dimension for 'expL' and 'obsL' -#'expL <- 1 : (8*10*2*6*7) -#'expL <- 1 :c(8*10*2*6*7) -#'dim(expL) <- c(lat = 8, lon = 10, time = 2, member = 6, sdate = 7) -#'obsL <- 1 : (8*10*5*3) -#'dim(obsL) <- c(lat = 8, time = 5, member = 3, lon = 10) -#'names_exp <- names(dim(expL)) -#'names_obs <- names(dim(obsL)) -#'replace_repeat_dimnames(names_exp, names_obs) -#'#[1] "lat" "lon" "time_exp" "member_exp" "sdate" -#' -#'@example -#' Example for time and memeber repeated with different order -#'dim(obsL) <- c(lon = 10, member = 3, time = 5, lat = 8) -#'names_obs <- names(dim(obsL)) -#'replace_repeat_dimnames(names_exp, names_obs) -#'#[1] "lat" "lon" "time_exp" "member_exp" "sdate" -#' -#'# Example for no repeated names: -#'dim(obsL) <- c(lon = 10, time_obs = 5, member_obs = 3, lat = 8) -#'names_obs <- names(dim(obsL)) -#'replace_repeat_dimnames(names_exp, names_obs) -#'#[1] "lat" "lon" "time" "member" "sdate" -#' -#' -# data <- 1:(20 * 3 * 2 * 4) -# dim(data) <- c(lon = 20, lat = 3, time = 2, model = 4) -# lon <- seq(2, 40, 2) -# lat <- c(1, 5, 10) -# a <- SelBox(data = data, lon = lon, lat = lat, region = c(2, 20, 1, 5), -# londim = 1, latdim = 2, mask = NULL) -# str(a) - -- GitLab From 1d34b9e70a01859555e29b5d0434c47c83844159 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Mon, 28 Oct 2019 10:40:23 +0100 Subject: [PATCH 24/43] Examples_Analogs --- tests/CST_Load_examples.R | 104 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 104 insertions(+) create mode 100644 tests/CST_Load_examples.R diff --git a/tests/CST_Load_examples.R b/tests/CST_Load_examples.R new file mode 100644 index 00000000..20c72e8d --- /dev/null +++ b/tests/CST_Load_examples.R @@ -0,0 +1,104 @@ +rm(list=ls()) +require(s2dverification) +require(CSTools) +require(multiApply) +#'@example1 +#configfile +configfile <- "/Library/Frameworks/R.framework/Versions/3.6/Resources/library/s2dverification/config/new2.conf" +ConfigFileCreate(configfile, confirm = FALSE) +c <- ConfigFileOpen(configfile) +c <- ConfigEditDefinition(c, 'DEFAULT_VAR_MIN', '-1e19', confirm = FALSE) +c <- ConfigEditDefinition(c, 'DEFAULT_VAR_MAX', '1e19', confirm = FALSE) +data_path <- "/Users/greenbird/Documents/ecmwf" +exp_data_path <- paste0(data_path, '/experimentA/') +obs_data_path <- paste0(data_path, '/observationA/') +c <- ConfigAddEntry(c, 'experiments', dataset_name = 'experimentA', + var_name = 'msl', main_path = exp_data_path, + file_path = '$STORE_FREQ$_mean/$VAR_NAME$_3hourly/$VAR_NAME$_$START_DATE$.nc') +c <- ConfigAddEntry(c, 'observations', dataset_name = 'observationA', + var_name = 'msl', main_path = obs_data_path, + file_path = '$STORE_FREQ$_mean/$VAR_NAME$/$VAR_NAME$_$START_DATE$.nc') +ConfigFileSave(c, configfile, confirm = FALSE) + +startDates <- c('20170501') +#Large scale +c(expL, obsL) %<-% ( + CST_Load('msl', c('experimentA'), c('observationA'), startDates, output = 'areave', + grid='r122x122',latmin = 30, latmax = 40, lonmin = -5, lonmax = 20, configfile = configfile)) +gridL <- length(expL$lon)*length(expL$lat) +exp <- expL$data[1:(5*gridL)] +obs <- obsL$data[1:(5*gridL)] +expL$data <- expL$data[1,1,1,1:(5*gridL)] +dim(expL$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expL$lat), lon = length(expL$lon)) +obsL$data <- obsL$data[1,1,1,1:(5*gridL)] +dim(obsL$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expL$lat), lon = length(expL$lon)) + +#local scale +c(expVar, obsVar) %<-% ( + CST_Load('msl', c('experimentA'), c('observationA'), startDates, output = 'areave', + grid='r122x122',latmin = 34, latmax = 38, lonmin = -2, lonmax = 2, configfile = configfile)) +gridVar <- length(expVar$lon)*length(expVar$lat) +exp <- expVar$data[1:(5*gridVar)] +obs <- obsVar$data[1:(5*gridVar)] +expVar$data <- expVar$data[1,1,1,1:(5*gridVar)] +dim(expVar$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expVar$lat), lon = length(expVar$lon)) +obsVar$data <- obsVar$data[1,1,1,1:(5*gridVar)] +dim(obsVar$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expVar$lat), lon = length(expVar$lon)) +#CST_Analogs +test <- CST_Analogs(expL,obsL,expVar,obsVar,criteria = "Large_dist") +# test <- CST_Analogs(expL,obsL,expVar,obsVar,criteria = "Large_dist") +# Error in names(dim(metric1)) <- `*vtmp*` : +# attempt to set an attribute on NULL +# In addition: Warning message: +# In Analogs(expL$data, obsL$data, time_obsL = timevector, expVar = expVar$data, : +# +# Error in names(dim(metric1)) <- `*vtmp*` : +# attempt to set an attribute on NULL + +#'@example2 +expL <- lonlat_data$exp +obsL <- lonlat_data$obs +dim(obsL$data) <- c(dataset = 1, member = 1, time = 18, lat = 22, lon = 53) +dim(expL$data) <- c(dataset = 1, member = 15, time = 18, lat = 22, lon = 53) +expVar=lonlat_prec +expVar$data=expVar$data*86400*1000 +obsVar=lonlat_prec +obsVar$data=obsVar$data*86400*1000*56 +dim(obsVar$data) <- c(dataset = 1, member = 31, time = 18, lat = 4, lon = 4) +dim(expVar$data) <- c(dataset = 1, member = 31, time = 18, lat = 4, lon = 4) +downscaled_largedist <- CST_Analogs(expL,obsL,expVar,obsVar,criteria="Large_dist") +#Error in `[.default`(time_obsL, best) : invalid subscript type 'list' +downscaled_localdis <- Analogs(expL,obsL,expVar,obsVar,criteria="Local_dist") +# Error in Analogs(expL, obsL, expVar, obsVar, criteria = "Local_dist") : +# Parameter 'expL' must have the dimensions 'lat' and 'lon'. +downscaled_localcor <- Analogs(expL,obsL,expVar,obsVar,criteria="Local_cor") +# Error in Analogs(expL, obsL, expVar, obsVar, criteria = "Local_cor") : +# Parameter 'expL' must have the dimensions 'lat' and 'lon'. + +#' @example3 +# Creating experimental data +exp <- 1 : (1 * 1 * 4 * 8 * 8)*16 +dim(exp) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, lat = 8, lon = 8) +lon <- seq(10, 13.5, 0.5) +dim(lon) <- c(lon = length(lon)) +lat <- seq(40, 43.5, 0.5) +dim(lat) <- c(lat = length(lat)) +Dates=list() +Dates$start=c("20170501") +Dates$end=c("20170505") +expL <- list(data = exp, lon = lon, lat = lat, Dates=Dates) +# Creating observations data +obs <- 1 : (1 * 1 * 4 * 8 * 8) *14 +dim(obs) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, lat = 8, lon = 8) +lon <- seq(10, 13.5, 0.5) +dim(lon) <- c(lon = length(lon)) +lat <- seq(40, 43.5, 0.5) +dim(lat) <- c(lat = length(lat)) +Dates=list() +Dates$start=c("20170501") +Dates$end=c("20170505") +obsL <- list(data = obs, lon = lon, lat = lat, Dates=Dates) +# Downscaling +downscaled_largedist <- CST_Analogs(expL=expL,obsL=obsL,expVar=expL,obsVar=obsL,criteria="Large_dist") +# Error in dim(newX) <- c(prod(d.call), d2) : +# dims [product 1] do not match the length of object [16] \ No newline at end of file -- GitLab From e1438f2bef4129238472a237495175d00f5f056a Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Mon, 28 Oct 2019 12:30:45 +0100 Subject: [PATCH 25/43] Update CST_Load_examples.R --- tests/CST_Load_examples.R | 82 ++++++++++++++++++++++++--------------- 1 file changed, 51 insertions(+), 31 deletions(-) diff --git a/tests/CST_Load_examples.R b/tests/CST_Load_examples.R index 20c72e8d..f194f9f5 100644 --- a/tests/CST_Load_examples.R +++ b/tests/CST_Load_examples.R @@ -1,56 +1,74 @@ -rm(list=ls()) -require(s2dverification) -require(CSTools) -require(multiApply) +#'@rdname examples CST_Analogs +#'@title examples of the Downscaling using Analogs based on large scale fields. +#' +#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +#'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} +#' +#'@description examples of CST_Analogs and Analogs +#'rm(list=ls()) +#'require(s2dverification) +#'require(CSTools) +#'require(multiApply) #'@example1 #configfile -configfile <- "/Library/Frameworks/R.framework/Versions/3.6/Resources/library/s2dverification/config/new2.conf" -ConfigFileCreate(configfile, confirm = FALSE) -c <- ConfigFileOpen(configfile) -c <- ConfigEditDefinition(c, 'DEFAULT_VAR_MIN', '-1e19', confirm = FALSE) -c <- ConfigEditDefinition(c, 'DEFAULT_VAR_MAX', '1e19', confirm = FALSE) -data_path <- "/Users/greenbird/Documents/ecmwf" -exp_data_path <- paste0(data_path, '/experimentA/') -obs_data_path <- paste0(data_path, '/observationA/') -c <- ConfigAddEntry(c, 'experiments', dataset_name = 'experimentA', - var_name = 'msl', main_path = exp_data_path, - file_path = '$STORE_FREQ$_mean/$VAR_NAME$_3hourly/$VAR_NAME$_$START_DATE$.nc') -c <- ConfigAddEntry(c, 'observations', dataset_name = 'observationA', - var_name = 'msl', main_path = obs_data_path, - file_path = '$STORE_FREQ$_mean/$VAR_NAME$/$VAR_NAME$_$START_DATE$.nc') -ConfigFileSave(c, configfile, confirm = FALSE) +# configfile <- "/Library/Frameworks/R.framework/Versions/3.6/Resources/ +#library/s2dverification/config/new2.conf" +# ConfigFileCreate(configfile, confirm = FALSE) +# c <- ConfigFileOpen(configfile) +# c <- ConfigEditDefinition(c, 'DEFAULT_VAR_MIN', '-1e19', confirm = FALSE) +# c <- ConfigEditDefinition(c, 'DEFAULT_VAR_MAX', '1e19', confirm = FALSE) +# data_path <- "/Users/greenbird/Documents/ecmwf" +# exp_data_path <- paste0(data_path, '/experimentA/') +# obs_data_path <- paste0(data_path, '/observationA/') +# c <- ConfigAddEntry(c, 'experiments', dataset_name = 'experimentA', +# var_name = 'msl', main_path = exp_data_path, +# file_path = '$STORE_FREQ$_mean/$VAR_NAME$_3hourly/ +# $VAR_NAME$_$START_DATE$.nc') +# c <- ConfigAddEntry(c, 'observations', dataset_name = 'observationA', +# var_name = 'msl', main_path = obs_data_path, +# file_path = '$STORE_FREQ$_mean/$VAR_NAME$/ +# $VAR_NAME$_$START_DATE$.nc') +# ConfigFileSave(c, configfile, confirm = FALSE) startDates <- c('20170501') #Large scale c(expL, obsL) %<-% ( - CST_Load('msl', c('experimentA'), c('observationA'), startDates, output = 'areave', - grid='r122x122',latmin = 30, latmax = 40, lonmin = -5, lonmax = 20, configfile = configfile)) + CST_Load('msl', c('experimentA'), c('observationA'), startDates, + output = 'areave',grid='r122x122',latmin = 30, latmax = 40, + lonmin = -5, lonmax = 20, configfile = configfile)) gridL <- length(expL$lon)*length(expL$lat) exp <- expL$data[1:(5*gridL)] obs <- obsL$data[1:(5*gridL)] expL$data <- expL$data[1,1,1,1:(5*gridL)] -dim(expL$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expL$lat), lon = length(expL$lon)) +dim(expL$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expL$lat), + lon = length(expL$lon)) obsL$data <- obsL$data[1,1,1,1:(5*gridL)] -dim(obsL$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expL$lat), lon = length(expL$lon)) +dim(obsL$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expL$lat), + lon = length(expL$lon)) #local scale c(expVar, obsVar) %<-% ( - CST_Load('msl', c('experimentA'), c('observationA'), startDates, output = 'areave', - grid='r122x122',latmin = 34, latmax = 38, lonmin = -2, lonmax = 2, configfile = configfile)) + CST_Load('msl', c('experimentA'), c('observationA'), startDates, + output = 'areave', + grid='r122x122',latmin = 34, latmax = 38, lonmin = -2, lonmax = 2, + configfile = configfile)) gridVar <- length(expVar$lon)*length(expVar$lat) exp <- expVar$data[1:(5*gridVar)] obs <- obsVar$data[1:(5*gridVar)] expVar$data <- expVar$data[1,1,1,1:(5*gridVar)] -dim(expVar$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expVar$lat), lon = length(expVar$lon)) +dim(expVar$data) <- c(dataset = 1, member = 1,time = 5, + lat = length(expVar$lat),lon = length(expVar$lon)) obsVar$data <- obsVar$data[1,1,1,1:(5*gridVar)] -dim(obsVar$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expVar$lat), lon = length(expVar$lon)) +dim(obsVar$data) <- c(dataset = 1, member = 1,time = 5, + lat = length(expVar$lat), lon = length(expVar$lon)) #CST_Analogs -test <- CST_Analogs(expL,obsL,expVar,obsVar,criteria = "Large_dist") +#test <- CST_Analogs(expL,obsL,expVar,obsVar,criteria = "Large_dist") # test <- CST_Analogs(expL,obsL,expVar,obsVar,criteria = "Large_dist") # Error in names(dim(metric1)) <- `*vtmp*` : # attempt to set an attribute on NULL # In addition: Warning message: -# In Analogs(expL$data, obsL$data, time_obsL = timevector, expVar = expVar$data, : +# In Analogs(expL$data, obsL$data, time_obsL = timevector, +expVar = expVar$data, : # # Error in names(dim(metric1)) <- `*vtmp*` : # attempt to set an attribute on NULL @@ -66,7 +84,8 @@ obsVar=lonlat_prec obsVar$data=obsVar$data*86400*1000*56 dim(obsVar$data) <- c(dataset = 1, member = 31, time = 18, lat = 4, lon = 4) dim(expVar$data) <- c(dataset = 1, member = 31, time = 18, lat = 4, lon = 4) -downscaled_largedist <- CST_Analogs(expL,obsL,expVar,obsVar,criteria="Large_dist") +downscaled_largedist <- CST_Analogs(expL,obsL,expVar,obsVar, + criteria="Large_dist") #Error in `[.default`(time_obsL, best) : invalid subscript type 'list' downscaled_localdis <- Analogs(expL,obsL,expVar,obsVar,criteria="Local_dist") # Error in Analogs(expL, obsL, expVar, obsVar, criteria = "Local_dist") : @@ -99,6 +118,7 @@ Dates$start=c("20170501") Dates$end=c("20170505") obsL <- list(data = obs, lon = lon, lat = lat, Dates=Dates) # Downscaling -downscaled_largedist <- CST_Analogs(expL=expL,obsL=obsL,expVar=expL,obsVar=obsL,criteria="Large_dist") +downscaled_largedist <- CST_Analogs(expL=expL,obsL=obsL,expVar=expL, + obsVar=obsL,criteria="Large_dist") # Error in dim(newX) <- c(prod(d.call), d2) : # dims [product 1] do not match the length of object [16] \ No newline at end of file -- GitLab From 5d0304c0b2f809432948dfffe8d3a8b8165d4132 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Mon, 28 Oct 2019 12:32:24 +0100 Subject: [PATCH 26/43] Update CST_Analogs_examples.R --- tests/{CST_Load_examples.R => CST_Analogs_examples.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename tests/{CST_Load_examples.R => CST_Analogs_examples.R} (100%) diff --git a/tests/CST_Load_examples.R b/tests/CST_Analogs_examples.R similarity index 100% rename from tests/CST_Load_examples.R rename to tests/CST_Analogs_examples.R -- GitLab From e2afa8ffdbaea4c8b702bfe926d62ab1b7b6e09d Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Mon, 28 Oct 2019 12:42:31 +0100 Subject: [PATCH 27/43] Updating documentation CST_Analogs.R --- R/CST_Analogs.R | 52 +++++++++++++++++++++++++++---------------------- 1 file changed, 29 insertions(+), 23 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 4c6c5e87..ff13d3d4 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -53,19 +53,16 @@ #'@param region region for the local scale #'@param nAnalogs number of Analogs to be selected to apply the criterias (this #'is not the necessary the number of analogs that the user can get) -#'@param return_list TRUE if you want to get a list with the best analogs FALSE -#'if not. -#'@param mAnalogs months for searching the analogs #'@import multiApply #'@import ClimProjDiags #'@import abind -#'@return list list with the best analogs (time, distance) -#'@return values values of a certain variable +#'@return Dowscaled values of the best analogs in the criteria selected #'@export CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { #checks timevector <- obsL$Dates$start - region <- c(min(expVar$lon), max(expVar$lon), min(expVar$lat), max(expVar$lon)) + region <- c(min(expVar$lon), max(expVar$lon), min(expVar$lat), + max(expVar$lon)) result <- Analogs(expL$data, obsL$data, time_obsL = timevector, expVar = expVar$data, obsVar = obsVar$data, criteria = criteria, @@ -153,26 +150,31 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, warning("Parameter 'obs' contains NA values.") } - position <- Select(expL = expL, obsL = obsL, expVar = expVar, obsVar = obsVar, - criteria = criteria, lon_local = lon_local, lat_local = lat_local, - region = region)$position - best <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, - criteria = criteria, return_list = return_list, nAnalogs = nAnalogs) + position <- Select(expL = expL, obsL = obsL, expVar = expVar, + obsVar = obsVar, criteria = criteria, lon_local = lon_local, + lat_local = lat_local,region = region)$position + best <- Apply(list(position), target_dims = c('time', 'pos'), + fun = BestAnalog, criteria = criteria, return_list = return_list, + nAnalogs = nAnalogs) Analogs_dates <- time_obsL[best] dim(Analogs_dates) <- dim(best) if (is.null(obsVar)) { obsLocal <- SelBox(obsL, lon = lon_local, lat = lat_local, region = region) - Analogs_fields <- Subset(obsLocal, along = which(names(dim(obsLocal)) == 'time'), indices = best) + Analogs_fields <- Subset(obsLocal, + along = which(names(dim(obsLocal)) == 'time'), indices = best) } else { obsVar <- SelBox(obsVar, lon = lon_local, lat = lat_local, region = region) - Analogs_fields <- Subset(obsVar, along = which(names(dim(obsVar)) == 'time'), indices = best) + Analogs_fields <- Subset(obsVar,along = which(names(dim(obsVar)) == 'time'), + indices = best) } lon_dim <- which(names(dim(Analogs_fields)) == 'lon') lat_dim <- which(names(dim(Analogs_fields)) == 'lat') if (lon_dim < lat_dim) { - dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lon_dim, lat_dim)], dim(best)) + dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lon_dim, lat_dim)], + dim(best)) } else if (lat_dim > lon_dim) { - dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lat_dim, lon_dim)], dim(best)) + dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lat_dim, lon_dim)], + dim(best)) } else { stop("Dimensions 'lat' and 'lon' not found.") } @@ -242,12 +244,13 @@ BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, return(pos) } } -Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", - lon_local = NULL, lat_local = NULL, region = NULL) { +Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, + criteria = "Large_dist", + lon_local = NULL, lat_local = NULL, region = NULL) { #check expL #check obsL #check obsVar - names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)), names(dim(obsL))) + names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)),names(dim(obsL))) metric1 <- Apply(list(obsL), target_dims = list(c('lat', 'lon')), fun = .select, expL, metric = "dist")$output1 dim_time_obs <- which(names(dim(metric1)) == 'time') @@ -280,8 +283,8 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ } } if (criteria == "Local_cor") { - obs <- SelBox(obsVar, lon = lon_local, lat = lat_local, region = region)$data - exp <- SelBox(expVar, lon = lon_local, lat = lat_local, region = region)$data + obs <- SelBox(obsVar, lon = lon_local, lat = lat_local,region = region)$data + exp <- SelBox(expVar, lon = lon_local, lat = lat_local,region = region)$data metric3 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), fun = .select, exp, metric = "cor")$output1 margins <- c(1 : length(dim(metric3)))[-dim_time_obs] @@ -308,11 +311,13 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ fun = function(x) {sum((x - exp) ^ 2)})$output1 } else if (metric == "cor") { result <- Apply(list(obs), target_dims = list(c('lat', 'lon')), - fun = function(x) {cor(as.vector(x), as.vector(exp))})$output1 + fun = function(x) { + cor(as.vector(x), as.vector(exp))})$output1 } result } -replace_repeat_dimnames <- function(names_exp, names_obs, lat_name = 'lat', lon_name = 'lon') { +replace_repeat_dimnames <- function(names_exp, names_obs, lat_name = 'lat', + lon_name = 'lon') { if (!is.character(names_exp)) { stop("Parameter 'names_exp' must be a vector of characters.") } @@ -323,7 +328,8 @@ replace_repeat_dimnames <- function(names_exp, names_obs, lat_name = 'lat', lon_ latlon_dim_obs <- which(names_obs == lat_name | names_obs == lon_name) if (any(unlist(lapply(names_exp[-latlon_dim_exp], function(x){x == names_obs[-latlon_dim_obs]})))) { - original_pos <- lapply(names_exp, function(x) which(x == names_obs[-latlon_dim_obs])) + original_pos <- lapply(names_exp, function(x) + which(x == names_obs[-latlon_dim_obs])) original_pos <- lapply(original_pos, length) > 0 names_exp[original_pos] <- paste0(names_exp[original_pos], "_exp") } -- GitLab From 53dff6bf59b1f4ec76c6e0cc0adf73c34ebd60a8 Mon Sep 17 00:00:00 2001 From: carmenalvarezcastro Date: Tue, 29 Oct 2019 16:40:08 +0100 Subject: [PATCH 28/43] updating warnings in Analogs function --- R/CST_Analogs.R | 303 +++++++++++++++++++++++++++++------------------- 1 file changed, 182 insertions(+), 121 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index ff13d3d4..39b758fb 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -119,10 +119,16 @@ CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { #'@param lon_local longitude in the local scale #'@param lat_local latitude in the local scale #'@param region region for the local scale +#'@param return_list TRUE if you want to get a list with the best analogs FALSE +#'#'if not. #'@param nAnalogs number of Analogs to be selected to apply the criterias (this -#'is not the necessary the number of analogs that the user can get) -#'@param return_list TRUE if you want to get a list with the best analogs FALSE -#'if not. +#'is not the necessary the number of analogs that the user can get, but the number +#'of events with minimal distance in which perform the search of the best Analog. +#' The default value for the Large_dist criteria is 1, the default value for +#' the Local_dist criteria is 10 and same for Local_cor. If return_list is +#' False you will get just the first one for downscaling purposes. If return_list +#' is True you will get the list of the best analogs that were searched in nAnalogs +#' under the selected criterias. #'@import multiApply #'@import ClimProjDiags #'@import abind @@ -131,160 +137,223 @@ CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { #'@export Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", - lon_local = NULL, lat_local = NULL, region = NULL, + lonVar = NULL, latVar = NULL, region = NULL, nAnalogs = 1, return_list = FALSE) { # checks - if (!all(c('lon', 'lat') %in% names(dim(expL)))) { - stop("Parameter 'expL' must have the dimensions 'lat' and 'lon'.") - } - - if (!all(c('lat', 'lon') %in% names(dim(obsL)))) { - stop("Parameter 'obsL' must have the dimension 'sdate'.") - } - - if (any(is.na(expL))) { - warning("Parameter 'exp' contains NA values.") - } - - if (any(is.na(obsL))) { - warning("Parameter 'obs' contains NA values.") - } + if (!all(c('lon', 'lat') %in% names(dim(expL)))) { + stop("Parameter 'expL' must have the dimensions 'lat' and 'lon'.") + } + + if (!all(c('lat', 'lon') %in% names(dim(obsL)))) { + stop("Parameter 'obsL' must have the dimension 'lat' and 'lon'.") + } + + if (any(is.na(expL))) { + warning("Parameter 'exp' contains NA values.") + } - position <- Select(expL = expL, obsL = obsL, expVar = expVar, - obsVar = obsVar, criteria = criteria, lon_local = lon_local, - lat_local = lat_local,region = region)$position - best <- Apply(list(position), target_dims = c('time', 'pos'), - fun = BestAnalog, criteria = criteria, return_list = return_list, - nAnalogs = nAnalogs) + if (any(is.na(obsL))) { + warning("Parameter 'obs' contains NA values.") + } + if (is.null(expVar) & !is.null(obsVar)) { + obsVar <- NULL + warning("Parameter 'obsVar' is set to NULL as parameter 'expVar'.") + } + if (!is.null(expVar) & is.null(obsVar)) { + expVar <- NULL + warning("Parameter 'expVar' is set to NULL as parameter 'obsVar'.") + } + if (any(names(dim(obsL)) %in% 'ftime')) { + if (any(names(dim(obsL)) %in% 'time')) { + stop("Multiple temporal dimensions ('ftime' and 'time') found", + "in parameter 'obsL'.") + } else { + time_pos_obsL <- which(names(dim(obsL)) == 'ftime') + names(dim(obsL))[time_pos_obsL] <- 'time' + if (any(names(dim(expL)) %in% 'ftime')) { + time_pos_expL <- which(names(dim(expL)) == 'ftime') + names(dim(expL))[time_pos_expL] <- 'time' + } + } + } + if (any(names(dim(obsL)) %in% 'sdate')) { + if (any(names(dim(obsL)) %in% 'time')) { + dims_obsL <- dim(obsL) + pos_sdate <- which(names(dim(obsL)) == 'sdate') + pos_time <- which(names(dim(obsL)) == 'time') + pos <- 1 : length(dim(obsL)) + pos <- c(pos_time, pos_sdate, pos[-c(pos_sdate,pos_time)]) + obsL <- aperm(obsL, pos) + dim(obsL) <- c(time = prod(dims_obsL[c(pos_time, pos_sdate)]), + dims_obsL[-c(pos_time, pos_sdate)]) + } else { + stop("Parameter 'obsL' must have a temporal dimension.") + } + } + if (is.null(region)) { + if (!is.null(lonVar) & !is.null(latVar)) { + region <- c(min(lonVar), max(lonVar), min(latVar), max(latVar)) + } + } + + position <- Select(expL = expL, obsL = obsL, expVar = expVar, obsVar = obsVar, + criteria = criteria, lonVar = lonVar, latVar = latVar, + region = region)$position + best <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, + criteria = criteria, + return_list = return_list, nAnalogs = nAnalogs)$output1 Analogs_dates <- time_obsL[best] dim(Analogs_dates) <- dim(best) - if (is.null(obsVar)) { - obsLocal <- SelBox(obsL, lon = lon_local, lat = lat_local, region = region) - Analogs_fields <- Subset(obsLocal, - along = which(names(dim(obsLocal)) == 'time'), indices = best) + if (all(!is.null(region), !is.null(lonVar), !is.null(latVar))) { + if (is.null(obsVar)) { + obsLocal <- SelBox(obsL, lon = lonVar, lat = latVar, region = region) + Analogs_fields <- Subset(obsL, along = which(names(dim(obsLocal)) == 'time'), + indices = best) + + } else { + obsVar <- SelBox(obsL, lon = lonVar, lat = latVar, region = region) + Analogs_fields <- Subset(obsVar, along = which(names(dim(obsVar)) == 'time'), + indices = best) + } } else { - obsVar <- SelBox(obsVar, lon = lon_local, lat = lat_local, region = region) - Analogs_fields <- Subset(obsVar,along = which(names(dim(obsVar)) == 'time'), - indices = best) + warning("One or more of the parameter 'region', 'lonVar' and 'latVar'", + " are NULL and the large scale field will be returned.") + if (is.null(obsVar)) { + Analogs_fields <- Subset(obsL, along = which(names(dim(obsL)) == 'time'), + indices = best) + } else { + Analogs_fields <- Subset(obsVar, + along = which(names(dim(obsVar)) == 'time'), + indices = best) + } } + lon_dim <- which(names(dim(Analogs_fields)) == 'lon') lat_dim <- which(names(dim(Analogs_fields)) == 'lat') if (lon_dim < lat_dim) { - dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lon_dim, lat_dim)], - dim(best)) - } else if (lat_dim > lon_dim) { - dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lat_dim, lon_dim)], - dim(best)) + dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lon_dim, lat_dim)], dim(best)) + } else if (lon_dim > lat_dim) { + dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lat_dim, lon_dim)], dim(best)) } else { - stop("Dimensions 'lat' and 'lon' not found.") + stop("Dimensions 'lat' and 'lon' not found.") } return(list(DatesAnalogs = Analogs_dates, AnalogsFields = Analogs_fields)) } BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, - nAnalogs = 1) { - pos_dim <- which(names(dim(position)) == 'pos') - if (dim(position)[pos_dim] == 1) { - pos1 <- position - if (criteria != 'Large_dist') { - warning("Dimension 'pos' in parameter 'position' has length 1,", - " criteria 'Large_dist' will be used.") - criteria <- 'Large_dist' - } - } else if (dim(position)[pos_dim] == 2) { - pos1 <- Subset(position, along = pos_dim, indices = 1) - pos2 <- Subset(position, along = pos_dim, indices = 2) - if (criteria == 'Local_cor') { - warning("Dimension 'pos' in parameter 'position' has length 2,", - " criteria 'Local_dist' will be used.") - criteria <- 'Local_dist' - } - } else if (dim(position)[pos_dim] == 3) { - pos1 <- Subset(position, along = pos_dim, indices = 1) - pos2 <- Subset(position, along = pos_dim, indices = 2) - pos3 <- Subset(position, along = pos_dim, indices = 3) - if (criteria != 'Local_cor') { - warning("Parameter 'criteria' is set to", criteria, ".") - } + nAnalogs = 10) { + pos_dim <- which(names(dim(position)) == 'pos') + if (dim(position)[pos_dim] == 1) { + pos1 <- position + if (criteria != 'Large_dist') { + warning("Dimension 'pos' in parameter 'position' has length 1,", + " criteria 'Large_dist' will be used.") + criteria <- 'Large_dist' + } + } else if (dim(position)[pos_dim] == 2) { + pos1 <- Subset(position, along = pos_dim, indices = 1) + pos2 <- Subset(position, along = pos_dim, indices = 2) + if (criteria == 'Local_cor') { + warning("Dimension 'pos' in parameter 'position' has length 2,", + " criteria 'Local_dist' will be used.") + criteria <- 'Local_dist' + } + } else if (dim(position)[pos_dim] == 3) { + pos1 <- Subset(position, along = pos_dim, indices = 1) + pos2 <- Subset(position, along = pos_dim, indices = 2) + pos3 <- Subset(position, along = pos_dim, indices = 3) + if (criteria != 'Local_cor') { + warning("Parameter 'criteria' is set to", criteria, ".") + } + } else { + stop("Parameter 'position' has dimension 'pos' of different ", + "length than expected (from 1 to 3).") + } + if (criteria == 'Large_dist') { + if (return_list == FALSE) { + pos <- pos1[1] } else { - stop("Parameter 'position' has dimension 'pos' of different ", - "length than expected (from 1 to 3).") + pos <- pos1[1 : nAnalogs] } - if (criteria == 'Large_dist') { - if (return_list == FALSE) { - pos <- pos1[1] - } else { - pos <- pos1[1 : nAnalogs] - } } else if (criteria== 'Local_dist') { - # pos1 <- c(7, 13, 5, 3, 6, 12, 10, 1, 8, 9, 11, 4, 2, 14) - # pos2 <- c(4, 8, 13, 6, 3, 1, 12, 5, 9, 7, 10, 2, 11, 14) pos1 <- pos1[1 : nAnalogs] pos2 <- pos2[1 : nAnalogs] best <- match(pos1, pos2) + if(length(best)==1){ + warning("Just 1 best analog matching Large_dist and ", + "Local_dist criteria") + } + if(length(best)==1 & is.na(best[1])==TRUE){ + stop("no best analogs matching Large_dist and Local_dist criterias") + } pos <- pos1[as.logical(best)] pos <- pos[which(!is.na(pos))] - if (return_list == FALSE) { - pos <- pos[1] - } + if (return_list == FALSE) { + pos <- pos[1] + } } else if (criteria == 'Local_cor') { pos1 <- pos1[1 : nAnalogs] pos2 <- pos2[1 : nAnalogs] best <- match(pos1, pos2) pos <- pos1[as.logical(best)] pos <- pos[which(!is.na(pos))] - # pos3 <- c(6, 11, 14, 3, 13, 7, 2, 5, 1, 12, 10, 9, 8, 4) pos3 <- pos3[1 : nAnalogs] best <- match(pos, pos3) pos <- pos[order(best, decreasing = F)] pos <- pos[which(!is.na(pos))] - if (return_list == FALSE) { - pos[1] - } - return(pos) + if (return_list == FALSE) { + pos[1] + } + return(pos) } } -Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, - criteria = "Large_dist", - lon_local = NULL, lat_local = NULL, region = NULL) { - #check expL - #check obsL - #check obsVar - names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)),names(dim(obsL))) +Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", + lonVar = NULL, latVar = NULL, region = NULL) { + names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)), names(dim(obsL))) metric1 <- Apply(list(obsL), target_dims = list(c('lat', 'lon')), fun = .select, expL, metric = "dist")$output1 - dim_time_obs <- which(names(dim(metric1)) == 'time') - margins <- c(1 : length(dim(metric1)))[-dim_time_obs] - pos1 <- apply(metric1, margins, order) - names(dim(pos1))[1] <- 'time' - metric1 <- apply(metric1, margins, sort) - names(dim(metric1))[1] <- 'time' + if (length(dim(metric1)) > 1) { + dim_time_obs <- which(names(dim(metric1)) == 'time' | + names(dim(metric1)) == 'ftime') + margins <- c(1 : length(dim(metric1)))[-dim_time_obs] + pos1 <- apply(metric1, margins, order) + names(dim(pos1))[1] <- 'time' + metric1 <- apply(metric1, margins, sort) + names(dim(metric1))[1] <- 'time' + } else { + pos1 <- order(metric1) + dim(pos1) <- c(time = length(pos1)) + metric1 <- sort(metric1) + dim(metric1) <- c(time = length(metric1)) + } if (criteria == "Large_dist") { - dim(metric1) <- c(dim(metric1), metric = 1) - dim(pos1) <- c(dim(pos1), pos = 1) - return(list(metric = metric1, position = pos1)) + dim(metric1) <- c(dim(metric1), metric = 1) + dim(pos1) <- c(dim(pos1), pos = 1) + return(list(metric = metric1, position = pos1)) } if (criteria == "Local_dist" | criteria == "Local_cor") { - obs <- SelBox(obsL, lon = lon_local, lat = lat_local, region = region)$data - exp <- SelBox(expL, lon = lon_local, lat = lat_local, region = region)$data + obs <- SelBox(obsL, lon = lonVar, lat = latVar, region = region)$data + exp <- SelBox(expL, lon = lonVar, lat = latVar, region = region)$data metric2 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), fun = .select, exp, metric = "dist")$output1 - margins <- c(1 : length(dim(metric2)))[-dim_time_obs] + dim(metric2) <- c(dim(metric2), metric=1) + margins <- c(1 : (length(dim(metric2))))[-dim_time_obs] pos2 <- apply(metric2, margins, order) + dim(pos2) <- dim(pos1) names(dim(pos2))[1] <- 'time' metric2 <- apply(metric2, margins, sort) names(dim(metric2))[1] <- 'time' if (criteria == "Local_dist") { - metric <- abind(metric1, metric2, along = length(dim(metric1)) + 1) - position <- abind(pos1, pos2, along = length(dim(pos1)) + 1) - names(dim(metric)) <- c(names(dim(metric1)), 'metric') + metric <- abind(metric1, metric2, along = length(dim(metric1))+1) + position <- abind(pos1, pos2, along = length(dim(pos1))+1) + names(dim(metric)) <- c(names(dim(pos1)), 'metric') names(dim(position)) <- c(names(dim(pos1)), 'pos') return(list(metric = metric, position = position)) } } if (criteria == "Local_cor") { - obs <- SelBox(obsVar, lon = lon_local, lat = lat_local,region = region)$data - exp <- SelBox(expVar, lon = lon_local, lat = lat_local,region = region)$data + obs <- SelBox(obsVar, lon = lonVar, lat = latVar, region = region)$data + exp <- SelBox(expVar, lon = lonVar, lat = latVar, region = region)$data metric3 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), fun = .select, exp, metric = "cor")$output1 margins <- c(1 : length(dim(metric3)))[-dim_time_obs] @@ -305,38 +374,30 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, } .select <- function(exp, obs, metric = "dist") { if (metric == "dist") { - #metric <- sum((obs - exp) ^ 2) - #metric <- apply(obs, "time", function(x) {sum((x - exp) ^ 2)}) result <- Apply(list(obs), target_dims = list(c('lat', 'lon')), fun = function(x) {sum((x - exp) ^ 2)})$output1 } else if (metric == "cor") { result <- Apply(list(obs), target_dims = list(c('lat', 'lon')), - fun = function(x) { - cor(as.vector(x), as.vector(exp))})$output1 + fun = function(x) {cor(as.vector(x), as.vector(exp))})$output1 } result } replace_repeat_dimnames <- function(names_exp, names_obs, lat_name = 'lat', - lon_name = 'lon') { + lon_name = 'lon') { if (!is.character(names_exp)) { - stop("Parameter 'names_exp' must be a vector of characters.") + stop("Parameter 'names_exp' must be a vector of characters.") } if (!is.character(names_obs)) { - stop("Parameter 'names_obs' must be a vector of characters.") + stop("Parameter 'names_obs' must be a vector of characters.") } latlon_dim_exp <- which(names_exp == lat_name | names_exp == lon_name) latlon_dim_obs <- which(names_obs == lat_name | names_obs == lon_name) if (any(unlist(lapply(names_exp[-latlon_dim_exp], - function(x){x == names_obs[-latlon_dim_obs]})))) { - original_pos <- lapply(names_exp, function(x) - which(x == names_obs[-latlon_dim_obs])) + function(x){x == names_obs[-latlon_dim_obs]})))) { + original_pos <- lapply(names_exp, function(x) which(x == names_obs[-latlon_dim_obs])) original_pos <- lapply(original_pos, length) > 0 - names_exp[original_pos] <- paste0(names_exp[original_pos], "_exp") + names_exp[original_pos] <- paste0(names_exp[original_pos], "_exp") } return(names_exp) -## Improvements: other dimensions to avoid replacement for more flexibility. -} - - - - + ## Improvements: other dimensions to avoid replacement for more flexibility. +} \ No newline at end of file -- GitLab From 5d04549df1f8170f73d8dad11c9661df7d12c501 Mon Sep 17 00:00:00 2001 From: carmenalvarezcastro Date: Tue, 29 Oct 2019 17:29:06 +0100 Subject: [PATCH 29/43] updating warnings in Analogs function --- R/CST_Analogs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 39b758fb..fc6a6764 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -207,7 +207,7 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, if (all(!is.null(region), !is.null(lonVar), !is.null(latVar))) { if (is.null(obsVar)) { obsLocal <- SelBox(obsL, lon = lonVar, lat = latVar, region = region) - Analogs_fields <- Subset(obsL, along = which(names(dim(obsLocal)) == 'time'), + Analogs_fields <- Subset(obsLocal, along = which(names(dim(obsLocal)) == 'time'), indices = best) } else { -- GitLab From 6b08f8a9dd5407fd15274db73048cae235a37ade Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 29 Oct 2019 18:59:56 +0100 Subject: [PATCH 30/43] Delete CST_Analogs_examples.R --- tests/CST_Analogs_examples.R | 124 ----------------------------------- 1 file changed, 124 deletions(-) delete mode 100644 tests/CST_Analogs_examples.R diff --git a/tests/CST_Analogs_examples.R b/tests/CST_Analogs_examples.R deleted file mode 100644 index f194f9f5..00000000 --- a/tests/CST_Analogs_examples.R +++ /dev/null @@ -1,124 +0,0 @@ -#'@rdname examples CST_Analogs -#'@title examples of the Downscaling using Analogs based on large scale fields. -#' -#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -#'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} -#' -#'@description examples of CST_Analogs and Analogs -#'rm(list=ls()) -#'require(s2dverification) -#'require(CSTools) -#'require(multiApply) -#'@example1 -#configfile -# configfile <- "/Library/Frameworks/R.framework/Versions/3.6/Resources/ -#library/s2dverification/config/new2.conf" -# ConfigFileCreate(configfile, confirm = FALSE) -# c <- ConfigFileOpen(configfile) -# c <- ConfigEditDefinition(c, 'DEFAULT_VAR_MIN', '-1e19', confirm = FALSE) -# c <- ConfigEditDefinition(c, 'DEFAULT_VAR_MAX', '1e19', confirm = FALSE) -# data_path <- "/Users/greenbird/Documents/ecmwf" -# exp_data_path <- paste0(data_path, '/experimentA/') -# obs_data_path <- paste0(data_path, '/observationA/') -# c <- ConfigAddEntry(c, 'experiments', dataset_name = 'experimentA', -# var_name = 'msl', main_path = exp_data_path, -# file_path = '$STORE_FREQ$_mean/$VAR_NAME$_3hourly/ -# $VAR_NAME$_$START_DATE$.nc') -# c <- ConfigAddEntry(c, 'observations', dataset_name = 'observationA', -# var_name = 'msl', main_path = obs_data_path, -# file_path = '$STORE_FREQ$_mean/$VAR_NAME$/ -# $VAR_NAME$_$START_DATE$.nc') -# ConfigFileSave(c, configfile, confirm = FALSE) - -startDates <- c('20170501') -#Large scale -c(expL, obsL) %<-% ( - CST_Load('msl', c('experimentA'), c('observationA'), startDates, - output = 'areave',grid='r122x122',latmin = 30, latmax = 40, - lonmin = -5, lonmax = 20, configfile = configfile)) -gridL <- length(expL$lon)*length(expL$lat) -exp <- expL$data[1:(5*gridL)] -obs <- obsL$data[1:(5*gridL)] -expL$data <- expL$data[1,1,1,1:(5*gridL)] -dim(expL$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expL$lat), - lon = length(expL$lon)) -obsL$data <- obsL$data[1,1,1,1:(5*gridL)] -dim(obsL$data) <- c(dataset = 1, member = 1,time = 5, lat = length(expL$lat), - lon = length(expL$lon)) - -#local scale -c(expVar, obsVar) %<-% ( - CST_Load('msl', c('experimentA'), c('observationA'), startDates, - output = 'areave', - grid='r122x122',latmin = 34, latmax = 38, lonmin = -2, lonmax = 2, - configfile = configfile)) -gridVar <- length(expVar$lon)*length(expVar$lat) -exp <- expVar$data[1:(5*gridVar)] -obs <- obsVar$data[1:(5*gridVar)] -expVar$data <- expVar$data[1,1,1,1:(5*gridVar)] -dim(expVar$data) <- c(dataset = 1, member = 1,time = 5, - lat = length(expVar$lat),lon = length(expVar$lon)) -obsVar$data <- obsVar$data[1,1,1,1:(5*gridVar)] -dim(obsVar$data) <- c(dataset = 1, member = 1,time = 5, - lat = length(expVar$lat), lon = length(expVar$lon)) -#CST_Analogs -#test <- CST_Analogs(expL,obsL,expVar,obsVar,criteria = "Large_dist") -# test <- CST_Analogs(expL,obsL,expVar,obsVar,criteria = "Large_dist") -# Error in names(dim(metric1)) <- `*vtmp*` : -# attempt to set an attribute on NULL -# In addition: Warning message: -# In Analogs(expL$data, obsL$data, time_obsL = timevector, -expVar = expVar$data, : -# -# Error in names(dim(metric1)) <- `*vtmp*` : -# attempt to set an attribute on NULL - -#'@example2 -expL <- lonlat_data$exp -obsL <- lonlat_data$obs -dim(obsL$data) <- c(dataset = 1, member = 1, time = 18, lat = 22, lon = 53) -dim(expL$data) <- c(dataset = 1, member = 15, time = 18, lat = 22, lon = 53) -expVar=lonlat_prec -expVar$data=expVar$data*86400*1000 -obsVar=lonlat_prec -obsVar$data=obsVar$data*86400*1000*56 -dim(obsVar$data) <- c(dataset = 1, member = 31, time = 18, lat = 4, lon = 4) -dim(expVar$data) <- c(dataset = 1, member = 31, time = 18, lat = 4, lon = 4) -downscaled_largedist <- CST_Analogs(expL,obsL,expVar,obsVar, - criteria="Large_dist") -#Error in `[.default`(time_obsL, best) : invalid subscript type 'list' -downscaled_localdis <- Analogs(expL,obsL,expVar,obsVar,criteria="Local_dist") -# Error in Analogs(expL, obsL, expVar, obsVar, criteria = "Local_dist") : -# Parameter 'expL' must have the dimensions 'lat' and 'lon'. -downscaled_localcor <- Analogs(expL,obsL,expVar,obsVar,criteria="Local_cor") -# Error in Analogs(expL, obsL, expVar, obsVar, criteria = "Local_cor") : -# Parameter 'expL' must have the dimensions 'lat' and 'lon'. - -#' @example3 -# Creating experimental data -exp <- 1 : (1 * 1 * 4 * 8 * 8)*16 -dim(exp) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, lat = 8, lon = 8) -lon <- seq(10, 13.5, 0.5) -dim(lon) <- c(lon = length(lon)) -lat <- seq(40, 43.5, 0.5) -dim(lat) <- c(lat = length(lat)) -Dates=list() -Dates$start=c("20170501") -Dates$end=c("20170505") -expL <- list(data = exp, lon = lon, lat = lat, Dates=Dates) -# Creating observations data -obs <- 1 : (1 * 1 * 4 * 8 * 8) *14 -dim(obs) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, lat = 8, lon = 8) -lon <- seq(10, 13.5, 0.5) -dim(lon) <- c(lon = length(lon)) -lat <- seq(40, 43.5, 0.5) -dim(lat) <- c(lat = length(lat)) -Dates=list() -Dates$start=c("20170501") -Dates$end=c("20170505") -obsL <- list(data = obs, lon = lon, lat = lat, Dates=Dates) -# Downscaling -downscaled_largedist <- CST_Analogs(expL=expL,obsL=obsL,expVar=expL, - obsVar=obsL,criteria="Large_dist") -# Error in dim(newX) <- c(prod(d.call), d2) : -# dims [product 1] do not match the length of object [16] \ No newline at end of file -- GitLab From bea5c6438c753ed08340ae317bd168d1a33a9539 Mon Sep 17 00:00:00 2001 From: carmenalvarezcastro Date: Tue, 29 Oct 2019 19:07:51 +0100 Subject: [PATCH 31/43] updating documentation --- R/CST_Analogs.R | 199 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 135 insertions(+), 64 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index fc6a6764..cf622652 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -11,7 +11,7 @@ #'The large scale is usually given by atmospheric circulation as sea level #'pressure or geopotential height (Yiou et al, 2013) but the function gives the #' possibility to use another field. The local scale will be usually given by -#' precipitation or Temperature, but might be another variable. +#' precipitation or temperature fields, but might be another variable. #' The analogs function will find the best analogs based in three criterias: #' (1) Minimal distance in the large scale pattern (i.e. SLP) #' (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal @@ -23,9 +23,9 @@ #' important since it is necessary to have a good representation of the #' possible states of the field in the past, and therefore, to get better #' analogs. Once the search of the analogs is complete, and in order to used the -#' three criterias the user can select a number of analogs nAnalogs to restrict +#' three criterias the user can select a number of analogsi, using parameter 'nAnalogs' to restrict #' the selection of the best analogs in a short number of posibilities, the best -#' ones. By default this parameter will be 1. +#' ones. #' This function has not constrains of specific regions, variables to downscale, #' or data to be used (seasonal forecast data, climate projections data, #' reanalyses data). @@ -33,92 +33,139 @@ #' Then, this interpolation is corrected selecting the analogs in the large #' and local scale in based of the observations. #' The function is an adapted version of the method of Yiou et al 2013. +#' #'@references Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, #' and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column #' from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. #' \email{pascal.yiou@lsce.ipsl.fr} -#'@param criteria different criteria to be used for the selection of analogs -#'if criteria = "Large_dist" -#'if criteria ="Local_dist" -#'if criteria ="Local_cor" -#'@param expL variable for the Large scale in the model (same variable -#'might be used in the local scale for criteria 2) -#'@param obsL variable for the large scale in the observations -#'@param expVar variable for the local scale in the model usually different -#'to the variable in expL -#'@param obsVar variable for the local scale in the observations usually -#'different to the variable in obsL -#'@param lon_local longitude in the local scale -#'@param lat_local latitude in the local scale -#'@param region region for the local scale -#'@param nAnalogs number of Analogs to be selected to apply the criterias (this -#'is not the necessary the number of analogs that the user can get) +#' +#'@param expL an 's2dv_cube' object containing the experimental field on the large scale for which the analog is aimed. This field is used to in all the criterias. If parameter 'expVar' is not provided, the function will return the expL analog. The element 'data' in the 's2dv_cube' object must have, at least, latitudinal and longitudinal dimensions. The object is expect to be already subset for the desired large scale region. +#'@param obsL an 's2dv_cube' object containing the observational field on the large scale. The element 'data' in the 's2dv_cube' object must have the same latitudinal and longitudinal dimensions as parameter 'expL' and a temporal dimension with the maximum number of available observations. +#'@param expVar an 's2dv_cube' object containing the experimental field on the local scale, usually a different variable to the parameter 'expL'. If it is not NULL (by default, NULL), the returned field by this function will be the analog of parameter 'expVar'. +#'@param obsVar an 's2dv_cube' containing the field of the same variable as the passed in parameter 'expVar' for the same region. +#'@param region a vector of length four indicating the minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude. +#'@param criteria a character string indicating the criteria to be used for the selection of analogs: +#'\itemize{ +#'\item{Large_dist} minimal distance in the large scale pattern; +#'\item{Local_dist} minimal distance in the large scale pattern and minimal +#' distance in the local scale pattern; and +#'\item{Local_cor} minimal distance in the large scale pattern, minimal +#' distance in the local scale pattern and maxima correlation in the +#' local variable to downscale.} +#' #'@import multiApply #'@import ClimProjDiags #'@import abind -#'@return Dowscaled values of the best analogs in the criteria selected -#'@export -CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { - #checks +#' +#'@seealso code{\link{CST_Load}}, \code{\link[s2dverification]{Load}} and \code{\link[s2dverification]{CDORemap}} +#' +#'@return An 's2dv_cube' object containing the dowscaled values of the best analogs in the criteria selected. +#'@examples +#'res <- CST_Analogs(expL = lonlat_data$exp, obsL = lonlat_data$obs) +CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, + region = NULL, criteria = "Large_dist") { + if (!inherits(expL, 's2dv_cube') || !inherits(obsL, 's2dv_cube')) { + stop("Parameter 'expL' and 'obsL' must be of the class 's2dv_cube', ", + "as output by CSTools::CST_Load.") + } + if (!is.null(expVar) || !is.null(obsVar)) { + if (!inherits(expVar, 's2dv_cube') || !inherits(obsVar, 's2dv_cube')) { + stop("Parameter 'expVar' and 'obsVar' must be of the class 's2dv_cube', ", + "as output by CSTools::CST_Load.") + } + } timevector <- obsL$Dates$start - region <- c(min(expVar$lon), max(expVar$lon), min(expVar$lat), - max(expVar$lon)) + if (!is.null(expVar)) { + region <- c(min(expVar$lon), max(expVar$lon), min(expVar$lat), max(expVar$lon)) + lonVar <- expVar$lon + latVar <- expVar$lat + } else { + region <- c(min(expL$lon), max(expL$lon), min(expL$lat), max(expL$lon)) + lonVar <- expL$lon + latVar <- expL$lat + } result <- Analogs(expL$data, obsL$data, time_obsL = timevector, expVar = expVar$data, obsVar = obsVar$data, criteria = criteria, - lon_local = expVar$lon, lat_local = expVar$lat, - region = region, nAnalogs = 1, return_list = FALSE) - obsVar$data <- result$AnalogsFields - result(obsVar) + lonVar = expVar$lon, latVar = expVar$lat, + region = region, nAnalogs = 1, return_list = FALSE) + if (!is.null(obsVar)) { + obsVar$data <- result$AnalogsFields + return(obsVar) + } else { + obsL$data <- result$AnalogsFields + return(obsL) + } } - #'@rdname Analogs - #'@title Search for analogs based on large scale fields. - #' - #'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} - #'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} - #' -#'@description This function search for days with similar large scale -#'conditions or similar large and local scale conditions. -#' +#'@rdname Analogs +#'@title Search for analogs based on large scale fields. +#' +#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +#'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} +#' +#'@description This function perform a downscaling using Analogs. To compute +#'the analogs, the function search for days with similar large scale conditions +#'to downscaled fields in the local scale. #'The large scale and the local scale regions are defined by the user. #'The large scale is usually given by atmospheric circulation as sea level #'pressure or geopotential height (Yiou et al, 2013) but the function gives the -#' possibility to use another field. For the local scale the user can select -#' any variable. +#' possibility to use another field. The local scale will be usually given by +#' precipitation or temperature fields, but might be another variable. #' The analogs function will find the best analogs based in three criterias: #' (1) Minimal distance in the large scale pattern (i.e. SLP) #' (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal #' distance in the local scale pattern (i.e. SLP). #' (3) Minimal distance in the large scale pattern (i.e. SLP), minimal #' distance in the local scale pattern (i.e. SLP) and maxima correlation in the -#' local variable to find the analog (i.e Precipitation). -#' Once the search of the analogs is complete, and in order to used the -#' three criterias the user can select a number of analogs nAnalogs to restrict +#' local variable to downscale (i.e Precipitation). +#' The search of analogs must be done in the longest dataset posible. This is +#' important since it is necessary to have a good representation of the +#' possible states of the field in the past, and therefore, to get better +#' analogs. Once the search of the analogs is complete, and in order to used the +#' three criterias the user can select a number of analogsi, using parameter +#' 'nAnalogs' to restrict #' the selection of the best analogs in a short number of posibilities, the best -#' ones. By default this parameter will be 1. -#' This function has not constrains of specific regions, variables to find the -#' analogs, or data to be used (seasonal forecast data, climate projections -#' data, reanalyses data). -#' The input data might be interpolated or not. +#' ones. +#' This function has not constrains of specific regions, variables to downscale, +#' or data to be used (seasonal forecast data, climate projections data, +#' reanalyses data). +#' The regrid into a finner scale is done interpolating with CST_Load. +#' Then, this interpolation is corrected selecting the analogs in the large +#' and local scale in based of the observations. #' The function is an adapted version of the method of Yiou et al 2013. +#' #'@references Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, #' and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column #' from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. #' \email{pascal.yiou@lsce.ipsl.fr} -#'@param criteria different criteria to be used for the selection of analogs -#'if criteria = "Large_dist" -#'if criteria ="Local_dist" -#'if criteria ="Local_cor" -#'@param expL variable for the Large scale in the model (same variable -#'might be used in the local scale for criteria 2) -#'@param obsL variable for the large scale in the observations -#'@param expVar variable for the local scale in the model usually different -#'to the variable in expL -#'@param obsVar variable for the local scale in the observations usually -#'different to the variable in obsL -#'@param lon_local longitude in the local scale -#'@param lat_local latitude in the local scale -#'@param region region for the local scale +#' +#'@param expL an array of N named dimensions containing the experimental field +#' on the large scale for which the analog is aimed. This field is used to in +#' all the criterias. If parameter 'expVar' is not provided, the function will +#' return the expL analog. The element 'data' in the 's2dv_cube' object must +#' have, at least, latitudinal and longitudinal dimensions. The object is +#' expect to be already subset for the desired large scale region. +#'@param obsL an array of N named dimensions containing the observational field +#'on the large scale. The element 'data' in the 's2dv_cube' object must have +#'the same latitudinal and longitudinal dimensions as parameter 'expL' and a +#' temporal dimension with the maximum number of available observations. +#'@param expVar an array of N named dimensions containing the experimental +#'field on the local scale, usually a different variable to the parameter +#''expL'. If it is not NULL (by default, NULL), the returned field by this +#'function will be the analog of parameter 'expVar'. +#'@param obsVar an array of N named dimensions containing the field of the same variable as the passed in parameter 'expVar' for the same region. +#'@param criteria a character string indicating the criteria to be used for the selection of analogs: +#'\itemize{ +#'\item{Large_dist} minimal distance in the large scale pattern; +#'\item{Local_dist} minimal distance in the large scale pattern and minimal +#' distance in the local scale pattern; and +#'\item{Local_cor} minimal distance in the large scale pattern, minimal +#' distance in the local scale pattern and maxima correlation in the +#' local variable to downscale.} +#'@param lonVar a vector containing the longitude of parameter 'expVar'. +#'@param latVar a vector containing the latitude of parameter 'expVar'. +#'@param region a vector of length four indicating the minimum longitude, +#'the maximum longitude, the minimum latitude and the maximum latitude. #'@param return_list TRUE if you want to get a list with the best analogs FALSE #'#'if not. #'@param nAnalogs number of Analogs to be selected to apply the criterias (this @@ -132,8 +179,32 @@ CST_Analogs <- function(expL, obsL, expVar, obsVar, criteria = 'Large_dist') { #'@import multiApply #'@import ClimProjDiags #'@import abind -#'@return list list with the best analogs (time, distance) -#'@return values values of a certain variable +#'@return list list with the best analogs (time, distance) +#'@return values dowscaled values of the best analogs for the criteria selected. +#'@examples +#'# Example 1: +#'expL <- 1:20 +#'dim(expL) <- c(lat = 4, lon = 5) +#'obsL <- 1:120 +#'dim(obsL) <- c(lat = 4, lon = 5, time = 6) +#'time_obsL <- paste(rep("01", 6), rep("01", 6), 1998 : 2003, sep = "-") +#'Analogs(expL, obsL, time_obsL) +#'# Example 2: +#'expL <- 1 : (1 * 1 * 4 * 8 * 8)* 16 +#'dim(expL) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, +#'lat = 8, lon = 8) +#'obsL <- 1 : (1 * 1 * 4 * 8 * 8) * 14 +#'dim(obsL) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, +#'lat = 8, lon = 8) +#'time_obsL <- paste(paste0(rep("0", 4), 1 : 4), rep("05", 4), +#'rep("2017", 4), sep = "-") +#'res <- Analogs(expL, obsL, time_obsL) +#'# Example 3: +#'library(CSTools) +#'expL <- lonlat_data$exp$data +#'obsL <- lonlat_data$obs$data +#'time_obsL <- lonlat_data$obs$Dates$start +#'res <- Analogs(expL, obsL, time_obsL) #'@export Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", -- GitLab From 464de6a8fa0054585dd3e4b5a3c03db5ba506c38 Mon Sep 17 00:00:00 2001 From: carmenalvarezcastro Date: Tue, 29 Oct 2019 19:11:55 +0100 Subject: [PATCH 32/43] adding Rd --- man/Analogs.Rd | 116 ++++++++++++++++++++++++++++++++------------- man/CST_Analogs.Rd | 56 ++++++++++------------ 2 files changed, 108 insertions(+), 64 deletions(-) diff --git a/man/Analogs.Rd b/man/Analogs.Rd index 12d30fe9..902b0a7b 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -5,69 +5,119 @@ \title{Search for analogs based on large scale fields.} \usage{ Analogs(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, - criteria = "Large_dist", lon_local = NULL, lat_local = NULL, + criteria = "Large_dist", lonVar = NULL, latVar = NULL, region = NULL, nAnalogs = 1, return_list = FALSE) } \arguments{ -\item{expL}{variable for the Large scale in the model (same variable -might be used in the local scale for criteria 2)} +\item{expL}{an array of N named dimensions containing the experimental field +on the large scale for which the analog is aimed. This field is used to in +all the criterias. If parameter 'expVar' is not provided, the function will + return the expL analog. The element 'data' in the 's2dv_cube' object must + have, at least, latitudinal and longitudinal dimensions. The object is + expect to be already subset for the desired large scale region.} -\item{obsL}{variable for the large scale in the observations} +\item{obsL}{an array of N named dimensions containing the observational field +on the large scale. The element 'data' in the 's2dv_cube' object must have +the same latitudinal and longitudinal dimensions as parameter 'expL' and a +temporal dimension with the maximum number of available observations.} -\item{expVar}{variable for the local scale in the model usually different -to the variable in expL} +\item{expVar}{an array of N named dimensions containing the experimental +field on the local scale, usually a different variable to the parameter +'expL'. If it is not NULL (by default, NULL), the returned field by this +function will be the analog of parameter 'expVar'.} -\item{obsVar}{variable for the local scale in the observations usually -different to the variable in obsL} +\item{obsVar}{an array of N named dimensions containing the field of the same variable as the passed in parameter 'expVar' for the same region.} -\item{criteria}{different criteria to be used for the selection of analogs -if criteria = "Large_dist" -if criteria ="Local_dist" -if criteria ="Local_cor"} +\item{criteria}{a character string indicating the criteria to be used for the selection of analogs: +\itemize{ +\item{Large_dist} minimal distance in the large scale pattern; +\item{Local_dist} minimal distance in the large scale pattern and minimal +distance in the local scale pattern; and +\item{Local_cor} minimal distance in the large scale pattern, minimal +distance in the local scale pattern and maxima correlation in the +local variable to downscale.}} -\item{lon_local}{longitude in the local scale} +\item{lonVar}{a vector containing the longitude of parameter 'expVar'.} -\item{lat_local}{latitude in the local scale} +\item{latVar}{a vector containing the latitude of parameter 'expVar'.} -\item{region}{region for the local scale} +\item{region}{a vector of length four indicating the minimum longitude, +the maximum longitude, the minimum latitude and the maximum latitude.} \item{nAnalogs}{number of Analogs to be selected to apply the criterias (this -is not the necessary the number of analogs that the user can get)} +is not the necessary the number of analogs that the user can get, but the number +of events with minimal distance in which perform the search of the best Analog. +The default value for the Large_dist criteria is 1, the default value for +the Local_dist criteria is 10 and same for Local_cor. If return_list is +False you will get just the first one for downscaling purposes. If return_list +is True you will get the list of the best analogs that were searched in nAnalogs +under the selected criterias.} -\item{return_list}{TRUE if you want to get a list with the best analogs FALSE -if not.} +\item{return_list}{TRUE if you want to get a list with the best analogs FALSE +#'if not.} } \value{ -list list with the best analogs (time, distance) +list list with the best analogs (time, distance) -values values of a certain variable +values dowscaled values of the best analogs for the criteria selected. } \description{ -This function search for days with similar large scale -conditions or similar large and local scale conditions. - +This function perform a downscaling using Analogs. To compute +the analogs, the function search for days with similar large scale conditions +to downscaled fields in the local scale. The large scale and the local scale regions are defined by the user. The large scale is usually given by atmospheric circulation as sea level pressure or geopotential height (Yiou et al, 2013) but the function gives the -possibility to use another field. For the local scale the user can select -any variable. +possibility to use another field. The local scale will be usually given by +precipitation or temperature fields, but might be another variable. The analogs function will find the best analogs based in three criterias: (1) Minimal distance in the large scale pattern (i.e. SLP) (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal distance in the local scale pattern (i.e. SLP). (3) Minimal distance in the large scale pattern (i.e. SLP), minimal distance in the local scale pattern (i.e. SLP) and maxima correlation in the -local variable to find the analog (i.e Precipitation). -Once the search of the analogs is complete, and in order to used the -three criterias the user can select a number of analogs nAnalogs to restrict +local variable to downscale (i.e Precipitation). +The search of analogs must be done in the longest dataset posible. This is +important since it is necessary to have a good representation of the +possible states of the field in the past, and therefore, to get better +analogs. Once the search of the analogs is complete, and in order to used the +three criterias the user can select a number of analogsi, using parameter +'nAnalogs' to restrict the selection of the best analogs in a short number of posibilities, the best -ones. By default this parameter will be 1. -This function has not constrains of specific regions, variables to find the -analogs, or data to be used (seasonal forecast data, climate projections -data, reanalyses data). -The input data might be interpolated or not. +ones. +This function has not constrains of specific regions, variables to downscale, +or data to be used (seasonal forecast data, climate projections data, +reanalyses data). +The regrid into a finner scale is done interpolating with CST_Load. +Then, this interpolation is corrected selecting the analogs in the large +and local scale in based of the observations. The function is an adapted version of the method of Yiou et al 2013. } +\examples{ +# Example 1: +expL <- 1:20 +dim(expL) <- c(lat = 4, lon = 5) +obsL <- 1:120 +dim(obsL) <- c(lat = 4, lon = 5, time = 6) +time_obsL <- paste(rep("01", 6), rep("01", 6), 1998 : 2003, sep = "-") +Analogs(expL, obsL, time_obsL) +# Example 2: +expL <- 1 : (1 * 1 * 4 * 8 * 8)* 16 +dim(expL) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, +lat = 8, lon = 8) +obsL <- 1 : (1 * 1 * 4 * 8 * 8) * 14 +dim(obsL) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, +lat = 8, lon = 8) +time_obsL <- paste(paste0(rep("0", 4), 1 : 4), rep("05", 4), +rep("2017", 4), sep = "-") +res <- Analogs(expL, obsL, time_obsL) +# Example 3: +library(CSTools) +expL <- lonlat_data$exp$data +obsL <- lonlat_data$obs$data +time_obsL <- lonlat_data$obs$Dates$start +res <- Analogs(expL, obsL, time_obsL) +} \references{ Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column diff --git a/man/CST_Analogs.Rd b/man/CST_Analogs.Rd index ccbb3319..c3602355 100644 --- a/man/CST_Analogs.Rd +++ b/man/CST_Analogs.Rd @@ -4,43 +4,31 @@ \alias{CST_Analogs} \title{Downscaling using Analogs based on large scale fields.} \usage{ -CST_Analogs(expL, obsL, expVar, obsVar, criteria = "Large_dist") +CST_Analogs(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, + region = NULL, criteria = "Large_dist") } \arguments{ -\item{expL}{variable for the Large scale in the model (same variable -might be used in the local scale for criteria 2)} +\item{expL}{an 's2dv_cube' object containing the experimental field on the large scale for which the analog is aimed. This field is used to in all the criterias. If parameter 'expVar' is not provided, the function will return the expL analog. The element 'data' in the 's2dv_cube' object must have, at least, latitudinal and longitudinal dimensions. The object is expect to be already subset for the desired large scale region.} -\item{obsL}{variable for the large scale in the observations} +\item{obsL}{an 's2dv_cube' object containing the observational field on the large scale. The element 'data' in the 's2dv_cube' object must have the same latitudinal and longitudinal dimensions as parameter 'expL' and a temporal dimension with the maximum number of available observations.} -\item{expVar}{variable for the local scale in the model usually different -to the variable in expL} +\item{expVar}{an 's2dv_cube' object containing the experimental field on the local scale, usually a different variable to the parameter 'expL'. If it is not NULL (by default, NULL), the returned field by this function will be the analog of parameter 'expVar'.} -\item{obsVar}{variable for the local scale in the observations usually -different to the variable in obsL} +\item{obsVar}{an 's2dv_cube' containing the field of the same variable as the passed in parameter 'expVar' for the same region.} -\item{criteria}{different criteria to be used for the selection of analogs -if criteria = "Large_dist" -if criteria ="Local_dist" -if criteria ="Local_cor"} +\item{region}{a vector of length four indicating the minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude.} -\item{lon_local}{longitude in the local scale} - -\item{lat_local}{latitude in the local scale} - -\item{region}{region for the local scale} - -\item{nAnalogs}{number of Analogs to be selected to apply the criterias (this -is not the necessary the number of analogs that the user can get)} - -\item{return_list}{TRUE if you want to get a list with the best analogs FALSE -if not.} - -\item{mAnalogs}{months for searching the analogs} +\item{criteria}{a character string indicating the criteria to be used for the selection of analogs: +\itemize{ +\item{Large_dist} minimal distance in the large scale pattern; +\item{Local_dist} minimal distance in the large scale pattern and minimal +distance in the local scale pattern; and +\item{Local_cor} minimal distance in the large scale pattern, minimal +distance in the local scale pattern and maxima correlation in the +local variable to downscale.}} } \value{ -list list with the best analogs (time, distance) - -values values of a certain variable +An 's2dv_cube' object containing the dowscaled values of the best analogs in the criteria selected. } \description{ This function perform a downscaling using Analogs. To compute @@ -50,7 +38,7 @@ The large scale and the local scale regions are defined by the user. The large scale is usually given by atmospheric circulation as sea level pressure or geopotential height (Yiou et al, 2013) but the function gives the possibility to use another field. The local scale will be usually given by -precipitation or Temperature, but might be another variable. +precipitation or temperature fields, but might be another variable. The analogs function will find the best analogs based in three criterias: (1) Minimal distance in the large scale pattern (i.e. SLP) (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal @@ -62,9 +50,9 @@ The search of analogs must be done in the longest dataset posible. This is important since it is necessary to have a good representation of the possible states of the field in the past, and therefore, to get better analogs. Once the search of the analogs is complete, and in order to used the -three criterias the user can select a number of analogs nAnalogs to restrict +three criterias the user can select a number of analogsi, using parameter 'nAnalogs' to restrict the selection of the best analogs in a short number of posibilities, the best -ones. By default this parameter will be 1. +ones. This function has not constrains of specific regions, variables to downscale, or data to be used (seasonal forecast data, climate projections data, reanalyses data). @@ -73,12 +61,18 @@ Then, this interpolation is corrected selecting the analogs in the large and local scale in based of the observations. The function is an adapted version of the method of Yiou et al 2013. } +\examples{ +res <- CST_Analogs(expL = lonlat_data$exp, obsL = lonlat_data$obs) +} \references{ Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. \email{pascal.yiou@lsce.ipsl.fr} } +\seealso{ +code{\link{CST_Load}}, \code{\link[s2dverification]{Load}} and \code{\link[s2dverification]{CDORemap}} +} \author{ Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -- GitLab From 67faa3d9114292262b1a49254db80656ccb295a3 Mon Sep 17 00:00:00 2001 From: carmenalvarezcastro Date: Wed, 30 Oct 2019 17:52:38 +0100 Subject: [PATCH 33/43] adding examples --- R/CST_Analogs.R | 378 +++++++++++++++++++++++++++++++++++++++++++----- man/Analogs.Rd | 327 ++++++++++++++++++++++++++++++++++++++--- 2 files changed, 648 insertions(+), 57 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index cf622652..72b90921 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -179,32 +179,311 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'@import multiApply #'@import ClimProjDiags #'@import abind -#'@return list list with the best analogs (time, distance) -#'@return values dowscaled values of the best analogs for the criteria selected. +#'@return list with the best analogs (time, distance) +#'@return dowscaled values of the best analogs for the criteria selected. #'@examples -#'# Example 1: -#'expL <- 1:20 -#'dim(expL) <- c(lat = 4, lon = 5) -#'obsL <- 1:120 -#'dim(obsL) <- c(lat = 4, lon = 5, time = 6) -#'time_obsL <- paste(rep("01", 6), rep("01", 6), 1998 : 2003, sep = "-") -#'Analogs(expL, obsL, time_obsL) -#'# Example 2: -#'expL <- 1 : (1 * 1 * 4 * 8 * 8)* 16 -#'dim(expL) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, -#'lat = 8, lon = 8) -#'obsL <- 1 : (1 * 1 * 4 * 8 * 8) * 14 -#'dim(obsL) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, -#'lat = 8, lon = 8) -#'time_obsL <- paste(paste0(rep("0", 4), 1 : 4), rep("05", 4), -#'rep("2017", 4), sep = "-") -#'res <- Analogs(expL, obsL, time_obsL) -#'# Example 3: -#'library(CSTools) -#'expL <- lonlat_data$exp$data -#'obsL <- lonlat_data$obs$data -#'time_obsL <- lonlat_data$obs$Dates$start -#'res <- Analogs(expL, obsL, time_obsL) +#'require(zeallot) +#' +#' # Example 1:Large_dist +#' expL <- rnorm(1:20) +#' dim(expL) <- c(lat = 4, lon = 5) +#' obsL <- c(rnorm(1:180),expL*2) +#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) +#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#' downscale_field <- Analogs(expL, obsL, time_obsL) +#' layout(matrix(1:3,1,3,byrow=T)) +#' image(expL,main="expL") +#' image(downscale_field$AnalogsFields, +#' main=paste0("Best_Analog ",downscale_field$DatesAnalogs)) +#' +#' # Example 2:Large_dist imposing nAnalogs and return_list +#' expL <- rnorm(1:20) +#' dim(expL) <- c(lat = 4, lon = 5) +#' obsL <- c(rnorm(1:1980),expL*1.5) +#' dim(obsL) <- c(lat = 4, lon = 5, time = 100) +#' time_obsL <- paste(rep("01", 100), rep("01", 100), 1920 : 2019, sep = "-") +#' nAnalogs=30 +#' downscale_field <- Analogs(expL, obsL, time_obsL,nAnalogs=nAnalogs,return_list = TRUE) +#' str(downscale_field) +#' plot.new() +#' layout(matrix(1:3,1,3,byrow=T)) +#' image(expL,main="expL") +#' image(downscale_field$AnalogsFields[,,1], +#' main=paste0("Best_Analog ",downscale_field$DatesAnalogs[1])) +#' image(downscale_field$AnalogsFields[,,2], +#' main=paste0("2nd Best_Analog ",downscale_field$DatesAnalogs[2])) +#' +#' # Example 3:Local_dist with obsVar and expVar return_list = FALSE +#' expL <- rnorm(1:20) +#' dim(expL) <- c(lat = 4, lon = 5) +#' obsL <- c(rnorm(1:180),expL*2) +#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) +#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#' expVar <- expL[1:3,1:3] +#' dim(expVar) <- c(lat = 3, lon = 3) +#' obsVar <- obsL[1:3,1:3,1:10] +#' dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +#' lonmin=-1 +#' lonmax=2 +#' latmin=30 +#' latmax=33 +#' region=c(lonmin,lonmax,latmin,latmax) +#' Local_scale <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, +#' criteria="Local_dist",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 5, return_list = FALSE) +#' plot.new() +#' layout(matrix(1:3,1,3,byrow=T)) +#' image(expL,main="expL") +#' image(expVar,main="expVar") +#' image(Local_scale$AnalogsFields, +#' main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) +#' +#' # Example 4:Large_dist and Local_dist analogs. Local_dist with obsVar and expVar. return_list = FALSE in both +#' expL <- rnorm(1:20) +#' dim(expL) <- c(lat = 4, lon = 5) +#' obsL <- c(rnorm(1:180),expL*5) +#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) +#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#' expVar <- expL[1:3,1:3] +#' dim(expVar) <- c(lat = 3, lon = 3) +#' obsVar <- obsL[1:3,1:3,1:10] +#' dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +#' +#' # analogs of large scale using criteria 1 +#' Large_scale <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL, +#' criteria="Large_dist", +#' nAnalogs = 10, return_list = FALSE) +#' # analogs of local scale using criteria 2 +#' lonmin=-1 +#' lonmax=2 +#' latmin=30 +#' latmax=33 +#' region=c(lonmin,lonmax,latmin,latmax) +#' Local_scale <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, +#' criteria="Local_dist",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 10, return_list = FALSE) +#' plot.new() +#' layout(matrix(1:4,2,2,byrow=T)) +#' image(expL,main="expL") +#' image(Large_scale$AnalogsFields, +#' main=paste0("Best_Analog ",Large_scale$DatesAnalogs)) +#' image(expVar,main="expVar") +#' image(Local_scale$AnalogsFields, +#' main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) +#' +#' # Example 5: Local_dist without obsVar and expVar +#' expL <- rnorm(1:20) +#' dim(expL) <- c(lat = 4, lon = 5) +#' obsL <- c(rnorm(1:180),expL*2) +#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) +#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#' lonmin=-1 +#' lonmax=2 +#' latmin=30 +#' latmax=33 +#' region=c(lonmin,lonmax,latmin,latmax) +#' Local_scale2 <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL, +#' criteria="Local_dist",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 10, return_list = FALSE) +#' plot.new() +#' layout(matrix(1:4,2,2,byrow=T)) +#' image(expL,main="expL") +#' image(Local_scale2$AnalogsFields, +#' main=paste0("Best_Analog ",Local_scale2$DatesAnalogs)) +#' image(expVar,main="expVar") +#' image(Local_scale$AnalogsFields, +#' main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) +#' +#' # Example 6:Local_dist with obsVar and expVar return_list = TRUE +#' expL <- rnorm(1:20) +#' dim(expL) <- c(lat = 4, lon = 5) +#' obsL <- c(rnorm(1:180),expL*2) +#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) +#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#' expVar <- expL[1:3,1:3] +#' dim(expVar) <- c(lat = 3, lon = 3) +#' obsVar <- obsL[1:3,1:3,1:10] +#' dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +#' lonmin=-1 +#' lonmax=2 +#' latmin=30 +#' latmax=33 +#' region=c(lonmin,lonmax,latmin,latmax) +#' Local_scale <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, +#' criteria="Local_dist",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 5, return_list = TRUE) +#' str(Local_scale) +#' +#' # Example 7: Local_cor with obsVar and expVar return_list = FALSE +#' expL <- rnorm(1:20) +#' dim(expL) <- c(lat = 4, lon = 5) +#' obsL <- c(rnorm(1:180),expL*5) +#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) +#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#' expVar <- expL[1:3,1:3] +#' dim(expVar) <- c(lat = 3, lon = 3) +#' obsVar <- obsL[1:3,1:3,1:10] +#' dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +#' lonmin=-1 +#' lonmax=2 +#' latmin=30 +#' latmax=33 +#' region=c(lonmin,lonmax,latmin,latmax) +#' Local_corr <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, +#' criteria="Local_cor",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 5, return_list = FALSE) +#' plot.new() +#' layout(matrix(1:3,1,3,byrow=T)) +#' image(expL,main="expL") +#' image(expVar,main="expVar") +#' image(Local_corr$AnalogsFields[,,1], +#' main=paste0("Best_Analog ",Local_corr$DatesAnalogs[1])) +#' +#' # Example 8: Local_cor return list TRUE +#' expL <- rnorm(1:20) +#' dim(expL) <- c(lat = 4, lon = 5) +#' obsL <- c(rnorm(1:180),expL*5) +#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) +#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#' expVar <- expL[1:3,1:3] +#' dim(expVar) <- c(lat = 3, lon = 3) +#' obsVar <- obsL[1:3,1:3,1:10] +#' dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +#' lonmin=-1 +#' lonmax=2 +#' latmin=30 +#' latmax=33 +#' region=c(lonmin,lonmax,latmin,latmax) +#' Local_corr <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, +#' criteria="Local_cor",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 5, return_list = TRUE) +#' plot.new() +#' layout(matrix(1:4,2,2,byrow=T)) +#' image(expL,main="expL") +#' image(expVar,main="expVar") +#' image(Local_corr$AnalogsFields[,,1], +#' main=paste0("Best_Analog ",Local_corr$DatesAnalogs[1])) +#' image(Local_corr$AnalogsFields[,,2], +#' main=paste0("2nd Best_Analog ",Local_corr$DatesAnalogs[2])) +#' +#' # Example 9: Large_dist, Local_dist, and Local_cor return list FALSE same variable +#' expL <- rnorm(1:20) +#' dim(expL) <- c(lat = 4, lon = 5) +#' obsL <- c(rnorm(1:180),expL*7) +#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) +#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#' # analogs of large scale using criteria 1 +#' Large_scale <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL, +#' criteria="Large_dist", +#' nAnalogs = 10, return_list = TRUE) +#' # analogs of local scale using criteria 2 +#' lonmin=-1 +#' lonmax=2 +#' latmin=30 +#' latmax=33 +#' region=c(lonmin,lonmax,latmin,latmax) +#' Local_scale <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL, +#' criteria="Local_dist",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 10, return_list = TRUE) +#' # analogs of local scale using criteria 2 +#' Local_corr <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL, +#' criteria="Local_cor",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 10, return_list = TRUE) +#' plot.new() +#' layout(matrix(1:9,3,3,byrow=T)) +#' image(expL,main="expL") +#' image(Large_scale$AnalogsFields[,,1], +#' main=paste0("Best_Analog C1 ",Large_scale$DatesAnalogs[1])) +#' image(Large_scale$AnalogsFields[,,2], +#' main=paste0("Best_Analog C1 ",Large_scale$DatesAnalogs[2])) +#' image(expVar,main="expVar") +#' image(Local_scale$AnalogsFields[,,1], +#' main=paste0("Best_Analog C2 ",Local_scale$DatesAnalogs[1])) +#' image(Local_scale$AnalogsFields[,,2], +#' main=paste0("Best_Analog C2 ",Local_scale$DatesAnalogs[2])) +#' image(expVar,main="expVar") +#' image(Local_corr$AnalogsFields[,,1], +#' main=paste0("Best_Analog C3 ",Local_corr$DatesAnalogs[1])) +#' image(Local_corr$AnalogsFields[,,2], +#' main=paste0("2nd Best_Analog C3 ",Local_corr$DatesAnalogs[2])) +#' +#' # Example 10: Large_dist, Local_dist, and Local_cor return list FALSE different variable +#' expL1 <- rnorm(1:20) +#' dim(expL1) <- c(lat = 4, lon = 5) +#' obsL1 <- c(rnorm(1:180),expL1*5) +#' dim(obsL1) <- c(lat = 4, lon = 5, time = 10) +#' time_obsL1 <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#' expVar1 <- expL1[1:3,1:3] +#' dim(expVar1) <- c(lat = 3, lon = 3) +#' obsVar1 <- obsL1[1:3,1:3,1:10] +#' dim(obsVar1) <- c(lat = 3, lon = 3, time = 10) +#' # analogs of large scale using criteria 1 +#' Large_scale <- Analogs(expL=expL1, +#' obsL=obsL1, time_obsL=time_obsL1,expVar=expVar1,obsVar=obsVar1, +#' criteria="Large_dist", +#' nAnalogs = 10, return_list = TRUE) +#' # analogs of local scale using criteria 2 +#' lonmin=-1 +#' lonmax=2 +#' latmin=30 +#' latmax=33 +#' region=c(lonmin,lonmax,latmin,latmax) +#' Local_scale <- Analogs(expL=expL1, +#' obsL=obsL1, time_obsL=time_obsL1,obsVar=obsVar1,expVar=expVar1, +#' criteria="Local_dist",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 10, return_list = TRUE) +#' # analogs of local scale using criteria 3 and another variable so different obsL, expL, obsVar and expVar +#' expL2 <- rnorm(1:20) +#' dim(expL2) <- c(lat = 4, lon = 5) +#' obsL2 <- c(rnorm(1:180),expL2*5) +#' dim(obsL2) <- c(lat = 4, lon = 5, time = 10) +#' time_obsL2 <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#' expVar2 <- expL2[1:3,1:3] +#' dim(expVar2) <- c(lat = 3, lon = 3) +#' obsVar2 <- obsL2[1:3,1:3,1:10] +#' dim(obsVar2) <- c(lat = 3, lon = 3, time = 10) +#' Local_corr <- Analogs(expL=expL2, +#' obsL=obsL2, time_obsL=time_obsL2,obsVar=obsVar2,expVar=expVar2, +#' criteria="Local_cor",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 10, return_list = TRUE) +#' plot.new() +#' layout(matrix(1:9,3,3,byrow=T)) +#' image(expL1,main="expL Var1") +#' image(Large_scale$AnalogsFields[,,1], +#' main=paste0("BestAn. Var1 C1 ",Large_scale$DatesAnalogs[1])) +#' image(Large_scale$AnalogsFields[,,2], +#' main=paste0("BestAn. Var1 C1 ",Large_scale$DatesAnalogs[2])) +#' image(expVar1,main="expVar1") +#' image(Local_scale$AnalogsFields[,,1], +#' main=paste0("BestAn. Var1 C2 ",Local_scale$DatesAnalogs[1])) +#' image(Local_scale$AnalogsFields[,,2], +#' main=paste0("BestAn. Var1 C2 ",Local_scale$DatesAnalogs[2])) +#' image(expVar2,main="expVar2") +#' image(Local_corr$AnalogsFields[,,1], +#' main=paste0("BestAn. Var2 C3 ",Local_corr$DatesAnalogs[1])) +#' image(Local_corr$AnalogsFields[,,2], +#' main=paste0("2nd BestAn. Var2 C3 ",Local_corr$DatesAnalogs[2])) +#' #'@export Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", @@ -247,6 +526,19 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, } } } + if (any(names(dim(obsVar)) %in% 'ftime')) { + if (any(names(dim(obsVar)) %in% 'time')) { + stop("Multiple temporal dimensions ('ftime' and 'time') found", + "in parameter 'obsVar'.") + } else { + time_pos_obsVar <- which(names(dim(obsVar)) == 'ftime') + names(dim(obsVar))[time_pos_obsVar] <- 'time' + if (any(names(dim(expVar)) %in% 'ftime')) { + time_pos_expVar <- which(names(dim(expVar)) == 'ftime') + names(dim(expVar))[time_pos_expVar] <- 'time' + } + } + } if (any(names(dim(obsL)) %in% 'sdate')) { if (any(names(dim(obsL)) %in% 'time')) { dims_obsL <- dim(obsL) @@ -261,6 +553,21 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, stop("Parameter 'obsL' must have a temporal dimension.") } } + if (any(names(dim(obsVar)) %in% 'sdate')) { + if (any(names(dim(obsVar)) %in% 'time')) { + dims_obsVar <- dim(obsVar) + pos_sdate <- which(names(dim(obsVar)) == 'sdate') + pos_time <- which(names(dim(obsVar)) == 'time') + pos <- 1 : length(dim(obsVar)) + pos <- c(pos_time, pos_sdate, pos[-c(pos_sdate,pos_time)]) + obsVar <- aperm(obsVar, pos) + dim(obsVar) <- c(time = prod(dims_obsVar[c(pos_time, pos_sdate)]), + dims_obsVar[-c(pos_time, pos_sdate)]) + } else { + stop("Parameter 'obsVar' must have a temporal dimension.") + } + } + if (is.null(region)) { if (!is.null(lonVar) & !is.null(latVar)) { region <- c(min(lonVar), max(lonVar), min(latVar), max(latVar)) @@ -277,12 +584,13 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, dim(Analogs_dates) <- dim(best) if (all(!is.null(region), !is.null(lonVar), !is.null(latVar))) { if (is.null(obsVar)) { - obsLocal <- SelBox(obsL, lon = lonVar, lat = latVar, region = region) - Analogs_fields <- Subset(obsLocal, along = which(names(dim(obsLocal)) == 'time'), + obsVar <- SelBox(obsL, lon = lonVar, lat = latVar, region = region) + Analogs_fields <- Subset(obsVar$data, along = which(names(dim(obsVar)) == 'time'), indices = best) + warning("obsVar is NULL and will be calculated.") } else { - obsVar <- SelBox(obsL, lon = lonVar, lat = latVar, region = region) + #obsVar <- SelBox(obsL, lon = lonVar, lat = latVar, region = region) Analogs_fields <- Subset(obsVar, along = which(names(dim(obsVar)) == 'time'), indices = best) } @@ -361,7 +669,8 @@ BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, pos <- pos[which(!is.na(pos))] if (return_list == FALSE) { pos <- pos[1] - } + }else { + pos <- pos} } else if (criteria == 'Local_cor') { pos1 <- pos1[1 : nAnalogs] pos2 <- pos2[1 : nAnalogs] @@ -386,7 +695,8 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ if (length(dim(metric1)) > 1) { dim_time_obs <- which(names(dim(metric1)) == 'time' | names(dim(metric1)) == 'ftime') - margins <- c(1 : length(dim(metric1)))[-dim_time_obs] + dim(metric1) <- c(dim(metric1), metric=1) + margins <- c(1 : (length(dim(metric1))))[-dim_time_obs] pos1 <- apply(metric1, margins, order) names(dim(pos1))[1] <- 'time' metric1 <- apply(metric1, margins, sort) @@ -396,6 +706,7 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ dim(pos1) <- c(time = length(pos1)) metric1 <- sort(metric1) dim(metric1) <- c(time = length(metric1)) + dim_time_obs=1 } if (criteria == "Large_dist") { dim(metric1) <- c(dim(metric1), metric = 1) @@ -423,11 +734,12 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ } } if (criteria == "Local_cor") { - obs <- SelBox(obsVar, lon = lonVar, lat = latVar, region = region)$data - exp <- SelBox(expVar, lon = lonVar, lat = latVar, region = region)$data + obs <- SelBox(obsL, lon = lonVar, lat = latVar, region = region)$data + exp <- SelBox(expL, lon = lonVar, lat = latVar, region = region)$data metric3 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), fun = .select, exp, metric = "cor")$output1 - margins <- c(1 : length(dim(metric3)))[-dim_time_obs] + dim(metric3) <- c(dim(metric3), metric=1) + margins <- c(1 : (length(dim(metric3))))[-dim_time_obs] pos3 <- apply(metric3, margins, order, decreasing = TRUE) names(dim(pos3))[1] <- 'time' metric3 <- apply(metric3, margins, sort) diff --git a/man/Analogs.Rd b/man/Analogs.Rd index 902b0a7b..9e666fb3 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -57,9 +57,9 @@ under the selected criterias.} #'if not.} } \value{ -list list with the best analogs (time, distance) +list with the best analogs (time, distance) -values dowscaled values of the best analogs for the criteria selected. +dowscaled values of the best analogs for the criteria selected. } \description{ This function perform a downscaling using Analogs. To compute @@ -94,29 +94,308 @@ and local scale in based of the observations. The function is an adapted version of the method of Yiou et al 2013. } \examples{ -# Example 1: -expL <- 1:20 +require(zeallot) + +# Example 1:Large_dist +expL <- rnorm(1:20) +dim(expL) <- c(lat = 4, lon = 5) +obsL <- c(rnorm(1:180),expL*2) +dim(obsL) <- c(lat = 4, lon = 5, time = 10) +time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +downscale_field <- Analogs(expL, obsL, time_obsL) +layout(matrix(1:3,1,3,byrow=T)) +image(expL,main="expL") +image(downscale_field$AnalogsFields, + main=paste0("Best_Analog ",downscale_field$DatesAnalogs)) + +# Example 2:Large_dist imposing nAnalogs and return_list +expL <- rnorm(1:20) +dim(expL) <- c(lat = 4, lon = 5) +obsL <- c(rnorm(1:1980),expL*1.5) +dim(obsL) <- c(lat = 4, lon = 5, time = 100) +time_obsL <- paste(rep("01", 100), rep("01", 100), 1920 : 2019, sep = "-") +nAnalogs=30 +downscale_field <- Analogs(expL, obsL, time_obsL,nAnalogs=nAnalogs,return_list = TRUE) +str(downscale_field) +plot.new() +layout(matrix(1:3,1,3,byrow=T)) +image(expL,main="expL") +image(downscale_field$AnalogsFields[,,1], + main=paste0("Best_Analog ",downscale_field$DatesAnalogs[1])) +image(downscale_field$AnalogsFields[,,2], + main=paste0("2nd Best_Analog ",downscale_field$DatesAnalogs[2])) + +# Example 3:Local_dist with obsVar and expVar return_list = FALSE +expL <- rnorm(1:20) +dim(expL) <- c(lat = 4, lon = 5) +obsL <- c(rnorm(1:180),expL*2) +dim(obsL) <- c(lat = 4, lon = 5, time = 10) +time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +expVar <- expL[1:3,1:3] +dim(expVar) <- c(lat = 3, lon = 3) +obsVar <- obsL[1:3,1:3,1:10] +dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +lonmin=-1 +lonmax=2 +latmin=30 +latmax=33 +region=c(lonmin,lonmax,latmin,latmax) +Local_scale <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, + criteria="Local_dist",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 5, return_list = FALSE) +plot.new() +layout(matrix(1:3,1,3,byrow=T)) +image(expL,main="expL") +image(expVar,main="expVar") +image(Local_scale$AnalogsFields, + main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) + +# Example 4:Large_dist and Local_dist analogs. Local_dist with obsVar and expVar. return_list = FALSE in both +expL <- rnorm(1:20) +dim(expL) <- c(lat = 4, lon = 5) +obsL <- c(rnorm(1:180),expL*5) +dim(obsL) <- c(lat = 4, lon = 5, time = 10) +time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +expVar <- expL[1:3,1:3] +dim(expVar) <- c(lat = 3, lon = 3) +obsVar <- obsL[1:3,1:3,1:10] +dim(obsVar) <- c(lat = 3, lon = 3, time = 10) + +# analogs of large scale using criteria 1 +Large_scale <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL, + criteria="Large_dist", + nAnalogs = 10, return_list = FALSE) +# analogs of local scale using criteria 2 +lonmin=-1 +lonmax=2 +latmin=30 +latmax=33 +region=c(lonmin,lonmax,latmin,latmax) +Local_scale <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, + criteria="Local_dist",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 10, return_list = FALSE) +plot.new() +layout(matrix(1:4,2,2,byrow=T)) +image(expL,main="expL") +image(Large_scale$AnalogsFields, + main=paste0("Best_Analog ",Large_scale$DatesAnalogs)) +image(expVar,main="expVar") +image(Local_scale$AnalogsFields, + main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) + +# Example 5: Local_dist without obsVar and expVar +expL <- rnorm(1:20) dim(expL) <- c(lat = 4, lon = 5) -obsL <- 1:120 -dim(obsL) <- c(lat = 4, lon = 5, time = 6) -time_obsL <- paste(rep("01", 6), rep("01", 6), 1998 : 2003, sep = "-") -Analogs(expL, obsL, time_obsL) -# Example 2: -expL <- 1 : (1 * 1 * 4 * 8 * 8)* 16 -dim(expL) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, -lat = 8, lon = 8) -obsL <- 1 : (1 * 1 * 4 * 8 * 8) * 14 -dim(obsL) <- c(dataset = 1, member = 1, sdate = 1, ftime = 4, -lat = 8, lon = 8) -time_obsL <- paste(paste0(rep("0", 4), 1 : 4), rep("05", 4), -rep("2017", 4), sep = "-") -res <- Analogs(expL, obsL, time_obsL) -# Example 3: -library(CSTools) -expL <- lonlat_data$exp$data -obsL <- lonlat_data$obs$data -time_obsL <- lonlat_data$obs$Dates$start -res <- Analogs(expL, obsL, time_obsL) +obsL <- c(rnorm(1:180),expL*2) +dim(obsL) <- c(lat = 4, lon = 5, time = 10) +time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +lonmin=-1 +lonmax=2 +latmin=30 +latmax=33 +region=c(lonmin,lonmax,latmin,latmax) +Local_scale2 <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL, + criteria="Local_dist",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 10, return_list = FALSE) +plot.new() +layout(matrix(1:4,2,2,byrow=T)) +image(expL,main="expL") +image(Local_scale2$AnalogsFields, + main=paste0("Best_Analog ",Local_scale2$DatesAnalogs)) +image(expVar,main="expVar") +image(Local_scale$AnalogsFields, + main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) + +# Example 6:Local_dist with obsVar and expVar return_list = TRUE +expL <- rnorm(1:20) +dim(expL) <- c(lat = 4, lon = 5) +obsL <- c(rnorm(1:180),expL*2) +dim(obsL) <- c(lat = 4, lon = 5, time = 10) +time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +expVar <- expL[1:3,1:3] +dim(expVar) <- c(lat = 3, lon = 3) +obsVar <- obsL[1:3,1:3,1:10] +dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +lonmin=-1 +lonmax=2 +latmin=30 +latmax=33 +region=c(lonmin,lonmax,latmin,latmax) +Local_scale <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, + criteria="Local_dist",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 5, return_list = TRUE) +str(Local_scale) + +# Example 7: Local_cor with obsVar and expVar return_list = FALSE +expL <- rnorm(1:20) +dim(expL) <- c(lat = 4, lon = 5) +obsL <- c(rnorm(1:180),expL*5) +dim(obsL) <- c(lat = 4, lon = 5, time = 10) +time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +expVar <- expL[1:3,1:3] +dim(expVar) <- c(lat = 3, lon = 3) +obsVar <- obsL[1:3,1:3,1:10] +dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +lonmin=-1 +lonmax=2 +latmin=30 +latmax=33 +region=c(lonmin,lonmax,latmin,latmax) +Local_corr <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, + criteria="Local_cor",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 5, return_list = FALSE) +plot.new() +layout(matrix(1:3,1,3,byrow=T)) +image(expL,main="expL") +image(expVar,main="expVar") +image(Local_corr$AnalogsFields[,,1], + main=paste0("Best_Analog ",Local_corr$DatesAnalogs[1])) + +# Example 8: Local_cor return list TRUE +expL <- rnorm(1:20) +dim(expL) <- c(lat = 4, lon = 5) +obsL <- c(rnorm(1:180),expL*5) +dim(obsL) <- c(lat = 4, lon = 5, time = 10) +time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +expVar <- expL[1:3,1:3] +dim(expVar) <- c(lat = 3, lon = 3) +obsVar <- obsL[1:3,1:3,1:10] +dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +lonmin=-1 +lonmax=2 +latmin=30 +latmax=33 +region=c(lonmin,lonmax,latmin,latmax) +Local_corr <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, + criteria="Local_cor",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 5, return_list = TRUE) +plot.new() +layout(matrix(1:4,2,2,byrow=T)) +image(expL,main="expL") +image(expVar,main="expVar") +image(Local_corr$AnalogsFields[,,1], + main=paste0("Best_Analog ",Local_corr$DatesAnalogs[1])) +image(Local_corr$AnalogsFields[,,2], + main=paste0("2nd Best_Analog ",Local_corr$DatesAnalogs[2])) + +# Example 9: Large_dist, Local_dist, and Local_cor return list FALSE same variable +expL <- rnorm(1:20) +dim(expL) <- c(lat = 4, lon = 5) +obsL <- c(rnorm(1:180),expL*7) +dim(obsL) <- c(lat = 4, lon = 5, time = 10) +time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +# analogs of large scale using criteria 1 +Large_scale <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL, + criteria="Large_dist", + nAnalogs = 10, return_list = TRUE) +# analogs of local scale using criteria 2 +lonmin=-1 +lonmax=2 +latmin=30 +latmax=33 +region=c(lonmin,lonmax,latmin,latmax) +Local_scale <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL, + criteria="Local_dist",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 10, return_list = TRUE) +# analogs of local scale using criteria 2 +Local_corr <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL, + criteria="Local_cor",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 10, return_list = TRUE) +plot.new() +layout(matrix(1:9,3,3,byrow=T)) +image(expL,main="expL") +image(Large_scale$AnalogsFields[,,1], + main=paste0("Best_Analog C1 ",Large_scale$DatesAnalogs[1])) +image(Large_scale$AnalogsFields[,,2], + main=paste0("Best_Analog C1 ",Large_scale$DatesAnalogs[2])) +image(expVar,main="expVar") +image(Local_scale$AnalogsFields[,,1], + main=paste0("Best_Analog C2 ",Local_scale$DatesAnalogs[1])) +image(Local_scale$AnalogsFields[,,2], + main=paste0("Best_Analog C2 ",Local_scale$DatesAnalogs[2])) +image(expVar,main="expVar") +image(Local_corr$AnalogsFields[,,1], + main=paste0("Best_Analog C3 ",Local_corr$DatesAnalogs[1])) +image(Local_corr$AnalogsFields[,,2], + main=paste0("2nd Best_Analog C3 ",Local_corr$DatesAnalogs[2])) + +# Example 10: Large_dist, Local_dist, and Local_cor return list FALSE different variable +expL1 <- rnorm(1:20) +dim(expL1) <- c(lat = 4, lon = 5) +obsL1 <- c(rnorm(1:180),expL1*5) +dim(obsL1) <- c(lat = 4, lon = 5, time = 10) +time_obsL1 <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +expVar1 <- expL1[1:3,1:3] +dim(expVar1) <- c(lat = 3, lon = 3) +obsVar1 <- obsL1[1:3,1:3,1:10] +dim(obsVar1) <- c(lat = 3, lon = 3, time = 10) +# analogs of large scale using criteria 1 +Large_scale <- Analogs(expL=expL1, + obsL=obsL1, time_obsL=time_obsL1,expVar=expVar1,obsVar=obsVar1, + criteria="Large_dist", + nAnalogs = 10, return_list = TRUE) +# analogs of local scale using criteria 2 +lonmin=-1 +lonmax=2 +latmin=30 +latmax=33 +region=c(lonmin,lonmax,latmin,latmax) +Local_scale <- Analogs(expL=expL1, + obsL=obsL1, time_obsL=time_obsL1,obsVar=obsVar1,expVar=expVar1, + criteria="Local_dist",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 10, return_list = TRUE) +# analogs of local scale using criteria 3 and another variable so different obsL, expL, obsVar and expVar +expL2 <- rnorm(1:20) +dim(expL2) <- c(lat = 4, lon = 5) +obsL2 <- c(rnorm(1:180),expL2*5) +dim(obsL2) <- c(lat = 4, lon = 5, time = 10) +time_obsL2 <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +expVar2 <- expL2[1:3,1:3] +dim(expVar2) <- c(lat = 3, lon = 3) +obsVar2 <- obsL2[1:3,1:3,1:10] +dim(obsVar2) <- c(lat = 3, lon = 3, time = 10) +Local_corr <- Analogs(expL=expL2, + obsL=obsL2, time_obsL=time_obsL2,obsVar=obsVar2,expVar=expVar2, + criteria="Local_cor",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 10, return_list = TRUE) +plot.new() +layout(matrix(1:9,3,3,byrow=T)) +image(expL1,main="expL Var1") +image(Large_scale$AnalogsFields[,,1], + main=paste0("BestAn. Var1 C1 ",Large_scale$DatesAnalogs[1])) +image(Large_scale$AnalogsFields[,,2], + main=paste0("BestAn. Var1 C1 ",Large_scale$DatesAnalogs[2])) +image(expVar1,main="expVar1") +image(Local_scale$AnalogsFields[,,1], + main=paste0("BestAn. Var1 C2 ",Local_scale$DatesAnalogs[1])) +image(Local_scale$AnalogsFields[,,2], + main=paste0("BestAn. Var1 C2 ",Local_scale$DatesAnalogs[2])) +image(expVar2,main="expVar2") +image(Local_corr$AnalogsFields[,,1], + main=paste0("BestAn. Var2 C3 ",Local_corr$DatesAnalogs[1])) +image(Local_corr$AnalogsFields[,,2], + main=paste0("2nd BestAn. Var2 C3 ",Local_corr$DatesAnalogs[2])) + } \references{ Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, -- GitLab From 62598fbb9febbaa96439eace5147de0198929d19 Mon Sep 17 00:00:00 2001 From: carmenalvarezcastro Date: Wed, 30 Oct 2019 18:46:11 +0100 Subject: [PATCH 34/43] removing plots from the examples --- R/CST_Analogs.R | 100 +++++---------------------------------------- man/Analogs.Rd | 100 +++++---------------------------------------- man/CST_Analogs.Rd | 2 + 3 files changed, 22 insertions(+), 180 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 72b90921..60e5b5af 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -41,6 +41,7 @@ #' #'@param expL an 's2dv_cube' object containing the experimental field on the large scale for which the analog is aimed. This field is used to in all the criterias. If parameter 'expVar' is not provided, the function will return the expL analog. The element 'data' in the 's2dv_cube' object must have, at least, latitudinal and longitudinal dimensions. The object is expect to be already subset for the desired large scale region. #'@param obsL an 's2dv_cube' object containing the observational field on the large scale. The element 'data' in the 's2dv_cube' object must have the same latitudinal and longitudinal dimensions as parameter 'expL' and a temporal dimension with the maximum number of available observations. +#'@param time_obsL a character string indicating the date of the observations in the format "dd/mm/yyyy" #'@param expVar an 's2dv_cube' object containing the experimental field on the local scale, usually a different variable to the parameter 'expL'. If it is not NULL (by default, NULL), the returned field by this function will be the analog of parameter 'expVar'. #'@param obsVar an 's2dv_cube' containing the field of the same variable as the passed in parameter 'expVar' for the same region. #'@param region a vector of length four indicating the minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude. @@ -98,7 +99,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, } } #'@rdname Analogs -#'@title Search for analogs based on large scale fields. +#'@title Analogs based on large scale fields. #' #'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} #'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} @@ -149,6 +150,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'on the large scale. The element 'data' in the 's2dv_cube' object must have #'the same latitudinal and longitudinal dimensions as parameter 'expL' and a #' temporal dimension with the maximum number of available observations. +#'@param time_obsL a character string indicating the date of the observations in the format "dd/mm/yyyy" #'@param expVar an array of N named dimensions containing the experimental #'field on the local scale, usually a different variable to the parameter #''expL'. If it is not NULL (by default, NULL), the returned field by this @@ -179,8 +181,8 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'@import multiApply #'@import ClimProjDiags #'@import abind -#'@return list with the best analogs (time, distance) -#'@return dowscaled values of the best analogs for the criteria selected. +#'@return DatesAnalogs, A character string with the date of the best analogs (time, distance) +#'@return AnalogsFields, dowscaled values of the best analogs for the criteria selected. #'@examples #'require(zeallot) #' @@ -191,10 +193,6 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' dim(obsL) <- c(lat = 4, lon = 5, time = 10) #' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") #' downscale_field <- Analogs(expL, obsL, time_obsL) -#' layout(matrix(1:3,1,3,byrow=T)) -#' image(expL,main="expL") -#' image(downscale_field$AnalogsFields, -#' main=paste0("Best_Analog ",downscale_field$DatesAnalogs)) #' #' # Example 2:Large_dist imposing nAnalogs and return_list #' expL <- rnorm(1:20) @@ -205,13 +203,6 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' nAnalogs=30 #' downscale_field <- Analogs(expL, obsL, time_obsL,nAnalogs=nAnalogs,return_list = TRUE) #' str(downscale_field) -#' plot.new() -#' layout(matrix(1:3,1,3,byrow=T)) -#' image(expL,main="expL") -#' image(downscale_field$AnalogsFields[,,1], -#' main=paste0("Best_Analog ",downscale_field$DatesAnalogs[1])) -#' image(downscale_field$AnalogsFields[,,2], -#' main=paste0("2nd Best_Analog ",downscale_field$DatesAnalogs[2])) #' #' # Example 3:Local_dist with obsVar and expVar return_list = FALSE #' expL <- rnorm(1:20) @@ -233,13 +224,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Local_dist",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, #' nAnalogs = 5, return_list = FALSE) -#' plot.new() -#' layout(matrix(1:3,1,3,byrow=T)) -#' image(expL,main="expL") -#' image(expVar,main="expVar") -#' image(Local_scale$AnalogsFields, -#' main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) -#' +#' #' # Example 4:Large_dist and Local_dist analogs. Local_dist with obsVar and expVar. return_list = FALSE in both #' expL <- rnorm(1:20) #' dim(expL) <- c(lat = 4, lon = 5) @@ -267,15 +252,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Local_dist",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, #' nAnalogs = 10, return_list = FALSE) -#' plot.new() -#' layout(matrix(1:4,2,2,byrow=T)) -#' image(expL,main="expL") -#' image(Large_scale$AnalogsFields, -#' main=paste0("Best_Analog ",Large_scale$DatesAnalogs)) -#' image(expVar,main="expVar") -#' image(Local_scale$AnalogsFields, -#' main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) -#' +#' #' # Example 5: Local_dist without obsVar and expVar #' expL <- rnorm(1:20) #' dim(expL) <- c(lat = 4, lon = 5) @@ -292,14 +269,6 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Local_dist",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, #' nAnalogs = 10, return_list = FALSE) -#' plot.new() -#' layout(matrix(1:4,2,2,byrow=T)) -#' image(expL,main="expL") -#' image(Local_scale2$AnalogsFields, -#' main=paste0("Best_Analog ",Local_scale2$DatesAnalogs)) -#' image(expVar,main="expVar") -#' image(Local_scale$AnalogsFields, -#' main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) #' #' # Example 6:Local_dist with obsVar and expVar return_list = TRUE #' expL <- rnorm(1:20) @@ -343,13 +312,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Local_cor",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, #' nAnalogs = 5, return_list = FALSE) -#' plot.new() -#' layout(matrix(1:3,1,3,byrow=T)) -#' image(expL,main="expL") -#' image(expVar,main="expVar") -#' image(Local_corr$AnalogsFields[,,1], -#' main=paste0("Best_Analog ",Local_corr$DatesAnalogs[1])) -#' +#' #' # Example 8: Local_cor return list TRUE #' expL <- rnorm(1:20) #' dim(expL) <- c(lat = 4, lon = 5) @@ -370,15 +333,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Local_cor",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, #' nAnalogs = 5, return_list = TRUE) -#' plot.new() -#' layout(matrix(1:4,2,2,byrow=T)) -#' image(expL,main="expL") -#' image(expVar,main="expVar") -#' image(Local_corr$AnalogsFields[,,1], -#' main=paste0("Best_Analog ",Local_corr$DatesAnalogs[1])) -#' image(Local_corr$AnalogsFields[,,2], -#' main=paste0("2nd Best_Analog ",Local_corr$DatesAnalogs[2])) -#' +#' #' # Example 9: Large_dist, Local_dist, and Local_cor return list FALSE same variable #' expL <- rnorm(1:20) #' dim(expL) <- c(lat = 4, lon = 5) @@ -407,24 +362,6 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Local_cor",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, #' nAnalogs = 10, return_list = TRUE) -#' plot.new() -#' layout(matrix(1:9,3,3,byrow=T)) -#' image(expL,main="expL") -#' image(Large_scale$AnalogsFields[,,1], -#' main=paste0("Best_Analog C1 ",Large_scale$DatesAnalogs[1])) -#' image(Large_scale$AnalogsFields[,,2], -#' main=paste0("Best_Analog C1 ",Large_scale$DatesAnalogs[2])) -#' image(expVar,main="expVar") -#' image(Local_scale$AnalogsFields[,,1], -#' main=paste0("Best_Analog C2 ",Local_scale$DatesAnalogs[1])) -#' image(Local_scale$AnalogsFields[,,2], -#' main=paste0("Best_Analog C2 ",Local_scale$DatesAnalogs[2])) -#' image(expVar,main="expVar") -#' image(Local_corr$AnalogsFields[,,1], -#' main=paste0("Best_Analog C3 ",Local_corr$DatesAnalogs[1])) -#' image(Local_corr$AnalogsFields[,,2], -#' main=paste0("2nd Best_Analog C3 ",Local_corr$DatesAnalogs[2])) -#' #' # Example 10: Large_dist, Local_dist, and Local_cor return list FALSE different variable #' expL1 <- rnorm(1:20) #' dim(expL1) <- c(lat = 4, lon = 5) @@ -466,24 +403,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Local_cor",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, #' nAnalogs = 10, return_list = TRUE) -#' plot.new() -#' layout(matrix(1:9,3,3,byrow=T)) -#' image(expL1,main="expL Var1") -#' image(Large_scale$AnalogsFields[,,1], -#' main=paste0("BestAn. Var1 C1 ",Large_scale$DatesAnalogs[1])) -#' image(Large_scale$AnalogsFields[,,2], -#' main=paste0("BestAn. Var1 C1 ",Large_scale$DatesAnalogs[2])) -#' image(expVar1,main="expVar1") -#' image(Local_scale$AnalogsFields[,,1], -#' main=paste0("BestAn. Var1 C2 ",Local_scale$DatesAnalogs[1])) -#' image(Local_scale$AnalogsFields[,,2], -#' main=paste0("BestAn. Var1 C2 ",Local_scale$DatesAnalogs[2])) -#' image(expVar2,main="expVar2") -#' image(Local_corr$AnalogsFields[,,1], -#' main=paste0("BestAn. Var2 C3 ",Local_corr$DatesAnalogs[1])) -#' image(Local_corr$AnalogsFields[,,2], -#' main=paste0("2nd BestAn. Var2 C3 ",Local_corr$DatesAnalogs[2])) -#' +#' #'@export Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", diff --git a/man/Analogs.Rd b/man/Analogs.Rd index 9e666fb3..05e3bd32 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/CST_Analogs.R \name{Analogs} \alias{Analogs} -\title{Search for analogs based on large scale fields.} +\title{Analogs based on large scale fields.} \usage{ Analogs(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", lonVar = NULL, latVar = NULL, @@ -21,6 +21,8 @@ on the large scale. The element 'data' in the 's2dv_cube' object must have the same latitudinal and longitudinal dimensions as parameter 'expL' and a temporal dimension with the maximum number of available observations.} +\item{time_obsL}{a character string indicating the date of the observations in the format "dd/mm/yyyy"} + \item{expVar}{an array of N named dimensions containing the experimental field on the local scale, usually a different variable to the parameter 'expL'. If it is not NULL (by default, NULL), the returned field by this @@ -57,9 +59,9 @@ under the selected criterias.} #'if not.} } \value{ -list with the best analogs (time, distance) +DatesAnalogs, A character string with the date of the best analogs (time, distance) -dowscaled values of the best analogs for the criteria selected. +AnalogsFields, dowscaled values of the best analogs for the criteria selected. } \description{ This function perform a downscaling using Analogs. To compute @@ -103,10 +105,6 @@ obsL <- c(rnorm(1:180),expL*2) dim(obsL) <- c(lat = 4, lon = 5, time = 10) time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") downscale_field <- Analogs(expL, obsL, time_obsL) -layout(matrix(1:3,1,3,byrow=T)) -image(expL,main="expL") -image(downscale_field$AnalogsFields, - main=paste0("Best_Analog ",downscale_field$DatesAnalogs)) # Example 2:Large_dist imposing nAnalogs and return_list expL <- rnorm(1:20) @@ -117,13 +115,6 @@ time_obsL <- paste(rep("01", 100), rep("01", 100), 1920 : 2019, sep = "-") nAnalogs=30 downscale_field <- Analogs(expL, obsL, time_obsL,nAnalogs=nAnalogs,return_list = TRUE) str(downscale_field) -plot.new() -layout(matrix(1:3,1,3,byrow=T)) -image(expL,main="expL") -image(downscale_field$AnalogsFields[,,1], - main=paste0("Best_Analog ",downscale_field$DatesAnalogs[1])) -image(downscale_field$AnalogsFields[,,2], - main=paste0("2nd Best_Analog ",downscale_field$DatesAnalogs[2])) # Example 3:Local_dist with obsVar and expVar return_list = FALSE expL <- rnorm(1:20) @@ -145,13 +136,7 @@ Local_scale <- Analogs(expL=expL, criteria="Local_dist",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),region=region, nAnalogs = 5, return_list = FALSE) -plot.new() -layout(matrix(1:3,1,3,byrow=T)) -image(expL,main="expL") -image(expVar,main="expVar") -image(Local_scale$AnalogsFields, - main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) - + # Example 4:Large_dist and Local_dist analogs. Local_dist with obsVar and expVar. return_list = FALSE in both expL <- rnorm(1:20) dim(expL) <- c(lat = 4, lon = 5) @@ -179,15 +164,7 @@ Local_scale <- Analogs(expL=expL, criteria="Local_dist",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),region=region, nAnalogs = 10, return_list = FALSE) -plot.new() -layout(matrix(1:4,2,2,byrow=T)) -image(expL,main="expL") -image(Large_scale$AnalogsFields, - main=paste0("Best_Analog ",Large_scale$DatesAnalogs)) -image(expVar,main="expVar") -image(Local_scale$AnalogsFields, - main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) - + # Example 5: Local_dist without obsVar and expVar expL <- rnorm(1:20) dim(expL) <- c(lat = 4, lon = 5) @@ -204,14 +181,6 @@ Local_scale2 <- Analogs(expL=expL, criteria="Local_dist",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),region=region, nAnalogs = 10, return_list = FALSE) -plot.new() -layout(matrix(1:4,2,2,byrow=T)) -image(expL,main="expL") -image(Local_scale2$AnalogsFields, - main=paste0("Best_Analog ",Local_scale2$DatesAnalogs)) -image(expVar,main="expVar") -image(Local_scale$AnalogsFields, - main=paste0("Best_Analog ",Local_scale$DatesAnalogs)) # Example 6:Local_dist with obsVar and expVar return_list = TRUE expL <- rnorm(1:20) @@ -255,13 +224,7 @@ Local_corr <- Analogs(expL=expL, criteria="Local_cor",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),region=region, nAnalogs = 5, return_list = FALSE) -plot.new() -layout(matrix(1:3,1,3,byrow=T)) -image(expL,main="expL") -image(expVar,main="expVar") -image(Local_corr$AnalogsFields[,,1], - main=paste0("Best_Analog ",Local_corr$DatesAnalogs[1])) - + # Example 8: Local_cor return list TRUE expL <- rnorm(1:20) dim(expL) <- c(lat = 4, lon = 5) @@ -282,15 +245,7 @@ Local_corr <- Analogs(expL=expL, criteria="Local_cor",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),region=region, nAnalogs = 5, return_list = TRUE) -plot.new() -layout(matrix(1:4,2,2,byrow=T)) -image(expL,main="expL") -image(expVar,main="expVar") -image(Local_corr$AnalogsFields[,,1], - main=paste0("Best_Analog ",Local_corr$DatesAnalogs[1])) -image(Local_corr$AnalogsFields[,,2], - main=paste0("2nd Best_Analog ",Local_corr$DatesAnalogs[2])) - + # Example 9: Large_dist, Local_dist, and Local_cor return list FALSE same variable expL <- rnorm(1:20) dim(expL) <- c(lat = 4, lon = 5) @@ -319,24 +274,6 @@ Local_corr <- Analogs(expL=expL, criteria="Local_cor",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),region=region, nAnalogs = 10, return_list = TRUE) -plot.new() -layout(matrix(1:9,3,3,byrow=T)) -image(expL,main="expL") -image(Large_scale$AnalogsFields[,,1], - main=paste0("Best_Analog C1 ",Large_scale$DatesAnalogs[1])) -image(Large_scale$AnalogsFields[,,2], - main=paste0("Best_Analog C1 ",Large_scale$DatesAnalogs[2])) -image(expVar,main="expVar") -image(Local_scale$AnalogsFields[,,1], - main=paste0("Best_Analog C2 ",Local_scale$DatesAnalogs[1])) -image(Local_scale$AnalogsFields[,,2], - main=paste0("Best_Analog C2 ",Local_scale$DatesAnalogs[2])) -image(expVar,main="expVar") -image(Local_corr$AnalogsFields[,,1], - main=paste0("Best_Analog C3 ",Local_corr$DatesAnalogs[1])) -image(Local_corr$AnalogsFields[,,2], - main=paste0("2nd Best_Analog C3 ",Local_corr$DatesAnalogs[2])) - # Example 10: Large_dist, Local_dist, and Local_cor return list FALSE different variable expL1 <- rnorm(1:20) dim(expL1) <- c(lat = 4, lon = 5) @@ -378,24 +315,7 @@ Local_corr <- Analogs(expL=expL2, criteria="Local_cor",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),region=region, nAnalogs = 10, return_list = TRUE) -plot.new() -layout(matrix(1:9,3,3,byrow=T)) -image(expL1,main="expL Var1") -image(Large_scale$AnalogsFields[,,1], - main=paste0("BestAn. Var1 C1 ",Large_scale$DatesAnalogs[1])) -image(Large_scale$AnalogsFields[,,2], - main=paste0("BestAn. Var1 C1 ",Large_scale$DatesAnalogs[2])) -image(expVar1,main="expVar1") -image(Local_scale$AnalogsFields[,,1], - main=paste0("BestAn. Var1 C2 ",Local_scale$DatesAnalogs[1])) -image(Local_scale$AnalogsFields[,,2], - main=paste0("BestAn. Var1 C2 ",Local_scale$DatesAnalogs[2])) -image(expVar2,main="expVar2") -image(Local_corr$AnalogsFields[,,1], - main=paste0("BestAn. Var2 C3 ",Local_corr$DatesAnalogs[1])) -image(Local_corr$AnalogsFields[,,2], - main=paste0("2nd BestAn. Var2 C3 ",Local_corr$DatesAnalogs[2])) - + } \references{ Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, diff --git a/man/CST_Analogs.Rd b/man/CST_Analogs.Rd index c3602355..3fe092d3 100644 --- a/man/CST_Analogs.Rd +++ b/man/CST_Analogs.Rd @@ -12,6 +12,8 @@ CST_Analogs(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, \item{obsL}{an 's2dv_cube' object containing the observational field on the large scale. The element 'data' in the 's2dv_cube' object must have the same latitudinal and longitudinal dimensions as parameter 'expL' and a temporal dimension with the maximum number of available observations.} +\item{time_obsL}{a character string indicating the date of the observations in the format "dd/mm/yyyy"} + \item{expVar}{an 's2dv_cube' object containing the experimental field on the local scale, usually a different variable to the parameter 'expL'. If it is not NULL (by default, NULL), the returned field by this function will be the analog of parameter 'expVar'.} \item{obsVar}{an 's2dv_cube' containing the field of the same variable as the passed in parameter 'expVar' for the same region.} -- GitLab From d5e0b4b84b64c302e506ba8c02789f1891a4bf13 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 5 Nov 2019 09:12:56 +0100 Subject: [PATCH 35/43] updating examples Analogs --- R/CST_Analogs.R | 494 ++++++++++++++++++++++++++---------------------- man/Analogs.Rd | 374 +++++++++++++++++++----------------- 2 files changed, 465 insertions(+), 403 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 60e5b5af..e26f0816 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -3,7 +3,7 @@ #' #'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} #'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} -#' +#' #'@description This function perform a downscaling using Analogs. To compute #'the analogs, the function search for days with similar large scale conditions #'to downscaled fields in the local scale. @@ -169,10 +169,10 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'@param region a vector of length four indicating the minimum longitude, #'the maximum longitude, the minimum latitude and the maximum latitude. #'@param return_list TRUE if you want to get a list with the best analogs FALSE -#'#'if not. +#' if not. For Downscaling return_list must be FALSE. #'@param nAnalogs number of Analogs to be selected to apply the criterias (this -#'is not the necessary the number of analogs that the user can get, but the number -#'of events with minimal distance in which perform the search of the best Analog. +#' is not the necessary the number of analogs that the user can get, but the number +#' of events with minimal distance in which perform the search of the best Analog. #' The default value for the Large_dist criteria is 1, the default value for #' the Local_dist criteria is 10 and same for Local_cor. If return_list is #' False you will get just the first one for downscaling purposes. If return_list @@ -186,224 +186,252 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'@examples #'require(zeallot) #' -#' # Example 1:Large_dist -#' expL <- rnorm(1:20) -#' dim(expL) <- c(lat = 4, lon = 5) -#' obsL <- c(rnorm(1:180),expL*2) -#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) -#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -#' downscale_field <- Analogs(expL, obsL, time_obsL) -#' -#' # Example 2:Large_dist imposing nAnalogs and return_list -#' expL <- rnorm(1:20) -#' dim(expL) <- c(lat = 4, lon = 5) -#' obsL <- c(rnorm(1:1980),expL*1.5) -#' dim(obsL) <- c(lat = 4, lon = 5, time = 100) -#' time_obsL <- paste(rep("01", 100), rep("01", 100), 1920 : 2019, sep = "-") -#' nAnalogs=30 -#' downscale_field <- Analogs(expL, obsL, time_obsL,nAnalogs=nAnalogs,return_list = TRUE) -#' str(downscale_field) -#' -#' # Example 3:Local_dist with obsVar and expVar return_list = FALSE -#' expL <- rnorm(1:20) -#' dim(expL) <- c(lat = 4, lon = 5) -#' obsL <- c(rnorm(1:180),expL*2) -#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) -#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -#' expVar <- expL[1:3,1:3] -#' dim(expVar) <- c(lat = 3, lon = 3) -#' obsVar <- obsL[1:3,1:3,1:10] -#' dim(obsVar) <- c(lat = 3, lon = 3, time = 10) -#' lonmin=-1 -#' lonmax=2 -#' latmin=30 -#' latmax=33 -#' region=c(lonmin,lonmax,latmin,latmax) -#' Local_scale <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, -#' criteria="Local_dist",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),region=region, -#' nAnalogs = 5, return_list = FALSE) -#' -#' # Example 4:Large_dist and Local_dist analogs. Local_dist with obsVar and expVar. return_list = FALSE in both -#' expL <- rnorm(1:20) -#' dim(expL) <- c(lat = 4, lon = 5) -#' obsL <- c(rnorm(1:180),expL*5) -#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) -#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -#' expVar <- expL[1:3,1:3] -#' dim(expVar) <- c(lat = 3, lon = 3) -#' obsVar <- obsL[1:3,1:3,1:10] -#' dim(obsVar) <- c(lat = 3, lon = 3, time = 10) -#' -#' # analogs of large scale using criteria 1 -#' Large_scale <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL, -#' criteria="Large_dist", -#' nAnalogs = 10, return_list = FALSE) -#' # analogs of local scale using criteria 2 -#' lonmin=-1 -#' lonmax=2 -#' latmin=30 -#' latmax=33 -#' region=c(lonmin,lonmax,latmin,latmax) -#' Local_scale <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, -#' criteria="Local_dist",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),region=region, -#' nAnalogs = 10, return_list = FALSE) -#' -#' # Example 5: Local_dist without obsVar and expVar -#' expL <- rnorm(1:20) -#' dim(expL) <- c(lat = 4, lon = 5) -#' obsL <- c(rnorm(1:180),expL*2) -#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) -#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -#' lonmin=-1 -#' lonmax=2 -#' latmin=30 -#' latmax=33 -#' region=c(lonmin,lonmax,latmin,latmax) -#' Local_scale2 <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL, -#' criteria="Local_dist",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),region=region, -#' nAnalogs = 10, return_list = FALSE) -#' -#' # Example 6:Local_dist with obsVar and expVar return_list = TRUE -#' expL <- rnorm(1:20) -#' dim(expL) <- c(lat = 4, lon = 5) -#' obsL <- c(rnorm(1:180),expL*2) -#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) -#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -#' expVar <- expL[1:3,1:3] -#' dim(expVar) <- c(lat = 3, lon = 3) -#' obsVar <- obsL[1:3,1:3,1:10] -#' dim(obsVar) <- c(lat = 3, lon = 3, time = 10) -#' lonmin=-1 -#' lonmax=2 -#' latmin=30 -#' latmax=33 -#' region=c(lonmin,lonmax,latmin,latmax) -#' Local_scale <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, -#' criteria="Local_dist",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),region=region, -#' nAnalogs = 5, return_list = TRUE) -#' str(Local_scale) +#'# Example 1:Downscaling using criteria 'Large_dist' and a single variable: +#'# The best analog is found using a single variable (i.e. Sea level pressure, SLP) +#'# The downscaling will be done in the same variable used to study the minimal distance +#'# (i.e. SLP). obsVar and expVar NULLS or equal to obsL and expL respectively +#'# region, lonVar and latVar not necessary here. return_list=FALSE #' -#' # Example 7: Local_cor with obsVar and expVar return_list = FALSE -#' expL <- rnorm(1:20) -#' dim(expL) <- c(lat = 4, lon = 5) -#' obsL <- c(rnorm(1:180),expL*5) -#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) -#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -#' expVar <- expL[1:3,1:3] -#' dim(expVar) <- c(lat = 3, lon = 3) -#' obsVar <- obsL[1:3,1:3,1:10] -#' dim(obsVar) <- c(lat = 3, lon = 3, time = 10) -#' lonmin=-1 -#' lonmax=2 -#' latmin=30 -#' latmax=33 -#' region=c(lonmin,lonmax,latmin,latmax) -#' Local_corr <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, -#' criteria="Local_cor",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),region=region, -#' nAnalogs = 5, return_list = FALSE) -#' -#' # Example 8: Local_cor return list TRUE -#' expL <- rnorm(1:20) -#' dim(expL) <- c(lat = 4, lon = 5) -#' obsL <- c(rnorm(1:180),expL*5) -#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) -#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -#' expVar <- expL[1:3,1:3] -#' dim(expVar) <- c(lat = 3, lon = 3) -#' obsVar <- obsL[1:3,1:3,1:10] -#' dim(obsVar) <- c(lat = 3, lon = 3, time = 10) -#' lonmin=-1 -#' lonmax=2 -#' latmin=30 -#' latmax=33 -#' region=c(lonmin,lonmax,latmin,latmax) -#' Local_corr <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, -#' criteria="Local_cor",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),region=region, -#' nAnalogs = 5, return_list = TRUE) -#' -#' # Example 9: Large_dist, Local_dist, and Local_cor return list FALSE same variable -#' expL <- rnorm(1:20) -#' dim(expL) <- c(lat = 4, lon = 5) -#' obsL <- c(rnorm(1:180),expL*7) -#' dim(obsL) <- c(lat = 4, lon = 5, time = 10) -#' time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -#' # analogs of large scale using criteria 1 -#' Large_scale <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL, -#' criteria="Large_dist", -#' nAnalogs = 10, return_list = TRUE) -#' # analogs of local scale using criteria 2 -#' lonmin=-1 -#' lonmax=2 -#' latmin=30 -#' latmax=33 -#' region=c(lonmin,lonmax,latmin,latmax) -#' Local_scale <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL, +#'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) +#' +#'# Example 2: Downscaling using criteria 'Large_dist' and 2 variables: +#'# The best analog is found using 2 variables (i.e. Sea Level Pressure, +#'# SLP and precipitation, pr): one variable (i.e. sea level pressure, expL) +#'# to find the best analog day (defined in criteria 'Large_dist' as the day, in obsL, +#'# with the minimum Euclidean distance to the day of interest in expL) +#'# The second variable will be the variable to donwscale (i.e. precipitation, obsVar) +#'# Parameter obsVar must be different to obsL.The downscaled precipitation +#'# will be the precipitation that belongs to the best analog day in SLP. +#'# Region not needed here since will be the same for both variables. +#' +#'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) +#' +#'# Example 3:List of best Analogs using criteria 'Large_dist' and a single variable: +#'# same as Example 1 but getting a list of best analogs (return_list =TRUE) with the +#'# corresponding downscaled values, instead of only 1 single donwscaled value +#'# instead of 1 single downscaled value. Imposing nAnalogs (number of analogs to do the +#'# search of the best Analogs).obsVar and expVar NULL or equal to obsL and expL,respectively. +#' +#'expSLP <- rnorm(1:20) +#'dim(expSLP) <- c(lat = 4, lon = 5) +#'obsSLP <- c(rnorm(1:1980),expSLP*1.5) +#'dim(obsSLP) <- c(lat = 4, lon = 5, time = 100) +#'time_obsSLP <- paste(rep("01", 100), rep("01", 100), 1920 : 2019, sep = "-") +#'downscale_field<- Analogs(expL=expSLP, obsL=obsSLP, time_obsSLP, +#' nAnalogs=5,return_list = TRUE) +#'str(downscale_field) +#' +#'# Example 4:List of best Analogs using criteria 'Large_dist' and 2 variables: +#'# same as example 2 but getting a list of best analogs (return_list =TRUE) with the values +#'# instead of only a single downscaled value. Imposing nAnalogs (number of analogs to do the +#'# search of the best Analogs). obsVar and expVar must be different to obsL and expL. +#' +#'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,nAnalogs=5,return_list = TRUE) +#'str(downscale_field) +#' +#'# Example 5: Downscaling using criteria 'Local_dist' and 2 variables: +#'# The best analog is found using 2 variables (i.e. Sea Level Pressure, +#'# SLP and precipitation, pr). Parameter obsVar must be different to obsL.The +#'# downscaled precipitation will be the precipitation that belongs to the best +#'# analog day in SLP. lonVar, latVar and Region must be given here to select the local scale +#' +#'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) +#'# analogs of local scale using criteria 2 +#'lonmin=-1 +#'lonmax=2 +#'latmin=30 +#'latmax=33 +#'region=c(lonmin,lonmax,latmin,latmax) +#'Local_scale <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, +#' obsVar=obs.pr, +#' criteria="Local_dist",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' nAnalogs = 10, return_list = FALSE) +#'str(Local_scale) +#' +#'# Example 6: list of best analogs using criteria 'Local_dist' and 2 variables: +#'# The best analog is found using 2 variables. Parameter obsVar must be different to obsL in this case.The +#'# downscaled precipitation will be the precipitation that belongs to the best +#'# analog day in SLP. lonVar, latVar and Region needed. return_list=TRUE +#' +#'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) +#'# analogs of local scale using criteria 2 +#'lonmin=-1 +#'lonmax=2 +#'latmin=30 +#'latmax=33 +#'region=c(lonmin,lonmax,latmin,latmax) +#'Local_scale <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, +#' obsVar=obs.pr, #' criteria="Local_dist",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, #' nAnalogs = 10, return_list = TRUE) -#' # analogs of local scale using criteria 2 -#' Local_corr <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL, -#' criteria="Local_cor",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),region=region, -#' nAnalogs = 10, return_list = TRUE) -#' # Example 10: Large_dist, Local_dist, and Local_cor return list FALSE different variable -#' expL1 <- rnorm(1:20) -#' dim(expL1) <- c(lat = 4, lon = 5) -#' obsL1 <- c(rnorm(1:180),expL1*5) -#' dim(obsL1) <- c(lat = 4, lon = 5, time = 10) -#' time_obsL1 <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -#' expVar1 <- expL1[1:3,1:3] -#' dim(expVar1) <- c(lat = 3, lon = 3) -#' obsVar1 <- obsL1[1:3,1:3,1:10] -#' dim(obsVar1) <- c(lat = 3, lon = 3, time = 10) -#' # analogs of large scale using criteria 1 -#' Large_scale <- Analogs(expL=expL1, -#' obsL=obsL1, time_obsL=time_obsL1,expVar=expVar1,obsVar=obsVar1, -#' criteria="Large_dist", -#' nAnalogs = 10, return_list = TRUE) -#' # analogs of local scale using criteria 2 -#' lonmin=-1 -#' lonmax=2 -#' latmin=30 -#' latmax=33 -#' region=c(lonmin,lonmax,latmin,latmax) -#' Local_scale <- Analogs(expL=expL1, -#' obsL=obsL1, time_obsL=time_obsL1,obsVar=obsVar1,expVar=expVar1, +#'str(Local_scale) +#' +#'# Example 7: Downscaling using Local_dist criteria +#'# without parameters obsVar and expVar. return list =FALSE +#' +#'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 = "-") +#'# analogs of local scale using criteria 2 +#'lonmin=-1 +#'lonmax=2 +#'latmin=30 +#'latmax=33 +#'region=c(lonmin,lonmax,latmin,latmax) +#'Local_scale <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, #' criteria="Local_dist",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, #' nAnalogs = 10, return_list = TRUE) -#' # analogs of local scale using criteria 3 and another variable so different obsL, expL, obsVar and expVar -#' expL2 <- rnorm(1:20) -#' dim(expL2) <- c(lat = 4, lon = 5) -#' obsL2 <- c(rnorm(1:180),expL2*5) -#' dim(obsL2) <- c(lat = 4, lon = 5, time = 10) -#' time_obsL2 <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -#' expVar2 <- expL2[1:3,1:3] -#' dim(expVar2) <- c(lat = 3, lon = 3) -#' obsVar2 <- obsL2[1:3,1:3,1:10] -#' dim(obsVar2) <- c(lat = 3, lon = 3, time = 10) -#' Local_corr <- Analogs(expL=expL2, -#' obsL=obsL2, time_obsL=time_obsL2,obsVar=obsVar2,expVar=expVar2, -#' criteria="Local_cor",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),region=region, -#' nAnalogs = 10, return_list = TRUE) -#' +#'str(Local_scale) +#' +#'# Example 8: Downscaling using criteria 'Local_cor' and 2 variables: +#'# The best analog is found using 2 variables. Parameter obsVar and expVar are necessary and must be different +#'# to obsL and expL, respectively.The downscaled precipitation will be the +#'# precipitation that belongs to the best analog day in SLP large and local scales, +#'# and to the day with the higher correlation in precipitation. return_list=FALSE +#' +#'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 = "-") +#'exp.pr <- c(rnorm(1:20)*0.001) +#'dim(exp.pr)=dim(expSLP) +#'obs.pr <- c(rnorm(1:200)*0.001) +#'dim(obs.pr)=dim(obsSLP) +#'# analogs of local scale using criteria 2 +#'lonmin=-1 +#'lonmax=2 +#'latmin=30 +#'latmax=33 +#'region=c(lonmin,lonmax,latmin,latmax) +#'Local_scalecor <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, +#' obsVar=obs.pr,expVar=exp.pr, +#' criteria="Local_cor",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),nAnalogs=15,region=region, +#' return_list = FALSE) +#'str(Local_scalecor) +#' +#'# Example 9: List of best analogs in the three criterias Large_dist, Local_dist, and Local_cor +#'# return list TRUE same variable +#' +#'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 = "-") +#'# analogs of large scale using criteria 1 +#'Large_scale <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL, +#' criteria="Large_dist", +#' nAnalogs = 15, return_list = TRUE) +#'str(Large_scale) +#'# analogs of local scale using criteria 2 +#'lonmin=-1 +#'lonmax=2 +#'latmin=30 +#'latmax=33 +#'region=c(lonmin,lonmax,latmin,latmax) +#'Local_scale <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, +#' criteria="Local_dist",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),nAnalogs=15,region=region, +#' return_list = TRUE) +#'str(Local_scale) +#'# analogs of local scale using criteria 3 +#'Local_scalecor <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, +#' obsVar=obsSLP,expVar=expSLP, +#' criteria="Local_cor",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),nAnalogs=15,region=region, +#' return_list = TRUE) +#'str(Local_scalecor) +#' +#'# Example 10: Downscaling in the three criteria Large_dist, Local_dist, and Local_cor +#'return list FALSE, different variable +#' +#'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 = "-") +#'exp.pr <- c(rnorm(1:20)*0.001) +#'dim(exp.pr)=dim(expSLP) +#'obs.pr <- c(rnorm(1:200)*0.001) +#'dim(obs.pr)=dim(obsSLP) +#'# analogs of large scale using criteria 1 +#'Large_scale <- Analogs(expL=expL, +#' obsL=obsL, time_obsL=time_obsL, +#' criteria="Large_dist", +#' nAnalogs = 15, return_list = FALSE) +#'str(Large_scale) +#'# analogs of local scale using criteria 2 +#'lonmin=-1 +#'lonmax=2 +#'latmin=30 +#'latmax=33 +#'region=c(lonmin,lonmax,latmin,latmax) +#'Local_scale <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, +#' obsVar=obs.pr, +#' criteria="Local_dist",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),nAnalogs=15,region=region, +#' return_list = FALSE) +#'str(Local_scale) +#'# analogs of local scale using criteria 3 +#'Local_scalecor <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, +#' obsVar=obs.pr,expVar=exp.pr, +#' criteria="Local_cor",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),nAnalogs=15,region=region, +#' return_list = FALSE) +#'str(Local_scalecor) +#' #'@export Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", @@ -425,14 +453,17 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, if (any(is.na(obsL))) { warning("Parameter 'obs' contains NA values.") } - if (is.null(expVar) & !is.null(obsVar)) { - obsVar <- NULL - warning("Parameter 'obsVar' is set to NULL as parameter 'expVar'.") - } if (!is.null(expVar) & is.null(obsVar)) { expVar <- NULL - warning("Parameter 'expVar' is set to NULL as parameter 'obsVar'.") + warning("Parameter 'expVar' is set to NULL as parameter 'obsVar', large scale field will be returned.") } + if (is.null(expVar) & is.null(obsVar)) { + warning("Parameter 'expVar' and 'obsVar' are NULLs, downscaling/listing same variable as obsL and expL'.") + } + if(!is.null(obsVar) & is.null(expVar) & criteria=="Local_cor"){ + stop("parameter 'expVar' cannot be NULL") + } + if (any(names(dim(obsL)) %in% 'ftime')) { if (any(names(dim(obsL)) %in% 'time')) { stop("Multiple temporal dimensions ('ftime' and 'time') found", @@ -488,9 +519,11 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, } } - if (is.null(region)) { + if (is.null(region) & criteria!="Large_dist") { if (!is.null(lonVar) & !is.null(latVar)) { region <- c(min(lonVar), max(lonVar), min(latVar), max(latVar)) + }else{ + stop("Parameters 'lonVar' and 'latVar' must be given in criteria 'Local_dist' and 'Local_cor'") } } @@ -504,14 +537,15 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, dim(Analogs_dates) <- dim(best) if (all(!is.null(region), !is.null(lonVar), !is.null(latVar))) { if (is.null(obsVar)) { - obsVar <- SelBox(obsL, lon = lonVar, lat = latVar, region = region) - Analogs_fields <- Subset(obsVar$data, along = which(names(dim(obsVar)) == 'time'), + obsVar <- SelBox(obsL, lon = lonVar, lat = latVar, region = region)$data + expVar <- SelBox(expL, lon = lonVar, lat = latVar, region=region)$data + Analogs_fields <- Subset(obsVar, along = which(names(dim(obsVar)) == 'time'), indices = best) - warning("obsVar is NULL and will be calculated.") + warning("obsVar is NULL, obsVar will be computed from obsL (same variable)") } else { - #obsVar <- SelBox(obsL, lon = lonVar, lat = latVar, region = region) - Analogs_fields <- Subset(obsVar, along = which(names(dim(obsVar)) == 'time'), + obslocal <- SelBox(obsVar, lon = lonVar, lat = latVar, region = region)$data + Analogs_fields <- Subset(obslocal, along = which(names(dim(obslocal)) == 'time'), indices = best) } } else { @@ -521,7 +555,7 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, Analogs_fields <- Subset(obsL, along = which(names(dim(obsL)) == 'time'), indices = best) } else { - Analogs_fields <- Subset(obsVar, + Analogs_fields <- Subset(obsVar, along = which(names(dim(obsVar)) == 'time'), indices = best) } @@ -543,7 +577,7 @@ BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, nAnalogs = 10) { pos_dim <- which(names(dim(position)) == 'pos') if (dim(position)[pos_dim] == 1) { - pos1 <- position + pos1 <- Subset(position, along = pos_dim, indices = 1) if (criteria != 'Large_dist') { warning("Dimension 'pos' in parameter 'position' has length 1,", " criteria 'Large_dist' will be used.") @@ -654,8 +688,8 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ } } if (criteria == "Local_cor") { - obs <- SelBox(obsL, lon = lonVar, lat = latVar, region = region)$data - exp <- SelBox(expL, lon = lonVar, lat = latVar, region = region)$data + obs <- SelBox(obsVar, lon = lonVar, lat = latVar, region = region)$data + exp <- SelBox(expVar, lon = lonVar, lat = latVar, region = region)$data metric3 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), fun = .select, exp, metric = "cor")$output1 dim(metric3) <- c(dim(metric3), metric=1) diff --git a/man/Analogs.Rd b/man/Analogs.Rd index 05e3bd32..46546628 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -56,7 +56,7 @@ is True you will get the list of the best analogs that were searched in nAnalogs under the selected criterias.} \item{return_list}{TRUE if you want to get a list with the best analogs FALSE -#'if not.} +if not. For Downscaling return_list must be FALSE.} } \value{ DatesAnalogs, A character string with the date of the best analogs (time, distance) @@ -98,224 +98,252 @@ The function is an adapted version of the method of Yiou et al 2013. \examples{ require(zeallot) -# Example 1:Large_dist -expL <- rnorm(1:20) -dim(expL) <- c(lat = 4, lon = 5) -obsL <- c(rnorm(1:180),expL*2) -dim(obsL) <- c(lat = 4, lon = 5, time = 10) -time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -downscale_field <- Analogs(expL, obsL, time_obsL) - -# Example 2:Large_dist imposing nAnalogs and return_list -expL <- rnorm(1:20) -dim(expL) <- c(lat = 4, lon = 5) -obsL <- c(rnorm(1:1980),expL*1.5) -dim(obsL) <- c(lat = 4, lon = 5, time = 100) -time_obsL <- paste(rep("01", 100), rep("01", 100), 1920 : 2019, sep = "-") -nAnalogs=30 -downscale_field <- Analogs(expL, obsL, time_obsL,nAnalogs=nAnalogs,return_list = TRUE) +# Example 1:Downscaling using criteria 'Large_dist' and a single variable: +# The best analog is found using a single variable (i.e. Sea level pressure, SLP) +# The downscaling will be done in the same variable used to study the minimal distance +# (i.e. SLP). obsVar and expVar NULLS or equal to obsL and expL respectively +# region, lonVar and latVar not necessary here. return_list=FALSE + +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) -# Example 3:Local_dist with obsVar and expVar return_list = FALSE -expL <- rnorm(1:20) -dim(expL) <- c(lat = 4, lon = 5) -obsL <- c(rnorm(1:180),expL*2) -dim(obsL) <- c(lat = 4, lon = 5, time = 10) -time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -expVar <- expL[1:3,1:3] -dim(expVar) <- c(lat = 3, lon = 3) -obsVar <- obsL[1:3,1:3,1:10] -dim(obsVar) <- c(lat = 3, lon = 3, time = 10) -lonmin=-1 -lonmax=2 -latmin=30 -latmax=33 -region=c(lonmin,lonmax,latmin,latmax) -Local_scale <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, - criteria="Local_dist",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),region=region, - nAnalogs = 5, return_list = FALSE) - -# Example 4:Large_dist and Local_dist analogs. Local_dist with obsVar and expVar. return_list = FALSE in both -expL <- rnorm(1:20) -dim(expL) <- c(lat = 4, lon = 5) -obsL <- c(rnorm(1:180),expL*5) -dim(obsL) <- c(lat = 4, lon = 5, time = 10) -time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -expVar <- expL[1:3,1:3] -dim(expVar) <- c(lat = 3, lon = 3) -obsVar <- obsL[1:3,1:3,1:10] -dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +# Example 2: Downscaling using criteria 'Large_dist' and 2 variables: +# The best analog is found using 2 variables (i.e. Sea Level Pressure, +# SLP and precipitation, pr): one variable (i.e. sea level pressure, expL) +# to find the best analog day (defined in criteria 'Large_dist' as the day, in obsL, +# with the minimum Euclidean distance to the day of interest in expL) +# The second variable will be the variable to donwscale (i.e. precipitation, obsVar) +# Parameter obsVar must be different to obsL.The downscaled precipitation +# will be the precipitation that belongs to the best analog day in SLP. +# Region not needed here since will be the same for both variables. -# analogs of large scale using criteria 1 -Large_scale <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL, - criteria="Large_dist", - nAnalogs = 10, return_list = FALSE) +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) + +# Example 3:List of best Analogs using criteria 'Large_dist' and a single variable: +# same as Example 1 but getting a list of best analogs (return_list =TRUE) with the +# corresponding downscaled values, instead of only 1 single donwscaled value +# instead of 1 single downscaled value. Imposing nAnalogs (number of analogs to do the +# search of the best Analogs).obsVar and expVar NULL or equal to obsL and expL,respectively. + +expSLP <- rnorm(1:20) +dim(expSLP) <- c(lat = 4, lon = 5) +obsSLP <- c(rnorm(1:1980),expSLP*1.5) +dim(obsSLP) <- c(lat = 4, lon = 5, time = 100) +time_obsSLP <- paste(rep("01", 100), rep("01", 100), 1920 : 2019, sep = "-") +downscale_field<- Analogs(expL=expSLP, obsL=obsSLP, time_obsSLP, + nAnalogs=5,return_list = TRUE) +str(downscale_field) + +# Example 4:List of best Analogs using criteria 'Large_dist' and 2 variables: +# same as example 2 but getting a list of best analogs (return_list =TRUE) with the values +# instead of only a single downscaled value. Imposing nAnalogs (number of analogs to do the +# search of the best Analogs). obsVar and expVar must be different to obsL and expL. + +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,nAnalogs=5,return_list = TRUE) +str(downscale_field) + +# Example 5: Downscaling using criteria 'Local_dist' and 2 variables: +# The best analog is found using 2 variables (i.e. Sea Level Pressure, +# SLP and precipitation, pr). Parameter obsVar must be different to obsL.The +# downscaled precipitation will be the precipitation that belongs to the best +# analog day in SLP. lonVar, latVar and Region must be given here to select the local scale + +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) # analogs of local scale using criteria 2 lonmin=-1 lonmax=2 latmin=30 latmax=33 region=c(lonmin,lonmax,latmin,latmax) -Local_scale <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, - criteria="Local_dist",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),region=region, - nAnalogs = 10, return_list = FALSE) - -# Example 5: Local_dist without obsVar and expVar -expL <- rnorm(1:20) -dim(expL) <- c(lat = 4, lon = 5) -obsL <- c(rnorm(1:180),expL*2) -dim(obsL) <- c(lat = 4, lon = 5, time = 10) -time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -lonmin=-1 -lonmax=2 -latmin=30 -latmax=33 -region=c(lonmin,lonmax,latmin,latmax) -Local_scale2 <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL, - criteria="Local_dist",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),region=region, - nAnalogs = 10, return_list = FALSE) - -# Example 6:Local_dist with obsVar and expVar return_list = TRUE -expL <- rnorm(1:20) -dim(expL) <- c(lat = 4, lon = 5) -obsL <- c(rnorm(1:180),expL*2) -dim(obsL) <- c(lat = 4, lon = 5, time = 10) -time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -expVar <- expL[1:3,1:3] -dim(expVar) <- c(lat = 3, lon = 3) -obsVar <- obsL[1:3,1:3,1:10] -dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +Local_scale <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, + obsVar=obs.pr, + criteria="Local_dist",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 10, return_list = FALSE) +str(Local_scale) + +# Example 6: list of best analogs using criteria 'Local_dist' and 2 variables: +# The best analog is found using 2 variables. Parameter obsVar must be different to obsL in this case.The +# downscaled precipitation will be the precipitation that belongs to the best +# analog day in SLP. lonVar, latVar and Region needed. return_list=TRUE + +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) +# analogs of local scale using criteria 2 lonmin=-1 lonmax=2 latmin=30 latmax=33 region=c(lonmin,lonmax,latmin,latmax) -Local_scale <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, - criteria="Local_dist",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),region=region, - nAnalogs = 5, return_list = TRUE) +Local_scale <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, + obsVar=obs.pr, + criteria="Local_dist",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 10, return_list = TRUE) str(Local_scale) -# Example 7: Local_cor with obsVar and expVar return_list = FALSE -expL <- rnorm(1:20) -dim(expL) <- c(lat = 4, lon = 5) -obsL <- c(rnorm(1:180),expL*5) -dim(obsL) <- c(lat = 4, lon = 5, time = 10) -time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -expVar <- expL[1:3,1:3] -dim(expVar) <- c(lat = 3, lon = 3) -obsVar <- obsL[1:3,1:3,1:10] -dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +# Example 7: Downscaling using Local_dist criteria +# without parameters obsVar and expVar. return list =FALSE + +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 = "-") +# analogs of local scale using criteria 2 lonmin=-1 lonmax=2 latmin=30 latmax=33 region=c(lonmin,lonmax,latmin,latmax) -Local_corr <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, - criteria="Local_cor",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),region=region, - nAnalogs = 5, return_list = FALSE) - -# Example 8: Local_cor return list TRUE -expL <- rnorm(1:20) -dim(expL) <- c(lat = 4, lon = 5) -obsL <- c(rnorm(1:180),expL*5) -dim(obsL) <- c(lat = 4, lon = 5, time = 10) -time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -expVar <- expL[1:3,1:3] -dim(expVar) <- c(lat = 3, lon = 3) -obsVar <- obsL[1:3,1:3,1:10] -dim(obsVar) <- c(lat = 3, lon = 3, time = 10) +Local_scale <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, + criteria="Local_dist",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + nAnalogs = 10, return_list = TRUE) +str(Local_scale) + +# Example 8: Downscaling using criteria 'Local_cor' and 2 variables: +# The best analog is found using 2 variables. Parameter obsVar and expVar are necessary and must be different +# to obsL and expL, respectively.The downscaled precipitation will be the +# precipitation that belongs to the best analog day in SLP large and local scales, +# and to the day with the higher correlation in precipitation. return_list=FALSE + +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 = "-") +exp.pr <- c(rnorm(1:20)*0.001) +dim(exp.pr)=dim(expSLP) +obs.pr <- c(rnorm(1:200)*0.001) +dim(obs.pr)=dim(obsSLP) +# analogs of local scale using criteria 2 lonmin=-1 lonmax=2 latmin=30 latmax=33 region=c(lonmin,lonmax,latmin,latmax) -Local_corr <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL,obsVar=obsVar,expVar=expVar, - criteria="Local_cor",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),region=region, - nAnalogs = 5, return_list = TRUE) - -# Example 9: Large_dist, Local_dist, and Local_cor return list FALSE same variable -expL <- rnorm(1:20) -dim(expL) <- c(lat = 4, lon = 5) -obsL <- c(rnorm(1:180),expL*7) -dim(obsL) <- c(lat = 4, lon = 5, time = 10) -time_obsL <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +Local_scalecor <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, + obsVar=obs.pr,expVar=exp.pr, + criteria="Local_cor",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),nAnalogs=15,region=region, + return_list = FALSE) +str(Local_scalecor) + +# Example 9: List of best analogs in the three criterias Large_dist, Local_dist, and Local_cor +# return list TRUE same variable + +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 = "-") # analogs of large scale using criteria 1 Large_scale <- Analogs(expL=expL, obsL=obsL, time_obsL=time_obsL, criteria="Large_dist", - nAnalogs = 10, return_list = TRUE) + nAnalogs = 15, return_list = TRUE) +str(Large_scale) # analogs of local scale using criteria 2 lonmin=-1 lonmax=2 latmin=30 latmax=33 region=c(lonmin,lonmax,latmin,latmax) -Local_scale <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL, +Local_scale <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, criteria="Local_dist",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),region=region, - nAnalogs = 10, return_list = TRUE) -# analogs of local scale using criteria 2 -Local_corr <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL, - criteria="Local_cor",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),region=region, - nAnalogs = 10, return_list = TRUE) -# Example 10: Large_dist, Local_dist, and Local_cor return list FALSE different variable -expL1 <- rnorm(1:20) -dim(expL1) <- c(lat = 4, lon = 5) -obsL1 <- c(rnorm(1:180),expL1*5) -dim(obsL1) <- c(lat = 4, lon = 5, time = 10) -time_obsL1 <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -expVar1 <- expL1[1:3,1:3] -dim(expVar1) <- c(lat = 3, lon = 3) -obsVar1 <- obsL1[1:3,1:3,1:10] -dim(obsVar1) <- c(lat = 3, lon = 3, time = 10) + latVar=seq(30,35,1.5),nAnalogs=15,region=region, + return_list = TRUE) +str(Local_scale) +# analogs of local scale using criteria 3 +Local_scalecor <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, + obsVar=obsSLP,expVar=expSLP, + criteria="Local_cor",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),nAnalogs=15,region=region, + return_list = TRUE) +str(Local_scalecor) + +# Example 10: Downscaling in the three criteria Large_dist, Local_dist, and Local_cor +return list FALSE, different variable + +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 = "-") +exp.pr <- c(rnorm(1:20)*0.001) +dim(exp.pr)=dim(expSLP) +obs.pr <- c(rnorm(1:200)*0.001) +dim(obs.pr)=dim(obsSLP) # analogs of large scale using criteria 1 -Large_scale <- Analogs(expL=expL1, - obsL=obsL1, time_obsL=time_obsL1,expVar=expVar1,obsVar=obsVar1, +Large_scale <- Analogs(expL=expL, + obsL=obsL, time_obsL=time_obsL, criteria="Large_dist", - nAnalogs = 10, return_list = TRUE) + nAnalogs = 15, return_list = FALSE) +str(Large_scale) # analogs of local scale using criteria 2 lonmin=-1 lonmax=2 latmin=30 latmax=33 region=c(lonmin,lonmax,latmin,latmax) -Local_scale <- Analogs(expL=expL1, - obsL=obsL1, time_obsL=time_obsL1,obsVar=obsVar1,expVar=expVar1, +Local_scale <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, + obsVar=obs.pr, criteria="Local_dist",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),region=region, - nAnalogs = 10, return_list = TRUE) -# analogs of local scale using criteria 3 and another variable so different obsL, expL, obsVar and expVar -expL2 <- rnorm(1:20) -dim(expL2) <- c(lat = 4, lon = 5) -obsL2 <- c(rnorm(1:180),expL2*5) -dim(obsL2) <- c(lat = 4, lon = 5, time = 10) -time_obsL2 <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") -expVar2 <- expL2[1:3,1:3] -dim(expVar2) <- c(lat = 3, lon = 3) -obsVar2 <- obsL2[1:3,1:3,1:10] -dim(obsVar2) <- c(lat = 3, lon = 3, time = 10) -Local_corr <- Analogs(expL=expL2, - obsL=obsL2, time_obsL=time_obsL2,obsVar=obsVar2,expVar=expVar2, - criteria="Local_cor",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),region=region, - nAnalogs = 10, return_list = TRUE) - + latVar=seq(30,35,1.5),nAnalogs=15,region=region, + return_list = FALSE) +str(Local_scale) +# analogs of local scale using criteria 3 +Local_scalecor <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, + obsVar=obs.pr,expVar=exp.pr, + criteria="Local_cor",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),nAnalogs=15,region=region, + return_list = FALSE) +str(Local_scalecor) + } \references{ Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, -- GitLab From 305b648b54081c8bdb6988093cade6b204914216 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 5 Nov 2019 11:40:31 +0100 Subject: [PATCH 36/43] updating examples Analogs --- R/CST_Analogs.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index e26f0816..28262ac6 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -366,8 +366,8 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'dim(obsSLP) <- c(lat = 4, lon = 5, time = 10) #'time_obsSLP <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") #'# analogs of large scale using criteria 1 -#'Large_scale <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL, +#'Large_scale <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, #' criteria="Large_dist", #' nAnalogs = 15, return_list = TRUE) #'str(Large_scale) @@ -405,8 +405,8 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'obs.pr <- c(rnorm(1:200)*0.001) #'dim(obs.pr)=dim(obsSLP) #'# analogs of large scale using criteria 1 -#'Large_scale <- Analogs(expL=expL, -#' obsL=obsL, time_obsL=time_obsL, +#'Large_scale <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, #' criteria="Large_dist", #' nAnalogs = 15, return_list = FALSE) #'str(Large_scale) -- GitLab From aef2299cad9c4105a9d3691b98a1a7459258f94e Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 5 Nov 2019 11:59:16 +0100 Subject: [PATCH 37/43] updating and correcting Analogs --- man/Analogs.Rd | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/man/Analogs.Rd b/man/Analogs.Rd index 46546628..375a8137 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -278,8 +278,8 @@ 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 = "-") # analogs of large scale using criteria 1 -Large_scale <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL, +Large_scale <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, criteria="Large_dist", nAnalogs = 15, return_list = TRUE) str(Large_scale) @@ -317,8 +317,8 @@ dim(exp.pr)=dim(expSLP) obs.pr <- c(rnorm(1:200)*0.001) dim(obs.pr)=dim(obsSLP) # analogs of large scale using criteria 1 -Large_scale <- Analogs(expL=expL, - obsL=obsL, time_obsL=time_obsL, +Large_scale <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, criteria="Large_dist", nAnalogs = 15, return_list = FALSE) str(Large_scale) -- GitLab From 79e51702ba9f75e867bfb43a48eb77d6af635e26 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Tue, 5 Nov 2019 12:06:49 +0100 Subject: [PATCH 38/43] updating and correcting examples in Analogs --- R/CST_Analogs.R | 2 +- man/Analogs.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 28262ac6..87af7881 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -393,7 +393,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'str(Local_scalecor) #' #'# Example 10: Downscaling in the three criteria Large_dist, Local_dist, and Local_cor -#'return list FALSE, different variable +#'# return list FALSE, different variable #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) diff --git a/man/Analogs.Rd b/man/Analogs.Rd index 375a8137..c24a58e1 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -305,7 +305,7 @@ Local_scalecor <- Analogs(expL=expSLP, str(Local_scalecor) # Example 10: Downscaling in the three criteria Large_dist, Local_dist, and Local_cor -return list FALSE, different variable +# return list FALSE, different variable expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) -- GitLab From 4d729a072ccefcea6e626713722c170c1eb9b1ac Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Wed, 6 Nov 2019 09:49:23 +0100 Subject: [PATCH 39/43] including MetricValues output in Analogs --- R/CST_Analogs.R | 359 ++++++++++++++++++++++++++------------------- man/Analogs.Rd | 174 ++++++++++++---------- man/CST_Analogs.Rd | 68 +++++---- 3 files changed, 349 insertions(+), 252 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 87af7881..5ac8a035 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -1,51 +1,65 @@ #'@rdname CST_Analogs #'@title Downscaling using Analogs based on large scale fields. #' -#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +#'@author M. Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} #'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} #' #'@description This function perform a downscaling using Analogs. To compute #'the analogs, the function search for days with similar large scale conditions -#'to downscaled fields in the local scale. -#'The large scale and the local scale regions are defined by the user. -#'The large scale is usually given by atmospheric circulation as sea level -#'pressure or geopotential height (Yiou et al, 2013) but the function gives the -#' possibility to use another field. The local scale will be usually given by -#' precipitation or temperature fields, but might be another variable. -#' The analogs function will find the best analogs based in three criterias: +#'to downscaled fields in the local scale. The large scale and the local scale +#'regions are defined by the user. The large scale is usually given by +#'atmospheric circulation as sea level pressure or geopotential height +#'(Yiou et al, 2013) but the function gives the possibility to use another +#'field. The local scale will be usually given by precipitation or temperature +#'fields, but might be another variable.The analogs function will find the best +#'analogs based in three criterias: #' (1) Minimal distance in the large scale pattern (i.e. SLP) #' (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal #' distance in the local scale pattern (i.e. SLP). #' (3) Minimal distance in the large scale pattern (i.e. SLP), minimal #' distance in the local scale pattern (i.e. SLP) and maxima correlation in the #' local variable to downscale (i.e Precipitation). -#' The search of analogs must be done in the longest dataset posible. This is -#' important since it is necessary to have a good representation of the -#' possible states of the field in the past, and therefore, to get better -#' analogs. Once the search of the analogs is complete, and in order to used the -#' three criterias the user can select a number of analogsi, using parameter 'nAnalogs' to restrict -#' the selection of the best analogs in a short number of posibilities, the best -#' ones. -#' This function has not constrains of specific regions, variables to downscale, -#' or data to be used (seasonal forecast data, climate projections data, -#' reanalyses data). -#' The regrid into a finner scale is done interpolating with CST_Load. -#' Then, this interpolation is corrected selecting the analogs in the large -#' and local scale in based of the observations. -#' The function is an adapted version of the method of Yiou et al 2013. +#'The search of analogs must be done in the longest dataset posible. This is +#'important since it is necessary to have a good representation of the +#'possible states of the field in the past, and therefore, to get better +#'analogs. Once the search of the analogs is complete, and in order to used +#'the three criterias the user can select a number of analogs, using parameter +#''nAnalogs' to restrict the selection of the best analogs in a short number +#'of posibilities, the best ones. +#'This function has not constrains of specific regions, variables to downscale, +#'or data to be used (seasonal forecast data, climate projections data, +#'reanalyses data). The regrid into a finner scale is done interpolating with +#'CST_Load. Then, this interpolation is corrected selecting the analogs in the +#'large and local scale in based of the observations. The function is an +#'adapted version of the method of Yiou et al 2013. #' #'@references Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, #' and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column #' from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. #' \email{pascal.yiou@lsce.ipsl.fr} #' -#'@param expL an 's2dv_cube' object containing the experimental field on the large scale for which the analog is aimed. This field is used to in all the criterias. If parameter 'expVar' is not provided, the function will return the expL analog. The element 'data' in the 's2dv_cube' object must have, at least, latitudinal and longitudinal dimensions. The object is expect to be already subset for the desired large scale region. -#'@param obsL an 's2dv_cube' object containing the observational field on the large scale. The element 'data' in the 's2dv_cube' object must have the same latitudinal and longitudinal dimensions as parameter 'expL' and a temporal dimension with the maximum number of available observations. -#'@param time_obsL a character string indicating the date of the observations in the format "dd/mm/yyyy" -#'@param expVar an 's2dv_cube' object containing the experimental field on the local scale, usually a different variable to the parameter 'expL'. If it is not NULL (by default, NULL), the returned field by this function will be the analog of parameter 'expVar'. -#'@param obsVar an 's2dv_cube' containing the field of the same variable as the passed in parameter 'expVar' for the same region. -#'@param region a vector of length four indicating the minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude. -#'@param criteria a character string indicating the criteria to be used for the selection of analogs: +#'@param expL an 's2dv_cube' object containing the experimental field on the +#'large scale for which the analog is aimed. This field is used to in all the +#'criterias. If parameter 'expVar' is not provided, the function will return +#'the expL analog. The element 'data' in the 's2dv_cube' object must have, at +#'least, latitudinal and longitudinal dimensions. The object is expect to be +#'already subset for the desired large scale region. +#'@param obsL an 's2dv_cube' object containing the observational field on the +#'large scale. The element 'data' in the 's2dv_cube' object must have the same +#'latitudinal and longitudinal dimensions as parameter 'expL' and a temporal +#'dimension with the maximum number of available observations. +#'@param time_obsL a character string indicating the date of the observations +#'in the format "dd/mm/yyyy" +#'@param expVar an 's2dv_cube' object containing the experimental field on the +#'local scale, usually a different variable to the parameter 'expL'. If it is +#'not NULL (by default, NULL), the returned field by this function will be the +#'analog of parameter 'expVar'. +#'@param obsVar an 's2dv_cube' containing the field of the same variable as the +#'passed in parameter 'expVar' for the same region. +#'@param region a vector of length four indicating the minimum longitude, the +#'maximum longitude, the minimum latitude and the maximum latitude. +#'@param criteria a character string indicating the criteria to be used for the +#'selection of analogs: #'\itemize{ #'\item{Large_dist} minimal distance in the large scale pattern; #'\item{Local_dist} minimal distance in the large scale pattern and minimal @@ -58,9 +72,11 @@ #'@import ClimProjDiags #'@import abind #' -#'@seealso code{\link{CST_Load}}, \code{\link[s2dverification]{Load}} and \code{\link[s2dverification]{CDORemap}} +#'@seealso code{\link{CST_Load}}, \code{\link[s2dverification]{Load}} and +#'\code{\link[s2dverification]{CDORemap}} #' -#'@return An 's2dv_cube' object containing the dowscaled values of the best analogs in the criteria selected. +#'@return An 's2dv_cube' object containing the dowscaled values of the best +#'analogs in the criteria selected. #'@examples #'res <- CST_Analogs(expL = lonlat_data$exp, obsL = lonlat_data$obs) CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, @@ -71,13 +87,14 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, } if (!is.null(expVar) || !is.null(obsVar)) { if (!inherits(expVar, 's2dv_cube') || !inherits(obsVar, 's2dv_cube')) { - stop("Parameter 'expVar' and 'obsVar' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'expVar' and 'obsVar' must be of the class 's2dv_cube', + ","as output by CSTools::CST_Load.") } } timevector <- obsL$Dates$start if (!is.null(expVar)) { - region <- c(min(expVar$lon), max(expVar$lon), min(expVar$lat), max(expVar$lon)) + region <- c(min(expVar$lon), max(expVar$lon), min(expVar$lat), + max(expVar$lon)) lonVar <- expVar$lon latVar <- expVar$lat } else { @@ -101,62 +118,63 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'@rdname Analogs #'@title Analogs based on large scale fields. #' -#'@author Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +#'@author M. Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} #'@author Nuria Perez-Zanon \email{nuria.perez@bsc.es} #' #'@description This function perform a downscaling using Analogs. To compute #'the analogs, the function search for days with similar large scale conditions -#'to downscaled fields in the local scale. -#'The large scale and the local scale regions are defined by the user. -#'The large scale is usually given by atmospheric circulation as sea level -#'pressure or geopotential height (Yiou et al, 2013) but the function gives the -#' possibility to use another field. The local scale will be usually given by -#' precipitation or temperature fields, but might be another variable. -#' The analogs function will find the best analogs based in three criterias: +#'to downscaled fields in the local scale. The large scale and the local scale +#'regions are defined by the user. The large scale is usually given by +#'atmospheric circulation as sea level pressure or geopotential height (Yiou +#'et al, 2013) but the function gives the possibility to use another field. The +#'local scale will be usually given by precipitation or temperature fields, but +#'might be another variable. +#'The analogs function will find the best analogs based in three criterias: #' (1) Minimal distance in the large scale pattern (i.e. SLP) #' (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal #' distance in the local scale pattern (i.e. SLP). #' (3) Minimal distance in the large scale pattern (i.e. SLP), minimal -#' distance in the local scale pattern (i.e. SLP) and maxima correlation in the +#' distance in the local scale pattern (i.e. SLP) and maxima correlation in the #' local variable to downscale (i.e Precipitation). -#' The search of analogs must be done in the longest dataset posible. This is -#' important since it is necessary to have a good representation of the -#' possible states of the field in the past, and therefore, to get better -#' analogs. Once the search of the analogs is complete, and in order to used the -#' three criterias the user can select a number of analogsi, using parameter -#' 'nAnalogs' to restrict -#' the selection of the best analogs in a short number of posibilities, the best -#' ones. -#' This function has not constrains of specific regions, variables to downscale, -#' or data to be used (seasonal forecast data, climate projections data, -#' reanalyses data). -#' The regrid into a finner scale is done interpolating with CST_Load. -#' Then, this interpolation is corrected selecting the analogs in the large -#' and local scale in based of the observations. -#' The function is an adapted version of the method of Yiou et al 2013. +#'The search of analogs must be done in the longest dataset posible. This is +#'important since it is necessary to have a good representation of the +#'possible states of the field in the past, and therefore, to get better +#'analogs. Once the search of the analogs is complete, and in order to used the +#'three criterias the user can select a number of analogsi, using parameter +#''nAnalogs' to restrict +#'the selection of the best analogs in a short number of posibilities, the best +#'ones. This function has not constrains of specific regions, variables to +#'downscale, or data to be used (seasonal forecast data, climate projections +#'data, reanalyses data). The regrid into a finner scale is done interpolating +#'with CST_Load. Then, this interpolation is corrected selecting the analogs in +#'the large and local scale in based of the observations. The function is an +#'adapted version of the method of Yiou et al 2013. #' #'@references Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, -#' and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column -#' from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. -#' \email{pascal.yiou@lsce.ipsl.fr} +#'and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column +#'from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. +#'\email{pascal.yiou@lsce.ipsl.fr} #' #'@param expL an array of N named dimensions containing the experimental field -#' on the large scale for which the analog is aimed. This field is used to in -#' all the criterias. If parameter 'expVar' is not provided, the function will -#' return the expL analog. The element 'data' in the 's2dv_cube' object must -#' have, at least, latitudinal and longitudinal dimensions. The object is -#' expect to be already subset for the desired large scale region. +#'on the large scale for which the analog is aimed. This field is used to in +#'all the criterias. If parameter 'expVar' is not provided, the function will +#'return the expL analog. The element 'data' in the 's2dv_cube' object must +#'have, at least, latitudinal and longitudinal dimensions. The object is expect +#'to be already subset for the desired large scale region. #'@param obsL an array of N named dimensions containing the observational field #'on the large scale. The element 'data' in the 's2dv_cube' object must have #'the same latitudinal and longitudinal dimensions as parameter 'expL' and a #' temporal dimension with the maximum number of available observations. -#'@param time_obsL a character string indicating the date of the observations in the format "dd/mm/yyyy" +#'@param time_obsL a character string indicating the date of the observations +#'in the format "dd/mm/yyyy" #'@param expVar an array of N named dimensions containing the experimental #'field on the local scale, usually a different variable to the parameter #''expL'. If it is not NULL (by default, NULL), the returned field by this #'function will be the analog of parameter 'expVar'. -#'@param obsVar an array of N named dimensions containing the field of the same variable as the passed in parameter 'expVar' for the same region. -#'@param criteria a character string indicating the criteria to be used for the selection of analogs: +#'@param obsVar an array of N named dimensions containing the field of the +#'same variable as the passed in parameter 'expVar' for the same region. +#'@param criteria a character string indicating the criteria to be used for the +#'selection of analogs: #'\itemize{ #'\item{Large_dist} minimal distance in the large scale pattern; #'\item{Local_dist} minimal distance in the large scale pattern and minimal @@ -168,29 +186,34 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'@param latVar a vector containing the latitude of parameter 'expVar'. #'@param region a vector of length four indicating the minimum longitude, #'the maximum longitude, the minimum latitude and the maximum latitude. -#'@param return_list TRUE if you want to get a list with the best analogs FALSE -#' if not. For Downscaling return_list must be FALSE. -#'@param nAnalogs number of Analogs to be selected to apply the criterias (this -#' is not the necessary the number of analogs that the user can get, but the number -#' of events with minimal distance in which perform the search of the best Analog. -#' The default value for the Large_dist criteria is 1, the default value for -#' the Local_dist criteria is 10 and same for Local_cor. If return_list is -#' False you will get just the first one for downscaling purposes. If return_list -#' is True you will get the list of the best analogs that were searched in nAnalogs -#' under the selected criterias. +#'@param return_list TRUE to get a list with the best analogs. FALSE +#'to get a single analog, the best analog. For Downscaling return_list must be +#'FALSE. +#'@param nAnalogs number of Analogs to be selected to apply the criterias +#''Local_dist' or 'Local_cor'. This is not the necessary the number of analogs +#'that the user can get, but the number of events with minimal distance in +#'which perform the search of the best Analog. The default value for the +#''Large_dist' criteria is 1, for 'Local_dist' and 'Local_cor'criterias is 10. #'@import multiApply #'@import ClimProjDiags #'@import abind -#'@return DatesAnalogs, A character string with the date of the best analogs (time, distance) -#'@return AnalogsFields, dowscaled values of the best analogs for the criteria selected. +#'@return DatesAnalogs, a character string with the date of the best analogs +#'(time, distance) +#'@return AnalogsFields, dowscaled values of the best analogs for the criteria +#'selected. +#'@return MetricValues, a matrix with the number of analogs and the +#'corresponding value of the metric used in the selected criteria to find the +#'analogs (distance values for Large_dist and Local_dist, correlation values +#'for Local_cor) #'@examples #'require(zeallot) #' #'# Example 1:Downscaling using criteria 'Large_dist' and a single variable: -#'# The best analog is found using a single variable (i.e. Sea level pressure, SLP) -#'# The downscaling will be done in the same variable used to study the minimal distance -#'# (i.e. SLP). obsVar and expVar NULLS or equal to obsL and expL respectively -#'# region, lonVar and latVar not necessary here. return_list=FALSE +#'# The best analog is found using a single variable (i.e. Sea level pressure, +#'# SLP). The downscaling will be done in the same variable used to study the +#'# minimal distance (i.e. SLP). obsVar and expVar NULLS or equal to obsL and +#'# expL respectively region, lonVar and latVar not necessary here. +#'# return_list=FALSE #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) @@ -201,14 +224,14 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'str(downscale_field) #' #'# Example 2: Downscaling using criteria 'Large_dist' and 2 variables: -#'# The best analog is found using 2 variables (i.e. Sea Level Pressure, -#'# SLP and precipitation, pr): one variable (i.e. sea level pressure, expL) -#'# to find the best analog day (defined in criteria 'Large_dist' as the day, in obsL, -#'# with the minimum Euclidean distance to the day of interest in expL) -#'# The second variable will be the variable to donwscale (i.e. precipitation, obsVar) -#'# Parameter obsVar must be different to obsL.The downscaled precipitation -#'# will be the precipitation that belongs to the best analog day in SLP. -#'# Region not needed here since will be the same for both variables. +#'# The best analog is found using 2 variables (i.e. Sea Level Pressure, SLP +#'# and precipitation, pr): one variable (i.e. sea level pressure, expL) to +#'# find the best analog day (defined in criteria 'Large_dist' as the day, in +#'# obsL, with the minimum Euclidean distance to the day of interest in expL) +#'# The second variable will be the variable to donwscale (i.e. precipitation, +#'# obsVar). Parameter obsVar must be different to obsL.The downscaled +#'# precipitation will be the precipitation that belongs to the best analog day +#'# in SLP. Region not needed here since will be the same for both variables. #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) @@ -222,11 +245,12 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' time_obsL=time_obsSLP) #'str(downscale_field) #' -#'# Example 3:List of best Analogs using criteria 'Large_dist' and a single variable: -#'# same as Example 1 but getting a list of best analogs (return_list =TRUE) with the -#'# corresponding downscaled values, instead of only 1 single donwscaled value -#'# instead of 1 single downscaled value. Imposing nAnalogs (number of analogs to do the -#'# search of the best Analogs).obsVar and expVar NULL or equal to obsL and expL,respectively. +#'# Example 3:List of best Analogs using criteria 'Large_dist' and a single +#'# variable: same as Example 1 but getting a list of best analogs (return_list +#'# =TRUE) with the corresponding downscaled values, instead of only 1 single +#'# donwscaled value instead of 1 single downscaled value. Imposing nAnalogs +#'# (number of analogs to do the search of the best Analogs). obsVar and expVar +#'# NULL or equal to obsL and expL,respectively. #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) @@ -238,9 +262,10 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'str(downscale_field) #' #'# Example 4:List of best Analogs using criteria 'Large_dist' and 2 variables: -#'# same as example 2 but getting a list of best analogs (return_list =TRUE) with the values -#'# instead of only a single downscaled value. Imposing nAnalogs (number of analogs to do the -#'# search of the best Analogs). obsVar and expVar must be different to obsL and expL. +#'# same as example 2 but getting a list of best analogs (return_list =TRUE) +#'# with the values instead of only a single downscaled value. Imposing +#'# nAnalogs (number of analogs to do the search of the best Analogs). obsVar +#'# and expVar must be different to obsL and expL. #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) @@ -251,14 +276,16 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'dim(obs.pr)=dim(obsSLP) #'downscale_field <- Analogs(expL=expSLP, obsL=obsSLP, #' obsVar=obs.pr, -#' time_obsL=time_obsSLP,nAnalogs=5,return_list = TRUE) +#' time_obsL=time_obsSLP,nAnalogs=5, +#' return_list = TRUE) #'str(downscale_field) #' #'# Example 5: Downscaling using criteria 'Local_dist' and 2 variables: #'# The best analog is found using 2 variables (i.e. Sea Level Pressure, #'# SLP and precipitation, pr). Parameter obsVar must be different to obsL.The #'# downscaled precipitation will be the precipitation that belongs to the best -#'# analog day in SLP. lonVar, latVar and Region must be given here to select the local scale +#'# analog day in SLP. lonVar, latVar and Region must be given here to select +#'# the local scale #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) @@ -281,10 +308,12 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' nAnalogs = 10, return_list = FALSE) #'str(Local_scale) #' -#'# Example 6: list of best analogs using criteria 'Local_dist' and 2 variables: -#'# The best analog is found using 2 variables. Parameter obsVar must be different to obsL in this case.The -#'# downscaled precipitation will be the precipitation that belongs to the best -#'# analog day in SLP. lonVar, latVar and Region needed. return_list=TRUE +#'# Example 6: list of best analogs using criteria 'Local_dist' and 2 +#'# variables: +#'# The best analog is found using 2 variables. Parameter obsVar must be +#'# different to obsL in this case.The downscaled precipitation will be the +#'# precipitation that belongs to the best analog day in SLP. lonVar, latVar +#'# and Region needed. return_list=TRUE #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) @@ -304,7 +333,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' obsVar=obs.pr, #' criteria="Local_dist",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, -#' nAnalogs = 10, return_list = TRUE) +#' nAnalogs = 5, return_list = TRUE) #'str(Local_scale) #' #'# Example 7: Downscaling using Local_dist criteria @@ -329,10 +358,11 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'str(Local_scale) #' #'# Example 8: Downscaling using criteria 'Local_cor' and 2 variables: -#'# The best analog is found using 2 variables. Parameter obsVar and expVar are necessary and must be different -#'# to obsL and expL, respectively.The downscaled precipitation will be the -#'# precipitation that belongs to the best analog day in SLP large and local scales, -#'# and to the day with the higher correlation in precipitation. return_list=FALSE +#'# The best analog is found using 2 variables. Parameter obsVar and expVar +#'# are necessary and must be different to obsL and expL, respectively. +#'# The downscaled precipitation will be the precipitation that belongs to +#'# the best analog day in SLP large and local scales, and to the day with +#'# the higher correlation in precipitation. return_list=FALSE #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) @@ -353,12 +383,12 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' obsL=obsSLP, time_obsL=time_obsSLP, #' obsVar=obs.pr,expVar=exp.pr, #' criteria="Local_cor",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),nAnalogs=15,region=region, +#' latVar=seq(30,35,1.5),nAnalogs=8,region=region, #' return_list = FALSE) #'str(Local_scalecor) #' -#'# Example 9: List of best analogs in the three criterias Large_dist, Local_dist, and Local_cor -#'# return list TRUE same variable +#'# Example 9: List of best analogs in the three criterias Large_dist, +#'# Local_dist, and Local_cor return list TRUE same variable #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) @@ -369,8 +399,9 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'Large_scale <- Analogs(expL=expSLP, #' obsL=obsSLP, time_obsL=time_obsSLP, #' criteria="Large_dist", -#' nAnalogs = 15, return_list = TRUE) +#' nAnalogs = 7, return_list = TRUE) #'str(Large_scale) +#'Large_scale$MetricValues #'# analogs of local scale using criteria 2 #'lonmin=-1 #'lonmax=2 @@ -380,20 +411,22 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'Local_scale <- Analogs(expL=expSLP, #' obsL=obsSLP, time_obsL=time_obsSLP, #' criteria="Local_dist",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),nAnalogs=15,region=region, +#' latVar=seq(30,35,1.5),nAnalogs=7,region=region, #' return_list = TRUE) #'str(Local_scale) +#'Local_scale$MetricValues #'# analogs of local scale using criteria 3 #'Local_scalecor <- Analogs(expL=expSLP, #' obsL=obsSLP, time_obsL=time_obsSLP, #' obsVar=obsSLP,expVar=expSLP, #' criteria="Local_cor",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),nAnalogs=15,region=region, +#' latVar=seq(30,35,1.5),nAnalogs=7,region=region, #' return_list = TRUE) #'str(Local_scalecor) +#'Local_scalecor$MetricValues #' -#'# Example 10: Downscaling in the three criteria Large_dist, Local_dist, and Local_cor -#'# return list FALSE, different variable +#'# Example 10: Downscaling in the three criteria Large_dist, Local_dist, and +#'# Local_cor return list FALSE, different variable #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) @@ -408,8 +441,9 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'Large_scale <- Analogs(expL=expSLP, #' obsL=obsSLP, time_obsL=time_obsSLP, #' criteria="Large_dist", -#' nAnalogs = 15, return_list = FALSE) +#' nAnalogs = 7, return_list = FALSE) #'str(Large_scale) +#'Large_scale$MetricValues #'# analogs of local scale using criteria 2 #'lonmin=-1 #'lonmax=2 @@ -420,17 +454,19 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' obsL=obsSLP, time_obsL=time_obsSLP, #' obsVar=obs.pr, #' criteria="Local_dist",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),nAnalogs=15,region=region, +#' latVar=seq(30,35,1.5),nAnalogs=7,region=region, #' return_list = FALSE) #'str(Local_scale) +#'Local_scale$MetricValues #'# analogs of local scale using criteria 3 #'Local_scalecor <- Analogs(expL=expSLP, #' obsL=obsSLP, time_obsL=time_obsSLP, #' obsVar=obs.pr,expVar=exp.pr, #' criteria="Local_cor",lonVar=seq(-1,5,1.5), -#' latVar=seq(30,35,1.5),nAnalogs=15,region=region, +#' latVar=seq(30,35,1.5),nAnalogs=7,region=region, #' return_list = FALSE) #'str(Local_scalecor) +#'Local_scalecor$MetricValues #' #'@export Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, @@ -455,10 +491,12 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, } if (!is.null(expVar) & is.null(obsVar)) { expVar <- NULL - warning("Parameter 'expVar' is set to NULL as parameter 'obsVar', large scale field will be returned.") + warning("Parameter 'expVar' is set to NULL as parameter 'obsVar', + large scale field will be returned.") } if (is.null(expVar) & is.null(obsVar)) { - warning("Parameter 'expVar' and 'obsVar' are NULLs, downscaling/listing same variable as obsL and expL'.") + warning("Parameter 'expVar' and 'obsVar' are NULLs, downscaling/listing + same variable as obsL and expL'.") } if(!is.null(obsVar) & is.null(expVar) & criteria=="Local_cor"){ stop("parameter 'expVar' cannot be NULL") @@ -523,15 +561,18 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, if (!is.null(lonVar) & !is.null(latVar)) { region <- c(min(lonVar), max(lonVar), min(latVar), max(latVar)) }else{ - stop("Parameters 'lonVar' and 'latVar' must be given in criteria 'Local_dist' and 'Local_cor'") + stop("Parameters 'lonVar' and 'latVar' must be given in criteria + 'Local_dist' and 'Local_cor'") } } - - position <- Select(expL = expL, obsL = obsL, expVar = expVar, obsVar = obsVar, - criteria = criteria, lonVar = lonVar, latVar = latVar, - region = region)$position - best <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, - criteria = criteria, + position <- Select(expL = expL, obsL = obsL, expVar = expVar, + obsVar = obsVar, criteria = criteria, lonVar = lonVar, + latVar = latVar, region = region)$position + metrics <- Select(expL = expL, obsL = obsL, expVar = expVar, + obsVar = obsVar, criteria = criteria, lonVar = lonVar, + latVar = latVar, region = region)$metric + best <- Apply(list(position), target_dims = c('time', 'pos'), + fun = BestAnalog, criteria = criteria, return_list = return_list, nAnalogs = nAnalogs)$output1 Analogs_dates <- time_obsL[best] dim(Analogs_dates) <- dim(best) @@ -539,13 +580,17 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, if (is.null(obsVar)) { obsVar <- SelBox(obsL, lon = lonVar, lat = latVar, region = region)$data expVar <- SelBox(expL, lon = lonVar, lat = latVar, region=region)$data - Analogs_fields <- Subset(obsVar, along = which(names(dim(obsVar)) == 'time'), + Analogs_fields <- Subset(obsVar, + along = which(names(dim(obsVar)) == 'time'), indices = best) - warning("obsVar is NULL, obsVar will be computed from obsL (same variable)") + warning("obsVar is NULL, + obsVar will be computed from obsL (same variable)") } else { - obslocal <- SelBox(obsVar, lon = lonVar, lat = latVar, region = region)$data - Analogs_fields <- Subset(obslocal, along = which(names(dim(obslocal)) == 'time'), + obslocal <- SelBox(obsVar, lon = lonVar, lat = latVar, + region = region)$data + Analogs_fields <- Subset(obslocal, + along = which(names(dim(obslocal)) == 'time'), indices = best) } } else { @@ -564,17 +609,27 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, lon_dim <- which(names(dim(Analogs_fields)) == 'lon') lat_dim <- which(names(dim(Analogs_fields)) == 'lat') if (lon_dim < lat_dim) { - dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lon_dim, lat_dim)], dim(best)) + dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lon_dim, lat_dim)], dim(best)) } else if (lon_dim > lat_dim) { - dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lat_dim, lon_dim)], dim(best)) + dim(Analogs_fields) <- c(dim(Analogs_fields)[c(lat_dim, lon_dim)], dim(best)) } else { stop("Dimensions 'lat' and 'lon' not found.") } - return(list(DatesAnalogs = Analogs_dates, AnalogsFields = Analogs_fields)) -} + Analogs_metrics <- Subset(metrics, + along = which(names(dim(metrics)) == 'time'), + indices = best) + DistCorr <- cbind(1:nrow(Analogs_metrics),Analogs_metrics) + if(dim(DistCorr)[2]==2){colnames(DistCorr) <- c("Analog","LargeDist")} + if(dim(DistCorr)[2]==3){colnames(DistCorr) <- c("Analog","LargeDist", + "LocalDist")} + if(dim(DistCorr)[2]==4){colnames(DistCorr) <- c("Analog","LargeDist", + "LocalDist","LocalCorr")} + return(list(DatesAnalogs = Analogs_dates, AnalogsFields = Analogs_fields, + MetricValues=DistCorr)) + } BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, - nAnalogs = 10) { + nAnalogs = NULL) { pos_dim <- which(names(dim(position)) == 'pos') if (dim(position)[pos_dim] == 1) { pos1 <- Subset(position, along = pos_dim, indices = 1) @@ -641,9 +696,10 @@ BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, return(pos) } } -Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", +Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, + criteria = "Large_dist", lonVar = NULL, latVar = NULL, region = NULL) { - names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)), names(dim(obsL))) +names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)), names(dim(obsL))) metric1 <- Apply(list(obsL), target_dims = list(c('lat', 'lon')), fun = .select, expL, metric = "dist")$output1 if (length(dim(metric1)) > 1) { @@ -694,11 +750,14 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ fun = .select, exp, metric = "cor")$output1 dim(metric3) <- c(dim(metric3), metric=1) margins <- c(1 : (length(dim(metric3))))[-dim_time_obs] - pos3 <- apply(metric3, margins, order, decreasing = TRUE) + pos3 <- apply(abs(metric3), margins, order, decreasing = TRUE) names(dim(pos3))[1] <- 'time' - metric3 <- apply(metric3, margins, sort) - names(dim(metric3))[1] <- 'time' - metric <- abind(metric1, metric2, metric3, along = length(dim(metric1)) + 1) + #metric3 <- apply(abs(metric3), margins, sort) + metricsort <- metric3[pos3] + dim(metricsort)=dim(metric3) + names(dim(metricsort))[1] <- 'time' + metric <- abind(metric1, metric2, metricsort, + along = length(dim(metric1)) + 1) position <- abind(pos1, pos2, pos3, along = length(dim(pos1)) + 1) names(dim(metric)) <- c(names(dim(metric1)), 'metric') names(dim(position)) <- c(names(dim(pos1)), 'pos') @@ -715,7 +774,8 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, criteria = "Large_ fun = function(x) {sum((x - exp) ^ 2)})$output1 } else if (metric == "cor") { result <- Apply(list(obs), target_dims = list(c('lat', 'lon')), - fun = function(x) {cor(as.vector(x), as.vector(exp))})$output1 + fun = function(x) {cor(as.vector(x), + as.vector(exp))})$output1 } result } @@ -731,7 +791,8 @@ replace_repeat_dimnames <- function(names_exp, names_obs, lat_name = 'lat', latlon_dim_obs <- which(names_obs == lat_name | names_obs == lon_name) if (any(unlist(lapply(names_exp[-latlon_dim_exp], function(x){x == names_obs[-latlon_dim_obs]})))) { - original_pos <- lapply(names_exp, function(x) which(x == names_obs[-latlon_dim_obs])) + original_pos <- lapply(names_exp, + function(x) which(x == names_obs[-latlon_dim_obs])) original_pos <- lapply(original_pos, length) > 0 names_exp[original_pos] <- paste0(names_exp[original_pos], "_exp") } diff --git a/man/Analogs.Rd b/man/Analogs.Rd index c24a58e1..77740a60 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -12,25 +12,28 @@ Analogs(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, \item{expL}{an array of N named dimensions containing the experimental field on the large scale for which the analog is aimed. This field is used to in all the criterias. If parameter 'expVar' is not provided, the function will - return the expL analog. The element 'data' in the 's2dv_cube' object must - have, at least, latitudinal and longitudinal dimensions. The object is - expect to be already subset for the desired large scale region.} +return the expL analog. The element 'data' in the 's2dv_cube' object must +have, at least, latitudinal and longitudinal dimensions. The object is expect +to be already subset for the desired large scale region.} \item{obsL}{an array of N named dimensions containing the observational field on the large scale. The element 'data' in the 's2dv_cube' object must have the same latitudinal and longitudinal dimensions as parameter 'expL' and a temporal dimension with the maximum number of available observations.} -\item{time_obsL}{a character string indicating the date of the observations in the format "dd/mm/yyyy"} +\item{time_obsL}{a character string indicating the date of the observations +in the format "dd/mm/yyyy"} \item{expVar}{an array of N named dimensions containing the experimental field on the local scale, usually a different variable to the parameter 'expL'. If it is not NULL (by default, NULL), the returned field by this function will be the analog of parameter 'expVar'.} -\item{obsVar}{an array of N named dimensions containing the field of the same variable as the passed in parameter 'expVar' for the same region.} +\item{obsVar}{an array of N named dimensions containing the field of the +same variable as the passed in parameter 'expVar' for the same region.} -\item{criteria}{a character string indicating the criteria to be used for the selection of analogs: +\item{criteria}{a character string indicating the criteria to be used for the +selection of analogs: \itemize{ \item{Large_dist} minimal distance in the large scale pattern; \item{Local_dist} minimal distance in the large scale pattern and minimal @@ -46,38 +49,43 @@ local variable to downscale.}} \item{region}{a vector of length four indicating the minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude.} -\item{nAnalogs}{number of Analogs to be selected to apply the criterias (this -is not the necessary the number of analogs that the user can get, but the number -of events with minimal distance in which perform the search of the best Analog. -The default value for the Large_dist criteria is 1, the default value for -the Local_dist criteria is 10 and same for Local_cor. If return_list is -False you will get just the first one for downscaling purposes. If return_list -is True you will get the list of the best analogs that were searched in nAnalogs -under the selected criterias.} - -\item{return_list}{TRUE if you want to get a list with the best analogs FALSE -if not. For Downscaling return_list must be FALSE.} +\item{nAnalogs}{number of Analogs to be selected to apply the criterias +'Local_dist' or 'Local_cor'. This is not the necessary the number of analogs +that the user can get, but the number of events with minimal distance in +which perform the search of the best Analog. The default value for the +'Large_dist' criteria is 1, for 'Local_dist' and 'Local_cor'criterias is 10.} + +\item{return_list}{TRUE to get a list with the best analogs. FALSE +to get a single analog, the best analog. For Downscaling return_list must be +FALSE.} } \value{ -DatesAnalogs, A character string with the date of the best analogs (time, distance) +DatesAnalogs, a character string with the date of the best analogs +(time, distance) + +AnalogsFields, dowscaled values of the best analogs for the criteria +selected. -AnalogsFields, dowscaled values of the best analogs for the criteria selected. +MetricValues, a matrix with the number of analogs and the +corresponding value of the metric used in the selected criteria to find the +analogs (distance values for Large_dist and Local_dist, correlation values +for Local_cor) } \description{ This function perform a downscaling using Analogs. To compute the analogs, the function search for days with similar large scale conditions -to downscaled fields in the local scale. -The large scale and the local scale regions are defined by the user. -The large scale is usually given by atmospheric circulation as sea level -pressure or geopotential height (Yiou et al, 2013) but the function gives the -possibility to use another field. The local scale will be usually given by -precipitation or temperature fields, but might be another variable. +to downscaled fields in the local scale. The large scale and the local scale +regions are defined by the user. The large scale is usually given by +atmospheric circulation as sea level pressure or geopotential height (Yiou +et al, 2013) but the function gives the possibility to use another field. The +local scale will be usually given by precipitation or temperature fields, but +might be another variable. The analogs function will find the best analogs based in three criterias: (1) Minimal distance in the large scale pattern (i.e. SLP) (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal distance in the local scale pattern (i.e. SLP). (3) Minimal distance in the large scale pattern (i.e. SLP), minimal -distance in the local scale pattern (i.e. SLP) and maxima correlation in the +distance in the local scale pattern (i.e. SLP) and maxima correlation in the local variable to downscale (i.e Precipitation). The search of analogs must be done in the longest dataset posible. This is important since it is necessary to have a good representation of the @@ -86,23 +94,22 @@ analogs. Once the search of the analogs is complete, and in order to used the three criterias the user can select a number of analogsi, using parameter 'nAnalogs' to restrict the selection of the best analogs in a short number of posibilities, the best -ones. -This function has not constrains of specific regions, variables to downscale, -or data to be used (seasonal forecast data, climate projections data, -reanalyses data). -The regrid into a finner scale is done interpolating with CST_Load. -Then, this interpolation is corrected selecting the analogs in the large -and local scale in based of the observations. -The function is an adapted version of the method of Yiou et al 2013. +ones. This function has not constrains of specific regions, variables to +downscale, or data to be used (seasonal forecast data, climate projections +data, reanalyses data). The regrid into a finner scale is done interpolating +with CST_Load. Then, this interpolation is corrected selecting the analogs in +the large and local scale in based of the observations. The function is an +adapted version of the method of Yiou et al 2013. } \examples{ require(zeallot) # Example 1:Downscaling using criteria 'Large_dist' and a single variable: -# The best analog is found using a single variable (i.e. Sea level pressure, SLP) -# The downscaling will be done in the same variable used to study the minimal distance -# (i.e. SLP). obsVar and expVar NULLS or equal to obsL and expL respectively -# region, lonVar and latVar not necessary here. return_list=FALSE +# The best analog is found using a single variable (i.e. Sea level pressure, +# SLP). The downscaling will be done in the same variable used to study the +# minimal distance (i.e. SLP). obsVar and expVar NULLS or equal to obsL and +# expL respectively region, lonVar and latVar not necessary here. +# return_list=FALSE expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) @@ -113,14 +120,14 @@ downscale_field <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP) str(downscale_field) # Example 2: Downscaling using criteria 'Large_dist' and 2 variables: -# The best analog is found using 2 variables (i.e. Sea Level Pressure, -# SLP and precipitation, pr): one variable (i.e. sea level pressure, expL) -# to find the best analog day (defined in criteria 'Large_dist' as the day, in obsL, -# with the minimum Euclidean distance to the day of interest in expL) -# The second variable will be the variable to donwscale (i.e. precipitation, obsVar) -# Parameter obsVar must be different to obsL.The downscaled precipitation -# will be the precipitation that belongs to the best analog day in SLP. -# Region not needed here since will be the same for both variables. +# The best analog is found using 2 variables (i.e. Sea Level Pressure, SLP +# and precipitation, pr): one variable (i.e. sea level pressure, expL) to +# find the best analog day (defined in criteria 'Large_dist' as the day, in +# obsL, with the minimum Euclidean distance to the day of interest in expL) +# The second variable will be the variable to donwscale (i.e. precipitation, +# obsVar). Parameter obsVar must be different to obsL.The downscaled +# precipitation will be the precipitation that belongs to the best analog day +# in SLP. Region not needed here since will be the same for both variables. expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) @@ -134,11 +141,12 @@ downscale_field <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP) str(downscale_field) -# Example 3:List of best Analogs using criteria 'Large_dist' and a single variable: -# same as Example 1 but getting a list of best analogs (return_list =TRUE) with the -# corresponding downscaled values, instead of only 1 single donwscaled value -# instead of 1 single downscaled value. Imposing nAnalogs (number of analogs to do the -# search of the best Analogs).obsVar and expVar NULL or equal to obsL and expL,respectively. +# Example 3:List of best Analogs using criteria 'Large_dist' and a single +# variable: same as Example 1 but getting a list of best analogs (return_list +# =TRUE) with the corresponding downscaled values, instead of only 1 single +# donwscaled value instead of 1 single downscaled value. Imposing nAnalogs +# (number of analogs to do the search of the best Analogs). obsVar and expVar +# NULL or equal to obsL and expL,respectively. expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) @@ -150,9 +158,10 @@ downscale_field<- Analogs(expL=expSLP, obsL=obsSLP, time_obsSLP, str(downscale_field) # Example 4:List of best Analogs using criteria 'Large_dist' and 2 variables: -# same as example 2 but getting a list of best analogs (return_list =TRUE) with the values -# instead of only a single downscaled value. Imposing nAnalogs (number of analogs to do the -# search of the best Analogs). obsVar and expVar must be different to obsL and expL. +# same as example 2 but getting a list of best analogs (return_list =TRUE) +# with the values instead of only a single downscaled value. Imposing +# nAnalogs (number of analogs to do the search of the best Analogs). obsVar +# and expVar must be different to obsL and expL. expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) @@ -163,14 +172,16 @@ 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,nAnalogs=5,return_list = TRUE) + time_obsL=time_obsSLP,nAnalogs=5, + return_list = TRUE) str(downscale_field) # Example 5: Downscaling using criteria 'Local_dist' and 2 variables: # The best analog is found using 2 variables (i.e. Sea Level Pressure, # SLP and precipitation, pr). Parameter obsVar must be different to obsL.The # downscaled precipitation will be the precipitation that belongs to the best -# analog day in SLP. lonVar, latVar and Region must be given here to select the local scale +# analog day in SLP. lonVar, latVar and Region must be given here to select +# the local scale expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) @@ -193,10 +204,12 @@ Local_scale <- Analogs(expL=expSLP, nAnalogs = 10, return_list = FALSE) str(Local_scale) -# Example 6: list of best analogs using criteria 'Local_dist' and 2 variables: -# The best analog is found using 2 variables. Parameter obsVar must be different to obsL in this case.The -# downscaled precipitation will be the precipitation that belongs to the best -# analog day in SLP. lonVar, latVar and Region needed. return_list=TRUE +# Example 6: list of best analogs using criteria 'Local_dist' and 2 +# variables: +# The best analog is found using 2 variables. Parameter obsVar must be +# different to obsL in this case.The downscaled precipitation will be the +# precipitation that belongs to the best analog day in SLP. lonVar, latVar +# and Region needed. return_list=TRUE expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) @@ -216,7 +229,7 @@ Local_scale <- Analogs(expL=expSLP, obsVar=obs.pr, criteria="Local_dist",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),region=region, - nAnalogs = 10, return_list = TRUE) + nAnalogs = 5, return_list = TRUE) str(Local_scale) # Example 7: Downscaling using Local_dist criteria @@ -241,10 +254,11 @@ Local_scale <- Analogs(expL=expSLP, str(Local_scale) # Example 8: Downscaling using criteria 'Local_cor' and 2 variables: -# The best analog is found using 2 variables. Parameter obsVar and expVar are necessary and must be different -# to obsL and expL, respectively.The downscaled precipitation will be the -# precipitation that belongs to the best analog day in SLP large and local scales, -# and to the day with the higher correlation in precipitation. return_list=FALSE +# The best analog is found using 2 variables. Parameter obsVar and expVar +# are necessary and must be different to obsL and expL, respectively. +# The downscaled precipitation will be the precipitation that belongs to +# the best analog day in SLP large and local scales, and to the day with +# the higher correlation in precipitation. return_list=FALSE expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) @@ -265,12 +279,12 @@ Local_scalecor <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP, obsVar=obs.pr,expVar=exp.pr, criteria="Local_cor",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),nAnalogs=15,region=region, + latVar=seq(30,35,1.5),nAnalogs=8,region=region, return_list = FALSE) str(Local_scalecor) -# Example 9: List of best analogs in the three criterias Large_dist, Local_dist, and Local_cor -# return list TRUE same variable +# Example 9: List of best analogs in the three criterias Large_dist, +# Local_dist, and Local_cor return list TRUE same variable expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) @@ -281,8 +295,9 @@ time_obsSLP <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") Large_scale <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP, criteria="Large_dist", - nAnalogs = 15, return_list = TRUE) + nAnalogs = 7, return_list = TRUE) str(Large_scale) +Large_scale$MetricValues # analogs of local scale using criteria 2 lonmin=-1 lonmax=2 @@ -292,20 +307,22 @@ region=c(lonmin,lonmax,latmin,latmax) Local_scale <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP, criteria="Local_dist",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),nAnalogs=15,region=region, + latVar=seq(30,35,1.5),nAnalogs=7,region=region, return_list = TRUE) str(Local_scale) +Local_scale$MetricValues # analogs of local scale using criteria 3 Local_scalecor <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP, obsVar=obsSLP,expVar=expSLP, criteria="Local_cor",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),nAnalogs=15,region=region, + latVar=seq(30,35,1.5),nAnalogs=7,region=region, return_list = TRUE) str(Local_scalecor) +Local_scalecor$MetricValues -# Example 10: Downscaling in the three criteria Large_dist, Local_dist, and Local_cor -# return list FALSE, different variable +# Example 10: Downscaling in the three criteria Large_dist, Local_dist, and +# Local_cor return list FALSE, different variable expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) @@ -320,8 +337,9 @@ dim(obs.pr)=dim(obsSLP) Large_scale <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP, criteria="Large_dist", - nAnalogs = 15, return_list = FALSE) + nAnalogs = 7, return_list = FALSE) str(Large_scale) +Large_scale$MetricValues # analogs of local scale using criteria 2 lonmin=-1 lonmax=2 @@ -332,17 +350,19 @@ Local_scale <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP, obsVar=obs.pr, criteria="Local_dist",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),nAnalogs=15,region=region, + latVar=seq(30,35,1.5),nAnalogs=7,region=region, return_list = FALSE) str(Local_scale) +Local_scale$MetricValues # analogs of local scale using criteria 3 Local_scalecor <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP, obsVar=obs.pr,expVar=exp.pr, criteria="Local_cor",lonVar=seq(-1,5,1.5), - latVar=seq(30,35,1.5),nAnalogs=15,region=region, + latVar=seq(30,35,1.5),nAnalogs=7,region=region, return_list = FALSE) str(Local_scalecor) +Local_scalecor$MetricValues } \references{ @@ -352,7 +372,7 @@ from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. \email{pascal.yiou@lsce.ipsl.fr} } \author{ -Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +M. Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} Nuria Perez-Zanon \email{nuria.perez@bsc.es} } diff --git a/man/CST_Analogs.Rd b/man/CST_Analogs.Rd index 3fe092d3..5ad87254 100644 --- a/man/CST_Analogs.Rd +++ b/man/CST_Analogs.Rd @@ -8,19 +8,34 @@ CST_Analogs(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, region = NULL, criteria = "Large_dist") } \arguments{ -\item{expL}{an 's2dv_cube' object containing the experimental field on the large scale for which the analog is aimed. This field is used to in all the criterias. If parameter 'expVar' is not provided, the function will return the expL analog. The element 'data' in the 's2dv_cube' object must have, at least, latitudinal and longitudinal dimensions. The object is expect to be already subset for the desired large scale region.} +\item{expL}{an 's2dv_cube' object containing the experimental field on the +large scale for which the analog is aimed. This field is used to in all the +criterias. If parameter 'expVar' is not provided, the function will return +the expL analog. The element 'data' in the 's2dv_cube' object must have, at +least, latitudinal and longitudinal dimensions. The object is expect to be +already subset for the desired large scale region.} -\item{obsL}{an 's2dv_cube' object containing the observational field on the large scale. The element 'data' in the 's2dv_cube' object must have the same latitudinal and longitudinal dimensions as parameter 'expL' and a temporal dimension with the maximum number of available observations.} +\item{obsL}{an 's2dv_cube' object containing the observational field on the +large scale. The element 'data' in the 's2dv_cube' object must have the same +latitudinal and longitudinal dimensions as parameter 'expL' and a temporal +dimension with the maximum number of available observations.} -\item{time_obsL}{a character string indicating the date of the observations in the format "dd/mm/yyyy"} +\item{time_obsL}{a character string indicating the date of the observations +in the format "dd/mm/yyyy"} -\item{expVar}{an 's2dv_cube' object containing the experimental field on the local scale, usually a different variable to the parameter 'expL'. If it is not NULL (by default, NULL), the returned field by this function will be the analog of parameter 'expVar'.} +\item{expVar}{an 's2dv_cube' object containing the experimental field on the +local scale, usually a different variable to the parameter 'expL'. If it is +not NULL (by default, NULL), the returned field by this function will be the +analog of parameter 'expVar'.} -\item{obsVar}{an 's2dv_cube' containing the field of the same variable as the passed in parameter 'expVar' for the same region.} +\item{obsVar}{an 's2dv_cube' containing the field of the same variable as the +passed in parameter 'expVar' for the same region.} -\item{region}{a vector of length four indicating the minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude.} +\item{region}{a vector of length four indicating the minimum longitude, the +maximum longitude, the minimum latitude and the maximum latitude.} -\item{criteria}{a character string indicating the criteria to be used for the selection of analogs: +\item{criteria}{a character string indicating the criteria to be used for the +selection of analogs: \itemize{ \item{Large_dist} minimal distance in the large scale pattern; \item{Local_dist} minimal distance in the large scale pattern and minimal @@ -30,18 +45,19 @@ distance in the local scale pattern and maxima correlation in the local variable to downscale.}} } \value{ -An 's2dv_cube' object containing the dowscaled values of the best analogs in the criteria selected. +An 's2dv_cube' object containing the dowscaled values of the best +analogs in the criteria selected. } \description{ This function perform a downscaling using Analogs. To compute the analogs, the function search for days with similar large scale conditions -to downscaled fields in the local scale. -The large scale and the local scale regions are defined by the user. -The large scale is usually given by atmospheric circulation as sea level -pressure or geopotential height (Yiou et al, 2013) but the function gives the -possibility to use another field. The local scale will be usually given by -precipitation or temperature fields, but might be another variable. -The analogs function will find the best analogs based in three criterias: +to downscaled fields in the local scale. The large scale and the local scale +regions are defined by the user. The large scale is usually given by +atmospheric circulation as sea level pressure or geopotential height +(Yiou et al, 2013) but the function gives the possibility to use another +field. The local scale will be usually given by precipitation or temperature +fields, but might be another variable.The analogs function will find the best +analogs based in three criterias: (1) Minimal distance in the large scale pattern (i.e. SLP) (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal distance in the local scale pattern (i.e. SLP). @@ -51,17 +67,16 @@ local variable to downscale (i.e Precipitation). The search of analogs must be done in the longest dataset posible. This is important since it is necessary to have a good representation of the possible states of the field in the past, and therefore, to get better -analogs. Once the search of the analogs is complete, and in order to used the -three criterias the user can select a number of analogsi, using parameter 'nAnalogs' to restrict -the selection of the best analogs in a short number of posibilities, the best -ones. +analogs. Once the search of the analogs is complete, and in order to used +the three criterias the user can select a number of analogs, using parameter +'nAnalogs' to restrict the selection of the best analogs in a short number +of posibilities, the best ones. This function has not constrains of specific regions, variables to downscale, or data to be used (seasonal forecast data, climate projections data, -reanalyses data). -The regrid into a finner scale is done interpolating with CST_Load. -Then, this interpolation is corrected selecting the analogs in the large -and local scale in based of the observations. -The function is an adapted version of the method of Yiou et al 2013. +reanalyses data). The regrid into a finner scale is done interpolating with +CST_Load. Then, this interpolation is corrected selecting the analogs in the +large and local scale in based of the observations. The function is an +adapted version of the method of Yiou et al 2013. } \examples{ res <- CST_Analogs(expL = lonlat_data$exp, obsL = lonlat_data$obs) @@ -73,10 +88,11 @@ from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. \email{pascal.yiou@lsce.ipsl.fr} } \seealso{ -code{\link{CST_Load}}, \code{\link[s2dverification]{Load}} and \code{\link[s2dverification]{CDORemap}} +code{\link{CST_Load}}, \code{\link[s2dverification]{Load}} and +\code{\link[s2dverification]{CDORemap}} } \author{ -Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} +M. Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} Nuria Perez-Zanon \email{nuria.perez@bsc.es} } -- GitLab From 8947a1e9dc04c9ba64e2497ed8f8d8ec5888cb43 Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Wed, 6 Nov 2019 11:06:27 +0100 Subject: [PATCH 40/43] correcting MetricValues in Analogs --- R/CST_Analogs.R | 39 ++++++++++++++++++++++++++++++--------- man/Analogs.Rd | 22 +++++++++++++++++----- 2 files changed, 47 insertions(+), 14 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 5ac8a035..3d368482 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -140,7 +140,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'important since it is necessary to have a good representation of the #'possible states of the field in the past, and therefore, to get better #'analogs. Once the search of the analogs is complete, and in order to used the -#'three criterias the user can select a number of analogsi, using parameter +#'three criterias the user can select a number of analogs , using parameter #''nAnalogs' to restrict #'the selection of the best analogs in a short number of posibilities, the best #'ones. This function has not constrains of specific regions, variables to @@ -193,7 +193,8 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #''Local_dist' or 'Local_cor'. This is not the necessary the number of analogs #'that the user can get, but the number of events with minimal distance in #'which perform the search of the best Analog. The default value for the -#''Large_dist' criteria is 1, for 'Local_dist' and 'Local_cor'criterias is 10. +#''Large_dist' criteria is 1, for 'Local_dist' and 'Local_cor'criterias must +#' be selected by the user otherwise the default value will be set as 10. #'@import multiApply #'@import ClimProjDiags #'@import abind @@ -362,7 +363,8 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'# are necessary and must be different to obsL and expL, respectively. #'# The downscaled precipitation will be the precipitation that belongs to #'# the best analog day in SLP large and local scales, and to the day with -#'# the higher correlation in precipitation. return_list=FALSE +#'# the higher correlation in precipitation. return_list=FALSE. two options +#'# for nAnalogs #' #'expSLP <- rnorm(1:20) #'dim(expSLP) <- c(lat = 4, lon = 5) @@ -385,7 +387,17 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Local_cor",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),nAnalogs=8,region=region, #' return_list = FALSE) -#'str(Local_scalecor) +#'Local_scalecor$MetricValues +#'Local_scalecor$DatesAnalogs +#'# same but without imposing nAnalogs, so nAnalogs will be set by default as 10 +#'Local_scalecor <- Analogs(expL=expSLP, +#' obsL=obsSLP, time_obsL=time_obsSLP, +#' obsVar=obs.pr,expVar=exp.pr, +#' criteria="Local_cor",lonVar=seq(-1,5,1.5), +#' latVar=seq(30,35,1.5),region=region, +#' return_list = FALSE) +#'Local_scalecor$MetricValues +#'Local_scalecor$DatesAnalogs #' #'# Example 9: List of best analogs in the three criterias Large_dist, #'# Local_dist, and Local_cor return list TRUE same variable @@ -472,7 +484,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", lonVar = NULL, latVar = NULL, region = NULL, - nAnalogs = 1, return_list = FALSE) { + nAnalogs = NULL, return_list = FALSE) { # checks if (!all(c('lon', 'lat') %in% names(dim(expL)))) { stop("Parameter 'expL' must have the dimensions 'lat' and 'lon'.") @@ -501,6 +513,13 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, if(!is.null(obsVar) & is.null(expVar) & criteria=="Local_cor"){ stop("parameter 'expVar' cannot be NULL") } + if(is.null(nAnalogs) & criteria!="Large_dist"){ + nAnalogs=10 + warning("Parameter 'nAnalogs' is NULL and is set to 10 by default") + } + if(is.null(nAnalogs) & criteria=="Large_dist"){ + nAnalogs=1 + } if (any(names(dim(obsL)) %in% 'ftime')) { if (any(names(dim(obsL)) %in% 'time')) { @@ -629,7 +648,7 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, } BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, - nAnalogs = NULL) { + nAnalogs = nAnalogs) { pos_dim <- which(names(dim(position)) == 'pos') if (dim(position)[pos_dim] == 1) { pos1 <- Subset(position, along = pos_dim, indices = 1) @@ -690,9 +709,11 @@ BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, best <- match(pos, pos3) pos <- pos[order(best, decreasing = F)] pos <- pos[which(!is.na(pos))] - if (return_list == FALSE) { - pos[1] - } + if (return_list == FALSE) { + pos <- pos[1] + } else{ + pos <- pos + } return(pos) } } diff --git a/man/Analogs.Rd b/man/Analogs.Rd index 77740a60..1be8a63f 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -6,7 +6,7 @@ \usage{ Analogs(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, criteria = "Large_dist", lonVar = NULL, latVar = NULL, - region = NULL, nAnalogs = 1, return_list = FALSE) + region = NULL, nAnalogs = NULL, return_list = FALSE) } \arguments{ \item{expL}{an array of N named dimensions containing the experimental field @@ -53,7 +53,8 @@ the maximum longitude, the minimum latitude and the maximum latitude.} 'Local_dist' or 'Local_cor'. This is not the necessary the number of analogs that the user can get, but the number of events with minimal distance in which perform the search of the best Analog. The default value for the -'Large_dist' criteria is 1, for 'Local_dist' and 'Local_cor'criterias is 10.} +'Large_dist' criteria is 1, for 'Local_dist' and 'Local_cor'criterias must +be selected by the user otherwise the default value will be set as 10.} \item{return_list}{TRUE to get a list with the best analogs. FALSE to get a single analog, the best analog. For Downscaling return_list must be @@ -91,7 +92,7 @@ The search of analogs must be done in the longest dataset posible. This is important since it is necessary to have a good representation of the possible states of the field in the past, and therefore, to get better analogs. Once the search of the analogs is complete, and in order to used the -three criterias the user can select a number of analogsi, using parameter +three criterias the user can select a number of analogs , using parameter 'nAnalogs' to restrict the selection of the best analogs in a short number of posibilities, the best ones. This function has not constrains of specific regions, variables to @@ -258,7 +259,8 @@ str(Local_scale) # are necessary and must be different to obsL and expL, respectively. # The downscaled precipitation will be the precipitation that belongs to # the best analog day in SLP large and local scales, and to the day with -# the higher correlation in precipitation. return_list=FALSE +# the higher correlation in precipitation. return_list=FALSE. two options +# for nAnalogs expSLP <- rnorm(1:20) dim(expSLP) <- c(lat = 4, lon = 5) @@ -281,7 +283,17 @@ Local_scalecor <- Analogs(expL=expSLP, criteria="Local_cor",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),nAnalogs=8,region=region, return_list = FALSE) -str(Local_scalecor) +Local_scalecor$MetricValues +Local_scalecor$DatesAnalogs +# same but without imposing nAnalogs, so nAnalogs will be set by default as 10 +Local_scalecor <- Analogs(expL=expSLP, + obsL=obsSLP, time_obsL=time_obsSLP, + obsVar=obs.pr,expVar=exp.pr, + criteria="Local_cor",lonVar=seq(-1,5,1.5), + latVar=seq(30,35,1.5),region=region, + return_list = FALSE) +Local_scalecor$MetricValues +Local_scalecor$DatesAnalogs # Example 9: List of best analogs in the three criterias Large_dist, # Local_dist, and Local_cor return list TRUE same variable -- GitLab From 1fa3a39ba299205465054a089c3528cb61c0b50f Mon Sep 17 00:00:00 2001 From: Carmen Alvarez-Castro Date: Fri, 15 Nov 2019 10:09:07 +0100 Subject: [PATCH 41/43] corrections review --- R/CST_Analogs.R | 95 ++++++++++++++++++++++++++++--------------------- man/Analogs.Rd | 55 ++++++++++++++-------------- 2 files changed, 83 insertions(+), 67 deletions(-) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 3d368482..9021a99b 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -130,11 +130,11 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'local scale will be usually given by precipitation or temperature fields, but #'might be another variable. #'The analogs function will find the best analogs based in three criterias: -#' (1) Minimal distance in the large scale pattern (i.e. SLP) -#' (2) Minimal distance in the large scale pattern (i.e. SLP) and minimal -#' distance in the local scale pattern (i.e. SLP). -#' (3) Minimal distance in the large scale pattern (i.e. SLP), minimal -#' distance in the local scale pattern (i.e. SLP) and maxima correlation in the +#' (1) Minimum Euclidean distance in the large scale pattern (i.e. SLP) +#' (2) Minimum Euclidean distance in the large scale pattern (i.e. SLP) +#' and minimum Euclidean distance in the local scale pattern (i.e. SLP). +#' (3) Minimum Euclidean distance in the large scale pattern (i.e. SLP), minimum +#' distance in the local scale pattern (i.e. SLP) and highest correlation in the #' local variable to downscale (i.e Precipitation). #'The search of analogs must be done in the longest dataset posible. This is #'important since it is necessary to have a good representation of the @@ -176,12 +176,12 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'@param criteria a character string indicating the criteria to be used for the #'selection of analogs: #'\itemize{ -#'\item{Large_dist} minimal distance in the large scale pattern; -#'\item{Local_dist} minimal distance in the large scale pattern and minimal -#' distance in the local scale pattern; and -#'\item{Local_cor} minimal distance in the large scale pattern, minimal -#' distance in the local scale pattern and maxima correlation in the -#' local variable to downscale.} +#'\item{Large_dist} minimum Euclidean distance in the large scale pattern; +#'\item{Local_dist} minimum Euclidean distance in the large scale pattern +#'and minimum Euclidean distance in the local scale pattern; and +#'\item{Local_cor} minimum Euclidean distance in the large scale pattern, +#'minimum Euclidean distance in the local scale pattern and highest correlation +#' in the local variable to downscale.} #'@param lonVar a vector containing the longitude of parameter 'expVar'. #'@param latVar a vector containing the latitude of parameter 'expVar'. #'@param region a vector of length four indicating the minimum longitude, @@ -191,21 +191,23 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #'FALSE. #'@param nAnalogs number of Analogs to be selected to apply the criterias #''Local_dist' or 'Local_cor'. This is not the necessary the number of analogs -#'that the user can get, but the number of events with minimal distance in +#'that the user can get, but the number of events with minimum distance in #'which perform the search of the best Analog. The default value for the #''Large_dist' criteria is 1, for 'Local_dist' and 'Local_cor'criterias must #' be selected by the user otherwise the default value will be set as 10. #'@import multiApply #'@import ClimProjDiags #'@import abind -#'@return DatesAnalogs, a character string with the date of the best analogs -#'(time, distance) #'@return AnalogsFields, dowscaled values of the best analogs for the criteria #'selected. -#'@return MetricValues, a matrix with the number of analogs and the -#'corresponding value of the metric used in the selected criteria to find the -#'analogs (distance values for Large_dist and Local_dist, correlation values -#'for Local_cor) +#'@return AnalogsInfo, a dataframe with information about the number of the +#'best analogs, the corresponding value of the metric used in the selected +#'criteria (distance values for Large_dist and Local_dist,correlation values +#'for Local_cor), date of the analog). The analogs are listed in decreasing +#'order, the first one is the best analog (i.e if the selected criteria +#'is Local_cor the best analog will be the one with highest correlation, while +#'for Large_dist criteria the best analog will be the day with minimum +#'Euclidean distance) #'@examples #'require(zeallot) #' @@ -387,7 +389,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Local_cor",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),nAnalogs=8,region=region, #' return_list = FALSE) -#'Local_scalecor$MetricValues +#'Local_scalecor$AnalogsInfo #'Local_scalecor$DatesAnalogs #'# same but without imposing nAnalogs, so nAnalogs will be set by default as 10 #'Local_scalecor <- Analogs(expL=expSLP, @@ -396,7 +398,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Local_cor",lonVar=seq(-1,5,1.5), #' latVar=seq(30,35,1.5),region=region, #' return_list = FALSE) -#'Local_scalecor$MetricValues +#'Local_scalecor$AnalogsInfo #'Local_scalecor$DatesAnalogs #' #'# Example 9: List of best analogs in the three criterias Large_dist, @@ -413,7 +415,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Large_dist", #' nAnalogs = 7, return_list = TRUE) #'str(Large_scale) -#'Large_scale$MetricValues +#'Large_scale$AnalogsInfo #'# analogs of local scale using criteria 2 #'lonmin=-1 #'lonmax=2 @@ -426,7 +428,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' latVar=seq(30,35,1.5),nAnalogs=7,region=region, #' return_list = TRUE) #'str(Local_scale) -#'Local_scale$MetricValues +#'Local_scale$AnalogsInfo #'# analogs of local scale using criteria 3 #'Local_scalecor <- Analogs(expL=expSLP, #' obsL=obsSLP, time_obsL=time_obsSLP, @@ -435,7 +437,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' latVar=seq(30,35,1.5),nAnalogs=7,region=region, #' return_list = TRUE) #'str(Local_scalecor) -#'Local_scalecor$MetricValues +#'Local_scalecor$AnalogsInfo #' #'# Example 10: Downscaling in the three criteria Large_dist, Local_dist, and #'# Local_cor return list FALSE, different variable @@ -455,7 +457,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' criteria="Large_dist", #' nAnalogs = 7, return_list = FALSE) #'str(Large_scale) -#'Large_scale$MetricValues +#'Large_scale$AnalogsInfo #'# analogs of local scale using criteria 2 #'lonmin=-1 #'lonmax=2 @@ -469,7 +471,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' latVar=seq(30,35,1.5),nAnalogs=7,region=region, #' return_list = FALSE) #'str(Local_scale) -#'Local_scale$MetricValues +#'Local_scale$AnalogsInfo #'# analogs of local scale using criteria 3 #'Local_scalecor <- Analogs(expL=expSLP, #' obsL=obsSLP, time_obsL=time_obsSLP, @@ -478,7 +480,7 @@ CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, #' latVar=seq(30,35,1.5),nAnalogs=7,region=region, #' return_list = FALSE) #'str(Local_scalecor) -#'Local_scalecor$MetricValues +#'Local_scalecor$AnalogsInfo #' #'@export Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, @@ -587,9 +589,9 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, position <- Select(expL = expL, obsL = obsL, expVar = expVar, obsVar = obsVar, criteria = criteria, lonVar = lonVar, latVar = latVar, region = region)$position - metrics <- Select(expL = expL, obsL = obsL, expVar = expVar, + metrics<- Select(expL = expL, obsL = obsL, expVar = expVar, obsVar = obsVar, criteria = criteria, lonVar = lonVar, - latVar = latVar, region = region)$metric + latVar = latVar, region = region)$metric.original best <- Apply(list(position), target_dims = c('time', 'pos'), fun = BestAnalog, criteria = criteria, return_list = return_list, nAnalogs = nAnalogs)$output1 @@ -637,14 +639,15 @@ Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, Analogs_metrics <- Subset(metrics, along = which(names(dim(metrics)) == 'time'), indices = best) - DistCorr <- cbind(1:nrow(Analogs_metrics),Analogs_metrics) - if(dim(DistCorr)[2]==2){colnames(DistCorr) <- c("Analog","LargeDist")} - if(dim(DistCorr)[2]==3){colnames(DistCorr) <- c("Analog","LargeDist", - "LocalDist")} - if(dim(DistCorr)[2]==4){colnames(DistCorr) <- c("Analog","LargeDist", - "LocalDist","LocalCorr")} - return(list(DatesAnalogs = Analogs_dates, AnalogsFields = Analogs_fields, - MetricValues=DistCorr)) + DistCorr <- data.frame(as.numeric(1:nrow(Analogs_metrics)),(Analogs_metrics), + Analogs_dates) + if(dim(DistCorr)[2]==3){names(DistCorr) <- c("Analog","LargeDist","Dates")} + if(dim(DistCorr)[2]==4){names(DistCorr) <- c("Analog","LargeDist", + "LocalDist","Dates")} + if(dim(DistCorr)[2]==5){names(DistCorr) <- c("Analog","LargeDist", + "LocalDist","LocalCorr","Dates")} + return(list(AnalogsFields = Analogs_fields, + AnalogsInfo=DistCorr)) } BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, @@ -693,7 +696,7 @@ BestAnalog <- function(position, criteria = 'Large_dist', return_list = FALSE, if(length(best)==1 & is.na(best[1])==TRUE){ stop("no best analogs matching Large_dist and Local_dist criterias") } - pos <- pos1[as.logical(best)] + pos <- pos2[as.logical(best)] pos <- pos[which(!is.na(pos))] if (return_list == FALSE) { pos <- pos[1] @@ -723,6 +726,7 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)), names(dim(obsL))) metric1 <- Apply(list(obsL), target_dims = list(c('lat', 'lon')), fun = .select, expL, metric = "dist")$output1 + metric1.original=metric1 if (length(dim(metric1)) > 1) { dim_time_obs <- which(names(dim(metric1)) == 'time' | names(dim(metric1)) == 'ftime') @@ -730,25 +734,30 @@ names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)), names(dim(obsL))) margins <- c(1 : (length(dim(metric1))))[-dim_time_obs] pos1 <- apply(metric1, margins, order) names(dim(pos1))[1] <- 'time' + metric1.original=metric1 metric1 <- apply(metric1, margins, sort) names(dim(metric1))[1] <- 'time' + names(dim(metric1.original))=names(dim(metric1)) } else { pos1 <- order(metric1) dim(pos1) <- c(time = length(pos1)) metric1 <- sort(metric1) dim(metric1) <- c(time = length(metric1)) + dim(metric1.original)=dim(metric1) dim_time_obs=1 } if (criteria == "Large_dist") { dim(metric1) <- c(dim(metric1), metric = 1) dim(pos1) <- c(dim(pos1), pos = 1) - return(list(metric = metric1, position = pos1)) + dim(metric1.original)=dim(metric1) + return(list(metric = metric1, metric.original=metric1.original,position = pos1)) } if (criteria == "Local_dist" | criteria == "Local_cor") { obs <- SelBox(obsL, lon = lonVar, lat = latVar, region = region)$data exp <- SelBox(expL, lon = lonVar, lat = latVar, region = region)$data metric2 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), fun = .select, exp, metric = "dist")$output1 + metric2.original=metric2 dim(metric2) <- c(dim(metric2), metric=1) margins <- c(1 : (length(dim(metric2))))[-dim_time_obs] pos2 <- apply(metric2, margins, order) @@ -758,10 +767,12 @@ names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)), names(dim(obsL))) names(dim(metric2))[1] <- 'time' if (criteria == "Local_dist") { metric <- abind(metric1, metric2, along = length(dim(metric1))+1) + metric.original <- abind(metric1.original,metric2.original,along=length(dim(metric1))+1) position <- abind(pos1, pos2, along = length(dim(pos1))+1) names(dim(metric)) <- c(names(dim(pos1)), 'metric') names(dim(position)) <- c(names(dim(pos1)), 'pos') - return(list(metric = metric, position = position)) + names(dim(metric.original)) = names(dim(metric)) + return(list(metric = metric, metric.original=metric.original,position = position)) } } if (criteria == "Local_cor") { @@ -769,6 +780,7 @@ names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)), names(dim(obsL))) exp <- SelBox(expVar, lon = lonVar, lat = latVar, region = region)$data metric3 <- Apply(list(obs), target_dims = list(c('lat', 'lon')), fun = .select, exp, metric = "cor")$output1 + metric3.original=metric3 dim(metric3) <- c(dim(metric3), metric=1) margins <- c(1 : (length(dim(metric3))))[-dim_time_obs] pos3 <- apply(abs(metric3), margins, order, decreasing = TRUE) @@ -779,10 +791,13 @@ names(dim(expL)) <- replace_repeat_dimnames(names(dim(expL)), names(dim(obsL))) names(dim(metricsort))[1] <- 'time' metric <- abind(metric1, metric2, metricsort, along = length(dim(metric1)) + 1) + metric.original <- abind(metric1.original, metric2.original, metric3.original, + along = length(dim(metric1)) + 1) position <- abind(pos1, pos2, pos3, along = length(dim(pos1)) + 1) names(dim(metric)) <- c(names(dim(metric1)), 'metric') names(dim(position)) <- c(names(dim(pos1)), 'pos') - return(list(metric = metric, position = position)) + names(dim(metric.original)) = names(dim(metric)) + return(list(metric = metric, metric.original=metric.original,position = position)) } else { stop("Parameter 'criteria' must to be one of the: 'Large_dist', ", diff --git a/man/Analogs.Rd b/man/Analogs.Rd index 1be8a63f..52d9ff97 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -35,12 +35,12 @@ same variable as the passed in parameter 'expVar' for the same region.} \item{criteria}{a character string indicating the criteria to be used for the selection of analogs: \itemize{ -\item{Large_dist} minimal distance in the large scale pattern; -\item{Local_dist} minimal distance in the large scale pattern and minimal -distance in the local scale pattern; and -\item{Local_cor} minimal distance in the large scale pattern, minimal -distance in the local scale pattern and maxima correlation in the -local variable to downscale.}} +\item{Large_dist} minimum Euclidean distance in the large scale pattern; +\item{Local_dist} minimum Euclidean distance in the large scale pattern +and minimum Euclidean distance in the local scale pattern; and +\item{Local_cor} minimum Euclidean distance in the large scale pattern, +minimum Euclidean distance in the local scale pattern and highest correlation +in the local variable to downscale.}} \item{lonVar}{a vector containing the longitude of parameter 'expVar'.} @@ -51,7 +51,7 @@ the maximum longitude, the minimum latitude and the maximum latitude.} \item{nAnalogs}{number of Analogs to be selected to apply the criterias 'Local_dist' or 'Local_cor'. This is not the necessary the number of analogs -that the user can get, but the number of events with minimal distance in +that the user can get, but the number of events with minimum distance in which perform the search of the best Analog. The default value for the 'Large_dist' criteria is 1, for 'Local_dist' and 'Local_cor'criterias must be selected by the user otherwise the default value will be set as 10.} @@ -61,16 +61,17 @@ to get a single analog, the best analog. For Downscaling return_list must be FALSE.} } \value{ -DatesAnalogs, a character string with the date of the best analogs -(time, distance) - AnalogsFields, dowscaled values of the best analogs for the criteria selected. -MetricValues, a matrix with the number of analogs and the -corresponding value of the metric used in the selected criteria to find the -analogs (distance values for Large_dist and Local_dist, correlation values -for Local_cor) +AnalogsInfo, a dataframe with information about the number of the +best analogs, the corresponding value of the metric used in the selected +criteria (distance values for Large_dist and Local_dist,correlation values +for Local_cor), date of the analog). The analogs are listed in decreasing +order, the first one is the best analog (i.e if the selected criteria +is Local_cor the best analog will be the one with highest correlation, while +for Large_dist criteria the best analog will be the day with minimum +Euclidean distance) } \description{ This function perform a downscaling using Analogs. To compute @@ -82,11 +83,11 @@ et al, 2013) but the function gives the possibility to use another field. The local scale will be usually given by precipitation or temperature fields, but might be another variable. The analogs function will find the best analogs based in three criterias: -(1) Minimal distance in the large scale pattern (i.e. SLP) -(2) Minimal distance in the large scale pattern (i.e. SLP) and minimal -distance in the local scale pattern (i.e. SLP). -(3) Minimal distance in the large scale pattern (i.e. SLP), minimal -distance in the local scale pattern (i.e. SLP) and maxima correlation in the +(1) Minimum Euclidean distance in the large scale pattern (i.e. SLP) +(2) Minimum Euclidean distance in the large scale pattern (i.e. SLP) +and minimum Euclidean distance in the local scale pattern (i.e. SLP). +(3) Minimum Euclidean distance in the large scale pattern (i.e. SLP), minimum +distance in the local scale pattern (i.e. SLP) and highest correlation in the local variable to downscale (i.e Precipitation). The search of analogs must be done in the longest dataset posible. This is important since it is necessary to have a good representation of the @@ -283,7 +284,7 @@ Local_scalecor <- Analogs(expL=expSLP, criteria="Local_cor",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),nAnalogs=8,region=region, return_list = FALSE) -Local_scalecor$MetricValues +Local_scalecor$AnalogsInfo Local_scalecor$DatesAnalogs # same but without imposing nAnalogs, so nAnalogs will be set by default as 10 Local_scalecor <- Analogs(expL=expSLP, @@ -292,7 +293,7 @@ Local_scalecor <- Analogs(expL=expSLP, criteria="Local_cor",lonVar=seq(-1,5,1.5), latVar=seq(30,35,1.5),region=region, return_list = FALSE) -Local_scalecor$MetricValues +Local_scalecor$AnalogsInfo Local_scalecor$DatesAnalogs # Example 9: List of best analogs in the three criterias Large_dist, @@ -309,7 +310,7 @@ Large_scale <- Analogs(expL=expSLP, criteria="Large_dist", nAnalogs = 7, return_list = TRUE) str(Large_scale) -Large_scale$MetricValues +Large_scale$AnalogsInfo # analogs of local scale using criteria 2 lonmin=-1 lonmax=2 @@ -322,7 +323,7 @@ Local_scale <- Analogs(expL=expSLP, latVar=seq(30,35,1.5),nAnalogs=7,region=region, return_list = TRUE) str(Local_scale) -Local_scale$MetricValues +Local_scale$AnalogsInfo # analogs of local scale using criteria 3 Local_scalecor <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP, @@ -331,7 +332,7 @@ Local_scalecor <- Analogs(expL=expSLP, latVar=seq(30,35,1.5),nAnalogs=7,region=region, return_list = TRUE) str(Local_scalecor) -Local_scalecor$MetricValues +Local_scalecor$AnalogsInfo # Example 10: Downscaling in the three criteria Large_dist, Local_dist, and # Local_cor return list FALSE, different variable @@ -351,7 +352,7 @@ Large_scale <- Analogs(expL=expSLP, criteria="Large_dist", nAnalogs = 7, return_list = FALSE) str(Large_scale) -Large_scale$MetricValues +Large_scale$AnalogsInfo # analogs of local scale using criteria 2 lonmin=-1 lonmax=2 @@ -365,7 +366,7 @@ Local_scale <- Analogs(expL=expSLP, latVar=seq(30,35,1.5),nAnalogs=7,region=region, return_list = FALSE) str(Local_scale) -Local_scale$MetricValues +Local_scale$AnalogsInfo # analogs of local scale using criteria 3 Local_scalecor <- Analogs(expL=expSLP, obsL=obsSLP, time_obsL=time_obsSLP, @@ -374,7 +375,7 @@ Local_scalecor <- Analogs(expL=expSLP, latVar=seq(30,35,1.5),nAnalogs=7,region=region, return_list = FALSE) str(Local_scalecor) -Local_scalecor$MetricValues +Local_scalecor$AnalogsInfo } \references{ -- GitLab From e2c9543422610dd7f82a60eb4150f17270d1095d Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 20 Nov 2019 12:47:22 +0100 Subject: [PATCH 42/43] update documentation with dvtools --- DESCRIPTION | 4 ++-- NAMESPACE | 1 - man/Analogs.Rd | 13 +++++++------ man/CST_Analogs.Rd | 9 +++++---- 4 files changed, 14 insertions(+), 13 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c4c4defc..664218b7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,7 @@ Description: Exploits dynamical seasonal forecasts in order to provide contains process-based methods for forecast calibration, bias correction, statistical and stochastic downscaling, optimal forecast combination and multivariate verification, as well as basic and advanced tools to obtain - tailored products. This package was developed in the context of the + tailored products. This package was developed in the context of the ERA4CS project MEDSCOPE. Doblas-Reyes et al. (2005) . Mishra et al. (2018) . @@ -54,4 +54,4 @@ VignetteBuilder: knitr License: Apache License 2.0 Encoding: UTF-8 LazyData: true -RoxygenNote: 6.1.1 +RoxygenNote: 5.0.0 diff --git a/NAMESPACE b/NAMESPACE index 5858fac1..84ace898 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,6 @@ # Generated by roxygen2: do not edit by hand export(Analogs) -export(CST_Analogs) export(CST_Anomaly) export(CST_BiasCorrection) export(CST_Calibration) diff --git a/man/Analogs.Rd b/man/Analogs.Rd index 52d9ff97..ee8a737e 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -5,8 +5,8 @@ \title{Analogs based on large scale fields.} \usage{ Analogs(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, - criteria = "Large_dist", lonVar = NULL, latVar = NULL, - region = NULL, nAnalogs = NULL, return_list = FALSE) + criteria = "Large_dist", lonVar = NULL, latVar = NULL, region = NULL, + nAnalogs = NULL, return_list = FALSE) } \arguments{ \item{expL}{an array of N named dimensions containing the experimental field @@ -377,6 +377,11 @@ Local_scalecor <- Analogs(expL=expSLP, str(Local_scalecor) Local_scalecor$AnalogsInfo +} +\author{ +M. Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} + +Nuria Perez-Zanon \email{nuria.perez@bsc.es} } \references{ Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, @@ -384,8 +389,4 @@ and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. \email{pascal.yiou@lsce.ipsl.fr} } -\author{ -M. Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -Nuria Perez-Zanon \email{nuria.perez@bsc.es} -} diff --git a/man/CST_Analogs.Rd b/man/CST_Analogs.Rd index 5ad87254..474eca5a 100644 --- a/man/CST_Analogs.Rd +++ b/man/CST_Analogs.Rd @@ -81,6 +81,11 @@ adapted version of the method of Yiou et al 2013. \examples{ res <- CST_Analogs(expL = lonlat_data$exp, obsL = lonlat_data$obs) } +\author{ +M. Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} + +Nuria Perez-Zanon \email{nuria.perez@bsc.es} +} \references{ Yiou, P., T. Salameh, P. Drobinski, L. Menut, R. Vautard, and M. Vrac, 2013 : Ensemble reconstruction of the atmospheric column @@ -91,8 +96,4 @@ from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. code{\link{CST_Load}}, \code{\link[s2dverification]{Load}} and \code{\link[s2dverification]{CDORemap}} } -\author{ -M. Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -Nuria Perez-Zanon \email{nuria.perez@bsc.es} -} -- GitLab From 089f952749cdb30c1d32a3b6d74306bd15227b41 Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 20 Nov 2019 12:59:51 +0100 Subject: [PATCH 43/43] export CST_Analogs function --- NAMESPACE | 1 + R/CST_Analogs.R | 5 ++++- man/CST_Analogs.Rd | 1 + 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 84ace898..5858fac1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand export(Analogs) +export(CST_Analogs) export(CST_Anomaly) export(CST_BiasCorrection) export(CST_Calibration) diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index 9021a99b..0127b10f 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -77,8 +77,11 @@ #' #'@return An 's2dv_cube' object containing the dowscaled values of the best #'analogs in the criteria selected. +#' #'@examples #'res <- CST_Analogs(expL = lonlat_data$exp, obsL = lonlat_data$obs) +#' +#'@export CST_Analogs <- function(expL, obsL, time_obsL, expVar = NULL, obsVar = NULL, region = NULL, criteria = "Large_dist") { if (!inherits(expL, 's2dv_cube') || !inherits(obsL, 's2dv_cube')) { @@ -834,4 +837,4 @@ replace_repeat_dimnames <- function(names_exp, names_obs, lat_name = 'lat', } return(names_exp) ## Improvements: other dimensions to avoid replacement for more flexibility. -} \ No newline at end of file +} diff --git a/man/CST_Analogs.Rd b/man/CST_Analogs.Rd index 474eca5a..7c9a1e6f 100644 --- a/man/CST_Analogs.Rd +++ b/man/CST_Analogs.Rd @@ -80,6 +80,7 @@ adapted version of the method of Yiou et al 2013. } \examples{ res <- CST_Analogs(expL = lonlat_data$exp, obsL = lonlat_data$obs) + } \author{ M. Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} -- GitLab