diff --git a/DESCRIPTION b/DESCRIPTION index 412b0fe..4a28dcf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -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( diff --git a/R/greedyMix.R b/R/greedyMix.R index 53f3270..aa74a5a 100644 --- a/R/greedyMix.R +++ b/R/greedyMix.R @@ -23,7 +23,7 @@ #' data <- system.file("extdata", "FASTA_clustering_haploid.fasta", package = "rBAPS") #' greedyMix(data, "fasta") greedyMix <- function( - data, format, partitionCompare = NULL, ninds = 1L, npops = 1L, + data, format = gsub("^.*\\.", "", data), partitionCompare = NULL, ninds = 1L, npops = 1L, counts = NULL, sumcounts = NULL, max_iter = 100L, alleleCodes = NULL, inp = NULL, popnames = NULL, fixedK = FALSE, verbose = FALSE ) { @@ -73,5 +73,5 @@ greedyMix <- function( ) # Updateing results ========================================================== - return(c(out, "changesInLogml" = changesInLogml)) + return(c(out, list("changesInLogml" = changesInLogml))) } diff --git a/R/kldiv2str.R b/R/kldiv2str.R index 1a88a12..a73ac78 100644 --- a/R/kldiv2str.R +++ b/R/kldiv2str.R @@ -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 diff --git a/R/logml2String.R b/R/logml2String.R index bc47ce4..09ef88b 100644 --- a/R/logml2String.R +++ b/R/logml2String.R @@ -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) { diff --git a/R/takeLine.R b/R/takeLine.R index 1105e6a..a091477 100644 --- a/R/takeLine.R +++ b/R/takeLine.R @@ -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] diff --git a/R/writeMixtureInfo.R b/R/writeMixtureInfo.R index 97f2401..2a1144b 100644 --- a/R/writeMixtureInfo.R +++ b/R/writeMixtureInfo.R @@ -15,7 +15,6 @@ writeMixtureInfo <- function( logml, rowsFromInd, data, adjprior, priorTerm, outPutFile, inputFile, partitionSummary, popnames, fixedK, verbose ) { - changesInLogml <- list() ninds <- size(data, 1) / rowsFromInd npops <- size(COUNTS, 3) # Check that the names refer to individuals @@ -76,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") @@ -169,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") @@ -177,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") + append(fid, " KL-divergence matrix in PHYLIP format: ") } COUNTS <- COUNTS[seq_len(nrow(adjprior)), seq_len(ncol(adjprior)), , drop = FALSE] @@ -237,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") diff --git a/man/greedyMix.Rd b/man/greedyMix.Rd index b3e4d2b..e10fa87 100644 --- a/man/greedyMix.Rd +++ b/man/greedyMix.Rd @@ -6,7 +6,7 @@ \usage{ greedyMix( data, - format, + format = gsub("^.*\\\\.", "", data), partitionCompare = NULL, ninds = 1L, npops = 1L, diff --git a/man/logml2String.Rd b/man/logml2String.Rd index d8b81ce..281a6b0 100644 --- a/man/logml2String.Rd +++ b/man/logml2String.Rd @@ -4,10 +4,12 @@ \alias{logml2String} \title{Logml to string} \usage{ -logml2String(logml) +logml2String(logml, leading_zeros_replacement = " ") } \arguments{ \item{logml}{input Logml} + +\item{leading_zeros_replacement}{string to replace leading zeros with} } \value{ String version of logml