Fixed indMix() and subfunctions (#24)
This commit is contained in:
parent
e4af251307
commit
6aecf38231
5 changed files with 189 additions and 183 deletions
86
R/indMix.R
86
R/indMix.R
|
|
@ -195,9 +195,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
} else if (round == 2) { # Populaation yhdist<73>minen toiseen.
|
} else if (round == 2) { # Populaation yhdist<73>minen toiseen.
|
||||||
maxMuutos <- 0
|
maxMuutos <- 0
|
||||||
for (pop in seq_len(npops)) {
|
for (pop in seq_len(npops)) {
|
||||||
muutokset_diffInCounts <- greedyMix_muutokset$new
|
muutokset_diffInCounts <- greedyMix_muutokset$new()
|
||||||
# FIXME: wrong input
|
|
||||||
browser() # TEMP. Tip: browserText()
|
|
||||||
muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset2(
|
muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset2(
|
||||||
pop, rows, data, adjprior, priorTerm
|
pop, rows, data, adjprior, priorTerm
|
||||||
)
|
)
|
||||||
|
|
@ -241,7 +239,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
maxMuutos <- 0
|
maxMuutos <- 0
|
||||||
ninds <- size(rows, 1)
|
ninds <- size(rows, 1)
|
||||||
for (pop in seq_len(npops)) {
|
for (pop in seq_len(npops)) {
|
||||||
inds2 <- matlab2r::find(PARTITION == pop)
|
inds2 <- matlab2r::find(globals$PARTITION == pop)
|
||||||
ninds2 <- length(inds2)
|
ninds2 <- length(inds2)
|
||||||
if (ninds2 > 2) {
|
if (ninds2 > 2) {
|
||||||
dist2 <- laskeOsaDist(inds2, dist, ninds)
|
dist2 <- laskeOsaDist(inds2, dist, ninds)
|
||||||
|
|
@ -256,8 +254,8 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
muutokset <- muutokset_diffInCounts$laskeMuutokset3(
|
muutokset <- muutokset_diffInCounts$laskeMuutokset3(
|
||||||
T2, inds2, rows, data, adjprior, priorTerm, pop
|
T2, inds2, rows, data, adjprior, priorTerm, pop
|
||||||
)
|
)
|
||||||
isoin <- matlab2r::max(muutokset)[[1]]
|
isoin <- matlab2r::max(c(muutokset))[[1]]
|
||||||
indeksi <- matlab2r::max(muutokset)[[2]]
|
indeksi <- matlab2r::max(c(muutokset))[[2]]
|
||||||
if (isoin > maxMuutos) {
|
if (isoin > maxMuutos) {
|
||||||
maxMuutos <- isoin
|
maxMuutos <- isoin
|
||||||
muuttuvaPop2 <- indeksi %% npops2
|
muuttuvaPop2 <- indeksi %% npops2
|
||||||
|
|
@ -277,9 +275,9 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
rivit <- rbind(rivit, t(lisa))
|
rivit <- rbind(rivit, t(lisa))
|
||||||
}
|
}
|
||||||
diffInCounts <- computeDiffInCounts(
|
diffInCounts <- computeDiffInCounts(
|
||||||
t(rivit), size(COUNTS, 1), size(COUNTS, 2), data
|
t(rivit), size(globals$COUNTS, 1), size(globals$COUNTS, 2), data
|
||||||
)
|
)
|
||||||
i1 <- PARTITION[muuttuvat[1]]
|
i1 <- globals$PARTITION[muuttuvat[1]]
|
||||||
updateGlobalVariables3(
|
updateGlobalVariables3(
|
||||||
muuttuvat, diffInCounts, adjprior, priorTerm, i2
|
muuttuvat, diffInCounts, adjprior, priorTerm, i2
|
||||||
)
|
)
|
||||||
|
|
@ -308,26 +306,24 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
} else if (round == 5 || round == 6) {
|
} else if (round == 5 || round == 6) {
|
||||||
j <- 0
|
j <- 0
|
||||||
muutettu <- 0
|
muutettu <- 0
|
||||||
poplogml <- POP_LOGML
|
poplogml <- globals$POP_LOGML
|
||||||
partition <- PARTITION
|
partition <- globals$PARTITION
|
||||||
counts <- COUNTS
|
counts <- globals$COUNTS
|
||||||
sumcounts <- SUMCOUNTS
|
sumcounts <- globals$SUMCOUNTS
|
||||||
logdiff <- LOGDIFF
|
logdiff <- globals$LOGDIFF
|
||||||
|
|
||||||
pops <- sample(npops)
|
pops <- sample(npops)
|
||||||
while (j < npops & muutettu == 0) {
|
while (j < npops & muutettu == 0) {
|
||||||
j <- j + 1
|
j <- j + 1
|
||||||
pop <- pops[j]
|
pop <- pops[j]
|
||||||
totalMuutos <- 0
|
totalMuutos <- 0
|
||||||
inds <- matlab2r::find(PARTITION == pop)
|
inds <- matlab2r::find(globals$PARTITION == pop)
|
||||||
if (round == 5) {
|
if (round == 5) {
|
||||||
aputaulu <- c(inds, rand(length(inds), 1))
|
aputaulu <- matrix(c(inds, rand(length(inds), 1)), ncol = 2)
|
||||||
aputaulu <- sortrows(aputaulu, 2)
|
aputaulu <- sortrows(aputaulu, 2)
|
||||||
inds <- aputaulu[, 1]
|
inds <- aputaulu[, 1]
|
||||||
} else if (round == 6) {
|
} else if (round == 6 && length(inds) > 0) {
|
||||||
inds <- returnInOrder(
|
inds <- returnInOrder(inds, pop, rows, data, adjprior, priorTerm)
|
||||||
inds, pop, rows, data, adjprior, priorTerm
|
|
||||||
)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
i <- 0
|
i <- 0
|
||||||
|
|
@ -386,12 +382,12 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
} else {
|
} else {
|
||||||
# Miss<73><73>n vaiheessa tila ei parantunut.
|
# Miss<73><73>n vaiheessa tila ei parantunut.
|
||||||
# Perutaan kaikki muutokset.
|
# Perutaan kaikki muutokset.
|
||||||
PARTITION <- partition
|
globals$PARTITION <- partition
|
||||||
SUMCOUNTS <- sumcounts
|
globals$SUMCOUNTS <- sumcounts
|
||||||
POP_LOGML <- poplogml
|
globals$POP_LOGML <- poplogml
|
||||||
COUNTS <- counts
|
globals$COUNTS <- counts
|
||||||
logml <- logml - totalMuutos
|
logml <- logml - totalMuutos
|
||||||
LOGDIFF <- logdiff
|
globals$LOGDIFF <- logdiff
|
||||||
kokeiltu[round] <- 1
|
kokeiltu[round] <- 1
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -401,20 +397,20 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
j <- 0
|
j <- 0
|
||||||
pops <- sample(npops)
|
pops <- sample(npops)
|
||||||
muutoksiaNyt <- 0
|
muutoksiaNyt <- 0
|
||||||
if (emptyPop == -1) {
|
if (emptyPop$emptyPop == -1) {
|
||||||
j <- npops
|
j <- npops
|
||||||
}
|
}
|
||||||
while (j < npops) {
|
while (j < npops) {
|
||||||
j <- j + 1
|
j <- j + 1
|
||||||
pop <- pops[j]
|
pop <- pops[j]
|
||||||
inds2 <- matlab2r::find(PARTITION == pop)
|
inds2 <- matlab2r::find(globals$PARTITION == pop)
|
||||||
ninds2 <- length(inds2)
|
ninds2 <- length(inds2)
|
||||||
if (ninds2 > 5) {
|
if (ninds2 > 5) {
|
||||||
partition <- PARTITION
|
partition <- globals$PARTITION
|
||||||
sumcounts <- SUMCOUNTS
|
sumcounts <- globals$SUMCOUNTS
|
||||||
counts <- COUNTS
|
counts <- globals$COUNTS
|
||||||
poplogml <- POP_LOGML
|
poplogml <- globals$POP_LOGML
|
||||||
logdiff <- LOGDIFF
|
logdiff <- globals$LOGDIFF
|
||||||
|
|
||||||
dist2 <- laskeOsaDist(inds2, dist, ninds)
|
dist2 <- laskeOsaDist(inds2, dist, ninds)
|
||||||
Z2 <- linkage(t(dist2))
|
Z2 <- linkage(t(dist2))
|
||||||
|
|
@ -433,7 +429,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
rivit <- c(rivit, lisa)
|
rivit <- c(rivit, lisa)
|
||||||
}
|
}
|
||||||
diffInCounts <- computeDiffInCounts(
|
diffInCounts <- computeDiffInCounts(
|
||||||
rivit, size(COUNTS, 1), size(COUNTS, 2), data
|
rivit, size(globals$COUNTS, 1), size(globals$COUNTS, 2), data
|
||||||
)
|
)
|
||||||
|
|
||||||
updateGlobalVariables3(
|
updateGlobalVariables3(
|
||||||
|
|
@ -454,7 +450,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
maxMuutos <- indeksi <- matlab2r::max(muutokset)
|
maxMuutos <- indeksi <- matlab2r::max(muutokset)
|
||||||
|
|
||||||
muuttuva <- inds2(indeksi)
|
muuttuva <- inds2(indeksi)
|
||||||
if (PARTITION(muuttuva) == pop) {
|
if (globals$PARTITION(muuttuva) == pop) {
|
||||||
i2 <- emptyPop
|
i2 <- emptyPop
|
||||||
} else {
|
} else {
|
||||||
i2 <- pop
|
i2 <- pop
|
||||||
|
|
@ -463,7 +459,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
if (maxMuutos > 1e-5) {
|
if (maxMuutos > 1e-5) {
|
||||||
rivit <- rows[muuttuva, 1]:rows[muuttuva, 2]
|
rivit <- rows[muuttuva, 1]:rows[muuttuva, 2]
|
||||||
diffInCounts <- computeDiffInCounts(
|
diffInCounts <- computeDiffInCounts(
|
||||||
rivit, size(COUNTS, 1), size(COUNTS, 2),
|
rivit, size(globals$COUNTS, 1), size(globals$COUNTS, 2),
|
||||||
data
|
data
|
||||||
)
|
)
|
||||||
updateGlobalVariables3(
|
updateGlobalVariables3(
|
||||||
|
|
@ -498,11 +494,11 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
j <- npops
|
j <- npops
|
||||||
} else {
|
} else {
|
||||||
# palutetaan vanhat arvot
|
# palutetaan vanhat arvot
|
||||||
PARTITION <- partition
|
globals$PARTITION <- partition
|
||||||
SUMCOUNTS <- sumcounts
|
globals$SUMCOUNTS <- sumcounts
|
||||||
COUNTS <- counts
|
globals$COUNTS <- counts
|
||||||
POP_LOGML <- poplogml
|
globals$POP_LOGML <- poplogml
|
||||||
LOGDIFF <- logdiff
|
globals$LOGDIFF <- logdiff
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -540,7 +536,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
# TALLENNETAAN
|
# TALLENNETAAN
|
||||||
|
|
||||||
npops <- poistaTyhjatPopulaatiot(npops)
|
npops <- poistaTyhjatPopulaatiot(npops)
|
||||||
POP_LOGML <- computePopulationLogml(seq_len(npops), adjprior, priorTerm)
|
globals$POP_LOGML <- computePopulationLogml(seq_len(npops), adjprior, priorTerm)
|
||||||
if (dispText) {
|
if (dispText) {
|
||||||
message("Found partition with ", as.character(npops), " populations.")
|
message("Found partition with ", as.character(npops), " populations.")
|
||||||
message("Log(ml) = ", as.character(logml))
|
message("Log(ml) = ", as.character(logml))
|
||||||
|
|
@ -550,11 +546,11 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
|
||||||
# P<>ivitet<65><74>n parasta l<>ydetty<74> partitiota.
|
# P<>ivitet<65><74>n parasta l<>ydetty<74> partitiota.
|
||||||
logmlBest <- logml
|
logmlBest <- logml
|
||||||
npopsBest <- npops
|
npopsBest <- npops
|
||||||
partitionBest <- PARTITION
|
partitionBest <- globals$PARTITION
|
||||||
countsBest <- COUNTS
|
countsBest <- globals$COUNTS
|
||||||
sumCountsBest <- SUMCOUNTS
|
sumCountsBest <- globals$SUMCOUNTS
|
||||||
pop_logmlBest <- POP_LOGML
|
pop_logmlBest <- globals$POP_LOGML
|
||||||
logdiffbest <- LOGDIFF
|
logdiffbest <- globals$LOGDIFF
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return(
|
return(
|
||||||
|
|
|
||||||
|
|
@ -15,9 +15,9 @@ spatialMixture_muutokset <- R6Class(
|
||||||
) {
|
) {
|
||||||
# Palauttaa npops * 1 taulun, jossa i:s alkio kertoo, mik?olisi
|
# Palauttaa npops * 1 taulun, jossa i:s alkio kertoo, mik?olisi
|
||||||
# muutos logml:ss? mikהli yksil?ind siirretההn koriin i.
|
# muutos logml:ss? mikהli yksil?ind siirretההn koriin i.
|
||||||
# diffInCounts on poistettava COUNTS:in siivusta i1 ja lisהttהv?
|
# diffInCounts on poistettava globals$COUNTS:in siivusta i1 ja lisהttהv?
|
||||||
# COUNTS:in siivuun i2, mikהli muutos toteutetaan.
|
# globals$COUNTS:in siivuun i2, mikהli muutos toteutetaan.
|
||||||
npops <- size(COUNTS, 3)
|
npops <- size(globals$COUNTS, 3)
|
||||||
muutokset <- zeros(npops, 1)
|
muutokset <- zeros(npops, 1)
|
||||||
|
|
||||||
emptyPop_pops <- findEmptyPop(npops)
|
emptyPop_pops <- findEmptyPop(npops)
|
||||||
|
|
@ -25,42 +25,42 @@ spatialMixture_muutokset <- R6Class(
|
||||||
pops <- emptyPop_pops$pops
|
pops <- emptyPop_pops$pops
|
||||||
rm(emptyPop_pops)
|
rm(emptyPop_pops)
|
||||||
|
|
||||||
i1 <- PARTITION(ind)
|
i1 <- globals$PARTITION(ind)
|
||||||
i2 <- pops[find(pops != i1)]
|
i2 <- pops[find(pops != i1)]
|
||||||
if (emptyPop > 0) {
|
if (emptyPop > 0) {
|
||||||
i2 <- c(i2, emptyPop)
|
i2 <- c(i2, emptyPop)
|
||||||
}
|
}
|
||||||
|
|
||||||
rows <- ((ind - 1) * rowsFromInd + 1):(ind * rowsFromInd)
|
rows <- ((ind - 1) * rowsFromInd + 1):(ind * rowsFromInd)
|
||||||
diffInCounts <- computeDiffInCounts(rows, size(COUNTS, 1), size(COUNTS, 2), data)
|
diffInCounts <- computeDiffInCounts(rows, size(globals$COUNTS, 1), size(globals$COUNTS, 2), data)
|
||||||
diffInSumCounts <- sum(diffInCounts)
|
diffInSumCounts <- sum(diffInCounts)
|
||||||
|
|
||||||
diffInCliqCounts <- computeDiffInCliqCounts(cliques, ind)
|
diffInCliqCounts <- computeDiffInCliqCounts(cliques, ind)
|
||||||
diffInSepCounts <- computeDiffInCliqCounts(separators, ind)
|
diffInSepCounts <- computeDiffInCliqCounts(separators, ind)
|
||||||
|
|
||||||
COUNTS[, ,i1] <- COUNTS[, , i1] - diffInCounts
|
globals$COUNTS[, ,i1] <- globals$COUNTS[, , i1] - diffInCounts
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
|
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts
|
||||||
CLIQCOUNTS[, i1] <- CLIQCOUNTS[, i1] - diffInCliqCounts
|
globals$CLIQCOUNTS[, i1] <- globals$CLIQCOUNTS[, i1] - diffInCliqCounts
|
||||||
SEPCOUNTS[, i1] <- SEPCOUNTS[, i1] - diffInSepCounts
|
globals$SEPCOUNTS[, i1] <- globals$SEPCOUNTS[, i1] - diffInSepCounts
|
||||||
|
|
||||||
for (i in i2) {
|
for (i in i2) {
|
||||||
CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] + diffInCliqCounts
|
globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] + diffInCliqCounts
|
||||||
SEPCOUNTS[, i] <- SEPCOUNTS[, i] + diffInSepCounts
|
globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] + diffInSepCounts
|
||||||
COUNTS[, ,i] <- COUNTS[, , i] + diffInCounts
|
globals$COUNTS[, ,i] <- globals$COUNTS[, , i] + diffInCounts
|
||||||
SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] + diffInSumCounts
|
globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] + diffInSumCounts
|
||||||
|
|
||||||
muutokset[i] <- computeLogml(adjprior, priorTerm) - logml
|
muutokset[i] <- computeLogml(adjprior, priorTerm) - logml
|
||||||
|
|
||||||
CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] - diffInCliqCounts
|
globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] - diffInCliqCounts
|
||||||
SEPCOUNTS[, i] <- SEPCOUNTS[, i] - diffInSepCounts
|
globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] - diffInSepCounts
|
||||||
COUNTS[, , i] <- COUNTS[, , i] - diffInCounts
|
globals$COUNTS[, , i] <- globals$COUNTS[, , i] - diffInCounts
|
||||||
SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] - diffInSumCounts
|
globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] - diffInSumCounts
|
||||||
}
|
}
|
||||||
|
|
||||||
COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
|
globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] + diffInCounts
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] + diffInSumCounts
|
||||||
CLIQCOUNTS[, i1] <- CLIQCOUNTS[, i1] + diffInCliqCounts
|
globals$CLIQCOUNTS[, i1] <- globals$CLIQCOUNTS[, i1] + diffInCliqCounts
|
||||||
SEPCOUNTS[, i1] <- SEPCOUNTS[, i1] + diffInSepCounts
|
globals$SEPCOUNTS[, i1] <- globals$SEPCOUNTS[, i1] + diffInSepCounts
|
||||||
|
|
||||||
# Asetetaan muillekin tyhjille populaatioille sama muutos, kuin
|
# Asetetaan muillekin tyhjille populaatioille sama muutos, kuin
|
||||||
# emptyPop:lle
|
# emptyPop:lle
|
||||||
|
|
@ -87,11 +87,11 @@ spatialMixture_muutokset <- R6Class(
|
||||||
# koriin i.
|
# koriin i.
|
||||||
# Laskee muutokset vain yhdelle tyhjהlle populaatiolle, muille tulee
|
# Laskee muutokset vain yhdelle tyhjהlle populaatiolle, muille tulee
|
||||||
# muutokseksi 0.
|
# muutokseksi 0.
|
||||||
# global COUNTS # global SUMCOUNTS
|
# global globals$COUNTS # global globals$SUMCOUNTS
|
||||||
# global PARTITION # global POP_LOGML
|
# global globals$PARTITION # global globals$POP_LOGML
|
||||||
# global CLIQCOUNTS # global SEPCOUNTS
|
# global globals$CLIQCOUNTS # global globals$SEPCOUNTS
|
||||||
|
|
||||||
npops <- size(COUNTS, 3)
|
npops <- size(globals$COUNTS, 3)
|
||||||
muutokset <- zeros(npops, 1)
|
muutokset <- zeros(npops, 1)
|
||||||
|
|
||||||
emptyPop <- findEmptyPop(npops)$emptyPop
|
emptyPop <- findEmptyPop(npops)$emptyPop
|
||||||
|
|
@ -102,37 +102,37 @@ spatialMixture_muutokset <- R6Class(
|
||||||
i2 <- c(i2, emptyPop)
|
i2 <- c(i2, emptyPop)
|
||||||
}
|
}
|
||||||
|
|
||||||
inds <- find(PARTITION == i1)
|
inds <- find(globals$PARTITION == i1)
|
||||||
rows <- computeRows(rowsFromInd, inds, length(inds))
|
rows <- computeRows(rowsFromInd, inds, length(inds))
|
||||||
|
|
||||||
diffInCounts <- computeDiffInCounts(rows, size(COUNTS, 1), size(COUNTS, 2), data)
|
diffInCounts <- computeDiffInCounts(rows, size(globals$COUNTS, 1), size(globals$COUNTS, 2), data)
|
||||||
diffInSumCounts <- sum(diffInCounts)
|
diffInSumCounts <- sum(diffInCounts)
|
||||||
diffInCliqCounts <- computeDiffInCliqCounts(cliques, inds)
|
diffInCliqCounts <- computeDiffInCliqCounts(cliques, inds)
|
||||||
diffInSepCounts <- computeDiffInCliqCounts(separators, inds)
|
diffInSepCounts <- computeDiffInCliqCounts(separators, inds)
|
||||||
|
|
||||||
COUNTS[, ,i1] <- COUNTS[, , i1] - diffInCounts
|
globals$COUNTS[, ,i1] <- globals$COUNTS[, , i1] - diffInCounts
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
|
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts
|
||||||
CLIQCOUNTS[, i1] <- 0
|
globals$CLIQCOUNTS[, i1] <- 0
|
||||||
SEPCOUNTS[, i1] <- 0
|
globals$SEPCOUNTS[, i1] <- 0
|
||||||
|
|
||||||
for (i in i2) {
|
for (i in i2) {
|
||||||
CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] + diffInCliqCounts
|
globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] + diffInCliqCounts
|
||||||
SEPCOUNTS[, i] <- SEPCOUNTS[, i] + diffInSepCounts
|
globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] + diffInSepCounts
|
||||||
COUNTS[, ,i] <- COUNTS[, , i] + diffInCounts
|
globals$COUNTS[, ,i] <- globals$COUNTS[, , i] + diffInCounts
|
||||||
SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] + diffInSumCounts
|
globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] + diffInSumCounts
|
||||||
|
|
||||||
muutokset[i] <- computeLogml(adjprior, priorTerm) - logml
|
muutokset[i] <- computeLogml(adjprior, priorTerm) - logml
|
||||||
|
|
||||||
CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] - diffInCliqCounts
|
globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] - diffInCliqCounts
|
||||||
SEPCOUNTS[, i] <- SEPCOUNTS[, i] - diffInSepCounts
|
globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] - diffInSepCounts
|
||||||
COUNTS[, ,i] <- COUNTS[, , i] - diffInCounts
|
globals$COUNTS[, ,i] <- globals$COUNTS[, , i] - diffInCounts
|
||||||
SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] - diffInSumCounts
|
globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] - diffInSumCounts
|
||||||
}
|
}
|
||||||
|
|
||||||
COUNTS[, ,i1] <- COUNTS[, , i1] + diffInCounts
|
globals$COUNTS[, ,i1] <- globals$COUNTS[, , i1] + diffInCounts
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] + diffInSumCounts
|
||||||
CLIQCOUNTS[, i1] <- diffInCliqCounts
|
globals$CLIQCOUNTS[, i1] <- diffInCliqCounts
|
||||||
SEPCOUNTS[, i1] <- diffInSepCounts
|
globals$SEPCOUNTS[, i1] <- diffInSepCounts
|
||||||
return(list(muutokset = muutokset, diffInCounts = diffInCounts))
|
return(list(muutokset = muutokset, diffInCounts = diffInCounts))
|
||||||
},
|
},
|
||||||
#' @param T2 T2
|
#' @param T2 T2
|
||||||
|
|
@ -154,11 +154,11 @@ spatialMixture_muutokset <- R6Class(
|
||||||
# inds2(find(T2 == i)) siirretההn koriin j.
|
# inds2(find(T2 == i)) siirretההn koriin j.
|
||||||
# Laskee vain yhden tyhjהn populaation, muita kohden muutokseksi jהה 0.
|
# Laskee vain yhden tyhjהn populaation, muita kohden muutokseksi jהה 0.
|
||||||
|
|
||||||
# global COUNTS # global SUMCOUNTS
|
# global globals$COUNTS # global globals$SUMCOUNTS
|
||||||
# global PARTITION # global POP_LOGML
|
# global globals$PARTITION # global globals$POP_LOGML
|
||||||
# global CLIQCOUNTS # global SEPCOUNTS
|
# global globals$CLIQCOUNTS # global globals$SEPCOUNTS
|
||||||
|
|
||||||
npops <- size(COUNTS, 3)
|
npops <- size(globals$COUNTS, 3)
|
||||||
npops2 <- length(unique(T2))
|
npops2 <- length(unique(T2))
|
||||||
muutokset <- zeros(npops2, npops)
|
muutokset <- zeros(npops2, npops)
|
||||||
|
|
||||||
|
|
@ -168,15 +168,15 @@ spatialMixture_muutokset <- R6Class(
|
||||||
if (ninds > 0) {
|
if (ninds > 0) {
|
||||||
rows <- computeRows(rowsFromInd, inds, ninds)
|
rows <- computeRows(rowsFromInd, inds, ninds)
|
||||||
|
|
||||||
diffInCounts <- computeDiffInCounts(rows, size(COUNTS, 1), size(COUNTS, 2), data)
|
diffInCounts <- computeDiffInCounts(rows, size(globals$COUNTS, 1), size(globals$COUNTS, 2), data)
|
||||||
diffInSumCounts <- sum(diffInCounts)
|
diffInSumCounts <- sum(diffInCounts)
|
||||||
diffInCliqCounts <- computeDiffInCliqCounts(cliques, inds)
|
diffInCliqCounts <- computeDiffInCliqCounts(cliques, inds)
|
||||||
diffInSepCounts <- computeDiffInCliqCounts(separators, inds)
|
diffInSepCounts <- computeDiffInCliqCounts(separators, inds)
|
||||||
|
|
||||||
COUNTS[, ,i1] <- COUNTS[, , i1] - diffInCounts
|
globals$COUNTS[, ,i1] <- globals$COUNTS[, , i1] - diffInCounts
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
|
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts
|
||||||
CLIQCOUNTS[, i1] <- CLIQCOUNTS[, i1] - diffInCliqCounts
|
globals$CLIQCOUNTS[, i1] <- globals$CLIQCOUNTS[, i1] - diffInCliqCounts
|
||||||
SEPCOUNTS[, i1] <- SEPCOUNTS[, i1] - diffInSepCounts
|
globals$SEPCOUNTS[, i1] <- globals$SEPCOUNTS[, i1] - diffInSepCounts
|
||||||
|
|
||||||
emptyPop <- findEmptyPop(npops)$emptyPop
|
emptyPop <- findEmptyPop(npops)$emptyPop
|
||||||
pops <- findEmptyPop(npops)$pops
|
pops <- findEmptyPop(npops)$pops
|
||||||
|
|
@ -186,23 +186,23 @@ spatialMixture_muutokset <- R6Class(
|
||||||
}
|
}
|
||||||
|
|
||||||
for (i in i2) {
|
for (i in i2) {
|
||||||
CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] + diffInCliqCounts
|
globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] + diffInCliqCounts
|
||||||
SEPCOUNTS[, i] <- SEPCOUNTS[, i] + diffInSepCounts
|
globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] + diffInSepCounts
|
||||||
COUNTS[, ,i] <- COUNTS[, , i] + diffInCounts
|
globals$COUNTS[, ,i] <- globals$COUNTS[, , i] + diffInCounts
|
||||||
SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] + diffInSumCounts
|
globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] + diffInSumCounts
|
||||||
|
|
||||||
muutokset[pop2, i] <- computeLogml(adjprior, priorTerm) - logml
|
muutokset[pop2, i] <- computeLogml(adjprior, priorTerm) - logml
|
||||||
|
|
||||||
CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] - diffInCliqCounts
|
globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] - diffInCliqCounts
|
||||||
SEPCOUNTS[, i] <- SEPCOUNTS[, i] - diffInSepCounts
|
globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] - diffInSepCounts
|
||||||
COUNTS[, ,i] <- COUNTS[, , i] - diffInCounts
|
globals$COUNTS[, ,i] <- globals$COUNTS[, , i] - diffInCounts
|
||||||
SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] - diffInSumCounts
|
globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] - diffInSumCounts
|
||||||
}
|
}
|
||||||
|
|
||||||
COUNTS[, ,i1] <- COUNTS[, , i1] + diffInCounts
|
globals$COUNTS[, ,i1] <- globals$COUNTS[, , i1] + diffInCounts
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] + diffInSumCounts
|
||||||
CLIQCOUNTS[, i1] <- CLIQCOUNTS[, i1] + diffInCliqCounts
|
globals$CLIQCOUNTS[, i1] <- globals$CLIQCOUNTS[, i1] + diffInCliqCounts
|
||||||
SEPCOUNTS[, i1] <- SEPCOUNTS[, i1] + diffInSepCounts
|
globals$SEPCOUNTS[, i1] <- globals$SEPCOUNTS[, i1] + diffInSepCounts
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return(muutokset)
|
return(muutokset)
|
||||||
|
|
@ -224,18 +224,18 @@ spatialMixture_muutokset <- R6Class(
|
||||||
# Palauttaa length(inds) * 1 taulun, jossa i:s alkio kertoo, mik?olisi
|
# Palauttaa length(inds) * 1 taulun, jossa i:s alkio kertoo, mik?olisi
|
||||||
# muutos logml:ss? mikהli yksil?i vaihtaisi koria i1:n ja i2:n vהlill?
|
# muutos logml:ss? mikהli yksil?i vaihtaisi koria i1:n ja i2:n vהlill?
|
||||||
|
|
||||||
# global COUNTS # global SUMCOUNTS
|
# global globals$COUNTS # global globals$SUMCOUNTS
|
||||||
# global PARTITION
|
# global globals$PARTITION
|
||||||
# global CLIQCOUNTS # global SEPCOUNTS
|
# global globals$CLIQCOUNTS # global globals$SEPCOUNTS
|
||||||
|
|
||||||
ninds <- length(inds)
|
ninds <- length(inds)
|
||||||
muutokset <- zeros(ninds, 1)
|
muutokset <- zeros(ninds, 1)
|
||||||
cliqsize <- size(CLIQCOUNTS, 2)
|
cliqsize <- size(globals$CLIQCOUNTS, 2)
|
||||||
sepsize <- size(SEPCOUNTS, 2)
|
sepsize <- size(globals$SEPCOUNTS, 2)
|
||||||
|
|
||||||
for (i in 1:ninds) {
|
for (i in 1:ninds) {
|
||||||
ind <- inds[i]
|
ind <- inds[i]
|
||||||
if (PARTITION[ind] == i1) {
|
if (globals$PARTITION[ind] == i1) {
|
||||||
pop1 <- i1 # mist?
|
pop1 <- i1 # mist?
|
||||||
pop2 <- i2 # mihin
|
pop2 <- i2 # mihin
|
||||||
} else {
|
} else {
|
||||||
|
|
@ -244,32 +244,32 @@ spatialMixture_muutokset <- R6Class(
|
||||||
}
|
}
|
||||||
rows <- ((ind - 1) * rowsFromInd + 1):(ind * rowsFromInd)
|
rows <- ((ind - 1) * rowsFromInd + 1):(ind * rowsFromInd)
|
||||||
|
|
||||||
diffInCounts <- computeDiffInCounts(rows, size(COUNTS, 1), size(COUNTS, 2), data)
|
diffInCounts <- computeDiffInCounts(rows, size(globals$COUNTS, 1), size(globals$COUNTS, 2), data)
|
||||||
diffInSumCounts <- sum(diffInCounts)
|
diffInSumCounts <- sum(diffInCounts)
|
||||||
diffInCliqCounts <- computeDiffInCliqCounts(cliques, ind)
|
diffInCliqCounts <- computeDiffInCliqCounts(cliques, ind)
|
||||||
diffInSepCounts <- computeDiffInCliqCounts(separators, ind)
|
diffInSepCounts <- computeDiffInCliqCounts(separators, ind)
|
||||||
|
|
||||||
COUNTS[, ,pop1] <- COUNTS[, , pop1] - diffInCounts
|
globals$COUNTS[, ,pop1] <- globals$COUNTS[, , pop1] - diffInCounts
|
||||||
SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] - diffInSumCounts
|
globals$SUMCOUNTS[pop1, ] <- globals$SUMCOUNTS[pop1, ] - diffInSumCounts
|
||||||
COUNTS[, ,pop2] <- COUNTS[, , pop2] + diffInCounts
|
globals$COUNTS[, ,pop2] <- globals$COUNTS[, , pop2] + diffInCounts
|
||||||
SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] + diffInSumCounts
|
globals$SUMCOUNTS[pop2, ] <- globals$SUMCOUNTS[pop2, ] + diffInSumCounts
|
||||||
|
|
||||||
CLIQCOUNTS[, pop1] <- CLIQCOUNTS[, pop1] - diffInCliqCounts
|
globals$CLIQCOUNTS[, pop1] <- globals$CLIQCOUNTS[, pop1] - diffInCliqCounts
|
||||||
CLIQCOUNTS[, pop2] <- CLIQCOUNTS[, pop2] + diffInCliqCounts
|
globals$CLIQCOUNTS[, pop2] <- globals$CLIQCOUNTS[, pop2] + diffInCliqCounts
|
||||||
SEPCOUNTS[, pop1] <- SEPCOUNTS[, pop1] - diffInSepCounts
|
globals$SEPCOUNTS[, pop1] <- globals$SEPCOUNTS[, pop1] - diffInSepCounts
|
||||||
SEPCOUNTS[, pop2] <- SEPCOUNTS[, pop2] + diffInSepCounts
|
globals$SEPCOUNTS[, pop2] <- globals$SEPCOUNTS[, pop2] + diffInSepCounts
|
||||||
|
|
||||||
muutokset[i] <- computeLogml(adjprior, priorTerm) - logml
|
muutokset[i] <- computeLogml(adjprior, priorTerm) - logml
|
||||||
|
|
||||||
COUNTS[, ,pop1] <- COUNTS[, , pop1] + diffInCounts
|
globals$COUNTS[, ,pop1] <- globals$COUNTS[, , pop1] + diffInCounts
|
||||||
SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] + diffInSumCounts
|
globals$SUMCOUNTS[pop1, ] <- globals$SUMCOUNTS[pop1, ] + diffInSumCounts
|
||||||
COUNTS[, ,pop2] <- COUNTS[, , pop2] - diffInCounts
|
globals$COUNTS[, ,pop2] <- globals$COUNTS[, , pop2] - diffInCounts
|
||||||
SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] - diffInSumCounts
|
globals$SUMCOUNTS[pop2, ] <- globals$SUMCOUNTS[pop2, ] - diffInSumCounts
|
||||||
|
|
||||||
CLIQCOUNTS[, pop1] <- CLIQCOUNTS[, pop1] + diffInCliqCounts
|
globals$CLIQCOUNTS[, pop1] <- globals$CLIQCOUNTS[, pop1] + diffInCliqCounts
|
||||||
CLIQCOUNTS[, pop2] <- CLIQCOUNTS[, pop2] - diffInCliqCounts
|
globals$CLIQCOUNTS[, pop2] <- globals$CLIQCOUNTS[, pop2] - diffInCliqCounts
|
||||||
SEPCOUNTS[, pop1] <- SEPCOUNTS[, pop1] + diffInSepCounts
|
globals$SEPCOUNTS[, pop1] <- globals$SEPCOUNTS[, pop1] + diffInSepCounts
|
||||||
SEPCOUNTS[, pop2] <- SEPCOUNTS[, pop2] - diffInSepCounts
|
globals$SEPCOUNTS[, pop2] <- globals$SEPCOUNTS[, pop2] - diffInSepCounts
|
||||||
|
|
||||||
}
|
}
|
||||||
return(muutokset)
|
return(muutokset)
|
||||||
|
|
@ -327,8 +327,8 @@ admix1_muutokset <- R6Class(
|
||||||
#' @title Calculate changes (greedyMix class)
|
#' @title Calculate changes (greedyMix class)
|
||||||
#' @description Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
|
#' @description Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
|
||||||
#' muutos logml:ss<73>, mik<69>li yksil<69> ind siirret<65><74>n koriin i.
|
#' muutos logml:ss<73>, mik<69>li yksil<69> ind siirret<65><74>n koriin i.
|
||||||
#' diffInCounts on poistettava COUNTS:in siivusta i1 ja lis<69>tt<74>v<EFBFBD>
|
#' diffInCounts on poistettava globals$COUNTS:in siivusta i1 ja lis<69>tt<74>v<EFBFBD>
|
||||||
#' COUNTS:in siivuun i2, mik<69>li muutos toteutetaan.
|
#' globals$COUNTS:in siivuun i2, mik<69>li muutos toteutetaan.
|
||||||
#'
|
#'
|
||||||
#' Lis<69>ys 25.9.2007:
|
#' Lis<69>ys 25.9.2007:
|
||||||
#' Otettu k<>ytt<74><74>n globaali muuttuja LOGDIFF, johon on tallennettu muutokset
|
#' Otettu k<>ytt<74><74>n globaali muuttuja LOGDIFF, johon on tallennettu muutokset
|
||||||
|
|
@ -401,11 +401,11 @@ greedyMix_muutokset <- R6Class(
|
||||||
|
|
||||||
if (ninds == 0) {
|
if (ninds == 0) {
|
||||||
diffInCounts <- zeros(size(globals$COUNTS, 1), size(globals$COUNTS, 2))
|
diffInCounts <- zeros(size(globals$COUNTS, 1), size(globals$COUNTS, 2))
|
||||||
return()
|
return(list("muutokset" = muutokset, "diffInCounts" = diffInCounts))
|
||||||
}
|
}
|
||||||
|
|
||||||
rows <- list()
|
rows <- list()
|
||||||
for (i in 1:ninds) {
|
for (i in seq_len(ninds)) {
|
||||||
ind <- inds[i]
|
ind <- inds[i]
|
||||||
lisa <- globalRows[ind, 1]:globalRows[ind, 2]
|
lisa <- globalRows[ind, 1]:globalRows[ind, 2]
|
||||||
rows <- c(rows, t(lisa))
|
rows <- c(rows, t(lisa))
|
||||||
|
|
@ -414,7 +414,7 @@ greedyMix_muutokset <- R6Class(
|
||||||
diffInCounts <- computeDiffInCounts(
|
diffInCounts <- computeDiffInCounts(
|
||||||
t(rows), size(globals$COUNTS, 1), size(globals$COUNTS, 2), data
|
t(rows), size(globals$COUNTS, 1), size(globals$COUNTS, 2), data
|
||||||
)
|
)
|
||||||
diffInSumCounts <- sum(diffInCounts)
|
diffInSumCounts <- colSums(diffInCounts)
|
||||||
|
|
||||||
globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] - diffInCounts
|
globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] - diffInCounts
|
||||||
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts
|
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts
|
||||||
|
|
@ -422,7 +422,11 @@ greedyMix_muutokset <- R6Class(
|
||||||
globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] + diffInCounts
|
globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] + diffInCounts
|
||||||
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] + diffInSumCounts
|
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] + diffInSumCounts
|
||||||
|
|
||||||
i2 <- c(1:i1 - 1, i1 + 1:npops)
|
if (i1 < npops) {
|
||||||
|
i2 <- c(1:(i1 - 1), (i1 + 1):npops)
|
||||||
|
} else {
|
||||||
|
i2 <- 1:(i1 - 1)
|
||||||
|
}
|
||||||
i2_logml <- globals$POP_LOGML[i2]
|
i2_logml <- globals$POP_LOGML[i2]
|
||||||
|
|
||||||
globals$COUNTS[, , i2] <- globals$COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
|
globals$COUNTS[, , i2] <- globals$COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
|
||||||
|
|
@ -431,7 +435,8 @@ greedyMix_muutokset <- R6Class(
|
||||||
globals$COUNTS[, , i2] <- globals$COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, npops - 1))
|
globals$COUNTS[, , i2] <- globals$COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, npops - 1))
|
||||||
globals$SUMCOUNTS[i2, ] <- globals$SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(npops - 1, 1))
|
globals$SUMCOUNTS[i2, ] <- globals$SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(npops - 1, 1))
|
||||||
|
|
||||||
muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
|
i1_diff <- new_i1_logml - i1_logml
|
||||||
|
muutokset[i2] <- rep(i1_diff, length(i2_logml)) + new_i2_logml - i2_logml
|
||||||
return(list(muutokset = muutokset, diffInCounts = diffInCounts))
|
return(list(muutokset = muutokset, diffInCounts = diffInCounts))
|
||||||
},
|
},
|
||||||
#' @param T2 T2
|
#' @param T2 T2
|
||||||
|
|
@ -448,11 +453,11 @@ greedyMix_muutokset <- R6Class(
|
||||||
# kertoo, mik<69> olisi muutos logml:ss<73>, jos populaation i1 osapopulaatio
|
# kertoo, mik<69> olisi muutos logml:ss<73>, jos populaation i1 osapopulaatio
|
||||||
# inds2(matlab2r::find(T2==i)) siirret<65><74>n koriin j.
|
# inds2(matlab2r::find(T2==i)) siirret<65><74>n koriin j.
|
||||||
|
|
||||||
npops <- size(COUNTS, 3)
|
npops <- size(globals$COUNTS, 3)
|
||||||
npops2 <- length(unique(T2))
|
npops2 <- length(unique(T2))
|
||||||
muutokset <- zeros(npops2, npops)
|
muutokset <- zeros(npops2, npops)
|
||||||
|
|
||||||
i1_logml <- POP_LOGML[i1]
|
i1_logml <- globals$POP_LOGML[i1]
|
||||||
for (pop2 in 1:npops2) {
|
for (pop2 in 1:npops2) {
|
||||||
inds <- inds2[matlab2r::find(T2 == pop2)]
|
inds <- inds2[matlab2r::find(T2 == pop2)]
|
||||||
ninds <- length(inds)
|
ninds <- length(inds)
|
||||||
|
|
@ -464,26 +469,31 @@ greedyMix_muutokset <- R6Class(
|
||||||
rows <- c(rows, t(lisa))
|
rows <- c(rows, t(lisa))
|
||||||
}
|
}
|
||||||
diffInCounts <- computeDiffInCounts(
|
diffInCounts <- computeDiffInCounts(
|
||||||
t(rows), size(COUNTS, 1), size(COUNTS, 2), data
|
t(rows), size(globals$COUNTS, 1), size(globals$COUNTS, 2), data
|
||||||
)
|
)
|
||||||
diffInSumCounts <- sum(diffInCounts)
|
diffInSumCounts <- colSums(diffInCounts)
|
||||||
|
|
||||||
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
|
globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] - diffInCounts
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
|
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts
|
||||||
new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
|
new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
|
||||||
COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
|
globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] + diffInCounts
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] + diffInSumCounts
|
||||||
|
|
||||||
i2 <- c(1:i1 - 1, i1 + 1:npops)
|
if (i1 < npops) {
|
||||||
i2_logml <- t(POP_LOGML[i2])
|
i2 <- c(1:(i1 - 1), (i1 + 1):npops)
|
||||||
|
} else {
|
||||||
|
i2 <- 1:(i1 - 1)
|
||||||
|
}
|
||||||
|
i2_logml <- t(globals$POP_LOGML[i2])
|
||||||
|
|
||||||
COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
|
globals$COUNTS[, , i2] <- globals$COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
|
||||||
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(npops - 1, 1))
|
globals$SUMCOUNTS[i2, ] <- globals$SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(npops - 1, 1))
|
||||||
new_i2_logml <- t(computePopulationLogml(i2, adjprior, priorTerm))
|
new_i2_logml <- t(computePopulationLogml(i2, adjprior, priorTerm))
|
||||||
COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, npops - 1))
|
globals$COUNTS[, , i2] <- globals$COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, npops - 1))
|
||||||
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(npops - 1, 1))
|
globals$SUMCOUNTS[i2, ] <- globals$SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(npops - 1, 1))
|
||||||
|
|
||||||
muutokset[pop2, i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
|
i1_diff <- new_i1_logml - i1_logml
|
||||||
|
muutokset[pop2, i2] <- rep(i1_diff, length(i2_logml)) + new_i2_logml - i2_logml
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return(muutokset)
|
return(muutokset)
|
||||||
|
|
@ -502,12 +512,12 @@ greedyMix_muutokset <- R6Class(
|
||||||
ninds <- length(inds)
|
ninds <- length(inds)
|
||||||
muutokset <- zeros(ninds, 1)
|
muutokset <- zeros(ninds, 1)
|
||||||
|
|
||||||
i1_logml <- POP_LOGML[i1]
|
i1_logml <- globals$POP_LOGML[i1]
|
||||||
i2_logml <- POP_LOGML[i2]
|
i2_logml <- globals$POP_LOGML[i2]
|
||||||
|
|
||||||
for (i in 1:ninds) {
|
for (i in 1:ninds) {
|
||||||
ind <- inds[i]
|
ind <- inds[i]
|
||||||
if (PARTITION[ind] == i1) {
|
if (globals$PARTITION[ind] == i1) {
|
||||||
pop1 <- i1 # mist<73>
|
pop1 <- i1 # mist<73>
|
||||||
pop2 <- i2 # mihin
|
pop2 <- i2 # mihin
|
||||||
} else {
|
} else {
|
||||||
|
|
@ -516,24 +526,24 @@ greedyMix_muutokset <- R6Class(
|
||||||
}
|
}
|
||||||
rows <- globalRows[ind, 1]:globalRows[ind, 2]
|
rows <- globalRows[ind, 1]:globalRows[ind, 2]
|
||||||
diffInCounts <- computeDiffInCounts(
|
diffInCounts <- computeDiffInCounts(
|
||||||
rows, size(COUNTS, 1), size(COUNTS, 2), data
|
rows, size(globals$COUNTS, 1), size(globals$COUNTS, 2), data
|
||||||
)
|
)
|
||||||
diffInSumCounts <- sum(diffInCounts)
|
diffInSumCounts <- sum(diffInCounts)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
COUNTS[, , pop1] <- COUNTS[, , pop1] - diffInCounts
|
globals$COUNTS[, , pop1] <- globals$COUNTS[, , pop1] - diffInCounts
|
||||||
SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] - diffInSumCounts
|
globals$SUMCOUNTS[pop1, ] <- globals$SUMCOUNTS[pop1, ] - diffInSumCounts
|
||||||
COUNTS[, , pop2] <- COUNTS[, , pop2] + diffInCounts
|
globals$COUNTS[, , pop2] <- globals$COUNTS[, , pop2] + diffInCounts
|
||||||
SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] + diffInSumCounts
|
globals$SUMCOUNTS[pop2, ] <- globals$SUMCOUNTS[pop2, ] + diffInSumCounts
|
||||||
|
|
||||||
new_logmls <- computePopulationLogml(c(i1, i2), adjprior, priorTerm)
|
new_logmls <- computePopulationLogml(c(i1, i2), adjprior, priorTerm)
|
||||||
muutokset[i] <- sum(new_logmls)
|
muutokset[i] <- sum(new_logmls)
|
||||||
|
|
||||||
COUNTS[, , pop1] <- COUNTS[, , pop1] + diffInCounts
|
globals$COUNTS[, , pop1] <- globals$COUNTS[, , pop1] + diffInCounts
|
||||||
SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] + diffInSumCounts
|
globals$SUMCOUNTS[pop1, ] <- globals$SUMCOUNTS[pop1, ] + diffInSumCounts
|
||||||
COUNTS[, , pop2] <- COUNTS[, , pop2] - diffInCounts
|
globals$COUNTS[, , pop2] <- globals$COUNTS[, , pop2] - diffInCounts
|
||||||
SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] - diffInSumCounts
|
globals$SUMCOUNTS[pop2, ] <- globals$SUMCOUNTS[pop2, ] - diffInSumCounts
|
||||||
}
|
}
|
||||||
|
|
||||||
muutokset <- muutokset - i1_logml - i2_logml
|
muutokset <- muutokset - i1_logml - i2_logml
|
||||||
|
|
|
||||||
|
|
@ -11,8 +11,8 @@ laskeOsaDist <- function(inds2, dist, ninds) {
|
||||||
ninds2 <- length(inds2)
|
ninds2 <- length(inds2)
|
||||||
apu <- zeros(choose(ninds2, 2), 2)
|
apu <- zeros(choose(ninds2, 2), 2)
|
||||||
rivi <- 1
|
rivi <- 1
|
||||||
for (i in 1:ninds2 - 1) {
|
for (i in 1:(ninds2 - 1)) {
|
||||||
for (j in i + 1:ninds2) {
|
for (j in (i + 1):ninds2) {
|
||||||
apu[rivi, 1] <- inds2[i]
|
apu[rivi, 1] <- inds2[i]
|
||||||
apu[rivi, 2] <- inds2[j]
|
apu[rivi, 2] <- inds2[j]
|
||||||
rivi <- rivi + 1
|
rivi <- rivi + 1
|
||||||
|
|
|
||||||
|
|
@ -1,14 +1,14 @@
|
||||||
poistaTyhjatPopulaatiot <- function(npops) {
|
poistaTyhjatPopulaatiot <- function(npops) {
|
||||||
# % Poistaa tyhjentyneet populaatiot COUNTS:ista ja
|
# % Poistaa tyhjentyneet populaatiot globals$COUNTS:ista ja
|
||||||
# % SUMCOUNTS:ista. P<>ivitt<74><74> npops:in ja PARTITION:in.
|
# % globals$SUMCOUNTS:ista. P<>ivitt<74><74> npops:in ja globals$PARTITION:in.
|
||||||
notEmpty <- matlab2r::find(apply(SUMCOUNTS, 1, function(x) any(x > 0)))
|
notEmpty <- matlab2r::find(apply(globals$SUMCOUNTS, 1, function(x) any(x > 0)))
|
||||||
COUNTS <- COUNTS[, , notEmpty]
|
globals$COUNTS <- globals$COUNTS[, , notEmpty]
|
||||||
SUMCOUNTS <- SUMCOUNTS[notEmpty, ]
|
globals$SUMCOUNTS <- globals$SUMCOUNTS[notEmpty, ]
|
||||||
LOGDIFF <- LOGDIFF[, notEmpty]
|
globals$LOGDIFF <- globals$LOGDIFF[, notEmpty]
|
||||||
|
|
||||||
for (n in 1:length(notEmpty)) {
|
for (n in 1:length(notEmpty)) {
|
||||||
apu <- matlab2r::find(PARTITION == notEmpty[n])
|
apu <- matlab2r::find(globals$PARTITION == notEmpty[n])
|
||||||
PARTITION[apu] <- n
|
globals$PARTITION[apu] <- n
|
||||||
}
|
}
|
||||||
npops <- length(notEmpty)
|
npops <- length(notEmpty)
|
||||||
return(npops)
|
return(npops)
|
||||||
|
|
|
||||||
|
|
@ -4,21 +4,21 @@ returnInOrder <- function(inds, pop, globalRows, data, adjprior, priorTerm) {
|
||||||
# % arvoa eniten.
|
# % arvoa eniten.
|
||||||
|
|
||||||
ninds <- length(inds)
|
ninds <- length(inds)
|
||||||
apuTaulu <- c(inds, zeros(ninds, 1))
|
apuTaulu <- cbind(inds, zeros(ninds, 1))
|
||||||
|
|
||||||
for (i in 1:ninds) {
|
for (i in 1:ninds) {
|
||||||
ind <- inds[i]
|
ind <- inds[i]
|
||||||
rows <- globalRows[i, 1]:globalRows[i, 2]
|
rows <- globalRows[i, 1]:globalRows[i, 2]
|
||||||
diffInCounts <- computeDiffInCounts(
|
diffInCounts <- computeDiffInCounts(
|
||||||
rows, size[COUNTS, 1], size[COUNTS, 2], data
|
rows, size(globals$COUNTS, 1), size(globals$COUNTS, 2), data
|
||||||
)
|
)
|
||||||
diffInSumCounts <- sum(diffInCounts)
|
diffInSumCounts <- colSums(diffInCounts)
|
||||||
|
|
||||||
COUNTS[, , pop] <- COUNTS[, , pop] - diffInCounts
|
globals$COUNTS[, , pop] <- globals$COUNTS[, , pop] - diffInCounts
|
||||||
SUMCOUNTS[pop, ] <- SUMCOUNTS[pop, ] - diffInSumCounts
|
globals$SUMCOUNTS[pop, ] <- globals$SUMCOUNTS[pop, ] - diffInSumCounts
|
||||||
apuTaulu[i, 2] <- computePopulationLogml(pop, adjprior, priorTerm)
|
apuTaulu[i, 2] <- computePopulationLogml(pop, adjprior, priorTerm)
|
||||||
COUNTS[, , pop] <- COUNTS[, , pop] + diffInCounts
|
globals$COUNTS[, , pop] <- globals$COUNTS[, , pop] + diffInCounts
|
||||||
SUMCOUNTS[pop, ] <- SUMCOUNTS[pop, ] + diffInSumCounts
|
globals$SUMCOUNTS[pop, ] <- globals$SUMCOUNTS[pop, ] + diffInSumCounts
|
||||||
}
|
}
|
||||||
apuTaulu <- sortrows(apuTaulu, 2)
|
apuTaulu <- sortrows(apuTaulu, 2)
|
||||||
inds <- apuTaulu[ninds:1, 1]
|
inds <- apuTaulu[ninds:1, 1]
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue