ourMELONS/R/computePopulationLogml.R

41 lines
1.2 KiB
R
Raw Normal View History

2021-02-15 09:49:21 +01:00
computePopulationLogml <- function(pops, adjprior, priorTerm) {
# Palauttaa length(pops)*1 taulukon, jossa on laskettu korikohtaiset
2020-10-19 14:08:25 +02:00
# ======================================================== #
# Limiting COUNTS size #
# ======================================================== #
2022-07-28 15:47:36 +02:00
COUNTS <- COUNTS[
seq_len(nrow(adjprior)), seq_len(ncol(adjprior)), pops, drop = FALSE
]
2021-02-01 09:22:58 +01:00
x <- size(COUNTS, 1)
y <- size(COUNTS, 2)
z <- length(pops)
2020-10-19 14:08:25 +02:00
# ======================================================== #
# Computation #
# ======================================================== #
isarray <- length(dim(repmat(adjprior, c(1, 1, length(pops))))) > 2
term1 <- squeeze(
sum(
sum(
reshape(
lgamma(
repmat(adjprior, c(1, 1, length(pops))) +
2022-07-28 15:47:36 +02:00
COUNTS[
seq_len(nrow(adjprior)), seq_len(ncol(adjprior)), pops,
drop = !isarray
]
),
c(x, y, z)
),
1
),
2
)
)
if (is.null(priorTerm)) priorTerm <- 0
popLogml <- term1 - sum(lgamma(1 + SUMCOUNTS[pops, ]), 2) - priorTerm
return(popLogml)
}