Forward Package

Functions and manuals for use of forward package

DESCRIPTION

@@ -0,0 +1,10 @@
+Package: Forward
+Type: Package
+Title: Forward
+Version: 1.0
+Date: 2018-07-24
+Author: Klaus Wolfgang Wiese Acosta
+Maintainer: Klaus Wolfgang Wiese Acosta <klaus.wiese@unah.edu.hn>
+Description: Package for the study of vegetation resilience and resistance to temperature and drought
+License: GPL
+Depends: R (>= 2.14.0), methods, raster, stats

Forward.Rproj

@@ -0,0 +1,17 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source

NAMESPACE

@@ -0,0 +1,13 @@
+#Functions
+export("NDVIAnomaly")
+export("DifferenceAnnualCycle")
+export("FirstDifference")
+export("SD_NDVIAnomaly")
+export("monthlyMODIS")
+export("SD_NDVI_MAnomaly")
+export("Resilience")
+
+#Packages
+import("raster")
+importFrom("stats", "lm", "sd")
+import("methods")

R/DifferenceAnnualCycle.R

@@ -0,0 +1,9 @@
+#Ratio Annual Cycle ACF
+#K. Wiese Julio 2018
+#######################
+
+DifferenceAnnualCycle <- function(ACF, ASL){
+  difference <- function(x,y) x-y
+  DiffACFAnnualCycle <- overlay(ACF[[1]], ACF[[ASL]], fun=difference)
+  return(DiffACFAnnualCycle)
+}

R/FirstDifference.R

@@ -0,0 +1,9 @@
+#Evaluate the first difference of a series
+#K. Wiese Julio 2018
+##########################################
+
+FirstDifference <- function(r){
+  Firstdiff <- calc(r, fun=diff) 
+  return(Firstdiff)
+}
+

R/NDVIAnomaly.R

@@ -0,0 +1,20 @@
+#NDVI Anomaly
+#K. Wiese July 2018
+###################
+
+NDVIAnomaly <- function(NDVI, YearLength){
+
+  years <- seq(1, dim(NDVI)[3], by=YearLength)
+
+  lista <- list()
+  for (i in 1:(dim(NDVI)[3]/YearLength)){
+    lista[[i]] <- NDVI[[years[i]:(i*YearLength)]]
+  }
+
+  Medias <- lapply(lista, FUN = function(x) calc(x, mean))
+  MediaTotal <- calc(NDVI, mean)
+
+  Anomaly <- lapply(Medias, FUN = function(x) x - MediaTotal)
+
+  return(stack(Anomaly))
+}

R/Resilience.R

@@ -0,0 +1,24 @@
+#Resilience
+#K. Wiese September 2018
+########################
+
+Resilience <- function(NANOprev, TANO, SPEI, NANO){
+  Input <- stack(NANOprev, TANO, SPEI, NANO)#stack all raster variables 
+  tsl <- dim(NANO)[3] #time series length
+  #Resilience Beta coeficient, NANO - 1
+  funBeta <- function(x) { if (is.na(x[1])){ NA } else lm(x[(3*tsl+1):(4*tsl)] ~ x[1:tsl] + x[(tsl+1):(2*tsl)] + x[(2*tsl+1):(3*tsl)] + 0)$coefficients[1] }
+  Beta <- calc(Input, funBeta)
+  #Resistence to Temperatura alpha coeficient, TANO  
+  funAlpha <- function(x) { if (is.na(x[1])){ NA } else lm(x[(3*tsl+1):(4*tsl)] ~ x[1:tsl] + x[(tsl+1):(2*tsl)] + x[(2*tsl+1):(3*tsl)] + 0)$coefficients[2] }
+  Alpha <- calc(Input, funAlpha)
+  #Resistence to drought tetha coeficient, SPEI  
+  funTetha <- function(x) { if (is.na(x[1])){ NA } else lm(x[(3*tsl+1):(4*tsl)] ~ x[1:tsl] + x[(tsl+1):(2*tsl)] + x[(2*tsl+1):(3*tsl)] + 0)$coefficients[3] }
+  Tetha <- calc(Input, funTetha)
+  #RMSE
+  funRMSE <-  function(x) { if (is.na(x[1])){ NA } else sqrt(mean(lm(x[(3*tsl+1):(4*tsl)] ~ x[1:tsl] + x[(tsl+1):(2*tsl)] + x[(2*tsl+1):(3*tsl)] + 0)$residuals^2)) }
+  RMSE <- calc(Input,funRMSE)
+  #Results
+  Index <- stack(Beta, Alpha, Tetha, RMSE)
+  names(Index) <- c("Resilience", "Resistence_to_Temperature", "Resistence_to_Drought", "RMSE")
+  return(Index)
+}

R/SD_NDVIAnomaly.R

