Refactored remaining laskeMuutokset as R6 methods
This commit is contained in:
Waldir Leoncio
parent
c05a500d5f
commit
3efb54d8b5
3 changed files with 354 additions and 162 deletions
22
R/indMix.R
22
R/indMix.R
|
|
@ -142,8 +142,9 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
|
|
||||||
for (ind in inds) {
|
for (ind in inds) {
|
||||||
i1 <- PARTITION[ind]
|
i1 <- PARTITION[ind]
|
||||||
muutokset_diffInCounts <- laskeMuutokset(
|
muutokset_diffInCounts <- greedyMix_muutokset$new()
|
||||||
# FIXME: using 100-length global variables instead of the ones in this function
|
# FIXME: using 100-length global variables instead of the ones in this function
|
||||||
|
muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset(
|
||||||
ind, rows, data, adjprior, priorTerm
|
ind, rows, data, adjprior, priorTerm
|
||||||
)
|
)
|
||||||
muutokset <- muutokset_diffInCounts$muutokset
|
muutokset <- muutokset_diffInCounts$muutokset
|
||||||
|
|
@ -190,7 +191,8 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
} 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 1:npops) {
|
for (pop in 1:npops) {
|
||||||
muutokset_diffInCounts <- laskeMuutokset2(
|
muutokset_diffInCounts <- greedyMix_muutokset$new()
|
||||||
|
muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset2(
|
||||||
pop, rows, data, adjprior, priorTerm
|
pop, rows, data, adjprior, priorTerm
|
||||||
)
|
)
|
||||||
muutokset <- muutokset_diffInCounts$muutokset
|
muutokset <- muutokset_diffInCounts$muutokset
|
||||||
|
|
@ -244,7 +246,8 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
npops2 <- 2 # Moneenko osaan jaetaan
|
npops2 <- 2 # Moneenko osaan jaetaan
|
||||||
}
|
}
|
||||||
T2 <- cluster_own(Z2, npops2)
|
T2 <- cluster_own(Z2, npops2)
|
||||||
muutokset <- laskeMuutokset3(
|
muutokset_diffInCounts <- greedyMix_muutokset$new()
|
||||||
|
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(muutokset)[[1]]
|
||||||
|
|
@ -326,8 +329,8 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
while (length(inds) > 0 & i < length(inds)) {
|
while (length(inds) > 0 & i < length(inds)) {
|
||||||
i <- i + 1
|
i <- i + 1
|
||||||
ind <- inds[i]
|
ind <- inds[i]
|
||||||
|
muutokset_diffInCounts <- greedyMix_muutokset$new()
|
||||||
muutokset_diffInCounts <- laskeMuutokset(
|
muutokset_diffInCounts <- muutokset_diffInCounts$laskeMuutokset(
|
||||||
ind, rows, data, adjprior, priorTerm
|
ind, rows, data, adjprior, priorTerm
|
||||||
)
|
)
|
||||||
muutokset <- muutokset_diffInCounts$muutokset
|
muutokset <- muutokset_diffInCounts$muutokset
|
||||||
|
|
@ -411,8 +414,8 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
Z2 <- linkage(t(dist2))
|
Z2 <- linkage(t(dist2))
|
||||||
T2 <- cluster_own(Z2, 2)
|
T2 <- cluster_own(Z2, 2)
|
||||||
muuttuvat <- inds2[matlab2r::find(T2 == 1)]
|
muuttuvat <- inds2[matlab2r::find(T2 == 1)]
|
||||||
|
muutokset <- greedyMix_muutokset$new()
|
||||||
muutokset <- laskeMuutokset3(
|
muutokset <- muutokset$laskeMuutokset3(
|
||||||
T2, inds2, rows, data, adjprior, priorTerm, pop
|
T2, inds2, rows, data, adjprior, priorTerm, pop
|
||||||
)
|
)
|
||||||
totalMuutos <- muutokset(1, emptyPop)
|
totalMuutos <- muutokset(1, emptyPop)
|
||||||
|
|
@ -436,7 +439,8 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
while (muutettu == 1) {
|
while (muutettu == 1) {
|
||||||
muutettu <- 0
|
muutettu <- 0
|
||||||
# Siirret<65><74>n yksil<69>it<69> populaatioiden v<>lill<6C>
|
# Siirret<65><74>n yksil<69>it<69> populaatioiden v<>lill<6C>
|
||||||
muutokset <- laskeMuutokset5(
|
muutokset <- greedyMix_muutokset$new()
|
||||||
|
muutokset <- muutokset$laskeMuutokset5(
|
||||||
inds2, rows, data, adjprior, priorTerm,
|
inds2, rows, data, adjprior, priorTerm,
|
||||||
pop, emptyPop
|
pop, emptyPop
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,4 @@
|
||||||
#' @title Calculate changes (spatial mixture class)
|
#' @title Calculate changes (spatial mixture class)
|
||||||
#' @importFrom R6 R6Class
|
|
||||||
spatialMixture_muutokset <- R6Class(
|
spatialMixture_muutokset <- R6Class(
|
||||||
classname = "spatialMixture_muutokset",
|
classname = "spatialMixture_muutokset",
|
||||||
public = list(
|
public = list(
|
||||||
|
|
@ -66,123 +65,89 @@ admix1_muutokset <- R6Class(
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
#' @title Calculate changes (greedyMix class)
|
||||||
|
#' @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.
|
||||||
|
#' diffInCounts on poistettava COUNTS:in siivusta i1 ja lis<69>tt<74>v<EFBFBD>
|
||||||
|
#' COUNTS:in siivuun i2, mik<69>li muutos toteutetaan.
|
||||||
|
#'
|
||||||
|
#' Lis<69>ys 25.9.2007:
|
||||||
|
#' Otettu k<>ytt<74><74>n globaali muuttuja LOGDIFF, johon on tallennettu muutokset
|
||||||
|
#' logml:ss<73> siirrett<74>ess<73> yksil<69>it<69> toisiin populaatioihin.
|
||||||
|
greedyMix_muutokset <- R6Class(
|
||||||
|
classname = "greedyMix_muutokset",
|
||||||
|
public = list(
|
||||||
|
#' @param ind ind
|
||||||
|
#' @param globalRows globalRows
|
||||||
|
#' @param data data
|
||||||
|
#' @param adjprior adjprior
|
||||||
|
#' @param priorTerm priorTerm
|
||||||
|
laskeMuutokset = function(ind, globalRows, data, adjprior, priorTerm) {
|
||||||
|
npops <- size(COUNTS, 3)
|
||||||
|
muutokset <- LOGDIFF[ind, ]
|
||||||
|
|
||||||
# Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
|
i1 <- PARTITION[ind]
|
||||||
# muutos logml:ss<73>, mik<69>li yksil<69> ind siirret<65><74>n koriin i.
|
i1_logml <- POP_LOGML[i1]
|
||||||
# diffInCounts on poistettava COUNTS:in siivusta i1 ja lis<69>tt<74>v<EFBFBD>
|
muutokset[i1] <- 0
|
||||||
# COUNTS:in siivuun i2, mik<69>li muutos toteutetaan.
|
|
||||||
#
|
|
||||||
# Lis<69>ys 25.9.2007:
|
|
||||||
# Otettu k<>ytt<74><74>n globaali muuttuja LOGDIFF, johon on tallennettu muutokset
|
|
||||||
# logml:ss<73> siirrett<74>ess<73> yksil<69>it<69> toisiin populaatioihin.
|
|
||||||
laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) {
|
|
||||||
npops <- size(COUNTS, 3)
|
|
||||||
muutokset <- LOGDIFF[ind, ]
|
|
||||||
|
|
||||||
i1 <- PARTITION[ind]
|
rows <- globalRows[ind, 1]:globalRows[ind, 2]
|
||||||
i1_logml <- POP_LOGML[i1]
|
diffInCounts <- computeDiffInCounts(
|
||||||
muutokset[i1] <- 0
|
rows, size(COUNTS, 1), size(COUNTS, 2), data
|
||||||
|
)
|
||||||
|
diffInSumCounts <- colSums(diffInCounts)
|
||||||
|
|
||||||
rows <- globalRows[ind, 1]:globalRows[ind, 2]
|
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
|
||||||
diffInCounts <- computeDiffInCounts(
|
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
|
||||||
rows, size(COUNTS, 1), size(COUNTS, 2), data
|
new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
|
||||||
)
|
COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
|
||||||
diffInSumCounts <- colSums(diffInCounts)
|
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
||||||
|
|
||||||
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
|
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)
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
|
i2 <- setdiff(i2, i1)
|
||||||
new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
|
i2_logml <- POP_LOGML[i2]
|
||||||
COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
|
|
||||||
SUMCOUNTS[i1, ] <- 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)
|
ni2 <- length(i2)
|
||||||
i2 <- setdiff(i2, i1)
|
|
||||||
i2_logml <- POP_LOGML[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)
|
||||||
|
COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, ni2))
|
||||||
|
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(ni2, 1))
|
||||||
|
|
||||||
COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, ni2))
|
muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
|
||||||
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(ni2, 1))
|
LOGDIFF[ind, ] <- muutokset
|
||||||
new_i2_logml <- computePopulationLogml(i2, adjprior, priorTerm)
|
return(list(muutokset = muutokset, diffInCounts = diffInCounts))
|
||||||
COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, ni2))
|
},
|
||||||
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(ni2, 1))
|
#' @param i1 i1
|
||||||
|
#' @param globalRows globalRows
|
||||||
|
#' @param data data
|
||||||
|
#' @param adjprior adjprior
|
||||||
|
#' @param priorTerm priorTerm
|
||||||
|
laskeMuutokset2 = function(i1, globalRows, data, adjprior, priorTerm) {
|
||||||
|
# % Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
|
||||||
|
# % muutos logml:ss<73>, mik<69>li korin i1 kaikki yksil<69>t siirret<65><74>n
|
||||||
|
# % koriin i.
|
||||||
|
|
||||||
muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
|
npops <- size(COUNTS, 3)
|
||||||
LOGDIFF[ind, ] <- muutokset
|
muutokset <- zeros(npops, 1)
|
||||||
return(list(muutokset = muutokset, diffInCounts = diffInCounts))
|
|
||||||
}
|
|
||||||
|
|
||||||
laskeMuutokset2 <- function(i1, globalRows, data, adjprior, priorTerm) {
|
i1_logml <- POP_LOGML[i1]
|
||||||
# % Palauttaa npops*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
|
|
||||||
# % muutos logml:ss<73>, mik<69>li korin i1 kaikki yksil<69>t siirret<65><74>n
|
|
||||||
# % koriin i.
|
|
||||||
|
|
||||||
npops <- size(COUNTS, 3)
|
inds <- matlab2r::find(PARTITION == i1)
|
||||||
muutokset <- zeros(npops, 1)
|
ninds <- length(inds)
|
||||||
|
|
||||||
i1_logml <- POP_LOGML[i1]
|
if (ninds == 0) {
|
||||||
|
diffInCounts <- zeros(size(COUNTS, 1), size(COUNTS, 2))
|
||||||
|
return()
|
||||||
|
}
|
||||||
|
|
||||||
inds <- matlab2r::find(PARTITION == i1)
|
|
||||||
ninds <- length(inds)
|
|
||||||
|
|
||||||
if (ninds == 0) {
|
|
||||||
diffInCounts <- zeros(size(COUNTS, 1), size(COUNTS, 2))
|
|
||||||
return()
|
|
||||||
}
|
|
||||||
|
|
||||||
rows <- list()
|
|
||||||
for (i in 1:ninds) {
|
|
||||||
ind <- inds(i)
|
|
||||||
lisa <- globalRows(ind, 1):globalRows(ind, 2)
|
|
||||||
rows <- c(rows, t(lisa))
|
|
||||||
}
|
|
||||||
|
|
||||||
diffInCounts <- computeDiffInCounts(
|
|
||||||
t(rows), size(COUNTS, 1), size(COUNTS, 2), data
|
|
||||||
)
|
|
||||||
diffInSumCounts <- sum(diffInCounts)
|
|
||||||
|
|
||||||
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
|
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
|
|
||||||
new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
|
|
||||||
COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
|
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
|
||||||
|
|
||||||
i2 <- c(1:i1 - 1, i1 + 1:npops)
|
|
||||||
i2_logml <- POP_LOGML[i2]
|
|
||||||
|
|
||||||
COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
|
|
||||||
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(npops - 1, 1))
|
|
||||||
new_i2_logml <- 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))
|
|
||||||
|
|
||||||
muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
|
|
||||||
return(list(muutokset = muutokset, diffInCounts = diffInCounts))
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
laskeMuutokset3 <- function(T2, inds2, globalRows, data, adjprior, priorTerm, i1
|
|
||||||
) {
|
|
||||||
# Palauttaa length(unique(T2))*npops taulun, jossa (i,j):s alkio
|
|
||||||
# kertoo, mik<69> olisi muutos logml:ss<73>, jos populaation i1 osapopulaatio
|
|
||||||
# inds2(matlab2r::find(T2==i)) siirret<65><74>n koriin j.
|
|
||||||
|
|
||||||
npops <- size(COUNTS, 3)
|
|
||||||
npops2 <- length(unique(T2))
|
|
||||||
muutokset <- zeros(npops2, npops)
|
|
||||||
|
|
||||||
i1_logml <- POP_LOGML[i1]
|
|
||||||
for (pop2 in 1:npops2) {
|
|
||||||
inds <- inds2[matlab2r::find(T2 == pop2)]
|
|
||||||
ninds <- length(inds)
|
|
||||||
if (ninds > 0) {
|
|
||||||
rows <- list()
|
rows <- list()
|
||||||
for (i in 1:ninds) {
|
for (i in 1: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))
|
||||||
}
|
}
|
||||||
|
|
||||||
diffInCounts <- computeDiffInCounts(
|
diffInCounts <- computeDiffInCounts(
|
||||||
t(rows), size(COUNTS, 1), size(COUNTS, 2), data
|
t(rows), size(COUNTS, 1), size(COUNTS, 2), data
|
||||||
)
|
)
|
||||||
|
|
@ -195,61 +160,121 @@ laskeMuutokset3 <- function(T2, inds2, globalRows, data, adjprior, priorTerm, i1
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
||||||
|
|
||||||
i2 <- c(1:i1 - 1, i1 + 1:npops)
|
i2 <- c(1:i1 - 1, i1 + 1:npops)
|
||||||
i2_logml <- t(POP_LOGML[i2])
|
i2_logml <- POP_LOGML[i2]
|
||||||
|
|
||||||
COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
|
COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
|
||||||
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(npops - 1, 1))
|
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + repmat(diffInSumCounts, c(npops - 1, 1))
|
||||||
new_i2_logml <- t(computePopulationLogml(i2, adjprior, priorTerm))
|
new_i2_logml <- computePopulationLogml(i2, adjprior, priorTerm)
|
||||||
COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, npops - 1))
|
COUNTS[, , i2] <- COUNTS[, , i2] - repmat(diffInCounts, c(1, 1, npops - 1))
|
||||||
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(npops - 1, 1))
|
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] - repmat(diffInSumCounts, c(npops - 1, 1))
|
||||||
|
|
||||||
muutokset[pop2, i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
|
muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
|
||||||
|
return(list(muutokset = muutokset, diffInCounts = diffInCounts))
|
||||||
|
},
|
||||||
|
#' @param T2 T2
|
||||||
|
#' @param inds2 inds2
|
||||||
|
#' @param globalRows globalRows
|
||||||
|
#' @param data data
|
||||||
|
#' @param adjprior adjprior
|
||||||
|
#' @param priorTerm priorTerm
|
||||||
|
#' @param i1 i1
|
||||||
|
laskeMuutokset3 = function(
|
||||||
|
T2, inds2, globalRows, data, adjprior, priorTerm, i1
|
||||||
|
) {
|
||||||
|
# Palauttaa length(unique(T2))*npops taulun, jossa (i,j):s alkio
|
||||||
|
# kertoo, mik<69> olisi muutos logml:ss<73>, jos populaation i1 osapopulaatio
|
||||||
|
# inds2(matlab2r::find(T2==i)) siirret<65><74>n koriin j.
|
||||||
|
|
||||||
|
npops <- size(COUNTS, 3)
|
||||||
|
npops2 <- length(unique(T2))
|
||||||
|
muutokset <- zeros(npops2, npops)
|
||||||
|
|
||||||
|
i1_logml <- POP_LOGML[i1]
|
||||||
|
for (pop2 in 1:npops2) {
|
||||||
|
inds <- inds2[matlab2r::find(T2 == pop2)]
|
||||||
|
ninds <- length(inds)
|
||||||
|
if (ninds > 0) {
|
||||||
|
rows <- list()
|
||||||
|
for (i in 1:ninds) {
|
||||||
|
ind <- inds[i]
|
||||||
|
lisa <- globalRows[ind, 1]:globalRows[ind, 2]
|
||||||
|
rows <- c(rows, t(lisa))
|
||||||
|
}
|
||||||
|
diffInCounts <- computeDiffInCounts(
|
||||||
|
t(rows), size(COUNTS, 1), size(COUNTS, 2), data
|
||||||
|
)
|
||||||
|
diffInSumCounts <- sum(diffInCounts)
|
||||||
|
|
||||||
|
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
|
||||||
|
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
|
||||||
|
new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
|
||||||
|
COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
|
||||||
|
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
||||||
|
|
||||||
|
i2 <- c(1:i1 - 1, i1 + 1:npops)
|
||||||
|
i2_logml <- t(POP_LOGML[i2])
|
||||||
|
|
||||||
|
COUNTS[, , i2] <- COUNTS[, , i2] + repmat(diffInCounts, c(1, 1, npops - 1))
|
||||||
|
SUMCOUNTS[i2, ] <- 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))
|
||||||
|
|
||||||
|
muutokset[pop2, i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return(muutokset)
|
||||||
|
},
|
||||||
|
#' @param inds inds
|
||||||
|
#' @param globalRows globalRows
|
||||||
|
#' @param data data
|
||||||
|
#' @param adjprior adjprior
|
||||||
|
#' @param priorTerm priorTerm
|
||||||
|
#' @param i1 i1
|
||||||
|
#' @param i2 i2
|
||||||
|
laskeMuutokset5 = function(inds, globalRows, data, adjprior, priorTerm, i1, i2) {
|
||||||
|
# Palauttaa length(inds)*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
|
||||||
|
# muutos logml:ss<73>, mik<69>li yksil<69> i vaihtaisi koria i1:n ja i2:n v<>lill<6C>.
|
||||||
|
|
||||||
|
ninds <- length(inds)
|
||||||
|
muutokset <- zeros(ninds, 1)
|
||||||
|
|
||||||
|
i1_logml <- POP_LOGML[i1]
|
||||||
|
i2_logml <- POP_LOGML[i2]
|
||||||
|
|
||||||
|
for (i in 1:ninds) {
|
||||||
|
ind <- inds[i]
|
||||||
|
if (PARTITION[ind] == i1) {
|
||||||
|
pop1 <- i1 # mist<73>
|
||||||
|
pop2 <- i2 # mihin
|
||||||
|
} else {
|
||||||
|
pop1 <- i2
|
||||||
|
pop2 <- i1
|
||||||
|
}
|
||||||
|
rows <- globalRows[ind, 1]:globalRows[ind, 2]
|
||||||
|
diffInCounts <- computeDiffInCounts(
|
||||||
|
rows, size(COUNTS, 1), size(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
|
||||||
|
|
||||||
|
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
|
||||||
|
}
|
||||||
|
|
||||||
|
muutokset <- muutokset - i1_logml - i2_logml
|
||||||
|
return(muutokset)
|
||||||
}
|
}
|
||||||
}
|
)
|
||||||
return(muutokset)
|
)
|
||||||
}
|
|
||||||
|
|
||||||
laskeMuutokset5 <- function(inds, globalRows, data, adjprior, priorTerm, i1, i2) {
|
|
||||||
# Palauttaa length(inds)*1 taulun, jossa i:s alkio kertoo, mik<69> olisi
|
|
||||||
# muutos logml:ss<73>, mik<69>li yksil<69> i vaihtaisi koria i1:n ja i2:n v<>lill<6C>.
|
|
||||||
|
|
||||||
ninds <- length(inds)
|
|
||||||
muutokset <- zeros(ninds, 1)
|
|
||||||
|
|
||||||
i1_logml <- POP_LOGML[i1]
|
|
||||||
i2_logml <- POP_LOGML[i2]
|
|
||||||
|
|
||||||
for (i in 1:ninds) {
|
|
||||||
ind <- inds[i]
|
|
||||||
if (PARTITION[ind] == i1) {
|
|
||||||
pop1 <- i1 # mist<73>
|
|
||||||
pop2 <- i2 # mihin
|
|
||||||
} else {
|
|
||||||
pop1 <- i2
|
|
||||||
pop2 <- i1
|
|
||||||
}
|
|
||||||
rows <- globalRows[ind, 1]:globalRows[ind, 2]
|
|
||||||
diffInCounts <- computeDiffInCounts(
|
|
||||||
rows, size(COUNTS, 1), size(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
|
|
||||||
|
|
||||||
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
|
|
||||||
}
|
|
||||||
|
|
||||||
muutokset <- muutokset - i1_logml - i2_logml
|
|
||||||
return(muutokset)
|
|
||||||
}
|
|
||||||
|
|
|
||||||
163
man/greedyMix_muutokset.Rd
Normal file
163
man/greedyMix_muutokset.Rd
Normal file
|
|
@ -0,0 +1,163 @@
|
||||||
|
% Generated by roxygen2: do not edit by hand
|
||||||
|
% Please edit documentation in R/laskeMuutokset12345.R
|
||||||
|
\name{greedyMix_muutokset}
|
||||||
|
\alias{greedyMix_muutokset}
|
||||||
|
\title{Calculate changes (greedyMix class)}
|
||||||
|
\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.
|
||||||
|
diffInCounts on poistettava COUNTS:in siivusta i1 ja lis<69>tt<74>v<EFBFBD>
|
||||||
|
COUNTS:in siivuun i2, mik<69>li muutos toteutetaan.
|
||||||
|
|
||||||
|
Lis<EFBFBD>ys 25.9.2007:
|
||||||
|
Otettu k<>ytt<74><74>n globaali muuttuja LOGDIFF, johon on tallennettu muutokset
|
||||||
|
logml:ss<73> siirrett<74>ess<73> yksil<69>it<69> toisiin populaatioihin.
|
||||||
|
}
|
||||||
|
\section{Methods}{
|
||||||
|
\subsection{Public methods}{
|
||||||
|
\itemize{
|
||||||
|
\item \href{#method-greedyMix_muutokset-laskeMuutokset}{\code{greedyMix_muutokset$laskeMuutokset()}}
|
||||||
|
\item \href{#method-greedyMix_muutokset-laskeMuutokset2}{\code{greedyMix_muutokset$laskeMuutokset2()}}
|
||||||
|
\item \href{#method-greedyMix_muutokset-laskeMuutokset3}{\code{greedyMix_muutokset$laskeMuutokset3()}}
|
||||||
|
\item \href{#method-greedyMix_muutokset-laskeMuutokset5}{\code{greedyMix_muutokset$laskeMuutokset5()}}
|
||||||
|
\item \href{#method-greedyMix_muutokset-clone}{\code{greedyMix_muutokset$clone()}}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
\if{html}{\out{<hr>}}
|
||||||
|
\if{html}{\out{<a id="method-greedyMix_muutokset-laskeMuutokset"></a>}}
|
||||||
|
\if{latex}{\out{\hypertarget{method-greedyMix_muutokset-laskeMuutokset}{}}}
|
||||||
|
\subsection{Method \code{laskeMuutokset()}}{
|
||||||
|
\subsection{Usage}{
|
||||||
|
\if{html}{\out{<div class="r">}}\preformatted{greedyMix_muutokset$laskeMuutokset(ind, globalRows, data, adjprior, priorTerm)}\if{html}{\out{</div>}}
|
||||||
|
}
|
||||||
|
|
||||||
|
\subsection{Arguments}{
|
||||||
|
\if{html}{\out{<div class="arguments">}}
|
||||||
|
\describe{
|
||||||
|
\item{\code{ind}}{ind}
|
||||||
|
|
||||||
|
\item{\code{globalRows}}{globalRows}
|
||||||
|
|
||||||
|
\item{\code{data}}{data}
|
||||||
|
|
||||||
|
\item{\code{adjprior}}{adjprior}
|
||||||
|
|
||||||
|
\item{\code{priorTerm}}{priorTerm}
|
||||||
|
}
|
||||||
|
\if{html}{\out{</div>}}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
\if{html}{\out{<hr>}}
|
||||||
|
\if{html}{\out{<a id="method-greedyMix_muutokset-laskeMuutokset2"></a>}}
|
||||||
|
\if{latex}{\out{\hypertarget{method-greedyMix_muutokset-laskeMuutokset2}{}}}
|
||||||
|
\subsection{Method \code{laskeMuutokset2()}}{
|
||||||
|
\subsection{Usage}{
|
||||||
|
\if{html}{\out{<div class="r">}}\preformatted{greedyMix_muutokset$laskeMuutokset2(i1, globalRows, data, adjprior, priorTerm)}\if{html}{\out{</div>}}
|
||||||
|
}
|
||||||
|
|
||||||
|
\subsection{Arguments}{
|
||||||
|
\if{html}{\out{<div class="arguments">}}
|
||||||
|
\describe{
|
||||||
|
\item{\code{i1}}{i1}
|
||||||
|
|
||||||
|
\item{\code{globalRows}}{globalRows}
|
||||||
|
|
||||||
|
\item{\code{data}}{data}
|
||||||
|
|
||||||
|
\item{\code{adjprior}}{adjprior}
|
||||||
|
|
||||||
|
\item{\code{priorTerm}}{priorTerm}
|
||||||
|
}
|
||||||
|
\if{html}{\out{</div>}}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
\if{html}{\out{<hr>}}
|
||||||
|
\if{html}{\out{<a id="method-greedyMix_muutokset-laskeMuutokset3"></a>}}
|
||||||
|
\if{latex}{\out{\hypertarget{method-greedyMix_muutokset-laskeMuutokset3}{}}}
|
||||||
|
\subsection{Method \code{laskeMuutokset3()}}{
|
||||||
|
\subsection{Usage}{
|
||||||
|
\if{html}{\out{<div class="r">}}\preformatted{greedyMix_muutokset$laskeMuutokset3(
|
||||||
|
T2,
|
||||||
|
inds2,
|
||||||
|
globalRows,
|
||||||
|
data,
|
||||||
|
adjprior,
|
||||||
|
priorTerm,
|
||||||
|
i1
|
||||||
|
)}\if{html}{\out{</div>}}
|
||||||
|
}
|
||||||
|
|
||||||
|
\subsection{Arguments}{
|
||||||
|
\if{html}{\out{<div class="arguments">}}
|
||||||
|
\describe{
|
||||||
|
\item{\code{T2}}{T2}
|
||||||
|
|
||||||
|
\item{\code{inds2}}{inds2}
|
||||||
|
|
||||||
|
\item{\code{globalRows}}{globalRows}
|
||||||
|
|
||||||
|
\item{\code{data}}{data}
|
||||||
|
|
||||||
|
\item{\code{adjprior}}{adjprior}
|
||||||
|
|
||||||
|
\item{\code{priorTerm}}{priorTerm}
|
||||||
|
|
||||||
|
\item{\code{i1}}{i1}
|
||||||
|
}
|
||||||
|
\if{html}{\out{</div>}}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
\if{html}{\out{<hr>}}
|
||||||
|
\if{html}{\out{<a id="method-greedyMix_muutokset-laskeMuutokset5"></a>}}
|
||||||
|
\if{latex}{\out{\hypertarget{method-greedyMix_muutokset-laskeMuutokset5}{}}}
|
||||||
|
\subsection{Method \code{laskeMuutokset5()}}{
|
||||||
|
\subsection{Usage}{
|
||||||
|
\if{html}{\out{<div class="r">}}\preformatted{greedyMix_muutokset$laskeMuutokset5(
|
||||||
|
inds,
|
||||||
|
globalRows,
|
||||||
|
data,
|
||||||
|
adjprior,
|
||||||
|
priorTerm,
|
||||||
|
i1,
|
||||||
|
i2
|
||||||
|
)}\if{html}{\out{</div>}}
|
||||||
|
}
|
||||||
|
|
||||||
|
\subsection{Arguments}{
|
||||||
|
\if{html}{\out{<div class="arguments">}}
|
||||||
|
\describe{
|
||||||
|
\item{\code{inds}}{inds}
|
||||||
|
|
||||||
|
\item{\code{globalRows}}{globalRows}
|
||||||
|
|
||||||
|
\item{\code{data}}{data}
|
||||||
|
|
||||||
|
\item{\code{adjprior}}{adjprior}
|
||||||
|
|
||||||
|
\item{\code{priorTerm}}{priorTerm}
|
||||||
|
|
||||||
|
\item{\code{i1}}{i1}
|
||||||
|
|
||||||
|
\item{\code{i2}}{i2}
|
||||||
|
}
|
||||||
|
\if{html}{\out{</div>}}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
\if{html}{\out{<hr>}}
|
||||||
|
\if{html}{\out{<a id="method-greedyMix_muutokset-clone"></a>}}
|
||||||
|
\if{latex}{\out{\hypertarget{method-greedyMix_muutokset-clone}{}}}
|
||||||
|
\subsection{Method \code{clone()}}{
|
||||||
|
The objects of this class are cloneable with this method.
|
||||||
|
\subsection{Usage}{
|
||||||
|
\if{html}{\out{<div class="r">}}\preformatted{greedyMix_muutokset$clone(deep = FALSE)}\if{html}{\out{</div>}}
|
||||||
|
}
|
||||||
|
|
||||||
|
\subsection{Arguments}{
|
||||||
|
\if{html}{\out{<div class="arguments">}}
|
||||||
|
\describe{
|
||||||
|
\item{\code{deep}}{Whether to make a deep clone.}
|
||||||
|
}
|
||||||
|
\if{html}{\out{</div>}}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
Loading…
Add table
Reference in a new issue