#' Compute the value spatial penalty used in TESS3 objectif function.
#'
#' @param Q Ancestry coeficient matrix.
#' @param W Graph weight matrix.
#'
#' @return TODOC
#' @export
ComputeSpatialPenalty <- function(Q, W) {
Lapl <- as.matrix(ComputeGraphLaplacian(W))
aux <- crossprod(Lapl, Q)
aux <- crossprod(aux, Q)
return(sum(diag(aux)))
}
#' Compute the root mean square error between matrix by permuting
#' matrix column such that we have the best rmse.
#'
#'
#'
#' @param Q1 Numeric.
#' @param Q2 Numeric.
#'
#' @export
ComputeRmseWithBestPermutation <- function(Q1, Q2) {
TestRequiredPkg("permute")
aux = ComputeRmse(Q1,Q2)
K = dim(Q1)[2]
#Because of R !!!!
if ( K == 2 ) {
perms = matrix(c(2,1),nrow = 1,ncol = 2)
} else {
perms = permute::allPerms(K)
}
for (i in 1:(dim(perms)[1])) {
aux1 = ComputeRmse(Q1,Q2[,perms[i,]])
if (aux1 < aux) {
aux = aux1
}
}
return(aux)
}
#' Compute the root mean square error between matrix by permuting
#' matrix column such that we have the best rmse. Warning : Greedy algorithm !
#'
#'
#'
#' @param Q1 Numeric.
#' @param Q2 Numeric.
#'
#' @export
ComputeRmseWithBestPermutationGreedy <- function(Q1, Q2) {
# find perm
perm = 1:ncol(Q1)
taken = c()
for (i in 1:ncol(Q1)) {
min = .Machine$double.xmax
if (i > 1) {
taken = c(taken,perm[i - 1])
}
for (j in 1:ncol(Q1)) {
aux = ComputeRmse(Q1[,i],Q2[,j])
if (aux < min && !(j %in% taken)) {
perm[i] = j
min = aux
}
}
}
if (sum(duplicated(perm)) != 0) {
stop("this is not a permutation")
}
return(ComputeRmse(Q1,Q2[,perm]))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.