R/ops.R

Defines functions .genericAggregationFunction .genericBinaryFunction .genericUnaryFunction .autoArraySubset .checkMathConstants .quantile .var .sd .median .mean .range .max .min .prod .sum .greater .greater_eq .smaller_eq .smaller .notequal .equals .xor .or .and .not .mod .power .divide .multiply .minus .plus `[.ProcessGraphParameter` .cumprod .cummax .cummin .cumsum .atanh .asinh .acosh .atan .asin .acos .tanh .sinh .cosh .tan .sin .cos .log10 .log .exp .round .ceiling .floor .trunc .sqrt .sign .abs

# Definitions for operators to make it easier to create arithmetic ProcessGraphs

# it works on process nodes and ProcessGraphParameter


# 1. Group

#' Unary function wrappers
#' 
#' The functions here are used in combination with `ProcessGraphParameter` and `ProcessNode` and facilitate
#' writing arithmetic functions for openEO user defined processes in R. The functions translate into their openEO 
#' processes counterparts.
#' 
#' @param x `ProcessGraphParameter`, `ProcessNode` or a list or vector. Passes internal data to the function
#' @param ... further arguments to pass on, see the documentation of primitive functions of R for further information
#' @param digits the amount of decimal digits to round to
#' @param i the index of the element in a vector or list
#' @param drop listed for completeness but not used in openEO processes.
#' @param base the base of the exponential operation
#' 
#' @return a `ProcessNode`
#' 
#' @name unary_ops
NULL

.abs = function(x) {
  .genericUnaryFunction(x,"absolute")
}

#' @rdname unary_ops
#' @export
`abs.ProcessNode` <- .abs

#' @rdname unary_ops
#' @export
`abs.ProcessGraphParameter` <- .abs


.sign = function(x) {
  .genericUnaryFunction(x,"sgn")
}
#' @rdname unary_ops
#' @export
`sign.ProcessNode` <- .sign
#' @rdname unary_ops
#' @export
`sign.ProcessGraphParameter` <- .sign

.sqrt <- function(x) {
  .genericUnaryFunction(x,"sqrt")
}
#' @rdname unary_ops
#' @export
`sqrt.ProcessNode` <- .sqrt
#' @rdname unary_ops
#' @export
`sqrt.ProcessGraphParameter` <- .sqrt

.trunc = function(x, ...) {
  .genericUnaryFunction(x,"int")
}
#' @rdname unary_ops
#' @export
`trunc.ProcessNode` <- .trunc
#' @rdname unary_ops
#' @export
`trunc.ProcessGraphParameter` <- .trunc

.floor = function(x) {
  .genericUnaryFunction(x,"floor")
}
#' @rdname unary_ops
#' @export
`floor.ProcessNode` <- .floor
#' @rdname unary_ops
#' @export
`floor.ProcessGraphParameter` <- .floor

.ceiling = function(x) {
  .genericUnaryFunction(x,"ceil")
}
#' @rdname unary_ops
#' @export
`ceiling.ProcessNode` <- .ceiling
#' @rdname unary_ops
#' @export
`ceiling.ProcessGraphParameter` <- .ceiling

.round = function(x,digits=0) {
  graph = processes()
  
  
  FUN = "round"
  if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  
  x = .autoArraySubset(x)
  x = .checkMathConstants(x,graph)
  graph[[FUN]](x=x,p=digits) 
}
#' @rdname unary_ops
#' @export
`round.ProcessNode` <- .round
#' @rdname unary_ops
#' @export
`round.ProcessGraphParameter` <- .round

.exp = function(x) {
  .genericUnaryFunction(x,"exp")
}
#' @rdname unary_ops
#' @export
`exp.ProcessNode` <- .exp
#' @rdname unary_ops
#' @export
`exp.ProcessGraphParameter` <- .exp


.log = function(x,base=exp(1)) {
  graph = processes()
  
  if (base==exp(1)) {
    FUN = "ln"
  } else {
    FUN = "log"
  }
  
  if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  
  x = .autoArraySubset(x)
  x = .checkMathConstants(x,graph)
  
  if (FUN == "log") {
    graph[[FUN]](x=x,base=base) 
  } else {
    graph[[FUN]](x=x) 
  }
  
}
#' @rdname unary_ops
#' @export
`log.ProcessNode` <- .log
#' @rdname unary_ops
#' @export
`log.ProcessGraphParameter` <- .log


.log10 = function(x) {
  .log(x,10)
}
#' @rdname unary_ops
#' @export
`log10.ProcessNode` <- .log10
#' @rdname unary_ops
#' @export
`log10.ProcessGraphParameter` <- .log10

# trigonometric functions ----
.cos = function(x) {
  .genericUnaryFunction(x,"cos")
}
#' @rdname unary_ops
#' @export
`cos.ProcessNode` <- .cos
#' @rdname unary_ops
#' @export
`cos.ProcessGraphParameter` <- .cos


.sin = function(x) {
  .genericUnaryFunction(x,"sin")
}
#' @rdname unary_ops
#' @export
`sin.ProcessNode` <- .sin
#' @rdname unary_ops
#' @export
`sin.ProcessGraphParameter` <- .sin


.tan = function(x) {
  .genericUnaryFunction(x,"tan")
}
#' @rdname unary_ops
#' @export
`tan.ProcessNode` <- .tan
#' @rdname unary_ops
#' @export
`tan.ProcessGraphParameter` <- .tan


.cosh = function(x) {
  .genericUnaryFunction(x,"cosh")
}
#' @rdname unary_ops
#' @export
`cosh.ProcessNode` <- .cosh
#' @rdname unary_ops
#' @export
`cosh.ProcessGraphParameter` <- .cosh


.sinh = function(x) {
  .genericUnaryFunction(x,"sinh")
}
#' @rdname unary_ops
#' @export
`sinh.ProcessNode` <- .sinh
#' @rdname unary_ops
#' @export
`sinh.ProcessGraphParameter` <- .sinh


.tanh = function(x) {
  .genericUnaryFunction(x,"tanh")
}
#' @rdname unary_ops
#' @export
`tanh.ProcessNode` <- .tanh
#' @rdname unary_ops
#' @export
`tanh.ProcessGraphParameter` <- .tanh


.acos = function(x) {
  .genericUnaryFunction(x,"arccos")
}
#' @rdname unary_ops
#' @export
`acos.ProcessNode` <- .acos
#' @rdname unary_ops
#' @export
`acos.ProcessGraphParameter` <- .acos


.asin = function(x) {
  .genericUnaryFunction(x,"arcsin")
}
#' @rdname unary_ops
#' @export
`asin.ProcessNode` <- .asin
#' @rdname unary_ops
#' @export
`asin.ProcessGraphParameter` <- .asin


.atan = function(x) {
  .genericUnaryFunction(x,"arctan")
}
#' @rdname unary_ops
#' @export
`atan.ProcessNode` <- .atan
#' @rdname unary_ops
#' @export
`atan.ProcessGraphParameter` <- .atan


.acosh = function(x) {
  .genericUnaryFunction(x,"arccosh")
}
#' @rdname unary_ops
#' @export
`acosh.ProcessNode` <- .acosh
#' @rdname unary_ops
#' @export
`acosh.ProcessGraphParameter` <- .acosh


.asinh = function(x) {
  .genericUnaryFunction(x,"arcsinh")
}
#' @rdname unary_ops
#' @export
`asinh.ProcessNode` <- .asinh
#' @rdname unary_ops
#' @export
`asinh.ProcessGraphParameter` <- .asinh


.atanh = function(x) {
  .genericUnaryFunction(x,"arcsinh")
}
#' @rdname unary_ops
#' @export
`atanh.ProcessNode` <- .atanh
#' @rdname unary_ops
#' @export
`atanh.ProcessGraphParameter` <- .atanh


# internal function does not work
# @export
# `atan2` = function(y,x) {
#   UseMethod("atan2")
# }
# 
# .atan2 = function(y,x) {
#     graph = processes()
# 
#     FUN = "arctan2"
#     if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
#     graph[[FUN]](y=y,x=x)
# }
# @export
# `atan2.ProcessNode` <- .atan2
# 
# @export
# `atan2.ProcessGraphParameter` <- .atan2

