From e4af251307533cf2759cbaaaa4c5457436a30494 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio <w.l.netto@medisin.uio.no> Date: Tue, 2 Jul 2024 11:23:22 +0200 Subject: [PATCH 1/6] Fixed tests (#24) --- tests/testthat/test-greedyMix.R | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-greedyMix.R b/tests/testthat/test-greedyMix.R index 6a4f2f2..86cf9fb 100644 --- a/tests/testthat/test-greedyMix.R +++ b/tests/testthat/test-greedyMix.R @@ -46,11 +46,10 @@ raw_bam <- importFile( data = file.path(path_inst, "bam_example.bam"), format = "BAM", ) -# TODO: uncomment for testing #24 -# raw_baps <- importFile( -# data = file.path(path_inst, "FASTA_clustering_haploid.fasta"), -# format = "FASTA" -# ) +raw_baps <- importFile( + data = file.path(path_inst, "FASTA_clustering_haploid.fasta"), + format = "FASTA" +) test_that("Files are imported correctly", { expect_equal(dim(raw_fasta), c(5, 99)) @@ -71,7 +70,7 @@ 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, "bam_example.bam"))) }) From 6aecf382317182bfc977b92e38ab8e38467936bb Mon Sep 17 00:00:00 2001 From: Waldir Leoncio <w.l.netto@medisin.uio.no> Date: Tue, 2 Jul 2024 12:17:02 +0200 Subject: [PATCH 2/6] Fixed `indMix()` and subfunctions (#24) --- R/indMix.R | 86 ++++++------ R/laskeMuutokset12345.R | 252 +++++++++++++++++++----------------- R/laskeOsaDist.R | 4 +- R/poistaTyhjatPopulaatiot.R | 16 +-- R/returnInOrder.R | 14 +- 5 files changed, 189 insertions(+), 183 deletions(-) diff --git a/R/indMix.R b/R/indMix.R index 323c8d0..f868ed7 100644 --- a/R/indMix.R +++ b/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�minen toiseen. maxMuutos <- 0 for (pop in seq_len(npops)) { - muutokset_diffInCounts <- greedyMix_muutokset$new - # FIXME: wrong input - browser() # TEMP. Tip: browserText() + muutokset_diffInCounts <- greedyMix_muutokset$new() muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset2( pop, rows, data, adjprior, priorTerm ) @@ -241,7 +239,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d maxMuutos <- 0 ninds <- size(rows, 1) for (pop in seq_len(npops)) { - inds2 <- matlab2r::find(PARTITION == pop) + inds2 <- matlab2r::find(globals$PARTITION == pop) ninds2 <- length(inds2) if (ninds2 > 2) { 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( T2, inds2, rows, data, adjprior, priorTerm, pop ) - isoin <- matlab2r::max(muutokset)[[1]] - indeksi <- matlab2r::max(muutokset)[[2]] + isoin <- matlab2r::max(c(muutokset))[[1]] + indeksi <- matlab2r::max(c(muutokset))[[2]] if (isoin > maxMuutos) { maxMuutos <- isoin muuttuvaPop2 <- indeksi %% npops2 @@ -277,9 +275,9 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d rivit <- rbind(rivit, t(lisa)) } 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( 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) { j <- 0 muutettu <- 0 - poplogml <- POP_LOGML - partition <- PARTITION - counts <- COUNTS - sumcounts <- SUMCOUNTS - logdiff <- LOGDIFF + poplogml <- globals$POP_LOGML + partition <- globals$PARTITION + counts <- globals$COUNTS + sumcounts <- globals$SUMCOUNTS + logdiff <- globals$LOGDIFF pops <- sample(npops) while (j < npops & muutettu == 0) { j <- j + 1 pop <- pops[j] totalMuutos <- 0 - inds <- matlab2r::find(PARTITION == pop) + inds <- matlab2r::find(globals$PARTITION == pop) if (round == 5) { - aputaulu <- c(inds, rand(length(inds), 1)) + aputaulu <- matrix(c(inds, rand(length(inds), 1)), ncol = 2) aputaulu <- sortrows(aputaulu, 2) inds <- aputaulu[, 1] - } else if (round == 6) { - inds <- returnInOrder( - inds, pop, rows, data, adjprior, priorTerm - ) + } else if (round == 6 && length(inds) > 0) { + inds <- returnInOrder(inds, pop, rows, data, adjprior, priorTerm) } i <- 0 @@ -386,12 +382,12 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d } else { # Miss��n vaiheessa tila ei parantunut. # Perutaan kaikki muutokset. - PARTITION <- partition - SUMCOUNTS <- sumcounts - POP_LOGML <- poplogml - COUNTS <- counts + globals$PARTITION <- partition + globals$SUMCOUNTS <- sumcounts + globals$POP_LOGML <- poplogml + globals$COUNTS <- counts logml <- logml - totalMuutos - LOGDIFF <- logdiff + globals$LOGDIFF <- logdiff kokeiltu[round] <- 1 } } @@ -401,20 +397,20 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d j <- 0 pops <- sample(npops) muutoksiaNyt <- 0 - if (emptyPop == -1) { + if (emptyPop$emptyPop == -1) { j <- npops } while (j < npops) { j <- j + 1 pop <- pops[j] - inds2 <- matlab2r::find(PARTITION == pop) + inds2 <- matlab2r::find(globals$PARTITION == pop) ninds2 <- length(inds2) if (ninds2 > 5) { - partition <- PARTITION - sumcounts <- SUMCOUNTS - counts <- COUNTS - poplogml <- POP_LOGML - logdiff <- LOGDIFF + partition <- globals$PARTITION + sumcounts <- globals$SUMCOUNTS + counts <- globals$COUNTS + poplogml <- globals$POP_LOGML + logdiff <- globals$LOGDIFF dist2 <- laskeOsaDist(inds2, dist, ninds) Z2 <- linkage(t(dist2)) @@ -433,7 +429,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d rivit <- c(rivit, lisa) } diffInCounts <- computeDiffInCounts( - rivit, size(COUNTS, 1), size(COUNTS, 2), data + rivit, size(globals$COUNTS, 1), size(globals$COUNTS, 2), data ) updateGlobalVariables3( @@ -454,7 +450,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d maxMuutos <- indeksi <- matlab2r::max(muutokset) muuttuva <- inds2(indeksi) - if (PARTITION(muuttuva) == pop) { + if (globals$PARTITION(muuttuva) == pop) { i2 <- emptyPop } else { i2 <- pop @@ -463,7 +459,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d if (maxMuutos > 1e-5) { rivit <- rows[muuttuva, 1]:rows[muuttuva, 2] diffInCounts <- computeDiffInCounts( - rivit, size(COUNTS, 1), size(COUNTS, 2), + rivit, size(globals$COUNTS, 1), size(globals$COUNTS, 2), data ) updateGlobalVariables3( @@ -498,11 +494,11 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d j <- npops } else { # palutetaan vanhat arvot - PARTITION <- partition - SUMCOUNTS <- sumcounts - COUNTS <- counts - POP_LOGML <- poplogml - LOGDIFF <- logdiff + globals$PARTITION <- partition + globals$SUMCOUNTS <- sumcounts + globals$COUNTS <- counts + globals$POP_LOGML <- poplogml + globals$LOGDIFF <- logdiff } } } @@ -540,7 +536,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d # TALLENNETAAN npops <- poistaTyhjatPopulaatiot(npops) - POP_LOGML <- computePopulationLogml(seq_len(npops), adjprior, priorTerm) + globals$POP_LOGML <- computePopulationLogml(seq_len(npops), adjprior, priorTerm) if (dispText) { message("Found partition with ", as.character(npops), " populations.") message("Log(ml) = ", as.character(logml)) @@ -550,11 +546,11 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d # P�ivitet��n parasta l�ydetty� partitiota. logmlBest <- logml npopsBest <- npops - partitionBest <- PARTITION - countsBest <- COUNTS - sumCountsBest <- SUMCOUNTS - pop_logmlBest <- POP_LOGML - logdiffbest <- LOGDIFF + partitionBest <- globals$PARTITION + countsBest <- globals$COUNTS + sumCountsBest <- globals$SUMCOUNTS + pop_logmlBest <- globals$POP_LOGML + logdiffbest <- globals$LOGDIFF } } return( diff --git a/R/laskeMuutokset12345.R b/R/laskeMuutokset12345.R index 6cff0e1..78c9f5c 100644 --- a/R/laskeMuutokset12345.R +++ b/R/laskeMuutokset12345.R @@ -15,9 +15,9 @@ spatialMixture_muutokset <- R6Class( ) { # Palauttaa npops * 1 taulun, jossa i:s alkio kertoo, mik?olisi # muutos logml:ss? mikהli yksil?ind siirretההn koriin i. - # diffInCounts on poistettava COUNTS:in siivusta i1 ja lisהttהv? - # COUNTS:in siivuun i2, mikהli muutos toteutetaan. - npops <- size(COUNTS, 3) + # diffInCounts on poistettava globals$COUNTS:in siivusta i1 ja lisהttהv? + # globals$COUNTS:in siivuun i2, mikהli muutos toteutetaan. + npops <- size(globals$COUNTS, 3) muutokset <- zeros(npops, 1) emptyPop_pops <- findEmptyPop(npops) @@ -25,42 +25,42 @@ spatialMixture_muutokset <- R6Class( pops <- emptyPop_pops$pops rm(emptyPop_pops) - i1 <- PARTITION(ind) + i1 <- globals$PARTITION(ind) i2 <- pops[find(pops != i1)] if (emptyPop > 0) { i2 <- c(i2, emptyPop) } 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) diffInCliqCounts <- computeDiffInCliqCounts(cliques, ind) diffInSepCounts <- computeDiffInCliqCounts(separators, ind) - COUNTS[, ,i1] <- COUNTS[, , i1] - diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts - CLIQCOUNTS[, i1] <- CLIQCOUNTS[, i1] - diffInCliqCounts - SEPCOUNTS[, i1] <- SEPCOUNTS[, i1] - diffInSepCounts + globals$COUNTS[, ,i1] <- globals$COUNTS[, , i1] - diffInCounts + globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts + globals$CLIQCOUNTS[, i1] <- globals$CLIQCOUNTS[, i1] - diffInCliqCounts + globals$SEPCOUNTS[, i1] <- globals$SEPCOUNTS[, i1] - diffInSepCounts for (i in i2) { - CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] + diffInCliqCounts - SEPCOUNTS[, i] <- SEPCOUNTS[, i] + diffInSepCounts - COUNTS[, ,i] <- COUNTS[, , i] + diffInCounts - SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] + diffInSumCounts + globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] + diffInCliqCounts + globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] + diffInSepCounts + globals$COUNTS[, ,i] <- globals$COUNTS[, , i] + diffInCounts + globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] + diffInSumCounts muutokset[i] <- computeLogml(adjprior, priorTerm) - logml - CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] - diffInCliqCounts - SEPCOUNTS[, i] <- SEPCOUNTS[, i] - diffInSepCounts - COUNTS[, , i] <- COUNTS[, , i] - diffInCounts - SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] - diffInSumCounts + globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] - diffInCliqCounts + globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] - diffInSepCounts + globals$COUNTS[, , i] <- globals$COUNTS[, , i] - diffInCounts + globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] - diffInSumCounts } - COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts - CLIQCOUNTS[, i1] <- CLIQCOUNTS[, i1] + diffInCliqCounts - SEPCOUNTS[, i1] <- SEPCOUNTS[, i1] + diffInSepCounts + globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] + diffInCounts + globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] + diffInSumCounts + globals$CLIQCOUNTS[, i1] <- globals$CLIQCOUNTS[, i1] + diffInCliqCounts + globals$SEPCOUNTS[, i1] <- globals$SEPCOUNTS[, i1] + diffInSepCounts # Asetetaan muillekin tyhjille populaatioille sama muutos, kuin # emptyPop:lle @@ -87,11 +87,11 @@ spatialMixture_muutokset <- R6Class( # koriin i. # Laskee muutokset vain yhdelle tyhjהlle populaatiolle, muille tulee # muutokseksi 0. - # global COUNTS # global SUMCOUNTS - # global PARTITION # global POP_LOGML - # global CLIQCOUNTS # global SEPCOUNTS + # global globals$COUNTS # global globals$SUMCOUNTS + # global globals$PARTITION # global globals$POP_LOGML + # global globals$CLIQCOUNTS # global globals$SEPCOUNTS - npops <- size(COUNTS, 3) + npops <- size(globals$COUNTS, 3) muutokset <- zeros(npops, 1) emptyPop <- findEmptyPop(npops)$emptyPop @@ -102,37 +102,37 @@ spatialMixture_muutokset <- R6Class( i2 <- c(i2, emptyPop) } - inds <- find(PARTITION == i1) + inds <- find(globals$PARTITION == i1) 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) diffInCliqCounts <- computeDiffInCliqCounts(cliques, inds) diffInSepCounts <- computeDiffInCliqCounts(separators, inds) - COUNTS[, ,i1] <- COUNTS[, , i1] - diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts - CLIQCOUNTS[, i1] <- 0 - SEPCOUNTS[, i1] <- 0 + globals$COUNTS[, ,i1] <- globals$COUNTS[, , i1] - diffInCounts + globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts + globals$CLIQCOUNTS[, i1] <- 0 + globals$SEPCOUNTS[, i1] <- 0 for (i in i2) { - CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] + diffInCliqCounts - SEPCOUNTS[, i] <- SEPCOUNTS[, i] + diffInSepCounts - COUNTS[, ,i] <- COUNTS[, , i] + diffInCounts - SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] + diffInSumCounts + globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] + diffInCliqCounts + globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] + diffInSepCounts + globals$COUNTS[, ,i] <- globals$COUNTS[, , i] + diffInCounts + globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] + diffInSumCounts muutokset[i] <- computeLogml(adjprior, priorTerm) - logml - CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] - diffInCliqCounts - SEPCOUNTS[, i] <- SEPCOUNTS[, i] - diffInSepCounts - COUNTS[, ,i] <- COUNTS[, , i] - diffInCounts - SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] - diffInSumCounts + globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] - diffInCliqCounts + globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] - diffInSepCounts + globals$COUNTS[, ,i] <- globals$COUNTS[, , i] - diffInCounts + globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] - diffInSumCounts } - COUNTS[, ,i1] <- COUNTS[, , i1] + diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts - CLIQCOUNTS[, i1] <- diffInCliqCounts - SEPCOUNTS[, i1] <- diffInSepCounts + globals$COUNTS[, ,i1] <- globals$COUNTS[, , i1] + diffInCounts + globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] + diffInSumCounts + globals$CLIQCOUNTS[, i1] <- diffInCliqCounts + globals$SEPCOUNTS[, i1] <- diffInSepCounts return(list(muutokset = muutokset, diffInCounts = diffInCounts)) }, #' @param T2 T2 @@ -154,11 +154,11 @@ spatialMixture_muutokset <- R6Class( # inds2(find(T2 == i)) siirretההn koriin j. # Laskee vain yhden tyhjהn populaation, muita kohden muutokseksi jהה 0. - # global COUNTS # global SUMCOUNTS - # global PARTITION # global POP_LOGML - # global CLIQCOUNTS # global SEPCOUNTS + # global globals$COUNTS # global globals$SUMCOUNTS + # global globals$PARTITION # global globals$POP_LOGML + # global globals$CLIQCOUNTS # global globals$SEPCOUNTS - npops <- size(COUNTS, 3) + npops <- size(globals$COUNTS, 3) npops2 <- length(unique(T2)) muutokset <- zeros(npops2, npops) @@ -168,15 +168,15 @@ spatialMixture_muutokset <- R6Class( if (ninds > 0) { 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) diffInCliqCounts <- computeDiffInCliqCounts(cliques, inds) diffInSepCounts <- computeDiffInCliqCounts(separators, inds) - COUNTS[, ,i1] <- COUNTS[, , i1] - diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts - CLIQCOUNTS[, i1] <- CLIQCOUNTS[, i1] - diffInCliqCounts - SEPCOUNTS[, i1] <- SEPCOUNTS[, i1] - diffInSepCounts + globals$COUNTS[, ,i1] <- globals$COUNTS[, , i1] - diffInCounts + globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts + globals$CLIQCOUNTS[, i1] <- globals$CLIQCOUNTS[, i1] - diffInCliqCounts + globals$SEPCOUNTS[, i1] <- globals$SEPCOUNTS[, i1] - diffInSepCounts emptyPop <- findEmptyPop(npops)$emptyPop pops <- findEmptyPop(npops)$pops @@ -186,23 +186,23 @@ spatialMixture_muutokset <- R6Class( } for (i in i2) { - CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] + diffInCliqCounts - SEPCOUNTS[, i] <- SEPCOUNTS[, i] + diffInSepCounts - COUNTS[, ,i] <- COUNTS[, , i] + diffInCounts - SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] + diffInSumCounts + globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] + diffInCliqCounts + globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] + diffInSepCounts + globals$COUNTS[, ,i] <- globals$COUNTS[, , i] + diffInCounts + globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] + diffInSumCounts muutokset[pop2, i] <- computeLogml(adjprior, priorTerm) - logml - CLIQCOUNTS[, i] <- CLIQCOUNTS[, i] - diffInCliqCounts - SEPCOUNTS[, i] <- SEPCOUNTS[, i] - diffInSepCounts - COUNTS[, ,i] <- COUNTS[, , i] - diffInCounts - SUMCOUNTS[i, ] <- SUMCOUNTS[i, ] - diffInSumCounts + globals$CLIQCOUNTS[, i] <- globals$CLIQCOUNTS[, i] - diffInCliqCounts + globals$SEPCOUNTS[, i] <- globals$SEPCOUNTS[, i] - diffInSepCounts + globals$COUNTS[, ,i] <- globals$COUNTS[, , i] - diffInCounts + globals$SUMCOUNTS[i, ] <- globals$SUMCOUNTS[i, ] - diffInSumCounts } - COUNTS[, ,i1] <- COUNTS[, , i1] + diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts - CLIQCOUNTS[, i1] <- CLIQCOUNTS[, i1] + diffInCliqCounts - SEPCOUNTS[, i1] <- SEPCOUNTS[, i1] + diffInSepCounts + globals$COUNTS[, ,i1] <- globals$COUNTS[, , i1] + diffInCounts + globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] + diffInSumCounts + globals$CLIQCOUNTS[, i1] <- globals$CLIQCOUNTS[, i1] + diffInCliqCounts + globals$SEPCOUNTS[, i1] <- globals$SEPCOUNTS[, i1] + diffInSepCounts } } return(muutokset) @@ -224,18 +224,18 @@ spatialMixture_muutokset <- R6Class( # 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? - # global COUNTS # global SUMCOUNTS - # global PARTITION - # global CLIQCOUNTS # global SEPCOUNTS + # global globals$COUNTS # global globals$SUMCOUNTS + # global globals$PARTITION + # global globals$CLIQCOUNTS # global globals$SEPCOUNTS ninds <- length(inds) muutokset <- zeros(ninds, 1) - cliqsize <- size(CLIQCOUNTS, 2) - sepsize <- size(SEPCOUNTS, 2) + cliqsize <- size(globals$CLIQCOUNTS, 2) + sepsize <- size(globals$SEPCOUNTS, 2) for (i in 1:ninds) { ind <- inds[i] - if (PARTITION[ind] == i1) { + if (globals$PARTITION[ind] == i1) { pop1 <- i1 # mist? pop2 <- i2 # mihin } else { @@ -244,32 +244,32 @@ spatialMixture_muutokset <- R6Class( } 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) diffInCliqCounts <- computeDiffInCliqCounts(cliques, ind) diffInSepCounts <- computeDiffInCliqCounts(separators, ind) - COUNTS[, ,pop1] <- COUNTS[, , pop1] - diffInCounts - SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] - diffInSumCounts - COUNTS[, ,pop2] <- COUNTS[, , pop2] + diffInCounts - SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] + diffInSumCounts + globals$COUNTS[, ,pop1] <- globals$COUNTS[, , pop1] - diffInCounts + globals$SUMCOUNTS[pop1, ] <- globals$SUMCOUNTS[pop1, ] - diffInSumCounts + globals$COUNTS[, ,pop2] <- globals$COUNTS[, , pop2] + diffInCounts + globals$SUMCOUNTS[pop2, ] <- globals$SUMCOUNTS[pop2, ] + diffInSumCounts - CLIQCOUNTS[, pop1] <- CLIQCOUNTS[, pop1] - diffInCliqCounts - CLIQCOUNTS[, pop2] <- CLIQCOUNTS[, pop2] + diffInCliqCounts - SEPCOUNTS[, pop1] <- SEPCOUNTS[, pop1] - diffInSepCounts - SEPCOUNTS[, pop2] <- SEPCOUNTS[, pop2] + diffInSepCounts + globals$CLIQCOUNTS[, pop1] <- globals$CLIQCOUNTS[, pop1] - diffInCliqCounts + globals$CLIQCOUNTS[, pop2] <- globals$CLIQCOUNTS[, pop2] + diffInCliqCounts + globals$SEPCOUNTS[, pop1] <- globals$SEPCOUNTS[, pop1] - diffInSepCounts + globals$SEPCOUNTS[, pop2] <- globals$SEPCOUNTS[, pop2] + diffInSepCounts muutokset[i] <- computeLogml(adjprior, priorTerm) - logml - COUNTS[, ,pop1] <- COUNTS[, , pop1] + diffInCounts - SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] + diffInSumCounts - COUNTS[, ,pop2] <- COUNTS[, , pop2] - diffInCounts - SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] - diffInSumCounts + globals$COUNTS[, ,pop1] <- globals$COUNTS[, , pop1] + diffInCounts + globals$SUMCOUNTS[pop1, ] <- globals$SUMCOUNTS[pop1, ] + diffInSumCounts + globals$COUNTS[, ,pop2] <- globals$COUNTS[, , pop2] - diffInCounts + globals$SUMCOUNTS[pop2, ] <- globals$SUMCOUNTS[pop2, ] - diffInSumCounts - CLIQCOUNTS[, pop1] <- CLIQCOUNTS[, pop1] + diffInCliqCounts - CLIQCOUNTS[, pop2] <- CLIQCOUNTS[, pop2] - diffInCliqCounts - SEPCOUNTS[, pop1] <- SEPCOUNTS[, pop1] + diffInSepCounts - SEPCOUNTS[, pop2] <- SEPCOUNTS[, pop2] - diffInSepCounts + globals$CLIQCOUNTS[, pop1] <- globals$CLIQCOUNTS[, pop1] + diffInCliqCounts + globals$CLIQCOUNTS[, pop2] <- globals$CLIQCOUNTS[, pop2] - diffInCliqCounts + globals$SEPCOUNTS[, pop1] <- globals$SEPCOUNTS[, pop1] + diffInSepCounts + globals$SEPCOUNTS[, pop2] <- globals$SEPCOUNTS[, pop2] - diffInSepCounts } return(muutokset) @@ -327,8 +327,8 @@ admix1_muutokset <- R6Class( #' @title Calculate changes (greedyMix class) #' @description Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik� olisi #' muutos logml:ss�, mik�li yksil� ind siirret��n koriin i. -#' diffInCounts on poistettava COUNTS:in siivusta i1 ja lis�tt�v� -#' COUNTS:in siivuun i2, mik�li muutos toteutetaan. +#' diffInCounts on poistettava globals$COUNTS:in siivusta i1 ja lis�tt�v� +#' globals$COUNTS:in siivuun i2, mik�li muutos toteutetaan. #' #' Lis�ys 25.9.2007: #' Otettu k�ytt��n globaali muuttuja LOGDIFF, johon on tallennettu muutokset @@ -401,11 +401,11 @@ greedyMix_muutokset <- R6Class( if (ninds == 0) { diffInCounts <- zeros(size(globals$COUNTS, 1), size(globals$COUNTS, 2)) - return() + return(list("muutokset" = muutokset, "diffInCounts" = diffInCounts)) } rows <- list() - for (i in 1:ninds) { + for (i in seq_len(ninds)) { ind <- inds[i] lisa <- globalRows[ind, 1]:globalRows[ind, 2] rows <- c(rows, t(lisa)) @@ -414,7 +414,7 @@ greedyMix_muutokset <- R6Class( diffInCounts <- computeDiffInCounts( 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$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts @@ -422,7 +422,11 @@ greedyMix_muutokset <- R6Class( globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] + diffInCounts 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] 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$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)) }, #' @param T2 T2 @@ -448,11 +453,11 @@ greedyMix_muutokset <- R6Class( # kertoo, mik� olisi muutos logml:ss�, jos populaation i1 osapopulaatio # inds2(matlab2r::find(T2==i)) siirret��n koriin j. - npops <- size(COUNTS, 3) + npops <- size(globals$COUNTS, 3) npops2 <- length(unique(T2)) muutokset <- zeros(npops2, npops) - i1_logml <- POP_LOGML[i1] + i1_logml <- globals$POP_LOGML[i1] for (pop2 in 1:npops2) { inds <- inds2[matlab2r::find(T2 == pop2)] ninds <- length(inds) @@ -464,26 +469,31 @@ greedyMix_muutokset <- R6Class( rows <- c(rows, t(lisa)) } 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 - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts + globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] - diffInCounts + globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] - diffInSumCounts new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm) - COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts - SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts + globals$COUNTS[, , i1] <- globals$COUNTS[, , i1] + diffInCounts + globals$SUMCOUNTS[i1, ] <- globals$SUMCOUNTS[i1, ] + diffInSumCounts - i2 <- c(1:i1 - 1, i1 + 1:npops) - i2_logml <- t(POP_LOGML[i2]) + if (i1 < npops) { + 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)) - SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(npops - 1, 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)) new_i2_logml <- t(computePopulationLogml(i2, adjprior, priorTerm)) - COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, npops - 1)) - SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(npops - 1, 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)) - 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) @@ -502,12 +512,12 @@ greedyMix_muutokset <- R6Class( ninds <- length(inds) muutokset <- zeros(ninds, 1) - i1_logml <- POP_LOGML[i1] - i2_logml <- POP_LOGML[i2] + i1_logml <- globals$POP_LOGML[i1] + i2_logml <- globals$POP_LOGML[i2] for (i in 1:ninds) { ind <- inds[i] - if (PARTITION[ind] == i1) { + if (globals$PARTITION[ind] == i1) { pop1 <- i1 # mist� pop2 <- i2 # mihin } else { @@ -516,24 +526,24 @@ greedyMix_muutokset <- R6Class( } rows <- globalRows[ind, 1]:globalRows[ind, 2] diffInCounts <- computeDiffInCounts( - rows, size(COUNTS, 1), size(COUNTS, 2), data + rows, size(globals$COUNTS, 1), size(globals$COUNTS, 2), data ) diffInSumCounts <- sum(diffInCounts) - COUNTS[, , pop1] <- COUNTS[, , pop1] - diffInCounts - SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] - diffInSumCounts - COUNTS[, , pop2] <- COUNTS[, , pop2] + diffInCounts - SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] + diffInSumCounts + globals$COUNTS[, , pop1] <- globals$COUNTS[, , pop1] - diffInCounts + globals$SUMCOUNTS[pop1, ] <- globals$SUMCOUNTS[pop1, ] - diffInSumCounts + globals$COUNTS[, , pop2] <- globals$COUNTS[, , pop2] + diffInCounts + globals$SUMCOUNTS[pop2, ] <- globals$SUMCOUNTS[pop2, ] + diffInSumCounts new_logmls <- computePopulationLogml(c(i1, i2), adjprior, priorTerm) muutokset[i] <- sum(new_logmls) - COUNTS[, , pop1] <- COUNTS[, , pop1] + diffInCounts - SUMCOUNTS[pop1, ] <- SUMCOUNTS[pop1, ] + diffInSumCounts - COUNTS[, , pop2] <- COUNTS[, , pop2] - diffInCounts - SUMCOUNTS[pop2, ] <- SUMCOUNTS[pop2, ] - diffInSumCounts + globals$COUNTS[, , pop1] <- globals$COUNTS[, , pop1] + diffInCounts + globals$SUMCOUNTS[pop1, ] <- globals$SUMCOUNTS[pop1, ] + diffInSumCounts + globals$COUNTS[, , pop2] <- globals$COUNTS[, , pop2] - diffInCounts + globals$SUMCOUNTS[pop2, ] <- globals$SUMCOUNTS[pop2, ] - diffInSumCounts } muutokset <- muutokset - i1_logml - i2_logml diff --git a/R/laskeOsaDist.R b/R/laskeOsaDist.R index 4f76b8b..b6c8570 100644 --- a/R/laskeOsaDist.R +++ b/R/laskeOsaDist.R @@ -11,8 +11,8 @@ laskeOsaDist <- function(inds2, dist, ninds) { ninds2 <- length(inds2) apu <- zeros(choose(ninds2, 2), 2) rivi <- 1 - for (i in 1:ninds2 - 1) { - for (j in i + 1:ninds2) { + for (i in 1:(ninds2 - 1)) { + for (j in (i + 1):ninds2) { apu[rivi, 1] <- inds2[i] apu[rivi, 2] <- inds2[j] rivi <- rivi + 1 diff --git a/R/poistaTyhjatPopulaatiot.R b/R/poistaTyhjatPopulaatiot.R index 0635e9a..12eb486 100644 --- a/R/poistaTyhjatPopulaatiot.R +++ b/R/poistaTyhjatPopulaatiot.R @@ -1,14 +1,14 @@ poistaTyhjatPopulaatiot <- function(npops) { - # % Poistaa tyhjentyneet populaatiot COUNTS:ista ja - # % SUMCOUNTS:ista. P�ivitt�� npops:in ja PARTITION:in. - notEmpty <- matlab2r::find(apply(SUMCOUNTS, 1, function(x) any(x > 0))) - COUNTS <- COUNTS[, , notEmpty] - SUMCOUNTS <- SUMCOUNTS[notEmpty, ] - LOGDIFF <- LOGDIFF[, notEmpty] + # % Poistaa tyhjentyneet populaatiot globals$COUNTS:ista ja + # % globals$SUMCOUNTS:ista. P�ivitt�� npops:in ja globals$PARTITION:in. + notEmpty <- matlab2r::find(apply(globals$SUMCOUNTS, 1, function(x) any(x > 0))) + globals$COUNTS <- globals$COUNTS[, , notEmpty] + globals$SUMCOUNTS <- globals$SUMCOUNTS[notEmpty, ] + globals$LOGDIFF <- globals$LOGDIFF[, notEmpty] for (n in 1:length(notEmpty)) { - apu <- matlab2r::find(PARTITION == notEmpty[n]) - PARTITION[apu] <- n + apu <- matlab2r::find(globals$PARTITION == notEmpty[n]) + globals$PARTITION[apu] <- n } npops <- length(notEmpty) return(npops) diff --git a/R/returnInOrder.R b/R/returnInOrder.R index 5287007..4fda453 100644 --- a/R/returnInOrder.R +++ b/R/returnInOrder.R @@ -4,21 +4,21 @@ returnInOrder <- function(inds, pop, globalRows, data, adjprior, priorTerm) { # % arvoa eniten. ninds <- length(inds) - apuTaulu <- c(inds, zeros(ninds, 1)) + apuTaulu <- cbind(inds, zeros(ninds, 1)) for (i in 1:ninds) { ind <- inds[i] rows <- globalRows[i, 1]:globalRows[i, 2] 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 - SUMCOUNTS[pop, ] <- SUMCOUNTS[pop, ] - diffInSumCounts + globals$COUNTS[, , pop] <- globals$COUNTS[, , pop] - diffInCounts + globals$SUMCOUNTS[pop, ] <- globals$SUMCOUNTS[pop, ] - diffInSumCounts apuTaulu[i, 2] <- computePopulationLogml(pop, adjprior, priorTerm) - COUNTS[, , pop] <- COUNTS[, , pop] + diffInCounts - SUMCOUNTS[pop, ] <- SUMCOUNTS[pop, ] + diffInSumCounts + globals$COUNTS[, , pop] <- globals$COUNTS[, , pop] + diffInCounts + globals$SUMCOUNTS[pop, ] <- globals$SUMCOUNTS[pop, ] + diffInSumCounts } apuTaulu <- sortrows(apuTaulu, 2) inds <- apuTaulu[ninds:1, 1] From e873075ebf5b2c85f4a42f211660390dffb3e3d4 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio <w.l.netto@medisin.uio.no> Date: Tue, 2 Jul 2024 16:39:38 +0200 Subject: [PATCH 3/6] =?UTF-8?q?Fixed=20`greedyMix()`=20for=20BAPS=20files?= =?UTF-8?q?=20(#24)=20=F0=9F=8D=BE?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/writeMixtureInfo.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/writeMixtureInfo.R b/R/writeMixtureInfo.R index 65bdbee..79294e5 100644 --- a/R/writeMixtureInfo.R +++ b/R/writeMixtureInfo.R @@ -257,8 +257,8 @@ writeMixtureInfo <- function( } partitionSummary <- sortrows(partitionSummary, 2) - partitionSummary <- partitionSummary[size(partitionSummary, 1):1, ] - partitionSummary <- partitionSummary[matlab2r::find(partitionSummary[, 2] > -1e49), ] + partitionSummary <- partitionSummary[size(partitionSummary, 1):1, , drop = FALSE] + partitionSummary <- partitionSummary[matlab2r::find(partitionSummary[, 2] > -1e49), , drop = FALSE] if (size(partitionSummary, 1) > 10) { vikaPartitio <- 10 } else { From 95ff2378b1e81e8838908a34742a796250ec7882 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio <w.l.netto@medisin.uio.no> Date: Tue, 2 Jul 2024 16:39:48 +0200 Subject: [PATCH 4/6] Added unit tests (#24) --- tests/testthat/test-greedyMix.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/testthat/test-greedyMix.R b/tests/testthat/test-greedyMix.R index 86cf9fb..6029c63 100644 --- a/tests/testthat/test-greedyMix.R +++ b/tests/testthat/test-greedyMix.R @@ -75,6 +75,13 @@ test_that("greedyMix() fails successfully", { 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") test_that("Linkages are properly calculated", { From 3ce6659120f84f523330f787303145f1e30970c2 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio <w.l.netto@medisin.uio.no> Date: Tue, 2 Jul 2024 16:53:04 +0200 Subject: [PATCH 5/6] Updated docs --- man/greedyMix_muutokset.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/greedyMix_muutokset.Rd b/man/greedyMix_muutokset.Rd index e73eb05..3700a75 100644 --- a/man/greedyMix_muutokset.Rd +++ b/man/greedyMix_muutokset.Rd @@ -6,8 +6,8 @@ \description{ Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik� olisi muutos logml:ss�, mik�li yksil� ind siirret��n koriin i. -diffInCounts on poistettava COUNTS:in siivusta i1 ja lis�tt�v� -COUNTS:in siivuun i2, mik�li muutos toteutetaan. +diffInCounts on poistettava globals$COUNTS:in siivusta i1 ja lis�tt�v� +globals$COUNTS:in siivuun i2, mik�li muutos toteutetaan. Lis�ys 25.9.2007: Otettu k�ytt��n globaali muuttuja LOGDIFF, johon on tallennettu muutokset From d861ffb551b94d2f32220f9e237149eb3d450b52 Mon Sep 17 00:00:00 2001 From: Waldir Leoncio <w.l.netto@medisin.uio.no> Date: Tue, 2 Jul 2024 16:53:10 +0200 Subject: [PATCH 6/6] Increment version number to 0.0.0.9028 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 53dba3a..a2e2c03 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: rBAPS Title: Bayesian Analysis of Population Structure -Version: 0.0.0.9027 +Version: 0.0.0.9028 Date: 2020-11-09 Authors@R: c(