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

Merge branch 'issue-24' into develop

Browse source 
* issue-24:
  Increment version number to 0.0.0.9028
  Updated docs
  Added unit tests (#24)
  Fixed `greedyMix()` for BAPS files (#24) 🍾
  Fixed `indMix()` and subfunctions (#24)
  Fixed tests (#24)
This commit is contained in:
Waldir Leoncio 2024-07-02 16:54:33 +02:00
commit 5cc111f0c1
9 changed files with 206 additions and 194 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
DESCRIPTION
View file

@ -1,6 +1,6 @@
Package: rBAPS Package: rBAPS
Title: Bayesian Analysis of Population Structure Title: Bayesian Analysis of Population Structure
Version: 0.0.0.9027 Version: 0.0.0.9028
Date: 2020-11-09 Date: 2020-11-09
Authors@R: Authors@R:
c( c(

86
R/indMix.R
View file

@ -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(

252
R/laskeMuutokset12345.R
View file

@ -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

4
R/laskeOsaDist.R
View file

@ -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

16
R/poistaTyhjatPopulaatiot.R
View file

@ -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)

14
R/returnInOrder.R
View file

@ -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]

4
R/writeMixtureInfo.R
View file

@ -257,8 +257,8 @@ writeMixtureInfo <- function(
} }
partitionSummary <- sortrows(partitionSummary, 2) partitionSummary <- sortrows(partitionSummary, 2)
partitionSummary <- partitionSummary[size(partitionSummary, 1):1, ] partitionSummary <- partitionSummary[size(partitionSummary, 1):1, , drop = FALSE]
partitionSummary <- partitionSummary[matlab2r::find(partitionSummary[, 2] > -1e49), ] partitionSummary <- partitionSummary[matlab2r::find(partitionSummary[, 2] > -1e49), , drop = FALSE]
if (size(partitionSummary, 1) > 10) { if (size(partitionSummary, 1) > 10) {
vikaPartitio <- 10 vikaPartitio <- 10
} else { } else {

4
man/greedyMix_muutokset.Rd
View file

@ -6,8 +6,8 @@
\description{ \description{
Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik<69> olisi 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<EFBFBD>ys 25.9.2007: Lis<EFBFBD>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

18
tests/testthat/test-greedyMix.R
View file

@ -46,11 +46,10 @@ raw_bam <- importFile(
data = file.path(path_inst, "bam_example.bam"), data = file.path(path_inst, "bam_example.bam"),
format = "BAM", format = "BAM",
) )
# TODO: uncomment for testing #24 raw_baps <- importFile(
# raw_baps <- importFile( data = file.path(path_inst, "FASTA_clustering_haploid.fasta"),
# data = file.path(path_inst, "FASTA_clustering_haploid.fasta"), format = "FASTA"
# format = "FASTA" )
# )
test_that("Files are imported correctly", { test_that("Files are imported correctly", {
expect_equal(dim(raw_fasta), c(5, 99)) expect_equal(dim(raw_fasta), c(5, 99))
@ -71,11 +70,18 @@ test_that("Files are imported correctly", {
) )
}) })
test_that("greedyMix() works", { test_that("greedyMix() fails successfully", {
expect_error(greedyMix(file.path(path_inst, "vcf_example.vcf"))) expect_error(greedyMix(file.path(path_inst, "vcf_example.vcf")))
expect_error(greedyMix(file.path(path_inst, "bam_example.bam"))) expect_error(greedyMix(file.path(path_inst, "bam_example.bam")))
}) })
test_that("greedyMix() works when it should", {
baps_file <- file.path(path_inst, "BAPS_clustering_diploid.txt")
greedy_baps <- greedyMix(baps_file, "BAPS")
expect_type(greedy_baps, "list")
expect_length(greedy_baps, 10L)
})
context("Linkage") context("Linkage")
test_that("Linkages are properly calculated", { test_that("Linkages are properly calculated", {