# cummulative ----
.cumsum <- function(x) {
  .genericUnaryFunction(x,"cumsum")
}
#' @rdname unary_ops
#' @export
`cumsum.ProcessNode` <- .cumsum
#' @rdname unary_ops
#' @export
`cumsum.ProcessGraphParameter` <- .cumsum


.cummin <- function(x) {
  .genericUnaryFunction(x,"cummin")
}
#' @rdname unary_ops
#' @export
`cummin.ProcessNode` <- .cummin
#' @rdname unary_ops
#' @export
`cummin.ProcessGraphParameter` <- .cummin


.cummax <- function(x) {
  .genericUnaryFunction(x,"cummax")
}
#' @rdname unary_ops
#' @export
`cummax.ProcessNode` <- .cummax
#' @rdname unary_ops
#' @export
`cummax.ProcessGraphParameter` <- .cummax


.cumprod <- function(x) {
  .genericUnaryFunction(x,"cumproduct")
}
#' @rdname unary_ops
#' @export
`cumprod.ProcessNode` <- .cumprod
#' @rdname unary_ops
#' @export
`cumprod.ProcessGraphParameter` <- .cumprod

# 2. Group
# [ (subset) ====
#' @rdname unary_ops
#' @export
`[.ProcessGraphParameter` <- function(x,i,...,drop=TRUE) {
  # check x for being an array
  if (length(x$getSchema()$type) > 0 && 
      !isTRUE(x$getSchema()$type == "array")) stop("Non-array ProcessGraph value cannot be addressed by index. Check if the ProcessGraph requires a binary operator")
  
  graph = processes()
  
  FUN = "array_element"
  if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  
  if (is.numeric(i)) {
    graph[[FUN]](data=x,index=i-1) # do index shift because javascript / JSON addresses an element of an array from 0 to n-1
  } else if (is.character(i)) {
    graph[[FUN]](data=x,label=i) # do index shift because javascript / JSON addresses an element of an array from 0 to n-1
  } else {
    stop("Subsetting is neither done by integer nor with a label/character.")
  }
  
}

#' Binary function wrappers
#' 
#' The functions here are used in combination with `ProcessGraphParameter` and `ProcessNode` in order to make
#' it easier to write arithmetic functions for openEO user defined processes in R. The functions map into their openEO 
#' processes counterparts.
#' 
#' @param e1 `ProcessGraphParameter`, `ProcessNode` or a list or vector, which internal data is passed into 
#' the function or a numeric value
#' @param e2 same as e1
#' @param x the first expression in the xor statement
#' @param y the second expression in the xor statement
#' 
#' @return a `ProcessNode`
#' 
#' @name binary_ops
NULL

# mathematical operators ----
.plus = function(e1,e2){
  .genericBinaryFunction(e1,e2,"add")
}
#' @rdname binary_ops
#' @export
`+.ProcessNode` <- .plus
#' @rdname binary_ops
#' @export
`+.ProcessGraphParameter` <- .plus


.minus = function(e1,e2) {
  # v0.4.2 -> subtract of array
  # v0.5 -> subtract of two values
  if (missing(e2)) {
    return(-1 * e1)
  }
  
  .genericBinaryFunction(e1,e2,"subtract")
}
#' @rdname binary_ops
#' @export
`-.ProcessNode` <- .minus
#' @rdname binary_ops
#' @export
`-.ProcessGraphParameter` <- .minus


.multiply = function(e1,e2) {
  # v0.4.2 -> multiply or product of array
  # v0.5 -> multiply of two values, product of an array of values
  graph = processes()
  
  if ("multiply" %in% names(graph)) {
    FUN = "multiply"
  } else if ("product" %in% names(graph)) {
    FUN = "product"
  } else {
    stop("Neither 'multiply' nor 'product' are available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'.")
  }
  .genericBinaryFunction(e1,e2,FUN)
}
#' @rdname binary_ops
#' @export
`*.ProcessNode` <- .multiply
#' @rdname binary_ops
#' @export
`*.ProcessGraphParameter` <- .multiply


