R/affine-methods.r

Defines functions as.matrix.at_matrix `%*%.at_matrix` solve.at_matrix Math.at_matrix Complex.at_matrix Ops.at_matrix is_at_matrix t.at_matrix as_transform3d.default as_transform2d.default as_transform1d.default as_transform3d.transform3d as_transform2d.transform2d as_transform1d.transform1d as_transform3d as_transform2d as_transform1d is_transform3d is_transform2d is_transform1d

Documented in as_transform1d as_transform1d.default as_transform1d.transform1d as_transform2d as_transform2d.default as_transform2d.transform2d as_transform3d as_transform3d.default as_transform3d.transform3d is_transform1d is_transform2d is_transform3d

#' Test if 1D affine transformation matrix
#'
#' `is_transform1d()` tests if object is a [transform1d()] affine transformation matrix
#'
#' @param x An object
#' @return A logical value
#' @examples
#' m <- transform1d(diag(2L))
#' is_transform1d(m)
#' is_transform1d(diag(2L))
#' @export
is_transform1d <- function(x) {
    inherits(x, "transform1d")
}

#' Test if 2D affine transformation matrix
#'
#' `is_transform2d()` tests if object is a [transform2d()] affine transformation matrix
#'
#' @param x An object
#' @return A logical value
#' @examples
#' m <- transform2d(diag(3L))
#' is_transform2d(m)
#' is_transform2d(diag(3L))
#' @export
is_transform2d <- function(x) {
    inherits(x, "transform2d")
}

#' Test if 3D affine transformation matrix
#'
#' `is_transform3d()` tests if object is a [transform3d()] affine transformation matrix
#'
#' @param x An object
#' @return A logical value
#' @examples
#' m <- transform3d(diag(4L))
#' is_transform3d(m)
#' is_transform3d(diag(4L))
#' @export
is_transform3d <- function(x) {
    inherits(x, "transform3d")
}

#' Cast to 1D affine transformation matrix
#'
#' `as_transform1d()` casts to a [transform1d()] affine transformation matrix
#'
#' @param x An object that can be cast to a
#' @param ... Further arguments passed to or from other methods
#' @return A [transform1d()] object
#' @examples
#' m <- diag(2L)
#' as_transform1d(m)
#' @export
as_transform1d <- function(x, ...) {
    UseMethod("as_transform1d")
}

#' Cast to 2D affine transformation matrix
#'
#' `as_transform2d()` casts to a [transform2d()] affine transformation matrix
#'
#' @param x An object that can be cast to a
#' @param ... Further arguments passed to or from other methods
#' @return A [transform2d()] object
#' @examples
#' m <- diag(3L)
#' as_transform2d(m)
#' @export
as_transform2d <- function(x, ...) {
    UseMethod("as_transform2d")
}

#' Cast to 3D affine transformation matrix
#'
#' `as_transform3d()` casts to a [transform3d()] affine transformation matrix
#'
#' @param x An object that can be cast to a
#' @param ... Further arguments passed to or from other methods
#' @return A [transform3d()] object
#' @examples
#' m <- diag(4L)
#' as_transform3d(m)
#' @export
as_transform3d <- function(x, ...) {
    UseMethod("as_transform3d")
}

#' @rdname as_transform1d
#' @export
as_transform1d.transform1d <- function(x, ...) {
    x
}

#' @rdname as_transform2d
#' @export
as_transform2d.transform2d <- function(x, ...) {
    x
}

#' @rdname as_transform3d
#' @export
as_transform3d.transform3d <- function(x, ...) {
    x
}

#' @rdname as_transform1d
#' @export
as_transform1d.default <- function(x, ...) {
    transform1d(as.matrix(x, ...))
}

#' @rdname as_transform2d
#' @export
as_transform2d.default <- function(x, ...) {
    transform2d(as.matrix(x, ...))
}

#' @rdname as_transform3d
#' @export
as_transform3d.default <- function(x, ...) {
    transform3d(as.matrix(x, ...))
}

#' @export
t.at_matrix <- function(x) {
    class(x) <- NULL
    NextMethod()
}

is_at_matrix <- function(x) inherits(x, "at_matrix")

#' @export
Ops.at_matrix <- function(e1, e2) {
    if (is_at_matrix(e1))
        class(e1) <- NULL
    if (!missing(e2) && is_at_matrix(e2))
        class(e2) <- NULL
    NextMethod()
}

#' @export
Complex.at_matrix <- function(z) {
    class(z) <- NULL
    NextMethod()
}

#' @export
Math.at_matrix <- function(x, ...) {
    class(x) <- NULL
    NextMethod()
}

#' @export
solve.at_matrix <- function(a, b, ...) {
    m <- NextMethod()
    if (missing(b) && !is_at_matrix(m)) {
        class(m) <- class(a)
    }
    m
}

# S3 method registered for R (>= 4.3.0) in `hooks.r`
`%*%.at_matrix` <- function(x, y) {
    m <- NextMethod()
    if (is_at_matrix(x) && is_at_matrix(y) && !is_at_matrix(m)) {
        class(m) <- class(x)
    }
    m
}

#' @export
as.matrix.at_matrix <- function(x, ...) {
    class(x) <- NULL
    x
}

Try the affiner package in your browser

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

affiner documentation built on April 4, 2025, 4:42 a.m.