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

Fixed to indMix (#25)

Browse source
This commit is contained in:
Waldir Leoncio 2023-08-11 14:31:08 +02:00
parent 3537f18d2c
commit 372891fbe1
3 changed files with 15 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
R/greedyMix.R
View file

@ -27,7 +27,7 @@
#' data <- system.file("extdata", "FASTA_clustering_haploid.fasta", package = "rBAPS") #' data <- system.file("extdata", "FASTA_clustering_haploid.fasta", package = "rBAPS")
#' greedyMix(data, "fasta") #' greedyMix(data, "fasta")
greedyMix <- function( greedyMix <- function(
data, format, partitionCompare = NULL, ninds = NULL, npops = 1L, data, format, partitionCompare = NULL, ninds = 1L, npops = 1L,
counts = NULL, sumcounts = NULL, max_iter = 100L, alleleCodes = NULL, counts = NULL, sumcounts = NULL, max_iter = 100L, alleleCodes = NULL,
inp = NULL, popnames = NULL, fixedK = FALSE, verbose = FALSE inp = NULL, popnames = NULL, fixedK = FALSE, verbose = FALSE
) { ) {
@ -52,6 +52,8 @@ greedyMix <- function(
# Generating partition summary =============================================== # Generating partition summary ===============================================
ekat <- seq(1L, c[["rowsFromInd"]], ninds * c[["rowsFromInd"]]) # ekat = (1:rowsFromInd:ninds*rowsFromInd)';
c[["rows"]] <- c(ekat, ekat + c[["rowsFromInd"]] - 1L) # c.rows = [ekat ekat+rowsFromInd-1]
logml_npops_partitionSummary <- indMixWrapper(c, npops, counts, sumcounts, max_iter, fixedK, verbose); logml_npops_partitionSummary <- indMixWrapper(c, npops, counts, sumcounts, max_iter, fixedK, verbose);
logml <- logml_npops_partitionSummary[["logml"]] logml <- logml_npops_partitionSummary[["logml"]]
npops <- logml_npops_partitionSummary[["npops"]] npops <- logml_npops_partitionSummary[["npops"]]
@ -59,9 +61,10 @@ greedyMix <- function(
# Generating output object =================================================== # Generating output object ===================================================
out <- list( out <- list(
"alleleCodes" = alleleCodes, "adjprior" = c[["adjprior"]], "popnames" = popnames, "alleleCodes" = alleleCodes, "adjprior" = c[["adjprior"]],
"rowsFromInd" = c[["rowsFromInd"]], "data" = data, "npops" = npops, "popnames" = popnames, "rowsFromInd" = c[["rowsFromInd"]],
"noalle" = c[["noalle"]], "mixtureType" = "mix", "logml" = logml "data" = c[["data"]], "npops" = npops, "noalle" = c[["noalle"]],
"mixtureType" = "mix", "logml" = logml
) )
if (logml == 1) { if (logml == 1) {
return(out) return(out)

4
R/indMix.R
View file

@ -145,8 +145,8 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
if (kokeiltu[round] == 1) { # Askelta kokeiltu viime muutoksen j<>lkeen if (kokeiltu[round] == 1) { # Askelta kokeiltu viime muutoksen j<>lkeen
} else if (round == 0 | round == 1) { # Yksil<69>n siirt<72>minen toiseen populaatioon. } else if (round == 0 | round == 1) { # Yksil<69>n siirt<72>minen toiseen populaatioon.
inds <- seq_len(ninds) inds <- seq_len(ninds)
aputaulu <- cbind(inds, rand(ninds, 1)) aputaulu <- cbind(t(inds), rand(ninds, 1))
aputaulu <- sortrows(aputaulu, 2) aputaulu <- matrix(sortrows(aputaulu, 2), nrow = nrow(aputaulu))
inds <- t(aputaulu[, 1]) inds <- t(aputaulu[, 1])
muutosNyt <- 0 muutosNyt <- 0

5
R/laskeMuutokset12345.R
View file

@ -349,12 +349,15 @@ greedyMix_muutokset <- R6Class(
i1_logml <- POP_LOGML[i1] i1_logml <- POP_LOGML[i1]
muutokset[i1] <- 0 muutokset[i1] <- 0
if (is.null(dim(globalRows))) {
rows <- globalRows[1]:globalRows[2]
} else {
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(COUNTS, 1), size(COUNTS, 2), data
) )
diffInSumCounts <- colSums(diffInCounts) diffInSumCounts <- colSums(diffInCounts)
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm) new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)