.divide = function(e1,e2) {
  .genericBinaryFunction(e1,e2,"divide")
}
#' @rdname binary_ops
#' @export
`/.ProcessNode` <- .divide
#' @rdname binary_ops
#' @export
`/.ProcessGraphParameter` <- .divide


.power = function(e1,e2) {
  .genericBinaryFunction(e1,e2,"power")
}
#' @rdname binary_ops
#' @export
`^.ProcessNode` <- .power
#' @rdname binary_ops
#' @export
`^.ProcessGraphParameter` <- .power


.mod = function(e1,e2) {
  .genericBinaryFunction(e1,e2,"mod")
}
#' @rdname binary_ops
#' @export
`%%.ProcessNode` <- .mod
#' @rdname binary_ops
#' @export
`%%.ProcessGraphParameter` <- .mod

# logical operators ----

.not = function(x) {
  .genericUnaryFunction(x,"not")
}
#' @rdname unary_ops
#' @export
`!.ProcessNode` <- .not
#' @rdname unary_ops
#' @export
`!.ProcessGraphParameter` <- .not


.and = function(e1,e2) {
  .genericBinaryFunction(e1 = e1,e2=e2,"and")
}
#' @rdname binary_ops
#' @export
`&.ProcessNode` <- .and
#' @rdname binary_ops
#' @export
`&.ProcessGraphParameter` <- .and


.or = function(e1, e2) {
  .genericBinaryFunction(e1 = e1,e2=e2,"or")
}
#' @rdname binary_ops
#' @export
`|.ProcessNode` <- .or
#' @rdname binary_ops
#' @export
`|.ProcessGraphParameter` <- .or


.xor = function(x,y) {
  .genericBinaryFunction(e1 = x,e2=y,"xor")
}
#' @rdname binary_ops
#' @export
`xor.ProcessNode` <- .xor
#' @rdname binary_ops
#' @export
`xor.ProcessGraphParameter` <- .xor


.equals = function(e1,e2) {
  graph = processes()
  
  FUN = "eq"
  if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  graph[[FUN]](x=e1,y=e2) 
}
#' @rdname binary_ops
#' @export
`==.ProcessNode` <- .equals
#' @rdname binary_ops
#' @export
`==.ProcessGraphParameter` <- .equals


.notequal = function(e1, e2) {
  graph = processes()
  
  FUN = "neq"
  if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  graph[[FUN]](x=e1,y=e2) 
}
#' @rdname binary_ops
#' @export
`!=.ProcessNode` <- .notequal
#' @rdname binary_ops
#' @export
`!=.ProcessGraphParameter` <- .notequal


.smaller = function(e1, e2) {
  graph = processes()
  
  FUN = "lt"
  if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  graph[[FUN]](x=e1,y=e2) 
}
#' @rdname binary_ops
#' @export
`<.ProcessNode` <- .smaller
#' @rdname binary_ops
#' @export
`<.ProcessGraphParameter` <- .smaller


.smaller_eq = function(e1, e2) {
  graph = processes()
  
  FUN = "lte"
  if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  graph[[FUN]](x=e1,y=e2) 
}
#' @rdname binary_ops
#' @export
`<=.ProcessNode` <- .smaller_eq
#' @rdname binary_ops
#' @export
`<=.ProcessGraphParameter` <- .smaller_eq


.greater_eq = function(e1, e2) {
  graph = processes()
  
  FUN = "gte"
  if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  graph[[FUN]](x=e1,y=e2) 
}
#' @rdname binary_ops
#' @export
`>=.ProcessNode` <- .greater_eq
#' @rdname binary_ops
#' @export
`>=.ProcessGraphParameter` <- .greater_eq


.greater = function(e1, e2) {
  graph = processes()
  
  FUN = "gt"
  if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  graph[[FUN]](x=e1,y=e2) 
}
#' @rdname binary_ops
#' @export
`>.ProcessNode` <- .greater
#' @rdname binary_ops
#' @export
`>.ProcessGraphParameter` <- .greater

# 3. group

