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

Translated laskeMuutokset1

Browse source
This commit is contained in:
Waldir Leoncio 2020-10-19 14:36:21 +02:00
parent f381207950
commit f28bf5d763
2 changed files with 34 additions and 76 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

71
R/laskeMuutokset12345.R
View file

@ -40,51 +40,48 @@ laskeMuutokset4 <- function (osuus, osuusTaulu, omaFreqs, logml,
laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) { laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) {
# % 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 COUNTS:in siivusta i1 ja lis<69>tt<74>v<EFBFBD>
# % COUNTS:in siivuun i2, mik<69>li muutos toteutetaan. # 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
# % logml:ss<73> siirrett<74>ess<73> yksil<69>it<69> toisiin populaatioihin. # logml:ss<73> siirrett<74>ess<73> yksil<69>it<69> toisiin populaatioihin.
# global COUNTS; global SUMCOUNTS; npops <- size(COUNTS, 3)
# global PARTITION; global POP_LOGML; muutokset <- LOGDIFF[ind, ]
# global LOGDIFF;
# npops = size(COUNTS,3); i1 <- PARTITION[ind]
# muutokset = LOGDIFF(ind,:); i1_logml <- POP_LOGML[i1]
muutokset[i1] <- 0
# 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 <- sum(diffInCounts)
# rows = globalRows(ind,1):globalRows(ind,2); COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
# diffInCounts = computeDiffInCounts(rows, size(COUNTS,1), size(COUNTS,2), data); SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - diffInSumCounts
# diffInSumCounts = sum(diffInCounts); new_i1_logml <- computePopulationLogml(i1, adjprior, priorTerm)
COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
# COUNTS(:,:,i1) = COUNTS(:,:,i1)-diffInCounts; i2 <- find(muutokset == -Inf) # Etsit<69><74>n populaatiot jotka muuttuneet viime kerran j<>lkeen.
# 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 = find(muutokset==-Inf); % Etsit<69><74>n populaatiot jotka muuttuneet viime kerran j<>lkeen. 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, [1 1 ni2]); muutokset[i2] <- new_i1_logml - i1_logml + new_i2_logml - i2_logml
# SUMCOUNTS(i2,:) = SUMCOUNTS(i2,:)+repmat(diffInSumCounts,[ni2 1]); LOGDIFF[ind, ] = muutokset
# new_i2_logml = computePopulationLogml(i2, adjprior, priorTerm);
# COUNTS(:,:,i2) = COUNTS(:,:,i2)-repmat(diffInCounts, [1 1 ni2]);
# SUMCOUNTS(i2,:) = SUMCOUNTS(i2,:)-repmat(diffInSumCounts,[ni2 1]);
# muutokset(i2) = new_i1_logml - i1_logml ...
# + new_i2_logml - i2_logml;
# LOGDIFF(ind,:) = muutokset;
return(list(muutokset = muutokset, diffInCounts = diffInCounts)) return(list(muutokset = muutokset, diffInCounts = diffInCounts))
} }

39
R/laskeMuutokset4.R
View file

@ -1,39 +0,0 @@
#' @title Calculate changes?
#' @description Palauttaa npops*npops taulun, jonka alkio (i,j) kertoo, mik?on
#' muutos logml:ss? mikäli populaatiosta i siirretään osuuden verran
#' todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään
#' siirrettävää, on vastaavassa kohdassa rivi nollia.
#' @param osuus Percentages?
#' @param omaFreqs own Freqs?
#' @param osuusTaulu Percentage table?
#' @param logml log maximum likelihood
#' @param COUNTS COUNTS
#' @export
laskeMuutokset4 <- function (osuus, osuusTaulu, omaFreqs, logml,
COUNTS = matrix(0)) {
npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
notEmpty <- which(osuusTaulu > 0.005)
muutokset <- zeros(npops)
empties <- !notEmpty
for (i1 in notEmpty) {
osuusTaulu[i1] <- osuusTaulu[i1] - osuus
for (i2 in c(colon(1, i1 - 1), colon(i1 + 1, npops))) {
osuusTaulu[i2] <- osuusTaulu[i2] + osuus
loggis <- computeIndLogml(omaFreqs, osuusTaulu)
# Work around Matlab OOB bug
if (i1 > nrow(muutokset)) {
muutokset <- rbind(muutokset, muutokset * 0)
}
if (i2 > ncol(muutokset)) {
muutokset <- cbind(muutokset, muutokset * 0)
}
muutokset[i1, i2] <- loggis - logml
osuusTaulu[i2] <- osuusTaulu[i2] - osuus
}
osuusTaulu[i1] <- osuusTaulu[i1] + osuus
}
return (muutokset)
}