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

Improved output of writeMixtureInfo()

Browse source 
Also, incremented version number to 0.0.0.9024
This commit is contained in:
Waldir Leoncio 2023-09-14 11:59:44 +02:00
parent 63af25a63d
commit 273edafd30
5 changed files with 32 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
DESCRIPTION
View file

@ -1,6 +1,6 @@
Package: rBAPS
Title: Bayesian Analysis of Population Structure
Version: 0.0.0.9023
Version: 0.0.0.9024
Date: 2020-11-09
Authors@R:
c(

11
R/kldiv2str.R
View file

@ -1,10 +1,11 @@
kldiv2str <- function(div) {
mjono <- " "
kldiv2str <- function(div, max_chars = 6L) {
if (max_chars > 6L) message("max_chars > 6L, truncating to 6L")
mjono <- rep(" ", max_chars)
if (abs(div) < 100) {
# Ei tarvita e-muotoa
mjono[6] <- as.character((floor(div * 1000)) %% 10)
mjono[5] <- as.character((floor(div * 100)) %% 10)
mjono[4] <- as.character((floor(div * 10)) %% 10)
if (max_chars >= 6) mjono[6] <- as.character((floor(div * 1000)) %% 10)
if (max_chars >= 5) mjono[5] <- as.character((floor(div * 100)) %% 10)
if (max_chars >= 4) mjono[4] <- as.character((floor(div * 10)) %% 10)
mjono[3] <- "."
mjono[2] <- as.character((floor(div)) %% 10)
arvo <- (floor(div / 10)) %% 10

11
R/logml2String.R
View file

@ -1,10 +1,12 @@
#' @title Logml to string
#' @description Returns a string representation of a logml
#' @param logml input Logml
#' @param
#' @param leading_zeros_replacement string to replace leading zeros with
#' @return String version of logml
logml2String <- function(logml) {
logml2String <- function(logml, leading_zeros_replacement = " ") {
mjono <- rep(" ", 7L)
# Palauttaa logml:n string-esityksen.
mjono <- " "
if (logml == -Inf) {
mjono[7] <- "-"
@ -20,8 +22,9 @@ logml2String <- function(logml) {
mjono[3] <- palautaYks(abs(logml), 2)
mjono[2] <- palautaYks(abs(logml), 3)
pointer <- 2
while (mjono[pointer] == "0" & pointer < 7) {
mjono[pointer] <- " "
while (mjono[pointer] == "0" && pointer < 7) {
# Removes leading zeros
mjono[pointer] <- leading_zeros_replacement
pointer <- pointer + 1
}
if (logml < 0) {

3
R/takeLine.R
View file

@ -6,9 +6,8 @@
takeLine <- function(description, width) {
# Returns one line from the description: line ends to the first
# space after width:th mark.
newLine <- description[1:width]
n <- width + 1
while ((description[n] != " ") & (n < length(description))) {
while (description[n] != "" && n < length(description)) {
n <- n + 1
}
newline <- description[1:n]

43
R/writeMixtureInfo.R
View file

@ -75,41 +75,34 @@ writeMixtureInfo <- function(
cluster_size <- length(indsInM)
if (names) {
text <- c(
"Cluster ",
as.character(m),
": {",
as.character(popnames[[indsInM[1]]])
)
text <- c("Cluster", m, ": {", popnames[[indsInM[1]]])
for (k in 2:cluster_size) {
text <- c(text, ", ", as.character(popnames[[indsInM[k]]]))
text <- c(text, ", ", popnames[[indsInM[k]]])
}
} else {
text <- c(
"Cluster ", as.character(m), ": {", as.character(indsInM[1])
)
text <- c("Cluster", m, ": {", indsInM[1])
for (k in 2:cluster_size) {
text <- c(text, ",", as.character(indsInM[k]))
text <- c(text, ", ", indsInM[k])
}
}
text <- c(text, "}\n")
while (length(text) > 58) {
# Take one line and display it.
# Take one line (new_line) and display it.
new_line <- takeLine(text, 58)
text <- (length(new_line) + 1):length(text)
if (verbose) cat(new_line)
text <- text[(length(new_line) + 1):length(text)]
if (verbose) cat(new_line, sep = "")
if (fid != -1) {
append(fid, new_line)
append(fid, "\n")
}
if (length(text) > 0) {
text <- c(blanks(length_of_beginning), text)
} else {
if (any(is.na(text))) {
text <- ""
} else {
text <- c(blanks(length_of_beginning), text)
}
}
if (any(text != "")) {
if (verbose) cat(text)
if (verbose) cat(text, sep = "")
if (fid != -1) {
append(fid, text)
append(fid, "\n")
@ -168,7 +161,6 @@ writeMixtureInfo <- function(
changesInLogml <- t(LOGDIFF)
for (ind in 1:ninds) {
muutokset <- changesInLogml[, ind]
if (names) {
nimi <- as.character(popnames[ind])
rivi <- c(blanks(maxSize - length(nimi)), nimi, ":\n")
@ -176,22 +168,19 @@ writeMixtureInfo <- function(
rivi <- c("\n", blanks(4 - floor(log10(ind))), ownNum2Str(ind), ":\n")
}
for (j in 1:npops) {
rivi <- c(rivi, " ", logml2String(omaRound(muutokset[j])))
rivi <- c(rivi, logml2String(omaRound(muutokset[j]), ""))
}
if (verbose) cat(rivi)
if (verbose) cat(rivi, sep = "")
if (fid != -1) {
append(fid, rivi)
append(fid, "\n")
}
}
if (verbose) cat("\n\nKL-divergence matrix in PHYLIP format:\n")
if (verbose) cat("\n\nKL-divergence matrix in PHYLIP format: ")
dist_mat <- zeros(npops, npops)
if (fid != -1) {
append(fid, " ")
append(fid, " ")
append(fid, " KL-divergence matrix in PHYLIP format: ")
append(fid, "\n")
}
COUNTS <- COUNTS[seq_len(nrow(adjprior)), seq_len(ncol(adjprior)), , drop = FALSE]
@ -236,9 +225,9 @@ writeMixtureInfo <- function(
for (pop1 in 1:npops) {
rivi <- c("\nCluster_", as.character(pop1), "\n")
for (pop2 in 1:npops) {
rivi <- c(rivi, kldiv2str(dist_mat[pop1, pop2]))
rivi <- c(rivi, kldiv2str(dist_mat[pop1, pop2], 4L))
}
if (verbose) cat(rivi)
if (verbose) cat(rivi, sep = "")
if (fid != -1) {
append(fid, rivi)
append(fid, "\n")