Merge compress-writeMixtureInfo-output into develop

* compress-writeMixtureInfo-output:
  Updated docs
  Improved output of writeMixtureInfo()
  Auto-recognizing format of greedyMix() data
  Fixed output of greedyMix()

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(

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)))
 }

R/kldiv2str.R

@@ -1,10 +1,11 @@
-kldiv2str <- function(div) {
+kldiv2str <- function(div, max_chars = 6L) {
-  mjono <- "      "
+  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)
+    if (max_chars >= 6) mjono[6] <- as.character((floor(div * 1000)) %% 10)
-    mjono[5] <- as.character((floor(div * 100)) %% 10)
+    if (max_chars >= 5) mjono[5] <- as.character((floor(div * 100)) %% 10)
-    mjono[4] <- as.character((floor(div * 10)) %% 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

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) {
+    while (mjono[pointer] == "0" && pointer < 7) {
-      mjono[pointer] <- " "
+      # Removes leading zeros
+      mjono[pointer] <- leading_zeros_replacement
       pointer <- pointer + 1
     }
     if (logml < 0) {

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]

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(
+      text <- c("Cluster", m, ": {", popnames[[indsInM[1]]])
-        "Cluster ",
-        as.character(m),
-        ": {",
-        as.character(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(
+      text <- c("Cluster", m, ": {", indsInM[1])
-        "Cluster ", as.character(m), ": {", as.character(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)
+      text <- text[(length(new_line) + 1):length(text)]
-      if (verbose) cat(new_line)
+      if (verbose) cat(new_line, sep = "")
       if (fid != -1) {
         append(fid, new_line)
         append(fid, "\n")
       }
-      if (length(text) > 0) {
+      if (any(is.na(text))) {
-        text <- c(blanks(length_of_beginning), text)
-      } else {
         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, "  KL-divergence matrix in PHYLIP format: ")
-      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]
@@ -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")

man/greedyMix.Rd

@@ -6,7 +6,7 @@
 \usage{
 greedyMix(
   data,
-  format,
+  format = gsub("^.*\\\\.", "", data),
   partitionCompare = NULL,
   ninds = 1L,
   npops = 1L,

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