La continuité du service gitlab.irstea.fr sera assurée en 2020. Nous envisageons ensuite une évolution vers une forge nationale INRAE encore à construire. Nous vous tiendrons au courant des évolutions futures.

Commit a0e2d0dc authored by Monnet Jean-Matthieu's avatar Monnet Jean-Matthieu

box-cox transformation handles rasterlayers

parent 725b315e
......@@ -207,13 +207,13 @@ lmaCheck <- function(formule, df, max.pvalue=0.05, max.vif=5)
#########################
#' Box-Cox Transformation
#'
#'@param x vector. values to be transformed
#'@param x vector or RasterLayer. values to be transformed
#'@param lambda numeric. parameter of Box-Cox transformation
#'@return a vector
#'@export
BoxcoxTr <- function(x,lambda)
{
count.neg <- sum(x<0)
count.neg <- ifelse(class(x)[1]=="RasterLayer", sum(raster::values(x<0), na.rm=TRUE), sum(x<0, na.rm=TRUE))
if (count.neg >0)
{
x[x<0] <- 0
......@@ -229,13 +229,13 @@ BoxcoxTr <- function(x,lambda)
########################
#' Inverse Box-Cox transformation
#'
#'@param x vector. values to be transformed
#'@param x vector or RasterLayer. values to be transformed
#'@param lambda numeric. parameter of Box-Cox transformation
#'@return a vector
#'@export
iBoxcoxTr <- function(x,lambda)
{
count.neg <- sum(x<0)
count.neg <- ifelse(class(x)[1]=="RasterLayer", sum(raster::values(x<0), na.rm=TRUE), sum(x<0, na.rm=TRUE))
if (count.neg >0)
{
x[x<0] <- 0
......@@ -254,7 +254,7 @@ iBoxcoxTr <- function(x,lambda)
#' Ref: A variance-stabilizing transformation to mitigate biased variogram estimation in heterogeneous surfaces with clustered samples
#' Xiaojun Pu and Michael Tiefelsdorf. Here varmod is not the local prediction variance as suggested in the paper but the models residuals variance
#' #'
#'@param x vector. values to be ransformed
#'@param x vector or RasterLayer. values to be ransformed
#'@param lambda numeric. parameter of Box-Cox transformation
#'@param varmod numeric. model residuals variance (use n-p instead of n-1 for variance computation, with p the number of variables in the model)
#'@return a vector
......@@ -382,6 +382,7 @@ ABApredict <- function(modell, map.metrics, strata=NULL)
{
map.metrics$strata <- 1
map.metrics$strata@data@attributes[[1]] <- data.frame(ID=1, propriete="1")
row.names(modell$stats)[1] <- "1"
}
#
dummy <- list()
......@@ -397,7 +398,7 @@ ABApredict <- function(modell, map.metrics, strata=NULL)
# apply linear model
dummy[[stratum]] <- raster::predict(map.metrics[[names(modell$model[[stratum]]$coefficients)[-1]]], modell$model[[stratum]])
# back-transform
dummy[[stratum]] <- lidaRtRee::iBoxcoxTrBiasCor(dummy[[stratum]], modell$stats[stratum,"lambda"], modell$stats[i,"var.res"])
dummy[[stratum]] <- lidaRtRee::iBoxcoxTrBiasCor(dummy[[stratum]], modell$stats[stratum,"lambda"], modell$stats[stratum,"var.res"])
}
if (modell$stats[stratum,"transform"] == "log") # case of case of log-log transform
{
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment