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

Using a dedicated environment for globals (#24)

Browse source 
Based on suggestion from <https://stackoverflow.com/a/12605694/1169233>.
This commit is contained in:
Waldir Leoncio 2024-04-10 14:23:09 +02:00
parent 55d302ab67
commit 5deadcf3ee
3 changed files with 31 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
R/globals.R
View file

@ -1,11 +1,10 @@
COUNTS <- array(0, dim = c(100, 100, 100)) baps.globals <- new.env(parent = emptyenv())
SUMCOUNTS <- array(0, dim = c(100, 100))
PARTITION <- array(1, dim = 100)
POP_LOGML <- array(1, dim = 100)
LOGDIFF <- array(1, dim = c(100, 100))
# If handling globas break, try other ideas from
# https://stackoverflow.com/a/65252740/1169233
utils::globalVariables( assign("COUNTS", array(0, dim = c(0, 0, 0)), envir = baps.globals)
c("PARTITION", "COUNTS", "SUMCOUNTS", "LOGDIFF", "POP_LOGML", "GAMMA_LN") assign("SUMCOUNTS", array(0, dim = c(0, 0)), envir = baps.globals)
) assign("PARTITION", array(1, dim = 0), envir = baps.globals)
assign("POP_LOGML", array(1, dim = 0), envir = baps.globals)
assign("LOGDIFF", array(1, dim = c(0, 0)), envir = baps.globals)
# If handling globas break, try other ideas from
# https://stackoverflow.com/a/65252740/1169233 and
# https://stackoverflow.com/questions/12598242/

15
R/indMix.R
View file

@ -4,7 +4,6 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
# Input npops is not used if called by greedyMix or greedyPopMix. # Input npops is not used if called by greedyMix or greedyPopMix.
logml <- 1 logml <- 1
clearGlobalVars()
noalle <- c$noalle noalle <- c$noalle
rows <- c$rows rows <- c$rows
@ -94,16 +93,16 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
counts <- sumcounts_counts_logml$counts counts <- sumcounts_counts_logml$counts
logml <- sumcounts_counts_logml$logml logml <- sumcounts_counts_logml$logml
PARTITION <- zeros(ninds, 1) assign("PARTITION", zeros(ninds, 1), baps.globals)
for (i in seq_len(ninds)) { for (i in seq_len(ninds)) {
apu <- rows[i] apu <- rows[i]
PARTITION[i] <- initialPartition[apu[1]] baps.globals$PARTITION[i] <- initialPartition[apu[1]]
} }
COUNTS <- counts assign("COUNTS", counts, baps.globals)
SUMCOUNTS <- sumcounts assign("SUMCOUNTS", sumcounts, baps.globals)
POP_LOGML <- computePopulationLogml(seq_len(npops), adjprior, priorTerm) assign("POP_LOGML", computePopulationLogml(seq_len(npops), adjprior, priorTerm), baps.globals)
LOGDIFF <- repmat(-Inf, c(ninds, npops)) assign("LOGDIFF", matrix(-Inf, nrow = ninds, ncol = npops), baps.globals)
# PARHAAN MIXTURE-PARTITION ETSIMINEN # PARHAAN MIXTURE-PARTITION ETSIMINEN
nRoundTypes <- 7 nRoundTypes <- 7
@ -147,7 +146,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
muutosNyt <- 0 muutosNyt <- 0
for (ind in inds) { for (ind in inds) {
i1 <- PARTITION[ind] i1 <- baps.globals$PARTITION[ind]
muutokset_diffInCounts <- greedyMix_muutokset$new() muutokset_diffInCounts <- greedyMix_muutokset$new()
muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset( muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset(
ind, rows, data, adjprior, priorTerm ind, rows, data, adjprior, priorTerm

29
R/laskeMuutokset12345.R
View file

@ -343,10 +343,10 @@ greedyMix_muutokset <- R6Class(
#' @param priorTerm priorTerm #' @param priorTerm priorTerm
laskeMuutokset = function(ind, globalRows, data, adjprior, priorTerm) { laskeMuutokset = function(ind, globalRows, data, adjprior, priorTerm) {
npops <- size(COUNTS, 3) npops <- size(COUNTS, 3)
muutokset <- LOGDIFF[ind, ] muutokset <- baps.globals$LOGDIFF[ind, ]
i1 <- PARTITION[ind] i1 <- baps.globals$PARTITION[ind]
i1_logml <- POP_LOGML[i1] i1_logml <- baps.globals$POP_LOGML[i1]
muutokset[i1] <- 0 muutokset[i1] <- 0
if (is.null(dim(globalRows))) { if (is.null(dim(globalRows))) {
@ -355,29 +355,30 @@ 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(baps.globals$COUNTS, 1), size(baps.globals$COUNTS, 2), data
diffInSumCounts <- colSums(diffInCounts) diffInSumCounts <- colSums(diffInCounts)
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm) new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts browser() # TEMP. Tip: browserText()
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts baps.globals$COUNTS[, , i1] <- baps.globals$COUNTS[, , i1] - diffInCounts
baps.globals$SUMCOUNTS[i1, ] <- baps.globals$SUMCOUNTS[i1, ] - diffInSumCounts
baps.globals$COUNTS[, , i1] <- baps.globals$COUNTS[, , i1] + diffInCounts
baps.globals$SUMCOUNTS[i1, ] <- baps.globals$SUMCOUNTS[i1, ] + diffInSumCounts
i2 <- matlab2r::find(muutokset == -Inf) # Etsit<69><74>n populaatiot jotka muuttuneet viime kerran j<>lkeen. (Searching for populations that have changed since the last time) i2 <- matlab2r::find(muutokset == -Inf) # Etsit<69><74>n populaatiot jotka muuttuneet viime kerran j<>lkeen. (Searching for populations that have changed since the last time)
i2 <- setdiff(i2, i1) i2 <- setdiff(i2, i1)
i2_logml <- POP_LOGML[i2] i2_logml <- baps.globals$POP_LOGML[i2]
ni2 <- length(i2) ni2 <- length(i2)
COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, ni2))
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(ni2, 1))
new_i2_logml <- computePopulationLogml(i2, adjprior, priorTerm) new_i2_logml <- computePopulationLogml(i2, adjprior, priorTerm)
COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, ni2)) baps.globals$COUNTS[, , i2] <- baps.globals$COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, ni2))
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(ni2, 1)) baps.globals$SUMCOUNTS[i2, ] <- baps.globals$SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(ni2, 1))
baps.globals$COUNTS[, , i2] <- baps.globals$COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, ni2))
baps.globals$SUMCOUNTS[i2, ] <- baps.globals$SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(ni2, 1))
muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
LOGDIFF[ind, ] <- muutokset baps.globals$LOGDIFF[ind, ] <- muutokset
return(list(muutokset = muutokset, diffInCounts = diffInCounts)) return(list(muutokset = muutokset, diffInCounts = diffInCounts))
}, },
#' @param i1 i1 #' @param i1 i1