/
transformation_matrix.R
59 lines (52 loc) · 2.09 KB
/
transformation_matrix.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
#' Transformation matrix, 2D or 3D depending on data and transformation type
#'
#' @name transformation_matrix
#' @param object [tridim_transformation][tridim_transformation-class()] object
#' @param summary Whether summary statistics should be returned instead of
#' raw sample values. Defaults to \code{TRUE}
#'
#' @return matrix 3x3 for 2D transformation or matrix 4x4 for 3D transformation
#' @export
#' @keywords internal
#'
#' @examples
#' euc2 <- fit_transformation(depV1+depV2~indepV1+indepV2,
#' data = NakayaData,
#' transformation = 'euclidean')
#' transformation_matrix(euc2)
NULL
#' @export
transformation_matrix.tridim_transformation <- function(object, summary=TRUE){
# getting parameter samples
param_samples <- rstan::extract(object$stanfit, pars=c("a", "b"))
# setting up a list of matrix functions
if (object$dimN == 2 ){
mfun <- list("translation" = m2_translation,
"euclidean" = m2_euclidean,
"affine" = m2_affine,
"projective" = m2_projective)
}
else if (object$dimN == 3){
mfun <- list("translation" = m3_translation,
"euclidean_x" = m3_euclidean_x,
"euclidean_y" = m3_euclidean_y,
"euclidean_z" = m3_euclidean_z,
"affine" = m3_affine,
"projective" = m3_projective)
}
else stop("Number of dimensions must be either 2 or 3")
if (!object$transformation %in% names(mfun)) stop(sprintf("Unknown transformation %s", object$transformation))
# generate matrices for each sample
matrices <- purrr::map(1:nrow(param_samples$a),
~mfun[[object$transformation]](param_samples$a[., ],
param_samples$b[., ]))
if (!summary) {
return(matrices)
}
# mean transform
matrix(unlist(matrices), byrow=TRUE, nrow=length(matrices) ) %>%
colMeans() %>%
matrix(ncol=object$dimN+1, byrow = TRUE)
}
#' @export
transformation_matrix <- function(object, summary) { UseMethod("transformation_matrix") }