@@ -0,0 +1,21 @@
+#NDVI Anomaly
+#K. Wiese July 2018
+###################
+
+SD_NDVIAnomaly <- function(NDVI, YearLength){
+
+  years <- seq(1, dim(NDVI)[3], by=YearLength)
+
+  lista <- list()
+  for (i in 1:(dim(NDVI)[3]/YearLength)){
+    lista[[i]] <- NDVI[[years[i]:(i*YearLength)]]
+  }
+
+  Medias <- lapply(lista, FUN = function(x) calc(x, mean))
+  MediaTotal <- calc(NDVI, mean)
+  sdTotal <- calc(NDVI, sd)
+
+  SDAnomaly <- lapply(Medias, FUN = function(x) (x - MediaTotal)/sdTotal)
+
+  return(stack(SDAnomaly))
+}

R/SD_NDVI_MAnomaly.R

@@ -0,0 +1,111 @@
+#NDVI monthly Anomaly
+#K. Wiese July 2018
+#####################
+
+SD_NDVI_MAnomaly <- function(NDVI, YearLength, ini, fin){
+
+  years <- seq(1, dim(NDVI)[3], by=YearLength)
+
+  Meses <- list()
+  for (i in 0:(12-1)){
+    Meses[[i+1]] <- NDVI[[years+i]]
+  }
+
+  MediasAnuales <- lapply(Meses, FUN = function(x) calc(x, mean))
+  sdAnuales <- lapply(Meses, FUN = function(x) calc(x, sd))
+
+  Jan <- list()
+  for (i in 1:dim(Meses[[1]])[3]){
+    Jan[[i]] <- Meses[[1]][[i]]
+  }
+
+  Feb <- list()
+  for (i in 1:dim(Meses[[2]])[3]){
+    Feb[[i]] <- Meses[[2]][[i]]
+  }
+
+  Mar <- list()
+  for (i in 1:dim(Meses[[3]])[3]){
+    Mar[[i]] <- Meses[[3]][[i]]
+  }
+
+  Abr <- list()
+  for (i in 1:dim(Meses[[3]])[3]){
+    Abr[[i]] <- Meses[[4]][[i]]
+  }
+
+  May <- list()
+  for (i in 1:dim(Meses[[5]])[3]){
+    May[[i]] <- Meses[[5]][[i]]
+  }
+
+  Jun <- list()
+  for (i in 1:dim(Meses[[6]])[3]){
+    Jun[[i]] <- Meses[[6]][[i]]
+  }
+
+  Jul <- list()
+  for (i in 1:dim(Meses[[7]])[3]){
+    Jul[[i]] <- Meses[[7]][[i]]
+  }
+
+  Aug <- list()
+  for (i in 1:dim(Meses[[8]])[3]){
+    Aug[[i]] <- Meses[[8]][[i]]
+  }
+
+  Sep <- list()
+  for (i in 1:dim(Meses[[9]])[3]){
+    Sep[[i]] <- Meses[[9]][[i]]
+  }
+
+  Oct <- list()
+  for (i in 1:dim(Meses[[10]])[3]){
+    Oct[[i]] <- Meses[[10]][[i]]
+  }
+
+  Nov <- list()
+  for (i in 1:dim(Meses[[11]])[3]){
+    Nov[[i]] <- Meses[[11]][[i]]
+  }
+
+  Dic <- list()
+  for (i in 1:dim(Meses[[12]])[3]){
+    Dic[[i]] <- Meses[[12]][[i]]
+  }
+
+  SDAnomalyJan <- lapply(Jan, FUN = function(x) (x - MediasAnuales[[1]])/sdAnuales[[1]])
+  SDAnomalyFeb <- lapply(Feb, FUN = function(x) (x - MediasAnuales[[2]])/sdAnuales[[2]])
+  SDAnomalyMar <- lapply(Mar, FUN = function(x) (x - MediasAnuales[[3]])/sdAnuales[[3]])
+  SDAnomalyAbr <- lapply(Abr, FUN = function(x) (x - MediasAnuales[[4]])/sdAnuales[[4]])
+  SDAnomalyMay <- lapply(May, FUN = function(x) (x - MediasAnuales[[5]])/sdAnuales[[5]])
+  SDAnomalyJun <- lapply(Jun, FUN = function(x) (x - MediasAnuales[[6]])/sdAnuales[[6]])
+  SDAnomalyJul <- lapply(Jul, FUN = function(x) (x - MediasAnuales[[7]])/sdAnuales[[7]])
+  SDAnomalyAug <- lapply(Aug, FUN = function(x) (x - MediasAnuales[[8]])/sdAnuales[[8]])
+  SDAnomalySep <- lapply(Sep, FUN = function(x) (x - MediasAnuales[[9]])/sdAnuales[[9]])
+  SDAnomalyOct <- lapply(Oct, FUN = function(x) (x - MediasAnuales[[10]])/sdAnuales[[10]])
+  SDAnomalyNov <- lapply(Nov, FUN = function(x) (x - MediasAnuales[[11]])/sdAnuales[[11]])
+  SDAnomalyDic <- lapply(Dic, FUN = function(x) (x - MediasAnuales[[12]])/sdAnuales[[12]])
+
+  SDAnomaly <- raster()
+  for(i in 1:length(SDAnomalyJan)){
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyJan[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyFeb[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyMar[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyAbr[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyMay[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyJun[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyJul[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyAug[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalySep[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyOct[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyNov[[i]])
+  SDAnomaly <- addLayer(SDAnomaly, SDAnomalyDic[[i]])
+  }
+
+
+  year <- sort(rep(ini:fin, 12))
+  names(SDAnomaly) <- paste0("MODIS_", year, "_", 01:12)
+
+  return(SDAnomaly)
+}

R/monthlyMODIS.R

@@ -0,0 +1,22 @@
+#MODIS monthly Time Series derived from 8 days times series
+###########################################################
+
+monthlyMODIS <- function(MODISyear, year){
+
+  Jan <- calc(MODISyear[[1:4]], fun=mean)
+  Feb <- calc(MODISyear[[5:8]], fun=mean)
+  Mar <- calc(MODISyear[[9:12]], fun=mean)
+  Abr <- calc(MODISyear[[13:15]], fun=mean)
+  May <- calc(MODISyear[[16:19]], fun=mean)
+  Jun <- calc(MODISyear[[20:23]], fun=mean)
+  Jul <- calc(MODISyear[[24:27]], fun=mean)
+  Aug <- calc(MODISyear[[28:31]], fun=mean)
+  Sep <- calc(MODISyear[[32:35]], fun=mean)
+  Oct <- calc(MODISyear[[36:38]], fun=mean)
+  Nov <- calc(MODISyear[[39:42]], fun=mean)
+  Dic <- calc(MODISyear[[43:46]], fun=mean)
+
+  monthlymean <- stack(Jan, Feb, Mar, Abr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dic)
+  names(monthlymean) <- paste0("MODIS_", year, "_", 01:12)
+  return(monthlymean)
+}

README.md

@@ -0,0 +1,17 @@
+# Forward-upm
+
+In the framework of the FORDWARD project we develop an R-package in order to work with NDVI MODIS time series.
+
+## Package Installation
+
+1. Download repository from GitLab
+2. Within R execute:
+
+```r
+install.packages("~/Downloads/forward-upm-master.tar", repos=NULL, type="source", dependencies=TRUE)
+```
+
+The forward package depends on the package raster https://www.rdocumentation.org/packages/raster/versions/2.6-7
+
+## NDVI time series
+

man/DifferenceAnnualCycle.Rd

@@ -0,0 +1,29 @@
+\name{DifferenceAnnualCycle}
+\alias{DifferenceAnnualCycle}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+ACF Difference Annual Cycle
+}
+\description{
+Calculate ACF Difference Annual Cycle, first lag minus the lag that represent the annual cycle}
+\usage{
+DifferenceAnnualCycle(ACF, ASL)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+  \item{ACF}{Time series ACF, a raster stack}
+  \item{ASL}{Annual Season Length, a numeric value}
+}
+
+\value{A raster that represents the difference between the first lag ann the lag that represents the annual cycle, the closer the value to cero more stable time series}
+\references{}
+\author{Klaus Wolfgang Wiese Acosta}
+
+
+\examples{
+#Set variables
+ACF <- stack("ACF.tiff")
+
+DifferenceAnnualCycle(ACF, 46)
+}
+

man/FirstDifference.Rd

@@ -0,0 +1,29 @@
+\name{FirstDifference}
+\alias{FirstDifference}
+%- Also NEED an '\alias' for EACH other topic documented here.
+\title{
+First Difference
+}
+\description{
+Find the First Difference for a time series}
+\usage{
+FirstDifference(r)
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+  \item{r}{A raster stack}
+  \item{...}{Options from the calc function from raster package}
+}
+
+\value{Calculate the first diffence from a raster time series}
+\references{}
+\author{Klaus Wolfgang Wiese Acosta}
+
+
+\examples{
+#Set variables
+ACF <- stack("ACF.tiff")
+
+FirstDifference(ACF)
+}
+

man/Forward-package.Rd

@@ -0,0 +1,24 @@
+\name{Forward-package}
+\alias{Forward-package}
+\alias{Forward}
+\docType{package}
+\title{
+\packageTitle{Forward}
+}
+\description{
+\packageDescription{Forward}
+}
+\details{
+
+The DESCRIPTION file:
+\packageDESCRIPTION{Forward}
+\packageIndices{Forward}
+~~ An overview of how to use the package, including the most important ~~
+~~ functions ~~
+}
+\author{
+\packageAuthor{Forward}
+
+Maintainer: \packageMaintainer{Forward}
+}
+\keyword{ package }