## Do not edit this file manually.
## It has been automatically generated from mixAR.org.
## Adaptation of the method in Celeux (2000)
## Input is a matrix with g columns, m is the number of iterations on which
## to compute initial mean and variance.
## If comparing probabilities, mu or sigma, output from bayes_mixAR can be used.
## If comparing AR coefficients, need first to adapt elements of interest in a matrix.
label_switch <- function(x, m){
N <- nrow(x)
g <- ncol(x)
avg <- colMeans(x[1:m, ])
s2 <- apply(x[1:m, ], 2, sd)
perm <- rbind(c(1:g), allPerms(g)) ## Function from package permute
## Builds a matrix where each row is 1 perm
## of the labels
true_perm <- matrix(nrow = N - m, ncol = g)
for(i in (m+1):N){
true_perm[i-m, ] <- c(1:g)
## Apply formulas from the theory
d <- sum((x[i, ] - avg)^2 / s2)
for(p in 2:nrow(perm)){
dd <- sum((x[i, ] - avg[perm[p, ]])^2 / s2[perm[p, ]])
if(dd < d){ ## Update "true" perm if new distance is smaller than current one
d <- dd
true_perm[i - m, ] <- perm[p, ]
}
}
x[i, ] <- x[i, true_perm[i - m, ]]
## Finally calculate standard deviations of "corrected" chain
avgg <- avg
avg <- (i - 1)/i * avgg + 1/i * x[i, ]
for(k in 1:g){
s2[k] <- (i - 1) / i * s2[k] +
(i - 1) / i *(avgg[k] - avg[k])^2 +
1 / i * (x[i, k] - avg[k])^2
}
}
list(x = x, true_perm = true_perm)
}
## todo: This could be exported to another package?
## as it is suitable for relabelling of ANY mixture.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.