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