#' Group operator wrappers
#' 
#' R's mathematical group primitives that are translated to openEO processes.
#' 
#' @details The `...` parameter is required to start with the [`ProcessNode`] or a [`ProcessGraphParameter`] that returns 
#' a numeric value. If it starts with a number the corresponding function in base R will be used, which will result in most cases in 
#' an error because base R cannot interprete the ProcessNode and ProcessGraphParameter objects. In that case you need to reorder the 
#' elements so that [openeo's group operators][group_ops] will be used.
#' 
#' @param ... multiple arguments that start with a [`ProcessNode`] or a [`ProcessGraphParameter`]
#' @param na.rm logical to determine if NA values shall be removed in the calculation
#' @param x a vector or list of values that are mixed or consist fully of [`ProcessNode`], 
#' [`ProcessGraphParameter`] or numerical values
#' 
#' @return [`ProcessNode`]
#' @name group_ops
#' 
NULL

# summary operators ----
.sum <- function(..., na.rm=FALSE) {
  elems = list(...)
  .genericAggregationFunction(x=elems,na.rm=na.rm,FUN="sum")
}
#' @rdname group_ops
#' @export
`sum.ProcessNode` <- .sum
#' @export
#' @rdname group_ops
`sum.ProcessGraphParameter` <- .sum
#' @rdname group_ops
#' @export
`sum.list` <- .sum


.prod <- function(..., na.rm=TRUE) {
  elems = list(...)
  .genericAggregationFunction(x=elems,na.rm=na.rm,FUN="product")
}
#' @rdname group_ops
#' @export
`prod.ProcessNode` <- .prod
#' @rdname group_ops
#' @export
`prod.ProcessGraphParameter` <- .prod
#' @rdname group_ops
#' @export
`prod.list` <- .prod


.min <- function(..., na.rm=TRUE) {
  elems = list(...)
  .genericAggregationFunction(x=elems,na.rm=na.rm,FUN="min")
}
#' @rdname group_ops
#' @export
`min.ProcessNode` <- .min
#' @rdname group_ops
#' @export
`min.ProcessGraphParameter` <- .min
#' @rdname group_ops
#' @export
`min.list` <- .min


.max <- function(..., na.rm=TRUE) {
  elems = list(...)
  .genericAggregationFunction(x=elems,na.rm=na.rm,FUN="max")
}
#' @rdname group_ops
#' @export
`max.ProcessNode` <- .max
#' @rdname group_ops
#' @export
`max.ProcessGraphParameter` <- .max
#' @rdname group_ops
#' @export
`max.list` <- .max


.range <- function(..., na.rm=TRUE) {
  elems = list(...)
  .genericAggregationFunction(x=elems,na.rm=na.rm,FUN="extrema")
}
#' @rdname group_ops
#' @export
`range.ProcessNode` <- .range
#' @rdname group_ops
#' @export
`range.ProcessGraphParameter` <- .range
#' @rdname group_ops
#' @export
`range.list` <- .range


.mean <- function(x, na.rm=FALSE,...) {
  .genericAggregationFunction(x=x,na.rm=na.rm,FUN="mean")
}
#' @rdname group_ops
#' @export
`mean.ProcessNode` <- .mean
#' @rdname group_ops
#' @export
`mean.ProcessGraphParameter` <- .mean
#' @rdname group_ops
#' @export
`mean.list` <- .mean




.median <- function(x, na.rm=FALSE,...) {
  .genericAggregationFunction(x=x,na.rm=na.rm,FUN="median")
}
#' @rdname group_ops
#' @importFrom stats median
#' @export
`median.ProcessNode`<- .median
#' @rdname group_ops
#' @export
`median.ProcessGraphParameter`<- .median
#' @rdname group_ops
#' @export
`median.list`<- .median


.sd <- function(x, na.rm=FALSE) {
  .genericAggregationFunction(x=x,na.rm=na.rm,FUN="sd")
}
#' @rdname group_ops
#' @importFrom stats sd
#' @export
`sd.ProcessNode`  <- .sd
#' @rdname group_ops
#' @export
`sd.ProcessGraphParameter`  <- .sd
#' @rdname group_ops
#' @export
`sd.list`  <- .sd


.var <- function(x, na.rm=FALSE) {
  .genericAggregationFunction(x=x,na.rm=na.rm,FUN="variance")
}
#' @rdname group_ops
#' @importFrom stats var
#' @export
`var.ProcessNode` <- .var
#' @rdname group_ops
#' @export
`var.ProcessGraphParameter` <- .var
#' @rdname group_ops
#' @export
`var.list` <- .var


