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

Fixed basic parsing of FASTA files (#25)

Browse source
This commit is contained in:
Waldir Leoncio 2023-09-11 12:15:30 +02:00
parent a88f31b3a5
commit 76828387a3
8 changed files with 80 additions and 78 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
NAMESPACE
View file

@ -1,6 +1,7 @@
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
export(greedyMix) export(greedyMix)
export(handleData)
export(load_fasta) export(load_fasta)
importFrom(R6,R6Class) importFrom(R6,R6Class)
importFrom(Rsamtools,scanBam) importFrom(Rsamtools,scanBam)

6
R/greedyMix.R
View file

@ -54,7 +54,7 @@ greedyMix <- function(
# Generating partition summary =============================================== # Generating partition summary ===============================================
ekat <- seq(1L, c[["rowsFromInd"]], ninds * c[["rowsFromInd"]]) # ekat = (1:rowsFromInd:ninds*rowsFromInd)'; ekat <- seq(1L, c[["rowsFromInd"]], ninds * c[["rowsFromInd"]]) # ekat = (1:rowsFromInd:ninds*rowsFromInd)';
c[["rows"]] <- c(ekat, ekat + c[["rowsFromInd"]] - 1L) # c.rows = [ekat ekat+rowsFromInd-1] c[["rows"]] <- c(ekat, ekat + c[["rowsFromInd"]] - 1L) # c.rows = [ekat ekat+rowsFromInd-1]
logml_npops_partitionSummary <- indMixWrapper(c, npops, counts, sumcounts, max_iter, fixedK, verbose); logml_npops_partitionSummary <- indMixWrapper(c, npops, counts, sumcounts, max_iter, fixedK, verbose)
logml <- logml_npops_partitionSummary[["logml"]] logml <- logml_npops_partitionSummary[["logml"]]
npops <- logml_npops_partitionSummary[["npops"]] npops <- logml_npops_partitionSummary[["npops"]]
partitionSummary <- logml_npops_partitionSummary[["partitionSummary"]] partitionSummary <- logml_npops_partitionSummary[["partitionSummary"]]
@ -72,8 +72,8 @@ greedyMix <- function(
# Writing mixture info ======================================================= # Writing mixture info =======================================================
changesInLogml <- writeMixtureInfo( changesInLogml <- writeMixtureInfo(
logml, rowsFromInd, data, adjprior, priorTerm, NULL, inp, partitionSummary, logml, c[["rowsFromInd"]], c[["data"]], c[["adjprior"]], c[["priorTerm"]],
popnames, fixedK NULL, inp, partitionSummary, popnames, fixedK
) )
# Updateing results ========================================================== # Updateing results ==========================================================

1
R/handleData.R
View file

@ -9,6 +9,7 @@
#' code to the smallest code that is larger than any code in use. After this, #' code to the smallest code that is larger than any code in use. After this,
#' the function changes the allele codes so that one locus j #' the function changes the allele codes so that one locus j
#' codes get values between? 1, ..., noalle(j). #' codes get values between? 1, ..., noalle(j).
#' @export
handleData <- function(raw_data, format = "Genepop") { handleData <- function(raw_data, format = "Genepop") {
# Alkuper?isen datan viimeinen sarake kertoo, milt?yksil?lt? # Alkuper?isen datan viimeinen sarake kertoo, milt?yksil?lt?
# kyseinen rivi on per?isin. Funktio tutkii ensin, ett?montako # kyseinen rivi on per?isin. Funktio tutkii ensin, ett?montako

2
R/indMix.R
View file

@ -68,7 +68,7 @@ indMix <- function(c, npops, counts = NULL, sumcounts = NULL, max_iter = 100L, d
nruns <- length(npopsTaulu) nruns <- length(npopsTaulu)
initData <- data initData <- data
data <- data[, 1:(ncol(data) - 1)] data <- data[, seq_along(noalle)] # Original code always dropped last column.
logmlBest <- -1e50 logmlBest <- -1e50
partitionSummary <- -1e50 * ones(30, 2) # Tiedot 30 parhaasta partitiosta (npops ja logml) partitionSummary <- -1e50 * ones(30, 2) # Tiedot 30 parhaasta partitiosta (npops ja logml)

4
R/laskeLoggis.R
View file

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

65
R/writeMixtureInfo.R
View file

@ -31,12 +31,12 @@ writeMixtureInfo <- function(
} }
dispLine() dispLine()
cat("RESULTS OF INDIVIDUAL LEVEL MIXTURE ANALYSIS:") cat("RESULTS OF INDIVIDUAL LEVEL MIXTURE ANALYSIS:\n")
cat(c("Data file: ", inputFile)) cat("Data file: ", inputFile, "\n")
cat("Model: independent") cat("Model: independent\n")
cat(c("Number of clustered individuals: ", ownNum2Str(ninds))) cat("Number of clustered individuals: ", ownNum2Str(ninds), "\n")
cat(c("Number of groups in optimal partition: ", ownNum2Str(npops))) cat("Number of groups in optimal partition: ", ownNum2Str(npops), "\n")
cat(c("Log(marginal likelihood) of optimal partition: ", ownNum2Str(logml))) cat("Log(marginal likelihood) of optimal partition: ", ownNum2Str(logml), "\n")
cat(" ") cat(" ")
if (fid != -1) { if (fid != -1) {
append(fid, "RESULTS OF INDIVIDUAL LEVEL MIXTURE ANALYSIS:\n") append(fid, "RESULTS OF INDIVIDUAL LEVEL MIXTURE ANALYSIS:\n")
@ -90,7 +90,7 @@ writeMixtureInfo <- function(
text <- c(text, ",", as.character(indsInM[k])) text <- c(text, ",", as.character(indsInM[k]))
} }
} }
text <- c(text, "}") text <- c(text, "}\n")
while (length(text) > 58) { while (length(text) > 58) {
# Take one line and display it. # Take one line and display it.
new_line <- takeLine(text, 58) new_line <- takeLine(text, 58)
@ -106,7 +106,7 @@ writeMixtureInfo <- function(
text <- "" text <- ""
} }
} }
if (text != "") { if (any(text != "")) {
cat(text) cat(text)
if (fid != -1) { if (fid != -1) {
append(fid, text) append(fid, text)
@ -116,11 +116,11 @@ writeMixtureInfo <- function(
} }
if (npops > 1) { if (npops > 1) {
cat(" ") cat("\n")
cat(" ") cat("\n")
cat( cat(
"Changes in log(marginal likelihood)", "Changes in log(marginal likelihood)",
" if indvidual i is moved to group j:" " if indvidual i is moved to group j:\n"
) )
if (fid != -1) { if (fid != -1) {
append(fid, " ") append(fid, " ")
@ -131,7 +131,7 @@ writeMixtureInfo <- function(
fid, fid,
c( c(
"Changes in log(marginal likelihood)", "Changes in log(marginal likelihood)",
"if indvidual i is moved to group j:" "if indvidual i is moved to group j:\n"
) )
) )
append(fid, "\n") append(fid, "\n")
@ -167,9 +167,9 @@ writeMixtureInfo <- function(
if (names) { if (names) {
nimi <- as.character(popnames[ind]) nimi <- as.character(popnames[ind])
rivi <- c(blanks(maxSize - length(nimi)), nimi, ":") rivi <- c(blanks(maxSize - length(nimi)), nimi, ":\n")
} else { } else {
rivi <- c(blanks(4 - floor(log10(ind))), ownNum2Str(ind), ":") rivi <- c("\n", blanks(4 - floor(log10(ind))), ownNum2Str(ind), ":\n")
} }
for (j in 1:npops) { for (j in 1:npops) {
rivi <- c(rivi, " ", logml2String(omaRound(muutokset[j]))) rivi <- c(rivi, " ", logml2String(omaRound(muutokset[j])))
@ -181,9 +181,9 @@ writeMixtureInfo <- function(
} }
} }
cat(" ") cat("\n")
cat(" ") cat("\n")
cat("KL-divergence matrix in PHYLIP format:") cat("KL-divergence matrix in PHYLIP format:\n")
dist_mat <- zeros(npops, npops) dist_mat <- zeros(npops, npops)
if (fid != -1) { if (fid != -1) {
@ -193,6 +193,7 @@ writeMixtureInfo <- function(
append(fid, "\n") append(fid, "\n")
} }
COUNTS <- COUNTS[seq_len(nrow(adjprior)), seq_len(ncol(adjprior)), , drop = FALSE]
maxnoalle <- size(COUNTS, 1) maxnoalle <- size(COUNTS, 1)
nloci <- size(COUNTS, 2) nloci <- size(COUNTS, 2)
d <- zeros(maxnoalle, nloci, npops) d <- zeros(maxnoalle, nloci, npops)
@ -204,8 +205,8 @@ writeMixtureInfo <- function(
prior[1, nollia] <- 1 prior[1, nollia] <- 1
for (pop1 in 1:npops) { for (pop1 in 1:npops) {
d[, , pop1] <- (squeeze(COUNTS[, , pop1]) + prior) / squeezed_COUNTS_prior <- squeeze(COUNTS[, , pop1]) + prior
repmat(sum(squeeze(COUNTS[, , pop1]) + prior), c(maxnoalle, 1)) d[, , pop1] <- squeezed_COUNTS_prior / sum(squeezed_COUNTS_prior)
} }
ekarivi <- as.character(npops) ekarivi <- as.character(npops)
cat(ekarivi) cat(ekarivi)
@ -215,14 +216,14 @@ writeMixtureInfo <- function(
} }
for (pop1 in 1:npops) { for (pop1 in 1:npops) {
for (pop2 in 1:(pop1 - 1)) { for (pop2 in seq_len(pop1 - 1)) {
dist1 <- d[, , pop1] dist1 <- d[, , pop1]
dist2 <- d[, , pop2] dist2 <- d[, , pop2]
div12 <- sum( div12 <- sum(
sum(dist1 * log2((dist1 + 10^-10) / (dist2 + 10^-10))) sum(dist1 * base::log2((dist1 + 10^-10) / (dist2 + 10^-10)))
) / nloci ) / nloci
div21 <- sum( div21 <- sum(
sum(dist2 * log2((dist2 + 10^-10) / (dist1 + 10^-10))) sum(dist2 * base::log2((dist2 + 10^-10) / (dist1 + 10^-10)))
) / nloci ) / nloci
div <- (div12 + div21) / 2 div <- (div12 + div21) / 2
dist_mat[pop1, pop2] <- div dist_mat[pop1, pop2] <- div
@ -232,9 +233,9 @@ writeMixtureInfo <- function(
dist_mat <- dist_mat + t(dist_mat) # make it symmetric dist_mat <- dist_mat + t(dist_mat) # make it symmetric
for (pop1 in 1:npops) { for (pop1 in 1:npops) {
rivi <- c("Cluster_", as.character(pop1), " ") rivi <- c("\nCluster_", as.character(pop1), "\n")
for (pop2 in 1:npops) { for (pop2 in 1:npops) {
rivi <- c(rivi, kldiv2str(dist_mat[pop1, pop2]), " ") rivi <- c(rivi, kldiv2str(dist_mat[pop1, pop2]))
} }
cat(rivi) cat(rivi)
if (fid != -1) { if (fid != -1) {
@ -244,11 +245,11 @@ writeMixtureInfo <- function(
} }
} }
cat(" ") cat("\n")
cat(" ") cat("\n")
cat( cat(
"List of sizes of 10 best visited partitions", "List of sizes of 10 best visited partitions",
"and corresponding log(ml) values" "and corresponding log(ml) values\n"
) )
if (fid != -1) { if (fid != -1) {
@ -278,7 +279,7 @@ writeMixtureInfo <- function(
line <- c( line <- c(
as.character(partitionSummary[part, 1]), as.character(partitionSummary[part, 1]),
" ", " ",
as.character(partitionSummary(part, 2)) as.character(partitionSummary[part, 2])
) )
cat(line) cat(line)
if (fid != -1) { if (fid != -1) {
@ -288,9 +289,9 @@ writeMixtureInfo <- function(
} }
if (!fixedK) { if (!fixedK) {
cat(" ") cat("\n")
cat(" ") cat("\n")
cat("Probabilities for number of clusters") cat("Probabilities for number of clusters\n")
if (fid != -1) { if (fid != -1) {
append(fid, " ") append(fid, " ")
@ -322,7 +323,7 @@ writeMixtureInfo <- function(
line <- c( line <- c(
as.character(npopsTaulu[i]), " ", as.character(probs[i]) as.character(npopsTaulu[i]), " ", as.character(probs[i])
) )
cat(line) cat(line, "\n")
if (fid != -1) { if (fid != -1) {
append(fid, line) append(fid, line)
append(fid, "\n") append(fid, "\n")

7
man/greedyMix.Rd
View file

@ -8,9 +8,8 @@ greedyMix(
data, data,
format, format,
partitionCompare = NULL, partitionCompare = NULL,
ninds = NULL, ninds = 1L,
npops = 1L, npops = 1L,
priorTerm = NULL,
counts = NULL, counts = NULL,
sumcounts = NULL, sumcounts = NULL,
max_iter = 100L, max_iter = 100L,
@ -32,8 +31,6 @@ greedyMix(
\item{npops}{number of populations} \item{npops}{number of populations}
\item{priorTerm}{prior terms}
\item{counts}{counts} \item{counts}{counts}
\item{sumcounts}{sumcounts} \item{sumcounts}{sumcounts}
@ -55,6 +52,8 @@ greedyMix(
\item{noalle}{number of alleles} \item{noalle}{number of alleles}
\item{adjprior}{ajuster prior probabilities} \item{adjprior}{ajuster prior probabilities}
\item{priorTerm}{prior terms}
} }
\description{ \description{
Clustering of individuals Clustering of individuals