Merge branch 'unite-laskeMuutokset' into translate-indMix
This commit is contained in:
Waldir Leoncio
commit
c41aacae13
12 changed files with 358 additions and 257 deletions
|
|
@ -23,6 +23,7 @@ export(linkage)
|
|||
export(logml2String)
|
||||
export(lueGenePopData)
|
||||
export(lueNimi)
|
||||
export(max_MATLAB)
|
||||
export(min_MATLAB)
|
||||
export(noIndex)
|
||||
export(ownNum2Str)
|
||||
|
|
@ -34,6 +35,7 @@ export(randdir)
|
|||
export(repmat)
|
||||
export(rivinSisaltamienMjonojenLkm)
|
||||
export(selvitaDigitFormat)
|
||||
export(setdiff_MATLAB)
|
||||
export(simulateAllFreqs)
|
||||
export(simulateIndividuals)
|
||||
export(simuloiAlleeli)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
addToSummary <- funciton(logml, partitionSummary, worstIndex) {
|
||||
addToSummary <- function(logml, partitionSummary, worstIndex) {
|
||||
# Tiedet<65><74>n, ett<74> annettu logml on isompi kuin huonoin arvo
|
||||
# partitionSummary taulukossa. Jos partitionSummary:ss<73> ei viel<65> ole
|
||||
# annettua logml arvoa, niin lis<69>t<EFBFBD><74>n worstIndex:in kohtaan uusi logml ja
|
||||
|
|
@ -6,13 +6,13 @@ addToSummary <- funciton(logml, partitionSummary, worstIndex) {
|
|||
|
||||
apu <- find(abs(partitionSummary[, 2] - logml) < 1e-5)
|
||||
if (isempty(apu)) {
|
||||
# Nyt l<>ydetty partitio ei ole viel<65> kirjattuna summaryyn.
|
||||
npops <- length(unique(PARTITION))
|
||||
partitionSummary[worstIndex, 1] <- npops
|
||||
partitionSummary[worstIndex, 2] <- logml
|
||||
added <- 1
|
||||
# Nyt l<>ydetty partitio ei ole viel<65> kirjattuna summaryyn.
|
||||
npops <- length(unique(PARTITION))
|
||||
partitionSummary[worstIndex, 1] <- npops
|
||||
partitionSummary[worstIndex, 2] <- logml
|
||||
added <- 1
|
||||
} else {
|
||||
added <- 0
|
||||
added <- 0
|
||||
}
|
||||
return(list(partitionSummary = partitionSummary, added = added))
|
||||
}
|
||||
204
R/indMix.R
204
R/indMix.R
|
|
@ -678,57 +678,6 @@ indMix <- function(c, npops, dispText) {
|
|||
|
||||
# %------------------------------------------------------------------------------------
|
||||
|
||||
# function [muutokset, diffInCounts] = ...
|
||||
# laskeMuutokset(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;
|
||||
|
||||
|
||||
# %----------------------------------------------------------------------
|
||||
|
||||
|
||||
# function diffInCounts = computeDiffInCounts(rows, max_noalle, nloci, data)
|
||||
# % Muodostaa max_noalle*nloci taulukon, jossa on niiden alleelien
|
||||
|
|
@ -781,62 +730,6 @@ indMix <- function(c, npops, dispText) {
|
|||
# %--------------------------------------------------------------------------
|
||||
# %--
|
||||
|
||||
# %------------------------------------------------------------------------------------
|
||||
|
||||
|
||||
# function [muutokset, diffInCounts] = laskeMuutokset2( ...
|
||||
# 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;
|
||||
|
||||
|
||||
# %---------------------------------------------------------------------------------
|
||||
|
||||
|
||||
# function updateGlobalVariables2( ...
|
||||
# i1, i2, diffInCounts, adjprior, priorTerm);
|
||||
|
|
@ -864,103 +757,6 @@ indMix <- function(c, npops, dispText) {
|
|||
# inx = [find(PARTITION==i1); find(PARTITION==i2)];
|
||||
# LOGDIFF(inx,:) = -Inf;
|
||||
|
||||
|
||||
# %--------------------------------------------------------------------------
|
||||
# %----
|
||||
|
||||
# function muutokset = laskeMuutokset3(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
|
||||
|
||||
# %------------------------------------------------------------------------------------
|
||||
|
||||
# function muutokset = laskeMuutokset5(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;
|
||||
|
||||
# %------------------------------------------------------------------------------------
|
||||
|
||||
|
||||
|
|
|
|||
227
R/laskeMuutokset12345.R
Normal file
227
R/laskeMuutokset12345.R
Normal file
|
|
@ -0,0 +1,227 @@
|
|||
#' @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.
|
||||
|
||||
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, 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))
|
||||
|
||||
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.
|
||||
|
||||
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()
|
||||
}
|
||||
|
||||
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(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[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)
|
||||
}
|
||||
|
||||
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)
|
||||
}
|
||||
|
|
@ -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)
|
||||
}
|
||||
17
R/setdiff.R
Normal file
17
R/setdiff.R
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
#' @title Set differences of two arrays
|
||||
#' @description Loosely replicates the behavior of the homonym Matlab function
|
||||
#' @param A first array
|
||||
#' @param B second awway
|
||||
#' @param legacy if `TRUE`, preserves the behavior of
|
||||
#' @return
|
||||
#' @author Waldir Leoncio
|
||||
#' @export
|
||||
setdiff_MATLAB <- function(A, B, legacy = FALSE) {
|
||||
if (is(A, "numeric") & is(B, "numeric")) {
|
||||
values <- sort(unique(A[is.na(match(A, B))]))
|
||||
} else if (is(A, "data.frame") & is(B, "data.frame")) {
|
||||
stop("Not implemented for data frames")
|
||||
}
|
||||
# TODO: add support for indices (if necessary)
|
||||
return(values)
|
||||
}
|
||||
11
man/admixture_initialization.Rd
Normal file
11
man/admixture_initialization.Rd
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/admixture_initialization.R
|
||||
\name{admixture_initialization}
|
||||
\alias{admixture_initialization}
|
||||
\title{Seuraavat kolme funktiota liittyvat alkupartition muodostamiseen.}
|
||||
\usage{
|
||||
admixture_initialization(data_matrix, nclusters, Z)
|
||||
}
|
||||
\description{
|
||||
Seuraavat kolme funktiota liittyvat alkupartition muodostamiseen.
|
||||
}
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/laskeMuutokset4.R
|
||||
% Please edit documentation in R/laskeMuutokset12345.R
|
||||
\name{laskeMuutokset4}
|
||||
\alias{laskeMuutokset4}
|
||||
\title{Calculate changes?}
|
||||
|
|
@ -20,6 +20,6 @@ laskeMuutokset4(osuus, osuusTaulu, omaFreqs, logml, COUNTS = matrix(0))
|
|||
\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
|
||||
todennäköisyysmassaa populaatioon j. Mikäli populaatiossa i ei ole mitään
|
||||
siirrettävää, on vastaavassa kohdassa rivi nollia.
|
||||
}
|
||||
|
|
|
|||
22
man/max_MATLAB.Rd
Normal file
22
man/max_MATLAB.Rd
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/min_max_MATLAB.R
|
||||
\name{max_MATLAB}
|
||||
\alias{max_MATLAB}
|
||||
\title{Maximum (MATLAB version)}
|
||||
\usage{
|
||||
max_MATLAB(X, indices = TRUE)
|
||||
}
|
||||
\arguments{
|
||||
\item{X}{matrix}
|
||||
|
||||
\item{indices}{return indices?}
|
||||
}
|
||||
\value{
|
||||
Either a list or a vector
|
||||
}
|
||||
\description{
|
||||
Finds the minimum value for each column of a matrix, potentially returning the indices instead
|
||||
}
|
||||
\author{
|
||||
Waldir Leoncio
|
||||
}
|
||||
|
|
@ -1,11 +1,15 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/min.R, R/min_MATLAB.R
|
||||
% Please edit documentation in R/min.R, R/min_MATLAB.R, R/min_max_MATLAB.R
|
||||
\name{min_MATLAB}
|
||||
\alias{min_MATLAB}
|
||||
\title{Minimum (MATLAB version)}
|
||||
\usage{
|
||||
min_MATLAB(X, indices = TRUE)
|
||||
|
||||
min_MATLAB(X, indices = TRUE)
|
||||
|
||||
min_MATLAB(X, indices = TRUE)
|
||||
|
||||
min_MATLAB(X, indices = TRUE)
|
||||
}
|
||||
\arguments{
|
||||
|
|
@ -16,15 +20,27 @@ min_MATLAB(X, indices = TRUE)
|
|||
\value{
|
||||
Either a list or a vector
|
||||
|
||||
Either a list or a vector
|
||||
|
||||
Either a list or a vector
|
||||
|
||||
Either a list or a vector
|
||||
}
|
||||
\description{
|
||||
Finds the minimum value for each column of a matrix, potentially returning the indices instead
|
||||
|
||||
Finds the minimum value for each column of a matrix, potentially returning the indices instead
|
||||
|
||||
Finds the minimum value for each column of a matrix, potentially returning the indices instead
|
||||
|
||||
Finds the minimum value for each column of a matrix, potentially returning the indices instead
|
||||
}
|
||||
\author{
|
||||
Waldir Leoncio
|
||||
|
||||
Waldir Leoncio
|
||||
|
||||
Waldir Leoncio
|
||||
|
||||
Waldir Leoncio
|
||||
}
|
||||
|
|
|
|||
24
man/setdiff_MATLAB.Rd
Normal file
24
man/setdiff_MATLAB.Rd
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/setdiff.R
|
||||
\name{setdiff_MATLAB}
|
||||
\alias{setdiff_MATLAB}
|
||||
\title{Set differences of two arrays}
|
||||
\usage{
|
||||
setdiff_MATLAB(A, B, legacy = FALSE)
|
||||
}
|
||||
\arguments{
|
||||
\item{A}{first array}
|
||||
|
||||
\item{B}{second awway}
|
||||
|
||||
\item{legacy}{if `TRUE`, preserves the behavior of}
|
||||
}
|
||||
\value{
|
||||
|
||||
}
|
||||
\description{
|
||||
Loosely replicates the behavior of the homonym Matlab function
|
||||
}
|
||||
\author{
|
||||
Waldir Leoncio
|
||||
}
|
||||
|
|
@ -158,12 +158,13 @@ test_that("find works as expected", {
|
|||
})
|
||||
|
||||
test_that("sortrows works as expected", {
|
||||
mx <- matrix(c(3, 2, 2, 1, 1, 10, 0, pi), 4)
|
||||
expect_equal(sortrows(mx), matrix(c(1, 2, 2, 3, pi, 10, 0, 1), 4))
|
||||
expect_equal(sortrows(mx, 2), matrix(c(2, 3, 1, 2, 0, 1, pi, 10), 4))
|
||||
expect_equal(sortrows(mx, 1:2), mx[order(mx[, 1], mx[, 2]), ])
|
||||
mx <- matrix(c(3, 2, 2, 1, 1, 10, 0, pi), 4)
|
||||
expect_equal(sortrows(mx), matrix(c(1, 2, 2, 3, pi, 10, 0, 1), 4))
|
||||
expect_equal(sortrows(mx, 2), matrix(c(2, 3, 1, 2, 0, 1, pi, 10), 4))
|
||||
expect_equal(sortrows(mx, 1:2), mx[order(mx[, 1], mx[, 2]), ])
|
||||
})
|
||||
|
||||
# FIXME: failing tests
|
||||
test_that("cell works as expected", {
|
||||
expect_equal(cell(0), array(dim = c(0, 0)))
|
||||
expect_equal(cell(1), array(dim = c(1, 1)))
|
||||
|
|
@ -217,4 +218,28 @@ test_that("nargin works correctly", {
|
|||
expect_equal(addme(13, 42), 55)
|
||||
expect_equal(addme(13), 26)
|
||||
expect_equal(addme(), 0)
|
||||
})
|
||||
|
||||
test_that("setdiff works as expected", {
|
||||
A <- c(3, 6, 2, 1, 5, 1, 1)
|
||||
B <- c(2, 4, 6)
|
||||
C <- c(1, 3, 5)
|
||||
expect_equal(setdiff(A, B), C)
|
||||
A <- data.frame(
|
||||
Var1 = 1:5,
|
||||
Var2 = LETTERS[1:5],
|
||||
Var3 = c(FALSE, TRUE, FALSE, TRUE, FALSE)
|
||||
)
|
||||
B <- data.frame(
|
||||
Var1 = seq(1, 9, by = 2),
|
||||
Var2 = LETTERS[seq(1, 9, by = 2)],
|
||||
Var3 = rep(FALSE, 5)
|
||||
)
|
||||
C <- data.frame(
|
||||
Var1 = c(2, 4),
|
||||
Var2 = c('B', 'D'),
|
||||
Var3 = c(TRUE, TRUE)
|
||||
)
|
||||
expect_equal(setdiff(A, B), C)
|
||||
# TODO: add more examples from https://se.mathworks.com/help/matlab/ref/double.setdiff.html;jsessionid=0d8d42582d4d299b8224403899f1
|
||||
})
|
||||
Loading…
Add table
Reference in a new issue