236 lines
No EOL
8.2 KiB
R
236 lines
No EOL
8.2 KiB
R
#' @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)
|
||
}
|
||
|
||
|
||
laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) {
|
||
# % 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.
|
||
|
||
# global COUNTS; global SUMCOUNTS;
|
||
# global PARTITION; global POP_LOGML;
|
||
# global LOGDIFF;
|
||
|
||
# npops = size(COUNTS,3);
|
||
# muutokset = LOGDIFF(ind,:);
|
||
|
||
# i1 = PARTITION(ind);
|
||
# i1_logml = POP_LOGML(i1);
|
||
# muutokset(i1) = 0;
|
||
|
||
# rows = globalRows(ind,1):globalRows(ind,2);
|
||
# diffInCounts = computeDiffInCounts(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 = find(muutokset==-Inf); % Etsit<69><74>n populaatiot jotka muuttuneet viime kerran j<>lkeen.
|
||
# i2 = setdiff(i2,i1);
|
||
# i2_logml = POP_LOGML(i2);
|
||
|
||
# ni2 = length(i2);
|
||
|
||
# COUNTS(:,:,i2) = COUNTS(:,:,i2)+repmat(diffInCounts, [1 1 ni2]);
|
||
# SUMCOUNTS(i2,:) = SUMCOUNTS(i2,:)+repmat(diffInSumCounts,[ni2 1]);
|
||
# 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))
|
||
}
|
||
|
||
# %------------------------------------------------------------------------------------
|
||
|
||
|
||
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.
|
||
|
||
# global COUNTS; global SUMCOUNTS;
|
||
# global PARTITION; global POP_LOGML;
|
||
# npops = size(COUNTS,3);
|
||
# muutokset = zeros(npops,1);
|
||
|
||
# i1_logml = POP_LOGML(i1);
|
||
|
||
# inds = find(PARTITION==i1);
|
||
# ninds = length(inds);
|
||
|
||
# if ninds==0
|
||
# diffInCounts = zeros(size(COUNTS,1), size(COUNTS,2));
|
||
# return;
|
||
# end
|
||
|
||
# rows = [];
|
||
# for i = 1:ninds
|
||
# ind = inds(i);
|
||
# lisa = globalRows(ind,1):globalRows(ind,2);
|
||
# rows = [rows; lisa'];
|
||
# %rows = [rows; globalRows{ind}'];
|
||
# end
|
||
|
||
# diffInCounts = computeDiffInCounts(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 = [1:i1-1 , i1+1:npops];
|
||
# i2_logml = POP_LOGML(i2);
|
||
|
||
# COUNTS(:,:,i2) = COUNTS(:,:,i2)+repmat(diffInCounts, [1 1 npops-1]);
|
||
# SUMCOUNTS(i2,:) = SUMCOUNTS(i2,:)+repmat(diffInSumCounts,[npops-1 1]);
|
||
# new_i2_logml = computePopulationLogml(i2, adjprior, priorTerm);
|
||
# COUNTS(:,:,i2) = COUNTS(:,:,i2)-repmat(diffInCounts, [1 1 npops-1]);
|
||
# SUMCOUNTS(i2,:) = SUMCOUNTS(i2,:)-repmat(diffInSumCounts,[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(find(T2==i)) siirret<65><74>n koriin j.
|
||
|
||
# global COUNTS; global SUMCOUNTS;
|
||
# global PARTITION; global POP_LOGML;
|
||
# npops = size(COUNTS,3);
|
||
# npops2 = length(unique(T2));
|
||
# muutokset = zeros(npops2, npops);
|
||
|
||
# i1_logml = POP_LOGML(i1);
|
||
# for pop2 = 1:npops2
|
||
# inds = inds2(find(T2==pop2));
|
||
# ninds = length(inds);
|
||
# if ninds>0
|
||
# rows = [];
|
||
# for i = 1:ninds
|
||
# ind = inds(i);
|
||
# lisa = globalRows(ind,1):globalRows(ind,2);
|
||
# rows = [rows; lisa'];
|
||
# %rows = [rows; globalRows{ind}'];
|
||
# end
|
||
# diffInCounts = computeDiffInCounts(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 = [1:i1-1 , i1+1:npops];
|
||
# i2_logml = POP_LOGML(i2)';
|
||
|
||
# COUNTS(:,:,i2) = COUNTS(:,:,i2)+repmat(diffInCounts, [1 1 npops-1]);
|
||
# SUMCOUNTS(i2,:) = SUMCOUNTS(i2,:)+repmat(diffInSumCounts,[npops-1 1]);
|
||
# new_i2_logml = computePopulationLogml(i2, adjprior, priorTerm)';
|
||
# COUNTS(:,:,i2) = COUNTS(:,:,i2)-repmat(diffInCounts, [1 1 npops-1]);
|
||
# SUMCOUNTS(i2,:) = SUMCOUNTS(i2,:)-repmat(diffInSumCounts,[npops-1 1]);
|
||
|
||
# muutokset(pop2,i2) = new_i1_logml - i1_logml ...
|
||
# + new_i2_logml - i2_logml;
|
||
# end
|
||
# end
|
||
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>.
|
||
|
||
# global COUNTS; global SUMCOUNTS;
|
||
# global PARTITION; global POP_LOGML;
|
||
|
||
# ninds = length(inds);
|
||
# muutokset = zeros(ninds,1);
|
||
|
||
# i1_logml = POP_LOGML(i1);
|
||
# i2_logml = POP_LOGML(i2);
|
||
|
||
# for i = 1:ninds
|
||
# ind = inds(i);
|
||
# if PARTITION(ind)==i1
|
||
# pop1 = i1; %mist<73>
|
||
# pop2 = i2; %mihin
|
||
# else
|
||
# pop1 = i2;
|
||
# pop2 = i1;
|
||
# end
|
||
# 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([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;
|
||
# end
|
||
|
||
# muutokset = muutokset - i1_logml - i2_logml;
|
||
return(muutokset)
|
||
} |