Resolved conflicts involving homonymous functions
This commit is contained in:
parent
b872760f81
commit
9ad4fa8c76
26 changed files with 92 additions and 90 deletions
|
|
@ -36,7 +36,6 @@ export(takeLine)
|
||||||
export(testaaOnkoKunnollinenBapsData)
|
export(testaaOnkoKunnollinenBapsData)
|
||||||
export(testaaPop)
|
export(testaaPop)
|
||||||
export(writeMixtureInfo)
|
export(writeMixtureInfo)
|
||||||
import(utils)
|
|
||||||
importFrom(Rsamtools,scanBam)
|
importFrom(Rsamtools,scanBam)
|
||||||
importFrom(adegenet,.readExt)
|
importFrom(adegenet,.readExt)
|
||||||
importFrom(adegenet,read.genepop)
|
importFrom(adegenet,read.genepop)
|
||||||
|
|
@ -45,6 +44,7 @@ importFrom(ape,read.FASTA)
|
||||||
importFrom(matlab2r,blanks)
|
importFrom(matlab2r,blanks)
|
||||||
importFrom(matlab2r,cell)
|
importFrom(matlab2r,cell)
|
||||||
importFrom(matlab2r,colon)
|
importFrom(matlab2r,colon)
|
||||||
|
importFrom(matlab2r,find)
|
||||||
importFrom(matlab2r,inputdlg)
|
importFrom(matlab2r,inputdlg)
|
||||||
importFrom(matlab2r,isempty)
|
importFrom(matlab2r,isempty)
|
||||||
importFrom(matlab2r,isfield)
|
importFrom(matlab2r,isfield)
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@ addToSummary <- function(logml, partitionSummary, worstIndex) {
|
||||||
# annettua logml arvoa, niin lis<69>t<EFBFBD><74>n worstIndex:in kohtaan uusi logml ja
|
# annettua logml arvoa, niin lis<69>t<EFBFBD><74>n worstIndex:in kohtaan uusi logml ja
|
||||||
# nykyist<73> partitiota vastaava nclusters:in arvo. Muutoin ei tehd<68> mit<69><74>n.
|
# nykyist<73> partitiota vastaava nclusters:in arvo. Muutoin ei tehd<68> mit<69><74>n.
|
||||||
|
|
||||||
apu <- find(abs(partitionSummary[, 2] - logml) < 1e-5)
|
apu <- matlab2r::find(abs(partitionSummary[, 2] - logml) < 1e-5)
|
||||||
if (isempty(apu)) {
|
if (isempty(apu)) {
|
||||||
# Nyt l<>ydetty partitio ei ole viel<65> kirjattuna summaryyn.
|
# Nyt l<>ydetty partitio ei ole viel<65> kirjattuna summaryyn.
|
||||||
npops <- length(unique(PARTITION))
|
npops <- length(unique(PARTITION))
|
||||||
|
|
|
||||||
24
R/admix1.R
24
R/admix1.R
|
|
@ -130,8 +130,8 @@ admix1 <- function(tietue) {
|
||||||
osuusTaulu[q] <- 1
|
osuusTaulu[q] <- 1
|
||||||
arvot[q] <- computeIndLogml(omaFreqs, osuusTaulu)
|
arvot[q] <- computeIndLogml(omaFreqs, osuusTaulu)
|
||||||
}
|
}
|
||||||
iso_arvo <- max(arvot)
|
iso_arvo <- base::max(arvot)
|
||||||
isoimman_indeksi <- match(max(arvot), arvot)
|
isoimman_indeksi <- match(base::max(arvot), arvot)
|
||||||
osuusTaulu <- zeros(1, npops)
|
osuusTaulu <- zeros(1, npops)
|
||||||
osuusTaulu[isoimman_indeksi] <- 1
|
osuusTaulu[isoimman_indeksi] <- 1
|
||||||
PARTITION[ind] <- isoimman_indeksi
|
PARTITION[ind] <- isoimman_indeksi
|
||||||
|
|
@ -149,7 +149,7 @@ admix1 <- function(tietue) {
|
||||||
}
|
}
|
||||||
|
|
||||||
# Analyze further only individuals who have log-likelihood ratio larger than 3:
|
# Analyze further only individuals who have log-likelihood ratio larger than 3:
|
||||||
to_investigate <- t(find(likelihood > 3))
|
to_investigate <- t(matlab2r::find(likelihood > 3))
|
||||||
cat("Possibly admixed individuals:\n")
|
cat("Possibly admixed individuals:\n")
|
||||||
for (i in 1:length(to_investigate)) {
|
for (i in 1:length(to_investigate)) {
|
||||||
cat(as.character(to_investigate[i]))
|
cat(as.character(to_investigate[i]))
|
||||||
|
|
@ -200,8 +200,8 @@ admix1 <- function(tietue) {
|
||||||
osuusTaulu[q] <- 1
|
osuusTaulu[q] <- 1
|
||||||
arvot[q] <- computeIndLogml(omaFreqs, osuusTaulu)
|
arvot[q] <- computeIndLogml(omaFreqs, osuusTaulu)
|
||||||
}
|
}
|
||||||
iso_arvo <- max(arvot)
|
iso_arvo <- base::max(arvot)
|
||||||
isoimman_indeksi <- match(max(arvot), arvot)
|
isoimman_indeksi <- match(base::max(arvot), arvot)
|
||||||
osuusTaulu <- zeros(1, npops)
|
osuusTaulu <- zeros(1, npops)
|
||||||
osuusTaulu[isoimman_indeksi] <- 1
|
osuusTaulu[isoimman_indeksi] <- 1
|
||||||
PARTITION[ind] <- isoimman_indeksi
|
PARTITION[ind] <- isoimman_indeksi
|
||||||
|
|
@ -233,13 +233,13 @@ admix1 <- function(tietue) {
|
||||||
missing_levels <- zeros(npops, 3) # the mean values for different levels.
|
missing_levels <- zeros(npops, 3) # the mean values for different levels.
|
||||||
missing_level_partition <- zeros(ninds, 1) # level of each individual (one of the levels of its population).
|
missing_level_partition <- zeros(ninds, 1) # level of each individual (one of the levels of its population).
|
||||||
for (i in 1:npops) {
|
for (i in 1:npops) {
|
||||||
inds <- find(PARTITION == i)
|
inds <- matlab2r::find(PARTITION == i)
|
||||||
# Proportions of non-missing data for the individuals:
|
# Proportions of non-missing data for the individuals:
|
||||||
non_missing_data <- zeros(length(inds), 1)
|
non_missing_data <- zeros(length(inds), 1)
|
||||||
for (j in 1:length(inds)) {
|
for (j in 1:length(inds)) {
|
||||||
ind <- inds[j]
|
ind <- inds[j]
|
||||||
non_missing_data[j] <- length(
|
non_missing_data[j] <- length(
|
||||||
find(data[(ind - 1) * rowsFromInd + 1:ind * rowsFromInd, ] > 0)
|
matlab2r::find(data[(ind - 1) * rowsFromInd + 1:ind * rowsFromInd, ] > 0)
|
||||||
) / (rowsFromInd * nloci)
|
) / (rowsFromInd * nloci)
|
||||||
}
|
}
|
||||||
if (all(non_missing_data > 0.9)) {
|
if (all(non_missing_data > 0.9)) {
|
||||||
|
|
@ -258,7 +258,7 @@ admix1 <- function(tietue) {
|
||||||
n_levels <- length(unique(part))
|
n_levels <- length(unique(part))
|
||||||
n_missing_levels[i] <- n_levels
|
n_missing_levels[i] <- n_levels
|
||||||
for (j in 1:n_levels) {
|
for (j in 1:n_levels) {
|
||||||
missing_levels[i, j] <- mean(non_missing_data[find(part == j)])
|
missing_levels[i, j] <- mean(non_missing_data[matlab2r::find(part == j)])
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -269,7 +269,7 @@ admix1 <- function(tietue) {
|
||||||
for (pop in t(admix_populaatiot)) {
|
for (pop in t(admix_populaatiot)) {
|
||||||
for (level in 1:n_missing_levels[pop]) {
|
for (level in 1:n_missing_levels[pop]) {
|
||||||
potential_inds_in_this_pop_and_level <-
|
potential_inds_in_this_pop_and_level <-
|
||||||
find(
|
matlab2r::find(
|
||||||
PARTITION == pop & missing_level_partition == level &
|
PARTITION == pop & missing_level_partition == level &
|
||||||
likelihood > 3
|
likelihood > 3
|
||||||
) # Potential admix individuals here.
|
) # Potential admix individuals here.
|
||||||
|
|
@ -338,8 +338,8 @@ admix1 <- function(tietue) {
|
||||||
# In case of a rounding error, the sum is made equal to unity by
|
# In case of a rounding error, the sum is made equal to unity by
|
||||||
# fixing the largest value.
|
# fixing the largest value.
|
||||||
if ((PARTITION[ind] > 0) & (sum(proportionsIt[ind, ]) != 1)) {
|
if ((PARTITION[ind] > 0) & (sum(proportionsIt[ind, ]) != 1)) {
|
||||||
isoin <- max(proportionsIt[ind, ])
|
isoin <- base::max(proportionsIt[ind, ])
|
||||||
indeksi <- match(isoin, max(proportionsIt[ind, ]))
|
indeksi <- match(isoin, base::max(proportionsIt[ind, ]))
|
||||||
erotus <- sum(proportionsIt[ind, ]) - 1
|
erotus <- sum(proportionsIt[ind, ]) - 1
|
||||||
proportionsIt[ind, indeksi] <- isoin - erotus
|
proportionsIt[ind, indeksi] <- isoin - erotus
|
||||||
}
|
}
|
||||||
|
|
@ -352,7 +352,7 @@ admix1 <- function(tietue) {
|
||||||
pop <- PARTITION[ind]
|
pop <- PARTITION[ind]
|
||||||
if (pop == 0) { # Individual is outlier
|
if (pop == 0) { # Individual is outlier
|
||||||
uskottavuus[ind] <- 1
|
uskottavuus[ind] <- 1
|
||||||
} else if (isempty(find(to_investigate == ind))) {
|
} else if (isempty(matlab2r::find(to_investigate == ind))) {
|
||||||
# Individual had log-likelihood ratio<3
|
# Individual had log-likelihood ratio<3
|
||||||
uskottavuus[ind] <- 1
|
uskottavuus[ind] <- 1
|
||||||
} else {
|
} else {
|
||||||
|
|
|
||||||
|
|
@ -6,12 +6,12 @@
|
||||||
admixture_initialization <- function(data_matrix, nclusters, Z) {
|
admixture_initialization <- function(data_matrix, nclusters, Z) {
|
||||||
size_data <- size(data_matrix)
|
size_data <- size(data_matrix)
|
||||||
nloci <- size_data[2] - 1
|
nloci <- size_data[2] - 1
|
||||||
n <- max(data_matrix[, ncol(data_matrix)])
|
n <- base::max(data_matrix[, ncol(data_matrix)])
|
||||||
T <- cluster_own(Z, nclusters)
|
T <- cluster_own(Z, nclusters)
|
||||||
initial_partition <- zeros(size_data[1], 1)
|
initial_partition <- zeros(size_data[1], 1)
|
||||||
for (i in 1:n) {
|
for (i in 1:n) {
|
||||||
kori <- T[i]
|
kori <- T[i]
|
||||||
here <- find(data_matrix[, ncol(data_matrix)] == i)
|
here <- matlab2r::find(data_matrix[, ncol(data_matrix)] == i)
|
||||||
for (j in 1:length(here)) {
|
for (j in 1:length(here)) {
|
||||||
initial_partition[here[j], 1] <- kori
|
initial_partition[here[j], 1] <- kori
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -2,7 +2,7 @@ arvoSeuraavaTila <- function(muutokset, logml) {
|
||||||
# Suorittaa yksil<69>n seuraavan tilan arvonnan
|
# Suorittaa yksil<69>n seuraavan tilan arvonnan
|
||||||
|
|
||||||
y <- logml + muutokset # siirron j<>lkeiset logml:t
|
y <- logml + muutokset # siirron j<>lkeiset logml:t
|
||||||
y <- y - max(y)
|
y <- y - base::max(y)
|
||||||
y <- exp(y)
|
y <- exp(y)
|
||||||
summa <- sum(y)
|
summa <- sum(y)
|
||||||
y <- y / summa
|
y <- y / summa
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@ computeDiffInCounts <- function(rows, max_noalle, nloci, data) {
|
||||||
diffInCounts <- zeros(max_noalle, nloci)
|
diffInCounts <- zeros(max_noalle, nloci)
|
||||||
for (i in seq_len(nrow(data))) {
|
for (i in seq_len(nrow(data))) {
|
||||||
row <- data[i, ]
|
row <- data[i, ]
|
||||||
notEmpty <- as.matrix(find(row >= 0))
|
notEmpty <- as.matrix(matlab2r::find(row >= 0))
|
||||||
|
|
||||||
if (length(notEmpty) > 0) {
|
if (length(notEmpty) > 0) {
|
||||||
diffInCounts[row(notEmpty) + (notEmpty - 1) * max_noalle] <-
|
diffInCounts[row(notEmpty) + (notEmpty - 1) * max_noalle] <-
|
||||||
|
|
|
||||||
|
|
@ -1,10 +1,10 @@
|
||||||
computeLogml <- function(counts, sumcounts, noalle, data, rowsFromInd) {
|
computeLogml <- function(counts, sumcounts, noalle, data, rowsFromInd) {
|
||||||
nloci <- size(counts, 2)
|
nloci <- size(counts, 2)
|
||||||
npops <- size(counts, 3)
|
npops <- size(counts, 3)
|
||||||
adjnoalle <- zeros(max(noalle), nloci)
|
adjnoalle <- zeros(base::max(noalle), nloci)
|
||||||
for (j in 1:nloci) {
|
for (j in 1:nloci) {
|
||||||
adjnoalle[1:noalle[j], j] <- noalle(j)
|
adjnoalle[1:noalle[j], j] <- noalle(j)
|
||||||
if ((noalle(j) < max(noalle))) {
|
if ((noalle(j) < base::max(noalle))) {
|
||||||
adjnoalle[noalle[j] + 1:ncol(adjnoalle), j] <- 1
|
adjnoalle[noalle[j] + 1:ncol(adjnoalle), j] <- 1
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -10,13 +10,13 @@ etsiParas <- function(osuus, osuusTaulu, omaFreqs, logml) {
|
||||||
while (ready != 1) {
|
while (ready != 1) {
|
||||||
muutokset <- laskeMuutokset4(osuus, osuusTaulu, omaFreqs, logml)
|
muutokset <- laskeMuutokset4(osuus, osuusTaulu, omaFreqs, logml)
|
||||||
|
|
||||||
# Work around R's max() limitation on complex numbers
|
# Work around R's base::max() limitation on complex numbers
|
||||||
if (any(sapply(muutokset, class) == "complex")) {
|
if (any(sapply(muutokset, class) == "complex")) {
|
||||||
maxRe <- max(Re(as.vector(muutokset)))
|
maxRe <- base::max(Re(as.vector(muutokset)))
|
||||||
maxIm <- max(Im(as.vector(muutokset)))
|
maxIm <- base::max(Im(as.vector(muutokset)))
|
||||||
maxMuutos <- complex(real = maxRe, imaginary = maxIm)
|
maxMuutos <- complex(real = maxRe, imaginary = maxIm)
|
||||||
} else {
|
} else {
|
||||||
maxMuutos <- max(as.vector(muutokset))
|
maxMuutos <- base::max(as.vector(muutokset))
|
||||||
}
|
}
|
||||||
indeksi <- which(muutokset == maxMuutos)
|
indeksi <- which(muutokset == maxMuutos)
|
||||||
if (Re(maxMuutos) > 0) {
|
if (Re(maxMuutos) > 0) {
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@ findEmptyPop <- function(npops) {
|
||||||
emptyPop <- -1
|
emptyPop <- -1
|
||||||
} else {
|
} else {
|
||||||
popDiff <- diff(c(0, pops, npops + 1))
|
popDiff <- diff(c(0, pops, npops + 1))
|
||||||
emptyPop <- min(find(popDiff > 1))
|
emptyPop <- base::min(matlab2r::find(popDiff > 1))
|
||||||
}
|
}
|
||||||
return(list(emptyPop = emptyPop, pops = pops))
|
return(list(emptyPop = emptyPop, pops = pops))
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -9,26 +9,26 @@ getDistances <- function(data_matrix, nclusters) {
|
||||||
|
|
||||||
size_data <- size(data_matrix)
|
size_data <- size(data_matrix)
|
||||||
nloci <- size_data[2] - 1
|
nloci <- size_data[2] - 1
|
||||||
n <- max(data_matrix[, ncol(data_matrix)])
|
n <- base::max(data_matrix[, ncol(data_matrix)])
|
||||||
distances <- zeros(choose(n, 2), 1)
|
distances <- zeros(choose(n, 2), 1)
|
||||||
pointer <- 1
|
pointer <- 1
|
||||||
for (i in 1:n - 1) {
|
for (i in 1:n - 1) {
|
||||||
i_data <- data_matrix[
|
i_data <- data_matrix[
|
||||||
find(data_matrix[, ncol(data_matrix)] == i),
|
matlab2r::find(data_matrix[, ncol(data_matrix)] == i),
|
||||||
1:nloci
|
1:nloci
|
||||||
]
|
]
|
||||||
for (j in (i + 1):n) {
|
for (j in (i + 1):n) {
|
||||||
d_ij <- 0
|
d_ij <- 0
|
||||||
j_data <- data_matrix[find(data_matrix[, ncol()] == j), 1:nloci]
|
j_data <- data_matrix[matlab2r::find(data_matrix[, ncol()] == j), 1:nloci]
|
||||||
vertailuja <- 0
|
vertailuja <- 0
|
||||||
for (k in 1:size(i_data, 1)) {
|
for (k in 1:size(i_data, 1)) {
|
||||||
for (l in 1:size(j_data, 1)) {
|
for (l in 1:size(j_data, 1)) {
|
||||||
here_i <- find(i_data[k, ] >= 0)
|
here_i <- matlab2r::find(i_data[k, ] >= 0)
|
||||||
here_j <- find(j_data[l, ] >= 0)
|
here_j <- matlab2r::find(j_data[l, ] >= 0)
|
||||||
here_joint <- intersect(here_i, here_j)
|
here_joint <- intersect(here_i, here_j)
|
||||||
vertailuja <- vertailuja + length(here_joint)
|
vertailuja <- vertailuja + length(here_joint)
|
||||||
d_ij <- d_ij + length(
|
d_ij <- d_ij + length(
|
||||||
find(i_data[k, here_joint] != j_data[l, here_joint])
|
matlab2r::find(i_data[k, here_joint] != j_data[l, here_joint])
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -5,8 +5,6 @@ POP_LOGML <- array(1, dim = 100)
|
||||||
LOGDIFF <- array(1, dim = c(100, 100))
|
LOGDIFF <- array(1, dim = c(100, 100))
|
||||||
# If handling globas break, try other ideas from https://stackoverflow.com/a/65252740/1169233
|
# If handling globas break, try other ideas from https://stackoverflow.com/a/65252740/1169233
|
||||||
|
|
||||||
|
|
||||||
#' @import utils
|
|
||||||
utils::globalVariables(
|
utils::globalVariables(
|
||||||
c("PARTITION", "COUNTS", "SUMCOUNTS", "LOGDIFF", "POP_LOGML", "GAMMA_LN")
|
c("PARTITION", "COUNTS", "SUMCOUNTS", "LOGDIFF", "POP_LOGML", "GAMMA_LN")
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -24,9 +24,9 @@ handleData <- function(raw_data) {
|
||||||
nloci <- size(raw_data, 2) - 1
|
nloci <- size(raw_data, 2) - 1
|
||||||
|
|
||||||
dataApu <- data[, 1:nloci]
|
dataApu <- data[, 1:nloci]
|
||||||
nollat <- find(dataApu == 0)
|
nollat <- matlab2r::find(dataApu == 0)
|
||||||
if (!isempty(nollat)) {
|
if (!isempty(nollat)) {
|
||||||
isoinAlleeli <- max(max(dataApu))
|
isoinAlleeli <- base::max(max(dataApu))
|
||||||
dataApu[nollat] <- isoinAlleeli + 1
|
dataApu[nollat] <- isoinAlleeli + 1
|
||||||
data[, 1:nloci] <- dataApu
|
data[, 1:nloci] <- dataApu
|
||||||
}
|
}
|
||||||
|
|
@ -39,16 +39,16 @@ handleData <- function(raw_data) {
|
||||||
for (i in 1:nloci) {
|
for (i in 1:nloci) {
|
||||||
alleelitLokuksessaI <- unique(data[, i])
|
alleelitLokuksessaI <- unique(data[, i])
|
||||||
alleelitLokuksessa[[i]] <- sort(alleelitLokuksessaI[
|
alleelitLokuksessa[[i]] <- sort(alleelitLokuksessaI[
|
||||||
find(
|
matlab2r::find(
|
||||||
alleelitLokuksessaI >= 0
|
alleelitLokuksessaI >= 0
|
||||||
)
|
)
|
||||||
])
|
])
|
||||||
noalle[i] <- length(alleelitLokuksessa[[i]])
|
noalle[i] <- length(alleelitLokuksessa[[i]])
|
||||||
}
|
}
|
||||||
alleleCodes <- zeros(max(noalle), nloci)
|
alleleCodes <- zeros(base::max(noalle), nloci)
|
||||||
for (i in 1:nloci) {
|
for (i in 1:nloci) {
|
||||||
alleelitLokuksessaI <- alleelitLokuksessa[[i]]
|
alleelitLokuksessaI <- alleelitLokuksessa[[i]]
|
||||||
puuttuvia <- max(noalle) - length(alleelitLokuksessaI)
|
puuttuvia <- base::max(noalle) - length(alleelitLokuksessaI)
|
||||||
alleleCodes[, i] <- as.matrix(
|
alleleCodes[, i] <- as.matrix(
|
||||||
c(alleelitLokuksessaI, zeros(puuttuvia, 1))
|
c(alleelitLokuksessaI, zeros(puuttuvia, 1))
|
||||||
)
|
)
|
||||||
|
|
@ -56,21 +56,21 @@ handleData <- function(raw_data) {
|
||||||
|
|
||||||
for (loc in seq_len(nloci)) {
|
for (loc in seq_len(nloci)) {
|
||||||
for (all in seq_len(noalle[loc])) {
|
for (all in seq_len(noalle[loc])) {
|
||||||
data[find(data[, loc] == alleleCodes[all, loc]), loc] <- all
|
data[matlab2r::find(data[, loc] == alleleCodes[all, loc]), loc] <- all
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
nind <- max(data[, ncol(data)])
|
nind <- base::max(data[, ncol(data)])
|
||||||
nrows <- size(data, 1)
|
nrows <- size(data, 1)
|
||||||
ncols <- size(data, 2)
|
ncols <- size(data, 2)
|
||||||
rowsFromInd <- zeros(nind, 1)
|
rowsFromInd <- zeros(nind, 1)
|
||||||
for (i in 1:nind) {
|
for (i in 1:nind) {
|
||||||
rowsFromInd[i] <- length(find(data[, ncol(data)] == i))
|
rowsFromInd[i] <- length(matlab2r::find(data[, ncol(data)] == i))
|
||||||
}
|
}
|
||||||
maxRowsFromInd <- max(rowsFromInd)
|
maxRowsFromInd <- base::max(rowsFromInd)
|
||||||
a <- -999
|
a <- -999
|
||||||
emptyRow <- repmat(a, c(1, ncols))
|
emptyRow <- repmat(a, c(1, ncols))
|
||||||
lessThanMax <- find(rowsFromInd < maxRowsFromInd)
|
lessThanMax <- matlab2r::find(rowsFromInd < maxRowsFromInd)
|
||||||
missingRows <- maxRowsFromInd * nind - nrows
|
missingRows <- maxRowsFromInd * nind - nrows
|
||||||
data <- rbind(data, zeros(missingRows, ncols))
|
data <- rbind(data, zeros(missingRows, ncols))
|
||||||
pointer <- 1
|
pointer <- 1
|
||||||
|
|
@ -81,12 +81,12 @@ handleData <- function(raw_data) {
|
||||||
newData <- data
|
newData <- data
|
||||||
rowsFromInd <- maxRowsFromInd
|
rowsFromInd <- maxRowsFromInd
|
||||||
|
|
||||||
adjprior <- zeros(max(noalle), nloci)
|
adjprior <- zeros(base::max(noalle), nloci)
|
||||||
priorTerm <- 0
|
priorTerm <- 0
|
||||||
for (j in 1:nloci) {
|
for (j in 1:nloci) {
|
||||||
adjprior[, j] <- as.matrix(c(
|
adjprior[, j] <- as.matrix(c(
|
||||||
repmat(1 / noalle[j], c(noalle[j], 1)),
|
repmat(1 / noalle[j], c(noalle[j], 1)),
|
||||||
ones(max(noalle) - noalle[j], 1)
|
ones(base::max(noalle) - noalle[j], 1)
|
||||||
))
|
))
|
||||||
priorTerm <- priorTerm + noalle[j] * lgamma(1 / noalle[j])
|
priorTerm <- priorTerm + noalle[j] * lgamma(1 / noalle[j])
|
||||||
}
|
}
|
||||||
|
|
|
||||||
14
R/indMix.R
14
R/indMix.R
|
|
@ -48,7 +48,7 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
return()
|
return()
|
||||||
} else {
|
} else {
|
||||||
npopsTaulu <- as.numeric(npopstext)
|
npopsTaulu <- as.numeric(npopstext)
|
||||||
ykkoset <- find(npopsTaulu == 1)
|
ykkoset <- matlab2r::find(npopsTaulu == 1)
|
||||||
npopsTaulu[ykkoset] <- NA # Mik<69>li ykk<6B>si<73> annettu yl<79>rajaksi, ne poistetaan (if ones are given as an upper limit, they are deleted)
|
npopsTaulu[ykkoset] <- NA # Mik<69>li ykk<6B>si<73> annettu yl<79>rajaksi, ne poistetaan (if ones are given as an upper limit, they are deleted)
|
||||||
if (isempty(npopsTaulu)) {
|
if (isempty(npopsTaulu)) {
|
||||||
logml <- 1
|
logml <- 1
|
||||||
|
|
@ -233,13 +233,13 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
maxMuutos <- 0
|
maxMuutos <- 0
|
||||||
ninds <- size(rows, 1)
|
ninds <- size(rows, 1)
|
||||||
for (pop in 1:npops) {
|
for (pop in 1:npops) {
|
||||||
inds2 <- find(PARTITION == pop)
|
inds2 <- matlab2r::find(PARTITION == pop)
|
||||||
ninds2 <- length(inds2)
|
ninds2 <- length(inds2)
|
||||||
if (ninds2 > 2) {
|
if (ninds2 > 2) {
|
||||||
dist2 <- laskeOsaDist(inds2, dist, ninds)
|
dist2 <- laskeOsaDist(inds2, dist, ninds)
|
||||||
Z2 <- linkage(t(dist2))
|
Z2 <- linkage(t(dist2))
|
||||||
if (round == 3) {
|
if (round == 3) {
|
||||||
npops2 <- max(min(20, floor(ninds2 / 5)), 2)
|
npops2 <- base::max(base::min(20, floor(ninds2 / 5)), 2)
|
||||||
} else if (round == 4) {
|
} else if (round == 4) {
|
||||||
npops2 <- 2 # Moneenko osaan jaetaan
|
npops2 <- 2 # Moneenko osaan jaetaan
|
||||||
}
|
}
|
||||||
|
|
@ -253,7 +253,7 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
maxMuutos <- isoin
|
maxMuutos <- isoin
|
||||||
muuttuvaPop2 <- indeksi %% npops2
|
muuttuvaPop2 <- indeksi %% npops2
|
||||||
if (muuttuvaPop2 == 0) muuttuvaPop2 <- npops2
|
if (muuttuvaPop2 == 0) muuttuvaPop2 <- npops2
|
||||||
muuttuvat <- inds2[find(T2 == muuttuvaPop2)]
|
muuttuvat <- inds2[matlab2r::find(T2 == muuttuvaPop2)]
|
||||||
i2 <- ceiling(indeksi / npops2)
|
i2 <- ceiling(indeksi / npops2)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -310,7 +310,7 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
j <- j + 1
|
j <- j + 1
|
||||||
pop <- pops[j]
|
pop <- pops[j]
|
||||||
totalMuutos <- 0
|
totalMuutos <- 0
|
||||||
inds <- find(PARTITION == pop)
|
inds <- matlab2r::find(PARTITION == pop)
|
||||||
if (round == 5) {
|
if (round == 5) {
|
||||||
aputaulu <- c(inds, rand(length(inds), 1))
|
aputaulu <- c(inds, rand(length(inds), 1))
|
||||||
aputaulu <- sortrows(aputaulu, 2)
|
aputaulu <- sortrows(aputaulu, 2)
|
||||||
|
|
@ -398,7 +398,7 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
while (j < npops) {
|
while (j < npops) {
|
||||||
j <- j + 1
|
j <- j + 1
|
||||||
pop <- pops[j]
|
pop <- pops[j]
|
||||||
inds2 <- find(PARTITION == pop)
|
inds2 <- matlab2r::find(PARTITION == pop)
|
||||||
ninds2 <- length(inds2)
|
ninds2 <- length(inds2)
|
||||||
if (ninds2 > 5) {
|
if (ninds2 > 5) {
|
||||||
partition <- PARTITION
|
partition <- PARTITION
|
||||||
|
|
@ -410,7 +410,7 @@ indMix <- function(c, npops, dispText = TRUE) {
|
||||||
dist2 <- laskeOsaDist(inds2, dist, ninds)
|
dist2 <- laskeOsaDist(inds2, dist, ninds)
|
||||||
Z2 <- linkage(t(dist2))
|
Z2 <- linkage(t(dist2))
|
||||||
T2 <- cluster_own(Z2, 2)
|
T2 <- cluster_own(Z2, 2)
|
||||||
muuttuvat <- inds2[find(T2 == 1)]
|
muuttuvat <- inds2[matlab2r::find(T2 == 1)]
|
||||||
|
|
||||||
muutokset <- laskeMuutokset3(
|
muutokset <- laskeMuutokset3(
|
||||||
T2, inds2, rows, data, adjprior, priorTerm, pop
|
T2, inds2, rows, data, adjprior, priorTerm, pop
|
||||||
|
|
|
||||||
|
|
@ -3,18 +3,18 @@ initialCounts <- function(partition, data, npops, rows, noalle, adjprior) {
|
||||||
ninds <- size(rows, 1)
|
ninds <- size(rows, 1)
|
||||||
|
|
||||||
koot <- rows[, 1] - rows[, 2] + 1
|
koot <- rows[, 1] - rows[, 2] + 1
|
||||||
maxSize <- max(koot)
|
maxSize <- base::max(koot)
|
||||||
|
|
||||||
counts <- zeros(max(noalle), nloci, npops)
|
counts <- zeros(base::max(noalle), nloci, npops)
|
||||||
sumcounts <- zeros(npops, nloci)
|
sumcounts <- zeros(npops, nloci)
|
||||||
for (i in 1:npops) {
|
for (i in 1:npops) {
|
||||||
for (j in 1:nloci) {
|
for (j in 1:nloci) {
|
||||||
havainnotLokuksessa <- find(partition == i & data[, j] >= 0)
|
havainnotLokuksessa <- matlab2r::find(partition == i & data[, j] >= 0)
|
||||||
sumcounts[i, j] <- length(havainnotLokuksessa)
|
sumcounts[i, j] <- length(havainnotLokuksessa)
|
||||||
for (k in 1:noalle[j]) {
|
for (k in 1:noalle[j]) {
|
||||||
alleleCode <- k
|
alleleCode <- k
|
||||||
N_ijk <- length(
|
N_ijk <- length(
|
||||||
find(data[havainnotLokuksessa, j] == alleleCode)
|
matlab2r::find(data[havainnotLokuksessa, j] == alleleCode)
|
||||||
)
|
)
|
||||||
counts[k, j, i] <- N_ijk
|
counts[k, j, i] <- N_ijk
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -1,16 +1,16 @@
|
||||||
initialPopCounts <- function(data, npops, rows, noalle, adjprior) {
|
initialPopCounts <- function(data, npops, rows, noalle, adjprior) {
|
||||||
nloci <- size(data, 2)
|
nloci <- size(data, 2)
|
||||||
counts <- zeros(max(noalle), nloci, npops)
|
counts <- zeros(base::max(noalle), nloci, npops)
|
||||||
sumcounts <- zeros(npops, nloci)
|
sumcounts <- zeros(npops, nloci)
|
||||||
|
|
||||||
for (i in 1:npops) {
|
for (i in 1:npops) {
|
||||||
for (j in 1:nloci) {
|
for (j in 1:nloci) {
|
||||||
i_rivit <- rows(i, 1):rows(i, 2)
|
i_rivit <- rows(i, 1):rows(i, 2)
|
||||||
havainnotLokuksessa <- find(data[i_rivit, j] >= 0)
|
havainnotLokuksessa <- matlab2r::find(data[i_rivit, j] >= 0)
|
||||||
sumcounts[i, j] <- length(havainnotLokuksessa)
|
sumcounts[i, j] <- length(havainnotLokuksessa)
|
||||||
for (k in 1:noalle[j]) {
|
for (k in 1:noalle[j]) {
|
||||||
alleleCode <- k
|
alleleCode <- k
|
||||||
N_ijk <- length(find(data[i_rivit, j] == alleleCode))
|
N_ijk <- length(matlab2r::find(data[i_rivit, j] == alleleCode))
|
||||||
counts[k, j, i] <- N_ijk
|
counts[k, j, i] <- N_ijk
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -68,7 +68,7 @@ laskeMuutokset <- function(ind, globalRows, data, adjprior, priorTerm) {
|
||||||
COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
|
COUNTS[, , i1] <- COUNTS[, , i1] + diffInCounts
|
||||||
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] + diffInSumCounts
|
||||||
|
|
||||||
i2 <- find(muutokset == -Inf) # Etsit<69><74>n populaatiot jotka muuttuneet viime kerran j<>lkeen. (Searching for populations that have changed since the last time)
|
i2 <- matlab2r::find(muutokset == -Inf) # Etsit<69><74>n populaatiot jotka muuttuneet viime kerran j<>lkeen. (Searching for populations that have changed since the last time)
|
||||||
i2 <- setdiff(i2, i1)
|
i2 <- setdiff(i2, i1)
|
||||||
i2_logml <- POP_LOGML[i2]
|
i2_logml <- POP_LOGML[i2]
|
||||||
|
|
||||||
|
|
@ -95,7 +95,7 @@ laskeMuutokset2 <- function(i1, globalRows, data, adjprior, priorTerm) {
|
||||||
|
|
||||||
i1_logml <- POP_LOGML[i1]
|
i1_logml <- POP_LOGML[i1]
|
||||||
|
|
||||||
inds <- find(PARTITION == i1)
|
inds <- matlab2r::find(PARTITION == i1)
|
||||||
ninds <- length(inds)
|
ninds <- length(inds)
|
||||||
|
|
||||||
if (ninds == 0) {
|
if (ninds == 0) {
|
||||||
|
|
@ -138,7 +138,7 @@ laskeMuutokset2 <- function(i1, globalRows, data, adjprior, priorTerm) {
|
||||||
laskeMuutokset3 <- function(T2, inds2, globalRows, data, adjprior, priorTerm, i1) {
|
laskeMuutokset3 <- function(T2, inds2, globalRows, data, adjprior, priorTerm, i1) {
|
||||||
# Palauttaa length(unique(T2))*npops taulun, jossa (i,j):s alkio
|
# Palauttaa length(unique(T2))*npops taulun, jossa (i,j):s alkio
|
||||||
# kertoo, mik<69> olisi muutos logml:ss<73>, jos populaation i1 osapopulaatio
|
# kertoo, mik<69> olisi muutos logml:ss<73>, jos populaation i1 osapopulaatio
|
||||||
# inds2(find(T2==i)) siirret<65><74>n koriin j.
|
# inds2(matlab2r::find(T2==i)) siirret<65><74>n koriin j.
|
||||||
|
|
||||||
npops <- size(COUNTS, 3)
|
npops <- size(COUNTS, 3)
|
||||||
npops2 <- length(unique(T2))
|
npops2 <- length(unique(T2))
|
||||||
|
|
@ -146,7 +146,7 @@ laskeMuutokset3 <- function(T2, inds2, globalRows, data, adjprior, priorTerm, i1
|
||||||
|
|
||||||
i1_logml <- POP_LOGML[i1]
|
i1_logml <- POP_LOGML[i1]
|
||||||
for (pop2 in 1:npops2) {
|
for (pop2 in 1:npops2) {
|
||||||
inds <- inds2[find(T2 == pop2)]
|
inds <- inds2[matlab2r::find(T2 == pop2)]
|
||||||
ninds <- length(inds)
|
ninds <- length(inds)
|
||||||
if (ninds > 0) {
|
if (ninds > 0) {
|
||||||
rows <- list()
|
rows <- list()
|
||||||
|
|
|
||||||
|
|
@ -11,9 +11,9 @@ learn_partition_modified <- function(ordered) {
|
||||||
part <- learn_simple_partition(ordered, 0.05)
|
part <- learn_simple_partition(ordered, 0.05)
|
||||||
nclust <- length(unique(part))
|
nclust <- length(unique(part))
|
||||||
if (nclust == 3) {
|
if (nclust == 3) {
|
||||||
mini_1 <- min(ordered(which(part == 1)))
|
mini_1 <- base::ordered(which(part == 1))
|
||||||
mini_2 <- min(ordered(which(part == 2)))
|
mini_2 <- base::min(ordered(which(part == 2)))
|
||||||
mini_3 <- min(ordered(which(part == 3)))
|
mini_3 <- base::min(ordered(which(part == 3)))
|
||||||
if (mini_1 > 0.9 & mini_2 > 0.9) {
|
if (mini_1 > 0.9 & mini_2 > 0.9) {
|
||||||
part[part == 2] <- 1
|
part[part == 2] <- 1
|
||||||
part[part == 3] <- 2
|
part[part == 3] <- 2
|
||||||
|
|
|
||||||
|
|
@ -1,11 +1,11 @@
|
||||||
newGetDistances <- function(data, rowsFromInd) {
|
newGetDistances <- function(data, rowsFromInd) {
|
||||||
ninds <- max(data[, ncol(data)])
|
ninds <- base::max(data[, ncol(data)])
|
||||||
nloci <- size(data, 2) - 1
|
nloci <- size(data, 2) - 1
|
||||||
riviLkm <- choose(ninds, 2)
|
riviLkm <- choose(ninds, 2)
|
||||||
|
|
||||||
empties <- find(data < 0)
|
empties <- matlab2r::find(data < 0)
|
||||||
data[empties] <- 0
|
data[empties] <- 0
|
||||||
data <- apply(data, 2, as.numeric) # max(noalle) oltava <256
|
data <- apply(data, 2, as.numeric) # base::max(noalle) oltava <256
|
||||||
|
|
||||||
pariTaulu <- zeros(riviLkm, 2)
|
pariTaulu <- zeros(riviLkm, 2)
|
||||||
aPointer <- 1
|
aPointer <- 1
|
||||||
|
|
@ -51,10 +51,10 @@ newGetDistances <- function(data, rowsFromInd) {
|
||||||
}
|
}
|
||||||
|
|
||||||
rm(x, y, vertailutNyt)
|
rm(x, y, vertailutNyt)
|
||||||
nollat <- find(vertailuja == 0)
|
nollat <- matlab2r::find(vertailuja == 0)
|
||||||
dist <- zeros(length(vertailuja), 1)
|
dist <- zeros(length(vertailuja), 1)
|
||||||
dist[nollat] <- 1
|
dist[nollat] <- 1
|
||||||
muut <- find(vertailuja > 0)
|
muut <- matlab2r::find(vertailuja > 0)
|
||||||
dist[muut] <- summa[muut] / vertailuja[muut]
|
dist[muut] <- summa[muut] / vertailuja[muut]
|
||||||
rm(summa, vertailuja)
|
rm(summa, vertailuja)
|
||||||
Z <- linkage(t(dist))
|
Z <- linkage(t(dist))
|
||||||
|
|
|
||||||
|
|
@ -1,13 +1,13 @@
|
||||||
poistaTyhjatPopulaatiot <- function(npops) {
|
poistaTyhjatPopulaatiot <- function(npops) {
|
||||||
# % Poistaa tyhjentyneet populaatiot COUNTS:ista ja
|
# % Poistaa tyhjentyneet populaatiot COUNTS:ista ja
|
||||||
# % SUMCOUNTS:ista. P<>ivitt<74><74> npops:in ja PARTITION:in.
|
# % SUMCOUNTS:ista. P<>ivitt<74><74> npops:in ja PARTITION:in.
|
||||||
notEmpty <- find(any(SUMCOUNTS, 2))
|
notEmpty <- matlab2r::find(any(SUMCOUNTS, 2))
|
||||||
COUNTS <- COUNTS[, , notEmpty]
|
COUNTS <- COUNTS[, , notEmpty]
|
||||||
SUMCOUNTS <- SUMCOUNTS[notEmpty, ]
|
SUMCOUNTS <- SUMCOUNTS[notEmpty, ]
|
||||||
LOGDIFF <- LOGDIFF[, notEmpty]
|
LOGDIFF <- LOGDIFF[, notEmpty]
|
||||||
|
|
||||||
for (n in 1:length(notEmpty)) {
|
for (n in 1:length(notEmpty)) {
|
||||||
apu <- find(PARTITION == notEmpty(n))
|
apu <- matlab2r::find(PARTITION == notEmpty(n))
|
||||||
PARTITION[apu] <- n
|
PARTITION[apu] <- n
|
||||||
}
|
}
|
||||||
npops <- length(notEmpty)
|
npops <- length(notEmpty)
|
||||||
|
|
|
||||||
|
|
@ -5,6 +5,6 @@
|
||||||
#' @note Found a bug? Want to suggest a feature? Contribute to the scientific
|
#' @note Found a bug? Want to suggest a feature? Contribute to the scientific
|
||||||
#' and open source communities by opening an issue on our home page.
|
#' and open source communities by opening an issue on our home page.
|
||||||
#' Check the "BugReports" field on the package description for the URL.
|
#' Check the "BugReports" field on the package description for the URL.
|
||||||
#' @importFrom matlab2r blanks cell colon inputdlg isempty isfield isspace max min ones rand repmat reshape size sortrows squeeze strcmp times zeros
|
#' @importFrom matlab2r blanks cell colon find inputdlg isempty isfield isspace max min ones rand repmat reshape size sortrows squeeze strcmp times zeros
|
||||||
#' @importFrom stats runif
|
#' @importFrom stats runif
|
||||||
NULL
|
NULL
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
rand_disc <- function(CDF) {
|
rand_disc <- function(CDF) {
|
||||||
# %returns an index of a value from a discrete distribution using inversion method
|
# %returns an index of a value from a discrete distribution using inversion method
|
||||||
slump <- rand
|
slump <- rand
|
||||||
har <- find(CDF > slump)
|
har <- matlab2r::find(CDF > slump)
|
||||||
svar <- har(1)
|
svar <- har(1)
|
||||||
return(svar)
|
return(svar)
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -26,6 +26,6 @@ simuloiAlleeli <- function(allfreqs, pop, loc) {
|
||||||
cumsumma <- cumsum(freqs)
|
cumsumma <- cumsum(freqs)
|
||||||
arvo <- runif(1)
|
arvo <- runif(1)
|
||||||
isommat <- which(cumsumma > arvo)
|
isommat <- which(cumsumma > arvo)
|
||||||
all <- min(isommat)
|
all <- base::min(isommat)
|
||||||
return(all)
|
return(all)
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -12,7 +12,7 @@ testaaOnkoKunnollinenBapsData <- function(data) {
|
||||||
return(ninds)
|
return(ninds)
|
||||||
}
|
}
|
||||||
lastCol <- data[, ncol(data)]
|
lastCol <- data[, ncol(data)]
|
||||||
ninds <- max(lastCol)
|
ninds <- base::max(lastCol)
|
||||||
if (any(1:ninds != unique(lastCol))) {
|
if (any(1:ninds != unique(lastCol))) {
|
||||||
ninds <- 0
|
ninds <- 0
|
||||||
return(ninds)
|
return(ninds)
|
||||||
|
|
|
||||||
|
|
@ -14,7 +14,7 @@ updateGlobalVariables <- function(ind, i2, diffInCounts, adjprior, priorTerm) {
|
||||||
)
|
)
|
||||||
|
|
||||||
LOGDIFF[, c(i1, i2)] <- -Inf
|
LOGDIFF[, c(i1, i2)] <- -Inf
|
||||||
inx <- c(find(PARTITION == i1), find(PARTITION == i2))
|
inx <- c(matlab2r::find(PARTITION == i1), matlab2r::find(PARTITION == i2))
|
||||||
LOGDIFF[inx, ] <- -Inf
|
LOGDIFF[inx, ] <- -Inf
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -22,7 +22,7 @@ updateGlobalVariables2 <- function(i1, i2, diffInCounts, adjprior, priorTerm) {
|
||||||
# % Suorittaa globaalien muuttujien muutokset, kun kaikki
|
# % Suorittaa globaalien muuttujien muutokset, kun kaikki
|
||||||
# % korissa i1 olevat yksil<69>t siirret<65><74>n koriin i2.
|
# % korissa i1 olevat yksil<69>t siirret<65><74>n koriin i2.
|
||||||
|
|
||||||
inds <- find(PARTITION == i1)
|
inds <- matlab2r::find(PARTITION == i1)
|
||||||
PARTITION[inds] <- i2
|
PARTITION[inds] <- i2
|
||||||
|
|
||||||
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
|
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
|
||||||
|
|
@ -34,7 +34,7 @@ updateGlobalVariables2 <- function(i1, i2, diffInCounts, adjprior, priorTerm) {
|
||||||
POP_LOGML[i2] <- computePopulationLogml(i2, adjprior, priorTerm)
|
POP_LOGML[i2] <- computePopulationLogml(i2, adjprior, priorTerm)
|
||||||
|
|
||||||
LOGDIFF[, c(i1, i2)] <- -Inf
|
LOGDIFF[, c(i1, i2)] <- -Inf
|
||||||
inx <- c(find(PARTITION == i1), find(PARTITION == i2))
|
inx <- c(matlab2r::find(PARTITION == i1), matlab2r::find(PARTITION == i2))
|
||||||
LOGDIFF[inx, ] <- -Inf
|
LOGDIFF[inx, ] <- -Inf
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -56,6 +56,6 @@ updateGlobalVariables3 <- function(muuttuvat, diffInCounts, adjprior, priorTerm,
|
||||||
)
|
)
|
||||||
|
|
||||||
LOGDIFF[, c(i1, i2)] <- -Inf
|
LOGDIFF[, c(i1, i2)] <- -Inf
|
||||||
inx <- c(find(PARTITION == i1), find(PARTITION == i2))
|
inx <- c(matlab2r::find(PARTITION == i1), matlab2r::find(PARTITION == i2))
|
||||||
LOGDIFF[inx, ] <- -Inf
|
LOGDIFF[inx, ] <- -Inf
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -64,7 +64,7 @@ writeMixtureInfo <- function(logml, rowsFromInd, data, adjprior, priorTerm, outP
|
||||||
append(fid, c("Best Partition: ", "\n"))
|
append(fid, c("Best Partition: ", "\n"))
|
||||||
}
|
}
|
||||||
for (m in 1:cluster_count) {
|
for (m in 1:cluster_count) {
|
||||||
indsInM <- find(PARTITION == m)
|
indsInM <- matlab2r::find(PARTITION == m)
|
||||||
length_of_beginning <- 11 + floor(log10(m))
|
length_of_beginning <- 11 + floor(log10(m))
|
||||||
cluster_size <- length(indsInM)
|
cluster_size <- length(indsInM)
|
||||||
|
|
||||||
|
|
@ -139,8 +139,8 @@ writeMixtureInfo <- function(logml, rowsFromInd, data, adjprior, priorTerm, outP
|
||||||
nimi <- as.character(popnames[i])
|
nimi <- as.character(popnames[i])
|
||||||
nameSizes[i] <- length(nimi)
|
nameSizes[i] <- length(nimi)
|
||||||
}
|
}
|
||||||
maxSize <- max(nameSizes)
|
maxSize <- base::max(nameSizes)
|
||||||
maxSize <- max(maxSize, 5)
|
maxSize <- base::max(maxSize, 5)
|
||||||
erotus <- maxSize - 5
|
erotus <- maxSize - 5
|
||||||
alku <- blanks(erotus)
|
alku <- blanks(erotus)
|
||||||
ekarivi <- c(alku, " ind", blanks(6 + erotus))
|
ekarivi <- c(alku, " ind", blanks(6 + erotus))
|
||||||
|
|
@ -193,8 +193,8 @@ writeMixtureInfo <- function(logml, rowsFromInd, data, adjprior, priorTerm, outP
|
||||||
nloci <- size(COUNTS, 2)
|
nloci <- size(COUNTS, 2)
|
||||||
d <- zeros(maxnoalle, nloci, npops)
|
d <- zeros(maxnoalle, nloci, npops)
|
||||||
prior <- adjprior
|
prior <- adjprior
|
||||||
prior[find(prior == 1)] <- 0
|
prior[matlab2r::find(prior == 1)] <- 0
|
||||||
nollia <- find(all(prior == 0)) # Loci in which only one allele was detected.
|
nollia <- matlab2r::find(all(prior == 0)) # Loci in which only one allele was detected.
|
||||||
prior[1, nollia] <- 1
|
prior[1, nollia] <- 1
|
||||||
for (pop1 in 1:npops) {
|
for (pop1 in 1:npops) {
|
||||||
d[, , pop1] <- (squeeze(COUNTS[, , pop1]) + prior) /
|
d[, , pop1] <- (squeeze(COUNTS[, , pop1]) + prior) /
|
||||||
|
|
@ -261,7 +261,7 @@ writeMixtureInfo <- function(logml, rowsFromInd, data, adjprior, priorTerm, outP
|
||||||
|
|
||||||
partitionSummary <- sortrows(partitionSummary, 2)
|
partitionSummary <- sortrows(partitionSummary, 2)
|
||||||
partitionSummary <- partitionSummary[size(partitionSummary, 1):1, ]
|
partitionSummary <- partitionSummary[size(partitionSummary, 1):1, ]
|
||||||
partitionSummary <- partitionSummary[find(partitionSummary[, 2] > -1e49), ]
|
partitionSummary <- partitionSummary[matlab2r::find(partitionSummary[, 2] > -1e49), ]
|
||||||
if (size(partitionSummary, 1) > 10) {
|
if (size(partitionSummary, 1) > 10) {
|
||||||
vikaPartitio <- 10
|
vikaPartitio <- 10
|
||||||
} else {
|
} else {
|
||||||
|
|
@ -298,12 +298,12 @@ writeMixtureInfo <- function(logml, rowsFromInd, data, adjprior, priorTerm, outP
|
||||||
len <- length(npopsTaulu)
|
len <- length(npopsTaulu)
|
||||||
probs <- zeros(len, 1)
|
probs <- zeros(len, 1)
|
||||||
partitionSummary[, 2] <- partitionSummary[, 2] -
|
partitionSummary[, 2] <- partitionSummary[, 2] -
|
||||||
max(partitionSummary[, 2])
|
base::max(partitionSummary[, 2])
|
||||||
sumtn <- sum(exp(partitionSummary[, 2]))
|
sumtn <- sum(exp(partitionSummary[, 2]))
|
||||||
for (i in 1:len) {
|
for (i in 1:len) {
|
||||||
npopstn <- sum(
|
npopstn <- sum(
|
||||||
exp(
|
exp(
|
||||||
partitionSummary[find(
|
partitionSummary[matlab2r::find(
|
||||||
partitionSummary[, 1] == npopsTaulu[i]
|
partitionSummary[, 1] == npopsTaulu[i]
|
||||||
), 2]
|
), 2]
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -23,5 +23,9 @@ output format of PDIST.
|
||||||
Z = linkage(X) returns a matrix Z that encodes a tree containing hierarchical clusters of the rows of the input data matrix X.
|
Z = linkage(X) returns a matrix Z that encodes a tree containing hierarchical clusters of the rows of the input data matrix X.
|
||||||
}
|
}
|
||||||
\note{
|
\note{
|
||||||
This is also a base Matlab function. The reason why the source code is also present here is unclear.
|
This is also a base MATLAB function. The reason why the BAPS
|
||||||
|
source code also contains a LINKAGE function is unclear. One could speculate
|
||||||
|
that BAPS should use this function instead of the base one, so this is why
|
||||||
|
this function is part of this package (instead of a MATLAB-replicating
|
||||||
|
package such as matlab2r)
|
||||||
}
|
}
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue