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

Merge branch 'clean-check' into import-genepop

Browse source
This commit is contained in:
Waldir Leoncio 2020-11-19 08:09:19 +01:00
commit e68dc6599c
17 changed files with 104 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.Rbuildignore
View file

@ -1,6 +1,6 @@
LICENSE
TODO.md
matlab
^matlab
CHANGELOG.md
CITATION.cff
.travis.yml

2
NAMESPACE
View file

@ -23,6 +23,7 @@ export(linkage)
export(logml2String)
export(lueGenePopData)
export(lueNimi)
export(matlab2r)
export(noIndex)
export(ownNum2Str)
export(poistaLiianPienet)
@ -49,3 +50,4 @@ export(writeMixtureInfo)
importFrom(methods,is)
importFrom(stats,runif)
importFrom(utils,read.delim)
importFrom(utils,write.table)

4
R/admixture_initialization.R
View file

@ -6,12 +6,12 @@
admixture_initialization <- function (data_matrix, nclusters, Z) {
size_data <- size(data_matrix)
nloci <- size_data[2] - 1
n <- max(data_matrix[, end])
n <- max(data_matrix[, ncol(data_matrix)])
T <- cluster_own(Z, nclusters)
initial_partition <- zeros(size_data[1], 1)
for (i in 1:n) {
kori <- T[i]
here <- find(data_matrix[,end] == i)
here <- find(data_matrix[, ncol(data_matrix)] == i)
for (j in 1:length(here)) {
initial_partition[here[j], 1] <- kori
}

11
R/clearGlobalVars.R
View file

@ -1,8 +1,7 @@
clearGlobalVars <- function() {
# COUNTS <- SUMCOUNTS <- PARTITION <- POP_LOGML <- vector() # placeholders
COUNTS <<- vector()
SUMCOUNTS <<- vector()
PARTITION <<- vector()
POP_LOGML <<- vector()
LOGDIFF <<- vector()
COUNTS <- vector()
SUMCOUNTS <- vector()
PARTITION <- vector()
POP_LOGML <- vector()
LOGDIFF <- vector()
}

2
R/cluster_own.R
View file

@ -15,7 +15,7 @@ cluster_own <- function(Z, nclust) {
for (k in (m - maxclust + 1):(m - 1)) {
i = Z(k, 1) # left tree
if (i <= m) { # original node, no leafs
T(i) = clsnum
T[i] = clsnum
clsnum = clsnum + 1
} else if (i < (2 * m - maxclust + 1)) { # created before cutoff, search down the tree
T <- clusternum(Z, T, i - m, clsnum)

4
R/computeDiffInCounts.R
View file

@ -9,8 +9,8 @@ computeDiffInCounts <- function(rows, max_noalle, nloci, data) {
notEmpty <- find(row>=0)
if (length(notEmpty) > 0) {
diffInCounts(row(notEmpty) + (notEmpty - 1) * max_noalle) <-
diffInCounts(row(notEmpty) + (notEmpty - 1) * max_noalle) + 1
diffInCounts[row(notEmpty) + (notEmpty - 1) * max_noalle] <-
diffInCounts[row(notEmpty) + (notEmpty - 1) * max_noalle] + 1
}
}
return(diffInCounts)

1
R/globals.R Normal file
View file

@ -0,0 +1 @@
utils::globalVariables(c("PARTITION", "COUNTS", "SUMCOUNTS", "LOGDIFF", "POP_LOGML"))

16
R/indMix.R
View file

@ -52,7 +52,7 @@ indMix <- function(c, npops, dispText) {
} else {
npopsTaulu <- as.numeric(npopstext)
ykkoset <- find(npopsTaulu == 1)
npopsTaulu(ykkoset) <- list() # Mik<69>li ykk<6B>si<73> annettu yl<79>rajaksi, ne poistetaan.
npopsTaulu[ykkoset] <- list() # Mik<69>li ykk<6B>si<73> annettu yl<79>rajaksi, ne poistetaan.
if (isempty(npopsTaulu)) {
logml <- 1
partitionSummary <- 1
@ -68,7 +68,7 @@ indMix <- function(c, npops, dispText) {
nruns <- length(npopsTaulu)
initData <- data
data <- data[,1:(end - 1)]
data <- data[,1:(ncol(data) - 1)]
logmlBest <- -1e50
partitionSummary <- -1e50 * ones(30, 2) # Tiedot 30 parhaasta partitiosta (npops ja logml)
@ -76,13 +76,13 @@ indMix <- function(c, npops, dispText) {
worstLogml <- -1e50
worstIndex <- 1
for (run in 1:nruns) {
npops <- npopsTaulu(run)
npops <- npopsTaulu[run]
if (dispText) {
dispLine()
print(
paste0(
'Run ', num2str(run), '/', num2str(nruns),
', maximum number of populations ', num2str(npops), '.'
'Run ', as.character(run), '/', as.character(nruns),
', maximum number of populations ', as.character(npops), '.'
)
)
}
@ -120,7 +120,7 @@ indMix <- function(c, npops, dispText) {
print(
paste0(
'Mixture analysis started with initial',
num2str(npops),
as.character(npops),
'populations.'
)
)
@ -130,7 +130,7 @@ indMix <- function(c, npops, dispText) {
muutoksia <- 0
if (dispText) {
print(paste('Performing steps:', num2str(roundTypes)))
print(paste('Performing steps:', as.character(roundTypes)))
}
for (n in 1:length(roundTypes)) {
@ -545,7 +545,7 @@ indMix <- function(c, npops, dispText) {
npops <- poistaTyhjatPopulaatiot(npops)
POP_LOGML <- computePopulationLogml(1:npops, adjprior, priorTerm)
if (dispText) {
print(paste('Found partition with', num2str(npops), 'populations.'))
print(paste('Found partition with', as.character(npops), 'populations.'))
print(paste('Log(ml) =', as.character(logml)))
print(' ')
}

4
R/initialPopCounts.R
View file

@ -7,11 +7,11 @@ initialPopCounts <- function(data, npops, rows, noalle, adjprior) {
for (j in 1:nloci) {
i_rivit <- rows(i, 1):rows(i, 2)
havainnotLokuksessa <- find(data[i_rivit, j] >= 0)
sumcounts(i, j) <- length(havainnotLokuksessa)
sumcounts[i, j] <- length(havainnotLokuksessa)
for (k in 1:noalle[j]) {
alleleCode <- k
N_ijk <- length(find(data[i_rivit, j] == alleleCode))
counts(k, j, i) <- N_ijk
counts[k, j, i] <- N_ijk
}
}
}

2
R/laskeLoggis.R
View file

@ -1,7 +1,7 @@
laskeLoggis <- function(counts, sumcounts, adjprior) {
npops <- size(counts, 3)
sum1 <- sum(sum(sum(gammaln(counts + repmat(adjprior, c(1, 1, npops))))))
sum1 <- sum(sum(sum(lgamma(counts + repmat(adjprior, c(1, 1, npops))))))
sum3 <- sum(sum(lgamma(adjprior))) - sum(sum(lgamma(1 + sumcounts)))
logml2 <- sum1 - npops * sum3
loggis <- logml2

8
R/laskeOsaDist.R
View file

@ -1,9 +1,15 @@
#' @title Lower part of the dist
#' @description Constructs from the dist vector a subvector containing the individual inds2, Forms dist sub-vectors the vector, which includes yksiliden inds2
#' @param inds2 inds2
#' @param dist dist
#' @param ninds ninds
#' @author Waldir Leoncio
laskeOsaDist <- function(inds2, dist, ninds) {
# % Muodostaa dist vektorista osavektorin, joka sis<69>lt<6C><74> yksil<69>iden inds2
# % v<>liset et<65>isyydet. ninds=kaikkien yksil<69>iden lukum<75><6D>r<EFBFBD>.
ninds2 <- length(inds2)
apu <- zeros(nchoosek(ninds2, 2), 2)
apu <- zeros(choose(ninds2, 2), 2)
rivi <- 1
for (i in 1:ninds2-1) {
for (j in i+1:ninds2) {

3
R/matlab2r.R
View file

@ -4,6 +4,7 @@
#' @param saveOutput if `TRUE`, `filename` is overwritten. Defaults to `FALSE`
#' @return text converted to R, printed to screen or replacing input file
#' @author Waldir Leoncio
#' @importFrom utils write.table
#' @export
matlab2r <- function(filename, saveOutput = FALSE) {
# Verification
@ -21,7 +22,7 @@ matlab2r <- function(filename, saveOutput = FALSE) {
txt <- gsub("for (.+)=(.+)", "for (\\1 in \\2) {", txt)
txt <- gsub("end", "}", txt)
txt <- gsub("(.),(\\S)", "\\1, \\2", txt)
# TODO: replace forms like (:,:) with [, ]
# TODO: replace forms like (:,:) with [, ] if they come before <-
# TODO: add argument to skip some of these rules
txt <- gsub("if (.+)", "if (\\1) {", txt) # FIXME: paste comments after {
txt <- gsub("else$", "} else {", txt)

2
R/poistaLiianPienet.R
View file

@ -41,7 +41,7 @@ poistaLiianPienet <- function (npops, rowsFromInd, alaraja,
PARTITION[yksilot] == n
}
# TODO: add COUNTS, SUMCOUNTS and PARTITION to return or use <<-
# TODO: add COUNTS, SUMCOUNTS and PARTITION to return or use <-
COUNTS[, , miniPops] <- NA
SUMCOUNTS[miniPops, ] <- NA

8
R/poistaTyhjatPopulaatiot.R
View file

@ -2,13 +2,13 @@ poistaTyhjatPopulaatiot <- function(npops) {
# % Poistaa tyhjentyneet populaatiot COUNTS:ista ja
# % SUMCOUNTS:ista. P<>ivitt<74><74> npops:in ja PARTITION:in.
notEmpty <- find(any(SUMCOUNTS, 2))
COUNTS <<- COUNTS[, , notEmpty]
SUMCOUNTS <<- SUMCOUNTS[notEmpty, ]
LOGDIFF <<- LOGDIFF[, notEmpty]
COUNTS <- COUNTS[, , notEmpty]
SUMCOUNTS <- SUMCOUNTS[notEmpty, ]
LOGDIFF <- LOGDIFF[, notEmpty]
for (n in 1:length(notEmpty)) {
apu <- find(PARTITION == notEmpty(n))
PARTITION(apu) <<- n
PARTITION[apu] <- n
}
npops <- length(notEmpty)
return(npops)

44
R/updateGlobalVariables.R
View file

@ -2,21 +2,21 @@ updateGlobalVariables <- function(ind, i2, diffInCounts, adjprior, priorTerm) {
# % Suorittaa globaalien muuttujien muutokset, kun yksil<69> ind
# % on siirret<65><74>n koriin i2.
i1 <- PARTITION(ind)
PARTITION(ind) <<- i2
i1 <- PARTITION[ind]
PARTITION[ind] <- i2
COUNTS[, , i1] <<- COUNTS[, , i1] - diffInCounts
COUNTS[, , i2] <<- COUNTS[, , i2] + diffInCounts
SUMCOUNTS[i1, ] <<- SUMCOUNTS[i1, ] - sum[diffInCounts]
SUMCOUNTS[i2, ] <<- SUMCOUNTS[i2, ] + sum[diffInCounts]
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
COUNTS[, , i2] <- COUNTS[, , i2] + diffInCounts
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - sum[diffInCounts]
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + sum[diffInCounts]
POP_LOGML[c(i1, i2)] <<- computePopulationLogml(
POP_LOGML[c(i1, i2)] <- computePopulationLogml(
c(i1, i2), adjprior, priorTerm
)
LOGDIFF[, c(i1, i2)] <<- -Inf
LOGDIFF[, c(i1, i2)] <- -Inf
inx <- c(find(PARTITION == i1), find(PARTITION==i2))
LOGDIFF[inx, ] <<- -Inf
LOGDIFF[inx, ] <- -Inf
}
updateGlobalVariables2 <- function(i1, i2, diffInCounts, adjprior, priorTerm) {
@ -24,12 +24,12 @@ updateGlobalVariables2 <- function(i1, i2, diffInCounts, adjprior, priorTerm) {
# % korissa i1 olevat yksil<69>t siirret<65><74>n koriin i2.
inds <- find(PARTITION == i1)
PARTITION(inds) <<- i2
PARTITION[inds] <- i2
COUNTS[, , i1] <<- COUNTS[, , i1] - diffInCounts
COUNTS[, , i2] <<- COUNTS[, , i2] + diffInCounts
SUMCOUNTS[i1, ] <<- SUMCOUNTS[i1, ] - sum[diffInCounts]
SUMCOUNTS[i2, ] <<- SUMCOUNTS[i2, ] + sum[diffInCounts]
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
COUNTS[, , i2] <- COUNTS[, , i2] + diffInCounts
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - sum[diffInCounts]
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + sum[diffInCounts]
POP_LOGML[i1] <- 0
POP_LOGML[i2] <- computePopulationLogml(i2, adjprior, priorTerm)
@ -47,18 +47,18 @@ updateGlobalVariables3 <- function(
# % koriin.
i1 <- PARTITION[muuttuvat(1)]
PARTITION[muuttuvat] <<- i2
PARTITION[muuttuvat] <- i2
COUNTS[, , i1] <<- COUNTS[, , i1] - diffInCounts
COUNTS[, , i2] <<- COUNTS[, , i2] + diffInCounts
SUMCOUNTS[i1, ] <<- SUMCOUNTS[i1, ] - sum[diffInCounts]
SUMCOUNTS[i2, ] <<- SUMCOUNTS[i2, ] + sum[diffInCounts]
COUNTS[, , i1] <- COUNTS[, , i1] - diffInCounts
COUNTS[, , i2] <- COUNTS[, , i2] + diffInCounts
SUMCOUNTS[i1, ] <- SUMCOUNTS[i1, ] - sum[diffInCounts]
SUMCOUNTS[i2, ] <- SUMCOUNTS[i2, ] + sum[diffInCounts]
POP_LOGML[c(i1, i2)] <<- computePopulationLogml(
POP_LOGML[c(i1, i2)] <- computePopulationLogml(
c(i1, i2), adjprior, priorTerm
)
LOGDIFF[, c(i1, i2)] <<- -Inf
LOGDIFF[, c(i1, i2)] <- -Inf
inx <- c(find(PARTITION == i1), find(PARTITION == i2))
LOGDIFF[inx, ] <<- -Inf
LOGDIFF[inx, ] <- -Inf
}

21
man/laskeOsaDist.Rd Normal file
View file

@ -0,0 +1,21 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/laskeOsaDist.R
\name{laskeOsaDist}
\alias{laskeOsaDist}
\title{Lower part of the dist}
\usage{
laskeOsaDist(inds2, dist, ninds)
}
\arguments{
\item{inds2}{inds2}
\item{dist}{dist}
\item{ninds}{ninds}
}
\description{
Constructs from the dist vector a subvector containing the individual inds2, Forms dist sub-vectors the vector, which includes yksiliden inds2
}
\author{
Waldir Leoncio
}

22
man/matlab2r.Rd Normal file
View file

@ -0,0 +1,22 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/matlab2r.R
\name{matlab2r}
\alias{matlab2r}
\title{Convert Matlab function to R}
\usage{
matlab2r(filename, saveOutput = FALSE)
}
\arguments{
\item{filename}{name of the file}
\item{saveOutput}{if `TRUE`, `filename` is overwritten. Defaults to `FALSE`}
}
\value{
text converted to R, printed to screen or replacing input file
}
\description{
Performs basic syntax conversion from Matlab to R
}
\author{
Waldir Leoncio
}