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

Worked around Matlab OOB bug

Browse source
This commit is contained in:
Waldir Leoncio 2020-01-15 16:22:21 +01:00
parent f9a344ad88
commit 1ad6616187
1 changed files with 12 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
R/laskeMuutokset4.R
View file

@ -1,4 +1,4 @@
#' @title laskeMuutokset4 #' @title Calculate changes?
#' @description Palauttaa npops*npops taulun, jonka alkio (i,j) kertoo, mik?on #' @description Palauttaa npops*npops taulun, jonka alkio (i,j) kertoo, mik?on
#' muutos logml:ss? mikäli populaatiosta i siirretään osuuden verran #' muutos logml:ss? mikäli populaatiosta i siirretään osuuden verran
#' todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään #' todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään
@ -12,15 +12,24 @@
laskeMuutokset4 <- function (osuus, osuusTaulu, omaFreqs, logml, laskeMuutokset4 <- function (osuus, osuusTaulu, omaFreqs, logml,
COUNTS = matrix(0)) { COUNTS = matrix(0)) {
npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3]) npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
notEmpty <- osuusTaulu > 0.005 notEmpty <- which(osuusTaulu > 0.005)
muutokset <- zeros(npops) muutokset <- zeros(npops)
empties <- !notEmpty empties <- !notEmpty
for (i1 in notEmpty) { for (i1 in notEmpty) {
osuusTaulu[i1] <- osuusTaulu[i1] - osuus osuusTaulu[i1] <- osuusTaulu[i1] - osuus
for (i2 in c(1:(i1 - 1), (i1 + 1):npops)) { for (i2 in c(colon(1, i1 - 1), colon(i1 + 1, npops))) {
osuusTaulu[i2] <- osuusTaulu[i2] + osuus osuusTaulu[i2] <- osuusTaulu[i2] + osuus
loggis <- computeIndLogml(omaFreqs, osuusTaulu) 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 muutokset[i1, i2] <- loggis - logml
osuusTaulu[i2] <- osuusTaulu[i2] - osuus osuusTaulu[i2] <- osuusTaulu[i2] - osuus
} }