#' @useDynLib Rvision, .registration = TRUE
#' @import Rcpp
#' @import methods
#' @import pbapply
#' @import ROpenCVLite
#' @importFrom graphics arrows par plot rasterImage points symbols
#' @importFrom stats median.default
#' @importFrom grDevices col2rgb
### Load package module ###
Rcpp::loadModule("class_Image", TRUE)
Rcpp::loadModule("class_Capture", TRUE)
Rcpp::loadModule("class_VideoWriter", TRUE)
Rcpp::loadModule("methods_Arithmetic", TRUE)
Rcpp::loadModule("methods_Statistics", TRUE)
Rcpp::loadModule("methods_Comparisons", TRUE)
Rcpp::loadModule("methods_Logical", TRUE)
Rcpp::loadModule("methods_OpticalFlow", TRUE)
Rcpp::loadModule("methods_Blob", TRUE)
Rcpp::loadModule("methods_Morphology", TRUE)
Rcpp::loadModule("methods_Filters", TRUE)
Rcpp::loadModule("methods_Display", TRUE)
Rcpp::loadModule("methods_Draw", TRUE)
Rcpp::loadModule("methods_Geometry", TRUE)
Rcpp::loadModule("methods_Shape", TRUE)
Rcpp::loadModule("methods_Transform", TRUE)
Rcpp::loadModule("methods_Feature", TRUE)
Rcpp::loadModule("methods_Autothresh", TRUE)
Rcpp::loadModule("methods_Ximgproc", TRUE)
Rcpp::loadModule("methods_Calib3d", TRUE)
### Define generic arithmetic methods ###
methods::evalqOnLoad({
setMethod("add", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_plus`(e1, e2, target)
})
setMethod("add", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_plus`(e1, e2, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_plus`(e1, e2, out)
out
} else {
stop("Invalid target")
}
})
setMethod("add", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "Rcpp_Image"),
function(e1, e2, target) {
`_plusScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("add", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_plusScalar`(e1, rep(e2, length.out = e1$nchan()), e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_plusScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("add", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_plusScalar`(e2, rep(e1, length.out = e2$nchan()), target)
})
setMethod("add", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_plusScalar`(e2, rep(e1, length.out = e2$nchan()), e2)
} else if (target == "new") {
out <- cloneImage(e2)
`_plusScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("add", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_plus`(e1, e2, out)
out
})
setMethod("add", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_plusScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
})
setMethod("add", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e2)
`_plusScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
})
})
methods::evalqOnLoad({
setMethod("subtract", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_minus`(e1, e2, target)
})
setMethod("subtract", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_minus`(e1, e2, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_minus`(e1, e2, out)
out
} else {
stop("Invalid target")
}
})
setMethod("subtract", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "Rcpp_Image"),
function(e1, e2, target) {
`_minusScalar`(e1, rep(e2, length.out = e1$nchan()), TRUE, target)
})
setMethod("subtract", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_minusScalar`(e1, rep(e2, length.out = e1$nchan()), TRUE, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_minusScalar`(e1, rep(e2, length.out = e1$nchan()), TRUE, out)
out
} else {
stop("Invalid target")
}
})
setMethod("subtract", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_minusScalar`(e2, rep(e1, length.out = e2$nchan()), FALSE, target)
})
setMethod("subtract", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_minusScalar`(e2, rep(e1, length.out = e2$nchan()), FALSE, e2)
} else if (target == "new") {
out <- cloneImage(e2)
`_minusScalar`(e2, rep(e1, length.out = e2$nchan()), FALSE, out)
out
} else {
stop("Invalid target")
}
})
setMethod("subtract", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_minus`(e1, e2, out)
out
})
setMethod("subtract", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_minusScalar`(e1, rep(e2, length.out = e1$nchan()), TRUE, out)
out
})
setMethod("subtract", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e2)
`_minusScalar`(e2, rep(e1, length.out = e2$nchan()), FALSE, out)
out
})
})
methods::evalqOnLoad({
setMethod("multiply", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_multiply`(e1, e2, target)
})
setMethod("multiply", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_multiply`(e1, e2, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_multiply`(e1, e2, out)
out
} else {
stop("Invalid target")
}
})
setMethod("multiply", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "Rcpp_Image"),
function(e1, e2, target) {
`_multiplyScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("multiply", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_multiplyScalar`(e1, rep(e2, length.out = e1$nchan()), e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_multiplyScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("multiply", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_multiplyScalar`(e2, rep(e1, length.out = e2$nchan()), target)
})
setMethod("multiply", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_multiplyScalar`(e2, rep(e1, length.out = e2$nchan()), e2)
} else if (target == "new") {
out <- cloneImage(e2)
`_multiplyScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("multiply", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_multiply`(e1, e2, out)
out
})
setMethod("multiply", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_multiplyScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
})
setMethod("multiply", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e2)
`_multiplyScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
})
})
methods::evalqOnLoad({
setMethod("divide", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_divide`(e1, e2, target)
})
setMethod("divide", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_divide`(e1, e2, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_divide`(e1, e2, out)
out
} else {
stop("Invalid target")
}
})
setMethod("divide", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "Rcpp_Image"),
function(e1, e2, target) {
`_divideScalar`(e1, rep(e2, length.out = e1$nchan()), TRUE, target)
})
setMethod("divide", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_divideScalar`(e1, rep(e2, length.out = e1$nchan()), TRUE, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_divideScalar`(e1, rep(e2, length.out = e1$nchan()), TRUE, out)
out
} else {
stop("Invalid target")
}
})
setMethod("divide", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_divideScalar`(e2, rep(e1, length.out = e2$nchan()), FALSE, target)
})
setMethod("divide", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_divideScalar`(e2, rep(e1, length.out = e2$nchan()), FALSE, e2)
} else if (target == "new") {
out <- cloneImage(e2)
`_divideScalar`(e2, rep(e1, length.out = e2$nchan()), FALSE, out)
out
} else {
stop("Invalid target")
}
})
setMethod("divide", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_divide`(e1, e2, out)
out
})
setMethod("divide", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_divideScalar`(e1, rep(e2, length.out = e1$nchan()), TRUE, out)
out
})
setMethod("divide", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e2)
`_divideScalar`(e2, rep(e1, length.out = e2$nchan()), FALSE, out)
out
})
})
methods::evalqOnLoad({
#' @aliases Arith,Rcpp_Image,Rcpp_Image-method
#' @aliases Arith,Rcpp_Image,numeric-method
#' @aliases Arith,numeric,Rcpp_Image-method
setMethod("+", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
add(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("+", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
add(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("+", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
add(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("-", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
subtract(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("-", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
subtract(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("-", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
subtract(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("*", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
multiply(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("*", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
multiply(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("*", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
multiply(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("/", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
divide(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("/", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
divide(e1, e2, "new")
}, where = .GlobalEnv)
setMethod("/", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
divide(e1, e2, "new")
}, where = .GlobalEnv)
})
methods::evalqOnLoad({
#' @name inPlaceArithmetic
#' @rdname inPlaceArithmetic
setMethod("%i+%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
add(e1, e2, "self")
})
setMethod("%i+%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
add(e1, e2, "self")
})
setMethod("%i+%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
add(e1, e2, "self")
})
setMethod("%i-%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
subtract(e1, e2, "self")
})
setMethod("%i-%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
subtract(e1, e2, "self")
})
setMethod("%i-%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
subtract(e1, e2, "self")
})
setMethod("%i*%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
multiply(e1, e2, "self")
})
setMethod("%i*%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
multiply(e1, e2, "self")
})
setMethod("%i*%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
multiply(e1, e2, "self")
})
setMethod("%i/%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
divide(e1, e2, "self")
})
setMethod("%i/%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
divide(e1, e2, "self")
})
setMethod("%i/%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
divide(e1, e2, "self")
})
})
methods::evalqOnLoad({
setMethod("absdiff", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_absdiff`(e1, e2, target)
})
setMethod("absdiff", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_absdiff`(e1, e2, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_absdiff`(e1, e2, out)
out
} else {
stop("Invalid target")
}
})
setMethod("absdiff", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "Rcpp_Image"),
function(e1, e2, target) {
`_absdiffScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("absdiff", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_absdiffScalar`(e1, rep(e2, length.out = e1$nchan()), e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_absdiffScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("absdiff", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_absdiffScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("absdiff", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_absdiffScalar`(e2, rep(e1, length.out = e2$nchan()), e2)
} else if (target == "new") {
out <- cloneImage(e2)
`_absdiffScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("absdiff", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_absdiff`(e1, e2, out)
out
})
setMethod("absdiff", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_absdiffScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
})
setMethod("absdiff", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e2)
`_absdiffScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
})
})
### Define generic math methods ###
#' @title Exponential Generic for Image objects
#'
#' @description Overloaded \code{\link[base]{exp}} to handle \code{\link{Image}}
#' objects.
#'
#' @param x A 32- or 64-bit (32F or 64F) \code{\link{Image}} object.
#'
#' @param target The location where the results should be stored when passing a
#' sum of images to the function. It can take 3 values:
#' \itemize{
#' \item{"new":}{a new \code{\link{Image}} object is created and the results
#' are stored inside (the default).}
#' \item{"self":}{the results are stored back into \code{x} (faster but
#' destructive).}
#' \item{An \code{\link{Image}} object:}{the results are stored in another
#' existing \code{\link{Image}} object. This is fast but will replace the
#' content of \code{target}. Note that \code{target} should have the same
#' dimensions, bitdepth, and number of channels as \code{x}, otherwise an
#' error will be thrown.}
#' }
#'
#' @return If \code{target="new"}, the function returns an \code{\link{Image}}
#' object. If \code{target="self"}, the function returns nothing and modifies
#' \code{x} in place. If \code{target} is an \code{\link{Image}} object, the
#' function returns nothing and modifies that \code{\link{Image}} object in
#' place.
#'
#' @author Simon Garnier, \email{garnier@@njit.edu}
#'
#' @seealso \code{\link{log}}, \code{\link{pow}}, \code{\link{sqrt}}
#'
#' @examples
#' balloon <- image(system.file("sample_img/balloon1.png", package = "Rvision"))
#' changeBitDepth(balloon, "32F", 1 / 255, "self")
#' exp(balloon)
#'
#' @name exp
#'
#' @export
setGeneric("exp", function(x, target = "new") standardGeneric("exp"),
useAsDefault = function(x, target) base::exp(x),
group = "Math")
methods::evalqOnLoad({
#' @name exp
#' @rdname exp
setMethod("exp", "Rcpp_Image",
function(x, target = "new") {
if (!isImage(x))
stop("x must be an Image object.")
if (x$depth() != "32F" & x$depth() != "64F")
stop("x must be a 32F or 64F image object.")
if (isImage(target)) {
if (target$depth() != "32F" & target$depth() != "64F")
stop("target must be a 32F or 64F image object.")
`_exp`(x, target)
} else if (target == "self") {
`_exp`(x, x)
} else if (target == "new") {
out <- cloneImage(x)
`_exp`(x, out)
out
} else {
stop("Invalid target.")
}
})
setMethod("exp", "array",
function(x) {
base::exp(x)
})
})
#' @title Logarithm Generic for Image objects
#'
#' @description Overloaded \code{\link[base]{log}} to handle \code{\link{Image}}
#' objects.
#'
#' @param x A 32- or 64-bit (32F or 64F) \code{\link{Image}} object.
#'
#' @param target The location where the results should be stored when passing a
#' sum of images to the function. It can take 3 values:
#' \itemize{
#' \item{"new":}{a new \code{\link{Image}} object is created and the results
#' are stored inside (the default).}
#' \item{"self":}{the results are stored back into \code{x} (faster but
#' destructive).}
#' \item{An \code{\link{Image}} object:}{the results are stored in another
#' existing \code{\link{Image}} object. This is fast but will replace the
#' content of \code{target}. Note that \code{target} should have the same
#' dimensions, bitdepth, and number of channels as \code{x}, otherwise an
#' error will be thrown.}
#' }
#'
#' @param ... Ignored.
#'
#' @return If \code{target="new"}, the function returns an \code{\link{Image}}
#' object. If \code{target="self"}, the function returns nothing and modifies
#' \code{x} in place. If \code{target} is an \code{\link{Image}} object, the
#' function returns nothing and modifies that \code{\link{Image}} object in
#' place.
#'
#' @author Simon Garnier, \email{garnier@@njit.edu}
#'
#' @seealso \code{\link{exp}}, \code{\link{pow}}, \code{\link{sqrt}}
#'
#' @examples
#' balloon <- image(system.file("sample_img/balloon1.png", package = "Rvision"))
#' changeBitDepth(balloon, "32F", 1 , "self")
#' log(balloon)
#'
#' @name log
#'
#' @export
setGeneric("log", function(x, target = "new", ...) standardGeneric("log"),
useAsDefault = function(x, target, ...) base::log(x, ...),
group = "Math")
methods::evalqOnLoad({
#' @name log
#' @rdname log
setMethod("log", "Rcpp_Image",
function(x, target = "new") {
if (!isImage(x))
stop("x must be an Image object.")
if (x$depth() != "32F" & x$depth() != "64F")
stop("x must be a 32F or 64F image object.")
if (isImage(target)) {
if (target$depth() != "32F" & target$depth() != "64F")
stop("target must be a 32F or 64F image object.")
`_log`(x, target)
} else if (target == "self") {
`_log`(x, x)
} else if (target == "new") {
out <- cloneImage(x)
`_log`(x, out)
out
} else {
stop("Invalid target.")
}
})
setMethod("log", "array",
function(x, base = exp(1)) {
base::log(x, base)
})
})
#' @title Square Root Generic for Image objects
#'
#' @description Overloaded \code{\link[base]{sqrt}} to handle \code{\link{Image}}
#' objects.
#'
#' @param x A 32- or 64-bit (32F or 64F) \code{\link{Image}} object.
#'
#' @param target The location where the results should be stored when passing a
#' sum of images to the function. It can take 3 values:
#' \itemize{
#' \item{"new":}{a new \code{\link{Image}} object is created and the results
#' are stored inside (the default).}
#' \item{"self":}{the results are stored back into \code{x} (faster but
#' destructive).}
#' \item{An \code{\link{Image}} object:}{the results are stored in another
#' existing \code{\link{Image}} object. This is fast but will replace the
#' content of \code{target}. Note that \code{target} should have the same
#' dimensions, bitdepth, and number of channels as \code{x}, otherwise an
#' error will be thrown.}
#' }
#'
#' @return If \code{target="new"}, the function returns an \code{\link{Image}}
#' object. If \code{target="self"}, the function returns nothing and modifies
#' \code{x} in place. If \code{target} is an \code{\link{Image}} object, the
#' function returns nothing and modifies that \code{\link{Image}} object in
#' place.
#'
#' @author Simon Garnier, \email{garnier@@njit.edu}
#'
#' @seealso \code{\link{exp}}, \code{\link{log}}, \code{\link{pow}}
#'
#' @examples
#' balloon <- image(system.file("sample_img/balloon1.png", package = "Rvision"))
#' changeBitDepth(balloon, "32F", 1 , "self")
#' sqrt(balloon)
#'
#' @name sqrt
#'
#' @export
setGeneric("sqrt", function(x, target = "new") standardGeneric("sqrt"),
useAsDefault = function(x, target) base::sqrt(x),
group = "Math")
methods::evalqOnLoad({
#' @name sqrt
#' @rdname sqrt
setMethod("sqrt", "Rcpp_Image",
function(x, target = "new") {
if (!isImage(x))
stop("x must be an Image object.")
if (x$depth() != "32F" & x$depth() != "64F")
stop("x must be a 32F or 64F image object.")
if (isImage(target)) {
if (target$depth() != "32F" & target$depth() != "64F")
stop("target must be a 32F or 64F image object.")
`_sqrt`(x, target)
} else if (target == "self") {
`_sqrt`(x, x)
} else if (target == "new") {
out <- cloneImage(x)
`_sqrt`(x, out)
out
} else {
stop("Invalid target.")
}
})
setMethod("sqrt", "array",
function(x) {
base::sqrt(x)
})
})
### Define generic statistics methods ###
#' @title Sum Generic for Image objects
#'
#' @description Overloaded \code{\link[base]{sum}} to handle \code{\link{Image}}
#' objects and lists of \code{\link{Image}} objects.
#'
#' @param x An \code{\link{Image}} object or a list of \code{\link{Image}}
#' objects.
#'
#' @param target The location where the results should be stored when passing a
#' sum of images to the function. It can take 2 values:
#' \itemize{
#' \item{"new":}{a new \code{\link{Image}} object is created and the results
#' are stored inside (the default).}
#' \item{An \code{\link{Image}} object:}{the results are stored in another
#' existing \code{\link{Image}} object. This is fast but will replace the
#' content of \code{target}. Note that \code{target} should have the same
#' dimensions and number of channels as the images in the list, otherwise an
#' error will be thrown.}
#' }
#'
#' @param ... Further arguments passed to summary methods. Unused if \code{x} is
#' an image or a list of images.
#'
#' @return If \code{x} is an \code{\link{Image}} object, the function returns a
#' numeric value (for single-channel images) or a vector of numeric values (for
#' multi-channel images).
#'
#' If \code{x} is a list of \code{\link{Image}} objects and \code{target="new"},
#' the function returns an \code{\link{Image}} object. If \code{target} is an
#' \code{\link{Image}} object, the function returns nothing and modifies that
#' \code{\link{Image}} object in place.
#'
#' @author Simon Garnier, \email{garnier@@njit.edu}
#'
#' @seealso \code{\link{Image}}
#'
#' @examples
#' balloon <- image(system.file("sample_img/balloon1.png", package = "Rvision"))
#' sum(balloon)
#'
#' balloon_vid <- video(system.file("sample_vid/Balloon.mp4", package = "Rvision"))
#' img_list <- lapply(1:10, function(x) readNext(balloon_vid))
#' sum(img_list)
#'
#' @name sum
#'
#' @export
setGeneric("sum", function(x, ..., target = "new") standardGeneric("sum"),
useAsDefault = function(x, ..., target) base::sum(x, ...),
group = "Summary")
methods::evalqOnLoad({
#' @name sum
#' @rdname sum
setMethod("sum", "list",
function(x, ..., target = "new") {
test <- sapply(x, function(x) class(x) == "Rcpp_Image")
if (all(test)) {
if (isImage(target)) {
invisible(lapply(x, `_plus`, image2 = target, target = target))
} else if (target == "new") {
out <- zeros(x[[1]]$nrow(), x[[1]]$ncol(), x[[1]]$nchan(), "32F")
lapply(x, `_plus`, image2 = out, target = out)
out
} else {
stop("Invalid target.")
}
} else {
base::sum(x, ...)
}
})
setMethod("sum", "Rcpp_Image",
function(x, ...) {
sum <- `_sumPx`(x)
names(sum) <- switch(x$nchan(),
"I",
c("I1", "I2"),
c("B", "G", "R"),
c("B", "G", "R", "A"),
NULL)
sum
})
})
methods::evalqOnLoad({
setMethod("bitMin", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
if (any(dim(e1) != dim(e2)) | e1$depth() != e1$depth())
stop("'e1' and 'e2' must be Image objects with same dimensions, number of channels, and bit depth.")
if (any(dim(e1) != dim(target)) | e1$depth() != target$depth())
stop("'target' must have the same dimensions, number of channels, and bit depth as 'e1'.")
`_bitMin`(e1, e2, target)
})
setMethod("bitMin", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (any(dim(e1) != dim(e2)) | e1$depth() != e1$depth())
stop("'e1' and 'e2' must be Image objects with same dimensions, number of channels, and bit depth.")
if (target == "self") {
`_bitMin`(e1, e2, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_bitMin`(e1, e2, out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitMin", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "Rcpp_Image"),
function(e1, e2, target) {
if (any(dim(e1) != dim(target)) | e1$depth() != target$depth())
stop("'target' must have the same dimensions, number of channels, and bit depth as 'e1'.")
`_bitMinScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("bitMin", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_bitMinScalar`(e1, rep(e2, length.out = e1$nchan()), e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_bitMinScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitMin", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
if (any(dim(e1) != dim(target)) | e1$depth() != target$depth())
stop("'target' must have the same dimensions, number of channels, and bit depth as 'e1'.")
`_bitMinScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("bitMin", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_bitMinScalar`(e2, rep(e1, length.out = e2$nchan()), e2)
} else if (target == "new") {
out <- cloneImage(e2)
`_bitMinScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitMin", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
if (any(dim(e1) != dim(e2)) | e1$depth() != e1$depth())
stop("'e1' and 'e2' must be Image objects with same dimensions, number of channels, and bit depth.")
out <- cloneImage(e1)
`_bitMin`(e1, e2, out)
out
})
setMethod("bitMin", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_bitMinScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
})
setMethod("bitMin", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e2)
`_bitMinScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
})
})
methods::evalqOnLoad({
setMethod("bitMax", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
if (any(dim(e1) != dim(e2)) | e1$depth() != e1$depth())
stop("'e1' and 'e2' must be Image objects with same dimensions, number of channels, and bit depth.")
if (any(dim(e1) != dim(target)) | e1$depth() != target$depth())
stop("'target' must have the same dimensions, number of channels, and bit depth as 'e1'.")
`_bitMax`(e1, e2, target)
})
setMethod("bitMax", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (any(dim(e1) != dim(e2)) | e1$depth() != e1$depth())
stop("'e1' and 'e2' must be Image objects with same dimensions, number of channels, and bit depth.")
if (target == "self") {
`_bitMax`(e1, e2, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_bitMax`(e1, e2, out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitMax", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "Rcpp_Image"),
function(e1, e2, target) {
if (any(dim(e1) != dim(target)) | e1$depth() != target$depth())
stop("'target' must have the same dimensions, number of channels, and bit depth as 'e1'.")
`_bitMaxScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("bitMax", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_bitMaxScalar`(e1, rep(e2, length.out = e1$nchan()), e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_bitMaxScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitMax", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
if (any(dim(e1) != dim(target)) | e1$depth() != target$depth())
stop("'target' must have the same dimensions, number of channels, and bit depth as 'e1'.")
`_bitMaxScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("bitMax", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_bitMaxScalar`(e2, rep(e1, length.out = e2$nchan()), e2)
} else if (target == "new") {
out <- cloneImage(e2)
`_bitMaxScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitMax", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
if (any(dim(e1) != dim(e2)) | e1$depth() != e1$depth())
stop("'e1' and 'e2' must be Image objects with same dimensions, number of channels, and bit depth.")
out <- cloneImage(e1)
`_bitMax`(e1, e2, out)
out
})
setMethod("bitMax", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_bitMaxScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
})
setMethod("bitMax", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e2)
`_bitMaxScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
})
})
### Define generic comparison methods ###
comparison <- function(str) {
switch (str,
"==" = 0L,
">" = 1L,
">=" = 2L,
"<" = 3L,
"<=" = 4L,
"!=" = 5L,
stop("Invalid comparison.")
)
}
methods::evalqOnLoad({
setMethod("compare", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, comparison, target) {
`_compare`(e1, e2, comparison(comparison), target)
})
setMethod("compare", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, comparison, target) {
if (target == "self") {
`_compare`(e1, e2, comparison(comparison), e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_compare`(e1, e2, comparison(comparison), out)
out
} else {
stop("Invalid target")
}
})
setMethod("compare", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, comparison, target) {
out <- cloneImage(e1)
`_compare`(e1, e2, comparison(comparison), out)
out
})
setMethod("compare", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "Rcpp_Image"),
function(e1, e2, comparison, target) {
`_compareScalar`(e1, rep(e2, length.out = e1$nchan()), comparison(comparison), target)
})
setMethod("compare", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "character"),
function(e1, e2, comparison, target) {
if (target == "self") {
`_compareScalar`(e1, rep(e2, length.out = e1$nchan()), comparison(comparison), e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_compareScalar`(e1, rep(e2, length.out = e1$nchan()), comparison(comparison), out)
out
} else {
stop("Invalid target")
}
})
setMethod("compare", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "missing"),
function(e1, e2, comparison, target) {
out <- cloneImage(e1)
`_compareScalar`(e1, rep(e2, length.out = e1$nchan()), comparison(comparison), out)
out
})
setMethod("compare", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, comparison, target) {
`_compareScalar`(e2, rep(e1, length.out = e2$nchan()), comparison(comparison), target)
})
setMethod("compare", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, comparison, target) {
if (target == "self") {
`_compareScalar`(e2, rep(e1, length.out = e2$nchan()), comparison(comparison), e2)
} else if (target == "new") {
out <- cloneImage(e2)
`_compareScalar`(e2, rep(e1, length.out = e2$nchan()), comparison(comparison), out)
out
} else {
stop("Invalid target")
}
})
setMethod("compare", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, comparison, target) {
out <- cloneImage(e2)
`_compareScalar`(e2, rep(e1, length.out = e2$nchan()), comparison(comparison), out)
out
})
})
methods::evalqOnLoad({
#' @aliases Comparison,Rcpp_Image,Rcpp_Image-method
#' @aliases Comparison,Rcpp_Image,numeric-method
#' @aliases Comparison,numeric,Rcpp_Image-method
setMethod(">", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, ">")
}, where = .GlobalEnv)
setMethod(">", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, ">")
}, where = .GlobalEnv)
setMethod(">", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, ">")
}, where = .GlobalEnv)
setMethod("<", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "<")
}, where = .GlobalEnv)
setMethod("<", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, "<")
}, where = .GlobalEnv)
setMethod("<", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "<")
}, where = .GlobalEnv)
setMethod("==", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "==")
}, where = .GlobalEnv)
setMethod("==", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, "==")
}, where = .GlobalEnv)
setMethod("==", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "==")
}, where = .GlobalEnv)
setMethod("!=", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "!=")
}, where = .GlobalEnv)
setMethod("!=", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, "!=")
}, where = .GlobalEnv)
setMethod("!=", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "!=")
}, where = .GlobalEnv)
setMethod(">=", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, ">=")
}, where = .GlobalEnv)
setMethod(">=", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, ">=")
}, where = .GlobalEnv)
setMethod(">=", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, ">=")
}, where = .GlobalEnv)
setMethod("<=", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "<=")
}, where = .GlobalEnv)
setMethod("<=", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, "<=")
}, where = .GlobalEnv)
setMethod("<=", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "<=")
}, where = .GlobalEnv)
})
methods::evalqOnLoad({
#' @name inPlaceComparison
#' @rdname inPlaceComparison
setMethod("%i>%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, ">", "self")
})
setMethod("%i>%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, ">", "self")
})
setMethod("%i>%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, ">", "self")
})
setMethod("%i<%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "<", "self")
})
setMethod("%i<%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, "<", "self")
})
setMethod("%i<%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "<", "self")
})
setMethod("%i>=%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, ">=", "self")
})
setMethod("%i>=%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, ">=", "self")
})
setMethod("%i>=%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, ">=", "self")
})
setMethod("%i<=%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "<=", "self")
})
setMethod("%i<=%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, "<=", "self")
})
setMethod("%i<=%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "<=", "self")
})
setMethod("%i==%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "==", "self")
})
setMethod("%i==%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, "==", "self")
})
setMethod("%i==%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "==", "self")
})
setMethod("%i!=%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "!=", "self")
})
setMethod("%i!=%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
compare(e1, e2, "!=", "self")
})
setMethod("%i!=%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
compare(e1, e2, "!=", "self")
})
})
### Define generic logical methods ###
methods::evalqOnLoad({
setMethod("bitAnd", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_and`(e1, e2, target)
})
setMethod("bitAnd", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_and`(e1, e2, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_and`(e1, e2, out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitAnd", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "Rcpp_Image"),
function(e1, e2, target) {
`_andScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("bitAnd", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_andScalar`(e1, rep(e2, length.out = e1$nchan()), e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_andScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitAnd", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_andScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("bitAnd", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_andScalar`(e2, rep(e1, length.out = e2$nchan()), e2)
} else if (target == "new") {
out <- cloneImage(e2)
`_andScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitAnd", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_and`(e1, e2, out)
out
})
setMethod("bitAnd", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_andScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
})
setMethod("bitAnd", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e2)
`_andScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
})
})
methods::evalqOnLoad({
setMethod("bitOr", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_or`(e1, e2, target)
})
setMethod("bitOr", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_or`(e1, e2, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_or`(e1, e2, out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitOr", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "Rcpp_Image"),
function(e1, e2, target) {
`_orScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("bitOr", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_orScalar`(e1, rep(e2, length.out = e1$nchan()), e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_orScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitOr", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, e2, target) {
`_orScalar`(e1, rep(e2, length.out = e1$nchan()), target)
})
setMethod("bitOr", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "character"),
function(e1, e2, target) {
if (target == "self") {
`_orScalar`(e2, rep(e1, length.out = e2$nchan()), e2)
} else if (target == "new") {
out <- cloneImage(e2)
`_orScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitOr", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_or`(e1, e2, out)
out
})
setMethod("bitOr", signature(e1 = "Rcpp_Image", e2 = "numeric", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e1)
`_orScalar`(e1, rep(e2, length.out = e1$nchan()), out)
out
})
setMethod("bitOr", signature(e1 = "numeric", e2 = "Rcpp_Image", target = "missing"),
function(e1, e2, target) {
out <- cloneImage(e2)
`_orScalar`(e2, rep(e1, length.out = e2$nchan()), out)
out
})
})
methods::evalqOnLoad({
setMethod("bitNot", signature(e1 = "Rcpp_Image", target = "Rcpp_Image"),
function(e1, target) {
`_not`(e1, target)
})
setMethod("bitNot", signature(e1 = "Rcpp_Image", target = "character"),
function(e1, target) {
if (target == "self") {
`_not`(e1, e1)
} else if (target == "new") {
out <- cloneImage(e1)
`_not`(e1, out)
out
} else {
stop("Invalid target")
}
})
setMethod("bitNot", signature(e1 = "Rcpp_Image", target = "missing"),
function(e1, target) {
out <- cloneImage(e1)
`_not`(e1, out)
out
})
})
methods::evalqOnLoad({
setMethod("&", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
bitAnd(e1, e2)
}, where = .GlobalEnv)
setMethod("&", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
bitAnd(e1, e2)
}, where = .GlobalEnv)
setMethod("&", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
bitAnd(e1, e2)
}, where = .GlobalEnv)
setMethod("|", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
bitOr(e1, e2)
}, where = .GlobalEnv)
setMethod("|", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
bitOr(e1, e2)
}, where = .GlobalEnv)
setMethod("|", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
bitOr(e1, e2)
}, where = .GlobalEnv)
setMethod("!", signature(x = "Rcpp_Image"),
function(x) {
bitNot(x)
}, where = .GlobalEnv)
})
methods::evalqOnLoad({
#' @name inPlaceLogical
#' @rdname inPlaceLogical
setMethod("%i&%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
bitAnd(e1, e2, "self")
})
setMethod("%i&%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
bitAnd(e1, e2, "self")
})
setMethod("%i&%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
bitAnd(e1, e2, "self")
})
setMethod("%i|%", signature(e1 = "Rcpp_Image", e2 = "Rcpp_Image"),
function(e1, e2) {
bitOr(e1, e2, "self")
})
setMethod("%i|%", signature(e1 = "Rcpp_Image", e2 = "numeric"),
function(e1, e2) {
bitOr(e1, e2, "self")
})
setMethod("%i|%", signature(e1 = "numeric", e2 = "Rcpp_Image"),
function(e1, e2) {
bitOr(e1, e2, "self")
})
})
### Define generic show methods ###
methods::evalqOnLoad({
setMethod("show", "Rcpp_Image", function(object) {
if (!isImage(object))
stop("This is not an Image object.")
width <- object$ncol()
height <- object$nrow()
type <- object$space
depth <- object$depth()
chan <- object$nchan()
gpu <- object$GPU
cat("Class: image. \n")
cat("Dimensions: ", width, "x", height, ".\n", sep = "")
cat("Type: ", type, ", ", chan, "-channel, ", depth, ".\n", sep = "")
cat("GPU: ", gpu, ".\n", sep = "")
})
setMethod("show", "Rcpp_Video", function(object) {
if (!isVideo(object))
stop("This is not a Video object.")
width <- ncol(object)
height <- nrow(object)
codec <- codec(object)
fps <- fps(object)
nframes <- nframes(object)
cat("Class: video file. \n")
cat("Dimensions: ", width, "x", height, ", ", nframes, " frames.\n", sep = "")
cat("Frame rate: ", fps, "fps.\n", sep = "")
cat("Codec: ", codec, ".\n", sep = "")
})
setMethod("show", "Rcpp_Stream", function(object) {
if (!isStream(object))
stop("This is not a Stream object.")
width <- ncol(object)
height <- nrow(object)
cat("Class: video stream.\n")
cat("Dimensions: ", width, "x", height, ".\n", sep = "")
})
setMethod("show", "Rcpp_VideoWriter", function(object) {
if (!isVideoWriter(object))
stop("This is not a VideoWriter object.")
width <- ncol(object)
height <- nrow(object)
codec <- codec(object)
fps <- fps(object)
api <- api(object)
output <- writerOuput((object))
cat("Class: video writer.\n")
cat("Dimensions: ", width, "x", height, ".\n", sep = "")
cat("Frame rate: ", fps, "fps.\n", sep = "")
cat("Codec: ", codec, ".\n", sep = "")
cat("API: ", api, ".\n", sep = "")
cat("Output file: ", output, "\n", sep = "")
})
})
### Cleanup function ###
.onUnload <- function(libpath) {
library.dynam.unload("Rvision", libpath)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.