1 2#' Affine transformer 3#' 4#' @param trans_matrix A 3x3 transformation matrix 5#' @param x A [wk_trans_affine()] 6#' @param dx,dy Coordinate offsets in the x and y direction 7#' @param scale_x,scale_y Scale factor to apply in the x and y directions, respectively 8#' @param rct_in,rct_out The input and output bounds 9#' @param rotation_deg A rotation to apply in degrees counterclockwise. 10#' @param src,dst Point vectors of control points used to estimate the affine mapping 11#' (using [base::qr.solve()]). 12#' @param ... Zero or more transforms in the order they should be applied. 13#' 14#' @export 15#' 16wk_trans_affine <- function(trans_matrix) { 17 new_wk_trans(.Call(wk_c_trans_affine_new, trans_matrix), "wk_trans_affine") 18} 19 20#' @export 21wk_trans_inverse.wk_trans_affine <- function(trans, ...) { 22 wk_affine_invert(trans) 23} 24 25#' @rdname wk_trans_affine 26#' @export 27wk_affine_identity <- function() { 28 wk_affine_translate(0, 0) 29} 30 31#' @rdname wk_trans_affine 32#' @export 33wk_affine_rotate <- function(rotation_deg) { 34 theta <- -rotation_deg * pi / 180 35 trans_matrix <- matrix( 36 c( 37 cos(theta), +sin(theta), 0, 38 -sin(theta), cos(theta), 0, 39 0, 0, 1 40 ), 41 nrow = 3, 42 byrow = TRUE 43 ) 44 45 wk_trans_affine(trans_matrix) 46} 47 48#' @rdname wk_trans_affine 49#' @export 50wk_affine_scale <- function(scale_x = 1, scale_y = 1) { 51 wk_trans_affine(matrix(c(scale_x, 0, 0, 0, scale_y, 0, 0, 0, 1), ncol = 3)) 52} 53 54#' @rdname wk_trans_affine 55#' @export 56wk_affine_translate <- function(dx = 0, dy = 0) { 57 wk_trans_affine(matrix(c(1, 0, 0, 0, 1, 0, dx, dy, 1), ncol = 3)) 58} 59 60#' @rdname wk_trans_affine 61#' @export 62wk_affine_fit <- function(src, dst) { 63 src <- as_xy(src) 64 dst <- as_xy(dst) 65 n <- length(src) 66 stopifnot(length(src) == length(dst)) 67 src <- unclass(src) 68 dst <- unclass(dst) 69 70 src_mat <- cbind(src$x, src$y, rep_len(1, n)) 71 dst_mat <- cbind(dst$x, dst$y, rep_len(1, n)) 72 73 wk_trans_affine(t(qr.solve(src_mat, dst_mat))) 74} 75 76#' @rdname wk_trans_affine 77#' @export 78wk_affine_rescale <- function(rct_in, rct_out) { 79 # use bbox to sanitize input as rct of length 1 80 rct_in <- unclass(wk_bbox(rct_in)) 81 rct_out <- unclass(wk_bbox(rct_out)) 82 83 width_in <- rct_in$xmax - rct_in$xmin 84 height_in <- rct_in$ymax - rct_in$ymin 85 width_out <- rct_out$xmax - rct_out$xmin 86 height_out <- rct_out$ymax - rct_out$ymin 87 88 dx <- rct_out$xmin - rct_in$xmin 89 dy <- rct_out$ymin - rct_in$ymin 90 91 wk_affine_compose( 92 wk_affine_translate(dx, dy), 93 wk_affine_scale(width_out / width_in, height_out / height_in) 94 ) 95} 96 97#' @rdname wk_trans_affine 98#' @export 99wk_affine_compose <- function(...) { 100 trans_matrix <- Reduce( 101 `%*%`, 102 lapply(rev(list(...)), as.matrix), 103 init = as.matrix(wk_affine_identity()) 104 ) 105 wk_trans_affine(trans_matrix) 106} 107 108#' @rdname wk_trans_affine 109#' @export 110wk_affine_invert <- function(x) { 111 wk_trans_affine(solve(as.matrix(x))) 112} 113 114#' @export 115as.matrix.wk_trans_affine <- function(x, ...) { 116 .Call(wk_c_trans_affine_as_matrix, x) 117} 118 119#' @export 120format.wk_trans_affine <- function(x, ...) { 121 format(as.matrix(x), ...) 122} 123 124#' @export 125print.wk_trans_affine <- function(x, ...) { 126 cat("<wk_trans_affine>\n") 127 print(as.matrix(x), ...) 128 invisible(x) 129} 130