.quantile <- function(x, ...) {
  args = list(...)
  probs = args$probs
  na.rm = args$na.rm
  
  if (length(na.rm) == 0) na.rm = FALSE
  
  if ("ProcessNode" %in% class(x)) {
    graph = x$getGraph()
  } else {
    graph = x$getProcess()$getGraph()
  }
  
  
  FUN = "quantiles"
  if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  graph[[FUN]](data = x,probabilites = probs)
}
#' @rdname unary_ops
#' @importFrom stats quantile
#' @export
`quantile.ProcessNode` <- .quantile
#' @rdname unary_ops
#' @export
`quantile.ProcessGraphParameter` <- .quantile


# utility functions ====

.checkMathConstants = function(x, graph=NULL) {
  if (length(graph) == 0) {
    if (length(active_connection()) == 0) {
      return(x)
    } else {
      graph = processes()
    }
  }
  
  if (is.numeric(x)) {
    if (isTRUE(x == exp(1))) {
      FUN = "e"
      if (FUN %in% names(graph)) {
        return(graph[[FUN]]())
      } else {
        warning("Mathematical constant 'e' detected, but back-end does not support function 'e()'. Using approximated value instead.")
      }
    }
    
    if (isTRUE(x == pi)) {
      FUN = "pi"
      if (FUN %in% names(graph)) {
        return(graph[[FUN]]())
      } else {
        warning("Mathematical constant 'pi' detected, but back-end does not support function 'pi()'. Using approximated value instead.")
      }
    }
  }
  
  return(x)
}

.autoArraySubset = function(x) {
  if ("ProcessGraphParameter" %in% class(x)) {
    
    if (length(x$getSchema()$type) > 0 && x$getSchema()$type == "array") {
      x = x[1]
      warning("Using first index of the input parameter else do explicit subset.")
    }
  }
  return(x)
}

.genericUnaryFunction = function(x,FUN) {
  graph = processes()
  
  if (!FUN %in% names(graph)) {
    stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  }
  
  x = .autoArraySubset(x)
  x = .checkMathConstants(x,graph)
  graph[[FUN]](x=x) 
}

.genericBinaryFunction = function(e1,e2,FUN) {
  graph = processes()

    if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
  
  # if ProcessGraphParameter, then check if array or single value
  e1 = .autoArraySubset(e1)
  e2 = .autoArraySubset(e2)
  
  e1 = .checkMathConstants(e1,graph)
  e2 = .checkMathConstants(e2,graph)
  
  p = as.list(formals(graph[[FUN]]))
  
  if (length(p) == 1) {
    p[[1]] = c(e1,e2)
  } else {
    p[[1]] = e1
    p[[2]] = e2
  }
  
  do.call(graph[[FUN]],args = p)
}

.genericAggregationFunction = function(x, ..., FUN) {
    graph = processes()
    params = list(...)
    na.rm = FALSE
    
    if ("na.rm" %in% names(params)) {
      na.rm = params$`na.rm`
    }
    
    # check x
    if ("ProcessGraphParameter" %in% class(x)) {
      
    }
    
    if ("ProcessNode" %in% class(x)) {
      
    } 
    
    if ("list" %in% class(x)) {
      # do type checking? everything should me a single value with the same type or it should
      # be of any type
      x = lapply(x, function(elem){
        .checkMathConstants(elem,graph)
      })
    }
    
    if (!FUN %in% names(graph)) stop(paste0("Process '",FUN,"' is not available on the back-end. Please check the provided processes for alternatives and create a ProcessGraph graph via the function 'openeo::ProcessGraphArgument'."))
    
    if ("ignore_nodata" %in% names(formals(graph[[FUN]]))) {
      graph[[FUN]](data = x,ignore_nodata=na.rm) 
    } else {
      graph[[FUN]](data = x) 
    }
}

Try the openeo package in your browser

Any scripts or data that you put into this service are public.

openeo documentation built on Nov. 17, 2022, 5:07 p.m.