max/ourMELONS
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Bugfixes to indMix() and subfunctions (#24)

Browse source
This commit is contained in:
Waldir Leoncio 2024-03-25 16:06:33 +01:00
parent 26ab0107a8
commit 5c35b9ad1e
3 changed files with 22 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
R/indMix.R
View file

@ -21,11 +21,9 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
Z <- NULL
}
rm(c)
nargin <- length(as.list(match.call())) - 1
if (nargin < 2) {
dispText <- 1
if (missing(npops)) {
# Recreate npopsTaulu from objects other than npops
dispText <- TRUE
npopstext <- matrix()
ready <- FALSE
teksti <- "Input upper bound to the number of populations (possibly multiple values)"
@ -75,7 +73,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
partitionSummary[, 1] <- zeros(30, 1)
worstLogml <- -1e50
worstIndex <- 1
for (run in seq_along(nruns)) {
for (run in seq_len(nruns)) {
npops <- npopsTaulu[[run]]
if (dispText) {
dispLine()
@ -110,7 +108,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
# PARHAAN MIXTURE-PARTITION ETSIMINEN
nRoundTypes <- 7
kokeiltu <- zeros(nRoundTypes, 1)
roundTypes <- c(1, 1) # Ykk<6B>svaiheen sykli kahteen kertaan.
roundTypes <- t(c(1, 1)) # Ykk<6B>svaiheen sykli kahteen kertaan.
ready <- 0
vaihe <- 1
@ -143,9 +141,9 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
if (kokeiltu[round] == 1) { # Askelta kokeiltu viime muutoksen j<>lkeen
} else if (round == 0 | round == 1) { # Yksil<69>n siirt<72>minen toiseen populaatioon.
inds <- seq_len(ninds)
aputaulu <- cbind(t(inds), rand(ninds, 1))
aputaulu <- cbind(inds, rand(ninds, 1))
aputaulu <- matrix(sortrows(aputaulu, 2), nrow = nrow(aputaulu))
inds <- t(aputaulu[, 1])
inds <- aputaulu[, 1]
muutosNyt <- 0
for (ind in inds) {
@ -324,7 +322,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
if (round == 5) {
aputaulu <- c(inds, rand(length(inds), 1))
aputaulu <- sortrows(aputaulu, 2)
inds <- t(aputaulu[, 1])
inds <- aputaulu[, 1]
} else if (round == 6) {
inds <- returnInOrder(
inds, pop, rows, data, adjprior, priorTerm
@ -525,15 +523,15 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
if (ready == 0) {
if (vaihe == 1) {
roundTypes <- 1
roundTypes <- t(1)
} else if (vaihe == 2) {
roundTypes <- c(2, 1)
roundTypes <- t(c(2, 1))
} else if (vaihe == 3) {
roundTypes <- c(5, 5, 7)
roundTypes <- t(c(5, 5, 7))
} else if (vaihe == 4) {
roundTypes <- c(4, 3, 1)
roundTypes <- t(c(4, 3, 1))
} else if (vaihe == 5) {
roundTypes <- c(6, 7, 2, 3, 4, 1)
roundTypes <- t(c(6, 7, 2, 3, 4, 1))
}
}
}

4
R/initialCounts.R
View file

@ -7,8 +7,8 @@ initialCounts <- function(partition, data, npops, rows, noalle, adjprior) {
counts <- zeros(base::max(noalle), nloci, npops)
sumcounts <- zeros(npops, nloci)
for (i in 1:npops) {
for (j in 1:nloci) {
for (i in seq_len(npops)) {
for (j in seq_len(nloci)) {
havainnotLokuksessa <- matlab2r::find(partition == i & data[, j] >= 0)
sumcounts[i, j] <- length(havainnotLokuksessa)
for (k in 1:noalle[j]) {

11
R/linkage.R
View file

@ -26,11 +26,11 @@ linkage <- function(Y, method = "co") {
monotonic <- 1
Z <- zeros(m - 1, 3) # allocate the output matrix.
N <- zeros(1, 2 * m - 1)
N[1:m] <- 1
N[seq_len(m)] <- 1
n <- m # since m is changing, we need to save m in n.
R <- 1:n
R <- seq_len(n)
for (s in 1:(n - 1)) {
X <- as.matrix(as.vector(Y), ncol = 1)
X <- as.matrix(as.vector(Y), nrow = 1)
v <- matlab2r::min(X)$mins
k <- matlab2r::min(X)$idx
@ -83,11 +83,14 @@ linkage <- function(Y, method = "co") {
)
J <- c(J, i * (m - (i + 1) / 2) - m + j)
Y <- Y[-J] # no need for the cluster information about j
# update m, N, R
m <- m - 1
N[n + s] <- N[R[i]] + N[R[j]]
R[i] <- n + s
R[j:(n - 1)] <- R[(j + 1):n]
if (j < n) {
R[j:(n - 1)] <- R[(j + 1):n]
}
}
return(Z)
}