From 3105ca999527f4616c48fb5b217a43a5dff43022 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Wed, 20 May 2020 11:21:07 +0200
Subject: [PATCH 01/11] Refactoring

---
 tests/testthat/test-convertedBaseFunctions.R | 254 +++++++++----------
 1 file changed, 127 insertions(+), 127 deletions(-)

diff --git a/tests/testthat/test-convertedBaseFunctions.R b/tests/testthat/test-convertedBaseFunctions.R
index 1800e15..63fa4bb 100644
--- a/tests/testthat/test-convertedBaseFunctions.R
+++ b/tests/testthat/test-convertedBaseFunctions.R
@@ -1,163 +1,163 @@
 context("Basic Matlab functions")
 
 test_that("rand works properly", {
-    expect_equal(dim(rand()), c(1, 1))
-    expect_equal(dim(rand(1, 2)), c(1, 2))
-    expect_equal(dim(rand(3, 2)), c(3, 2))
+	expect_equal(dim(rand()), c(1, 1))
+	expect_equal(dim(rand(1, 2)), c(1, 2))
+	expect_equal(dim(rand(3, 2)), c(3, 2))
 })
 
 test_that("repmat works properly", {
-    mx0 <- c(1:4) # when converted to matrix, results in a column vector
-    mx1 <- matrix(5:8)
-    mx2 <- matrix(0:-3, 2)
-    expect_error(repmat(mx0))
-    expect_equal(repmat(mx0, 1), as.matrix(mx0))
-    expect_equal(
-        object = repmat(mx0, 2),
-        expected = unname(t(cbind(rbind(mx0, mx0), rbind(mx0, mx0))))
-    )
-    expect_equal(
-        object = repmat(mx1, 2),
-        expected = unname(cbind(rbind(mx1, mx1), rbind(mx1, mx1)))
-    )
-    expect_equal(
-        object = repmat(mx2, c(2, 3)),
-        expected = cbind(rbind(mx2, mx2), rbind(mx2, mx2), rbind(mx2, mx2))
-    )
-    expect_equal(
-        object = repmat(mx2, c(4, 1)),
-        expected = rbind(mx2, mx2, mx2, mx2)
-    )
-    expect_equal(
-        object = repmat(mx2, c(1, 1, 2)),
-        expected = array(mx2, c(2, 2, 2))
-    )
+	mx0 <- c(1:4) # when converted to matrix, results in a column vector
+	mx1 <- matrix(5:8)
+	mx2 <- matrix(0:-3, 2)
+	expect_error(repmat(mx0))
+	expect_equal(repmat(mx0, 1), as.matrix(mx0))
+	expect_equal(
+		object = repmat(mx0, 2),
+		expected = unname(t(cbind(rbind(mx0, mx0), rbind(mx0, mx0))))
+	)
+	expect_equal(
+		object = repmat(mx1, 2),
+		expected = unname(cbind(rbind(mx1, mx1), rbind(mx1, mx1)))
+	)
+	expect_equal(
+		object = repmat(mx2, c(2, 3)),
+		expected = cbind(rbind(mx2, mx2), rbind(mx2, mx2), rbind(mx2, mx2))
+	)
+	expect_equal(
+		object = repmat(mx2, c(4, 1)),
+		expected = rbind(mx2, mx2, mx2, mx2)
+	)
+	expect_equal(
+		object = repmat(mx2, c(1, 1, 2)),
+		expected = array(mx2, c(2, 2, 2))
+	)
 })
 
 test_that("zeros and ones work as expected", {
-    expect_equal(zeros(1), matrix(0, 1))
-    expect_equal(zeros(2), matrix(0, 2, 2))
-    expect_equal(zeros(2, 1), matrix(0, 2, 1))
-    expect_equal(zeros(1, 10), matrix(0, 1, 10))
-    expect_equal(zeros(3, 2, 4), array(0, c(3, 2, 4)))
-    expect_equal(ones(8), matrix(1, 8, 8))
-    expect_equal(ones(5, 2), matrix(1, 5, 2))
-    expect_equal(ones(2, 100), matrix(1, 2, 100))
-    expect_equal(ones(3, 2, 4, 2), array(1, c(3, 2, 4, 2)))
+	expect_equal(zeros(1), matrix(0, 1))
+	expect_equal(zeros(2), matrix(0, 2, 2))
+	expect_equal(zeros(2, 1), matrix(0, 2, 1))
+	expect_equal(zeros(1, 10), matrix(0, 1, 10))
+	expect_equal(zeros(3, 2, 4), array(0, c(3, 2, 4)))
+	expect_equal(ones(8), matrix(1, 8, 8))
+	expect_equal(ones(5, 2), matrix(1, 5, 2))
+	expect_equal(ones(2, 100), matrix(1, 2, 100))
+	expect_equal(ones(3, 2, 4, 2), array(1, c(3, 2, 4, 2)))
 })
 
 test_that("times works as expected", {
-    expect_equal(times(9, 6), as.matrix(54))
-    expect_equal(times(9, c(.8, 9)), as.matrix(c(7.2, 81)))
-    expect_equal(times(c(.8, 9), 5), as.matrix(c(4, 45)))
-    expect_equal(times(matrix(1:4, 2), 5), matrix(c(5, 10, 15, 20), 2))
-    expect_equal(times(5, matrix(1:4, 2)), matrix(c(5, 10, 15, 20), 2))
-    expect_equal(times(matrix(1:4, 2), c(10, 3)), matrix(c(10, 6, 30, 12), 2))
-    expect_equal(
-        object = times(matrix(1:4, 2), matrix(c(10, 3), 1)),
-        expected = matrix(c(10, 20, 9, 12), 2)
-    )
-    expect_equal(times(c(10, 3), matrix(1:4, 2)), matrix(c(10, 6, 30, 12), 2))
-    expect_equal(
-        object = times(matrix(c(10, -5, 3, 9), 2), matrix(1:4, 2)),
-        expected = matrix(c(10, -10, 9, 36), 2)
-    )
-    expect_equal(
-        object = times(matrix(c(-1.6, 5), 1), c(8, 1)),
-        expected = matrix(c(-12.8, -1.6, 40, 5), 2)
-    )
+	expect_equal(times(9, 6), as.matrix(54))
+	expect_equal(times(9, c(.8, 9)), as.matrix(c(7.2, 81)))
+	expect_equal(times(c(.8, 9), 5), as.matrix(c(4, 45)))
+	expect_equal(times(matrix(1:4, 2), 5), matrix(c(5, 10, 15, 20), 2))
+	expect_equal(times(5, matrix(1:4, 2)), matrix(c(5, 10, 15, 20), 2))
+	expect_equal(times(matrix(1:4, 2), c(10, 3)), matrix(c(10, 6, 30, 12), 2))
+	expect_equal(
+		object = times(matrix(1:4, 2), matrix(c(10, 3), 1)),
+		expected = matrix(c(10, 20, 9, 12), 2)
+	)
+	expect_equal(times(c(10, 3), matrix(1:4, 2)), matrix(c(10, 6, 30, 12), 2))
+	expect_equal(
+		object = times(matrix(c(10, -5, 3, 9), 2), matrix(1:4, 2)),
+		expected = matrix(c(10, -10, 9, 36), 2)
+	)
+	expect_equal(
+		object = times(matrix(c(-1.6, 5), 1), c(8, 1)),
+		expected = matrix(c(-12.8, -1.6, 40, 5), 2)
+	)
 })
 
 test_that("colon works as expected (hee hee)", {
-    expect_equal(colon(1, 4), 1:4)
-    expect_length(colon(4, 1), 0)
+	expect_equal(colon(1, 4), 1:4)
+	expect_length(colon(4, 1), 0)
 })
 
 test_that("size works as on MATLAB", {
-    sk <- 10
-    vk <- 1:4
-    mx <- matrix(1:6, 2)
-    ra <- array(1:24, c(2, 3, 4))
-    expect_equal(size(sk), 1)
-    expect_equal(size(vk), c(1, 4))
-    expect_equal(size(mx), c(2, 3))
-    expect_equal(size(ra), c(2, 3, 4))
-    expect_equal(size(sk, 199), 1)
-    expect_equal(size(vk, 199), 1)
-    expect_equal(size(mx, 199), 1)
-    expect_equal(size(ra, 199), 1)
-    expect_equal(size(vk, 2), 4)
-    expect_equal(size(mx, 2), 3)
-    expect_equal(size(ra, 2), 3)
-    expect_equal(size(ra, 3), 4)
+	sk <- 10
+	vk <- 1:4
+	mx <- matrix(1:6, 2)
+	ra <- array(1:24, c(2, 3, 4))
+	expect_equal(size(sk), 1)
+	expect_equal(size(vk), c(1, 4))
+	expect_equal(size(mx), c(2, 3))
+	expect_equal(size(ra), c(2, 3, 4))
+	expect_equal(size(sk, 199), 1)
+	expect_equal(size(vk, 199), 1)
+	expect_equal(size(mx, 199), 1)
+	expect_equal(size(ra, 199), 1)
+	expect_equal(size(vk, 2), 4)
+	expect_equal(size(mx, 2), 3)
+	expect_equal(size(ra, 2), 3)
+	expect_equal(size(ra, 3), 4)
 })
 
 test_that("reshape reshapes properly", {
-    mx <- matrix(1:4, 2)
-    ra <- array(1:12, c(2, 3, 2))
-    expect_equal(reshape(mx, c(1, 4)), matrix(1:4, 1))
-    expect_equal(reshape(mx, c(2, 2)), mx)
-    expect_equal(reshape(mx, c(1, 1, 4)), array(mx, c(1, 1, 4)))
-    expect_error(reshape(mx, c(1, 2, 3)))
-    expect_error(reshape(ra, c(1, 2, 3)))
-    expect_equal(reshape(ra, c(3, 2, 2)), array(ra, c(3, 2, 2)))
+	mx <- matrix(1:4, 2)
+	ra <- array(1:12, c(2, 3, 2))
+	expect_equal(reshape(mx, c(1, 4)), matrix(1:4, 1))
+	expect_equal(reshape(mx, c(2, 2)), mx)
+	expect_equal(reshape(mx, c(1, 1, 4)), array(mx, c(1, 1, 4)))
+	expect_error(reshape(mx, c(1, 2, 3)))
+	expect_error(reshape(ra, c(1, 2, 3)))
+	expect_equal(reshape(ra, c(3, 2, 2)), array(ra, c(3, 2, 2)))
 })
 
 test_that("isfield works as on Matlab", {
-    S <- list()
-    S$x <- rnorm(100)
-    S$y <- sin(S$x)
-    S$title <- "y = sin(x)"
-    expect_true(isfield(S, "title"))
-    expect_equivalent(
-        object = isfield(S, c("x", "y", "z", "title", "error")),
-        expected = c(TRUE, TRUE, FALSE, TRUE, FALSE)
-    )
+	S <- list()
+	S$x <- rnorm(100)
+	S$y <- sin(S$x)
+	S$title <- "y = sin(x)"
+	expect_true(isfield(S, "title"))
+	expect_equivalent(
+		object = isfield(S, c("x", "y", "z", "title", "error")),
+		expected = c(TRUE, TRUE, FALSE, TRUE, FALSE)
+	)
 })
 
 test_that("strcmp works as expected", {
-    yes <- 'Yes'
-    no <- 'No'
-    ja <- 'Yes'
-    expect_false(strcmp(yes, no))
-    expect_true(strcmp(yes, ja))
-    s1 <- 'upon'
-    s2 <- matrix(c('Once', 'upon', 'a', 'time'), 2, byrow=TRUE)
-    s3 <- c('Once', 'upon', 'a', 'time')
-    s4 <- matrix(c("A", "bc", "def", "G"), 2, byrow=TRUE)
-    s5 <- matrix(c("B", "c", "def", "G"), 2, byrow=TRUE)
-    expect_equal(strcmp(s1, s2), matrix(c(FALSE, FALSE, TRUE, FALSE), 2))
-    expect_equivalent(strcmp(s1, s3), c(FALSE, TRUE, FALSE, FALSE))
-    expect_error(strcmp(s2, s3))
-    expect_equal(strcmp(s4, s5), matrix(c(FALSE, TRUE, FALSE, TRUE), 2))
+	yes <- 'Yes'
+	no <- 'No'
+	ja <- 'Yes'
+	expect_false(strcmp(yes, no))
+	expect_true(strcmp(yes, ja))
+	s1 <- 'upon'
+	s2 <- matrix(c('Once', 'upon', 'a', 'time'), 2, byrow=TRUE)
+	s3 <- c('Once', 'upon', 'a', 'time')
+	s4 <- matrix(c("A", "bc", "def", "G"), 2, byrow=TRUE)
+	s5 <- matrix(c("B", "c", "def", "G"), 2, byrow=TRUE)
+	expect_equal(strcmp(s1, s2), matrix(c(FALSE, FALSE, TRUE, FALSE), 2))
+	expect_equivalent(strcmp(s1, s3), c(FALSE, TRUE, FALSE, FALSE))
+	expect_error(strcmp(s2, s3))
+	expect_equal(strcmp(s4, s5), matrix(c(FALSE, TRUE, FALSE, TRUE), 2))
 })
 
 test_that("isempty works as expected", {
-    A <- array(dim=c(0, 2, 2))
-    B <- matrix(rep(NA, 4), 2)
-    C <- matrix(rep(0, 4), 2)
-    cat1 <- as.factor(c(NA, NA))
-    cat2 <- as.factor(c())
-    str1 <- matrix(rep("", 3))
-    expect_true(isempty(A))
-    expect_false(isempty(B))
-    expect_false(isempty(C))
-    expect_false(isempty(cat1))
-    expect_true(isempty(cat2))
-    expect_false(isempty(str1))
+	A <- array(dim=c(0, 2, 2))
+	B <- matrix(rep(NA, 4), 2)
+	C <- matrix(rep(0, 4), 2)
+	cat1 <- as.factor(c(NA, NA))
+	cat2 <- as.factor(c())
+	str1 <- matrix(rep("", 3))
+	expect_true(isempty(A))
+	expect_false(isempty(B))
+	expect_false(isempty(C))
+	expect_false(isempty(cat1))
+	expect_true(isempty(cat2))
+	expect_false(isempty(str1))
 })
 
 test_that("find works as expected", {
-    X <- matrix(c(1, 0, 2, 0, 1, 1, 0, 0, 4), 3, byrow=TRUE)
-    Y <- seq(1, 19, 2)
-    expect_equal(find(X), c(1, 5, 7, 8, 9))
-    expect_equal(find(!X), c(2, 3, 4, 6))
-    expect_equal(find(Y == 13), 7)
+	X <- matrix(c(1, 0, 2, 0, 1, 1, 0, 0, 4), 3, byrow=TRUE)
+	Y <- seq(1, 19, 2)
+	expect_equal(find(X), c(1, 5, 7, 8, 9))
+	expect_equal(find(!X), c(2, 3, 4, 6))
+	expect_equal(find(Y == 13), 7)
 })
 
 test_that("sortrows works as expected", {
-     mx <- matrix(c(3, 2, 2, 1, 1, 10, 0, pi), 4)
-     expect_equal(sortrows(mx), matrix(c(1, 2, 2, 3, pi, 10, 0, 1), 4))
-     expect_equal(sortrows(mx, 2), matrix(c(2, 3, 1, 2, 0, 1, pi, 10), 4))
-     expect_equal(sortrows(mx, 1:2), mx[order(mx[, 1], mx[, 2]), ])
-})
\ No newline at end of file
+	 mx <- matrix(c(3, 2, 2, 1, 1, 10, 0, pi), 4)
+	 expect_equal(sortrows(mx), matrix(c(1, 2, 2, 3, pi, 10, 0, 1), 4))
+	 expect_equal(sortrows(mx, 2), matrix(c(2, 3, 1, 2, 0, 1, pi, 10), 4))
+	 expect_equal(sortrows(mx, 1:2), mx[order(mx[, 1], mx[, 2]), ])
+})

From d6675940a184346bd23af2008f0acb022a36ecfb Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Wed, 20 May 2020 11:21:35 +0200
Subject: [PATCH 02/11] Added questdlg

---
 R/questdlg.R    | 34 ++++++++++++++++++++++++++++++++++
 man/questdlg.Rd | 21 +++++++++++++++++++++
 2 files changed, 55 insertions(+)
 create mode 100644 R/questdlg.R
 create mode 100644 man/questdlg.Rd

diff --git a/R/questdlg.R b/R/questdlg.R
new file mode 100644
index 0000000..07a0104
--- /dev/null
+++ b/R/questdlg.R
@@ -0,0 +1,34 @@
+#' @title Prompt for multiple-choice
+#' @param quest Question
+#' @param dlgtitle Title of question
+#' @param btn Vector of alternatives
+#' @param defbtn Scalar with the name of the default option
+#' @description This function aims to loosely mimic the behavior of the
+#' questdlg function on Matlab
+#' @export
+questdlg <- function(quest, dlgtitle, btn = c('y', 'n'), defbtn = 'n') {
+	message(dlgtitle)
+	# ==========================================================================
+	# Replacing the default option with a capitalized version on btn
+	# ==========================================================================
+	btn[match(tolower(defbtn), tolower(btn))] <- toupper(defbtn)
+	# ==========================================================================
+	# Creating prompt
+	# ==========================================================================
+	option_char <- paste0(' [', paste(btn, collapse = ', '), ']')
+	answer <- readline(paste0(quest, option_char, ": "))
+	# ==========================================================================
+	# Processing answer
+	# ==========================================================================
+	answer <- tolower(answer)
+	if (!(answer %in% tolower(c(btn)))) {
+		if (answer != "") {
+			warning(
+				"'", answer, "' is not a valid altenative. Defaulting to ",
+				defbtn
+			)
+		}
+		answer <- defbtn
+	}
+	return(answer)
+}
\ No newline at end of file
diff --git a/man/questdlg.Rd b/man/questdlg.Rd
new file mode 100644
index 0000000..fdd329c
--- /dev/null
+++ b/man/questdlg.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/questdlg.R
+\name{questdlg}
+\alias{questdlg}
+\title{Prompt for multiple-choice}
+\usage{
+questdlg(quest, dlgtitle, btn = c("y", "n"), defbtn = "n")
+}
+\arguments{
+\item{quest}{Question}
+
+\item{dlgtitle}{Title of question}
+
+\item{btn}{Vector of alternatives}
+
+\item{defbtn}{Scalar with the name of the default option}
+}
+\description{
+This function aims to loosely mimic the behavior of the
+questdlg function on Matlab
+}

From 3f8121f5a62c4f2696f8d545cac0467cf0670c22 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Wed, 20 May 2020 11:22:31 +0200
Subject: [PATCH 03/11] Minor documentation updates

---
 NAMESPACE        |  1 +
 R/uigetfile.R    |  2 +-
 man/greedyMix.Rd | 14 ++++++++++++++
 3 files changed, 16 insertions(+), 1 deletion(-)
 create mode 100644 man/greedyMix.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 9b2f730..37940fb 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -16,6 +16,7 @@ export(noIndex)
 export(ownNum2Str)
 export(poistaLiianPienet)
 export(proportion2str)
+export(questdlg)
 export(rand)
 export(randdir)
 export(repmat)
diff --git a/R/uigetfile.R b/R/uigetfile.R
index 217684d..41e347d 100644
--- a/R/uigetfile.R
+++ b/R/uigetfile.R
@@ -8,7 +8,7 @@ uigetfile <- function(title =  "") {
 	# ==========================================================================
 	# Pre-prompt message
 	# ==========================================================================
-	cat(title)
+	message(title)
 	# ==========================================================================
 	# Reading file path and name
 	# ==========================================================================
diff --git a/man/greedyMix.Rd b/man/greedyMix.Rd
new file mode 100644
index 0000000..71ef088
--- /dev/null
+++ b/man/greedyMix.Rd
@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/greedyMix.R
+\name{greedyMix}
+\alias{greedyMix}
+\title{Clustering of individuals}
+\usage{
+greedyMix(tietue)
+}
+\arguments{
+\item{tietue}{Record}
+}
+\description{
+Clustering of individuals
+}

From ce7fdeb0030feb7b966f0e2135de3fa998b8e3e1 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Wed, 20 May 2020 11:34:26 +0200
Subject: [PATCH 04/11] Added accepted_ans arg to improve answer handling

---
 R/questdlg.R    | 13 ++++++++++---
 man/questdlg.Rd | 10 +++++++++-
 2 files changed, 19 insertions(+), 4 deletions(-)

diff --git a/R/questdlg.R b/R/questdlg.R
index 07a0104..9f7e1aa 100644
--- a/R/questdlg.R
+++ b/R/questdlg.R
@@ -3,10 +3,17 @@
 #' @param dlgtitle Title of question
 #' @param btn Vector of alternatives
 #' @param defbtn Scalar with the name of the default option
+#' @param accepted_ans Vector containing accepted answers
 #' @description This function aims to loosely mimic the behavior of the
 #' questdlg function on Matlab
 #' @export
-questdlg <- function(quest, dlgtitle, btn = c('y', 'n'), defbtn = 'n') {
+questdlg <- function(
+	quest,
+	dlgtitle,
+	btn = c('y', 'n'),
+	defbtn = 'n',
+	accepted_ans = c('y', 'yes', 'n', 'no')
+) {
 	message(dlgtitle)
 	# ==========================================================================
 	# Replacing the default option with a capitalized version on btn
@@ -21,10 +28,10 @@ questdlg <- function(quest, dlgtitle, btn = c('y', 'n'), defbtn = 'n') {
 	# Processing answer
 	# ==========================================================================
 	answer <- tolower(answer)
-	if (!(answer %in% tolower(c(btn)))) {
+	if (!(answer %in% tolower(c(btn, accepted_ans)))) {
 		if (answer != "") {
 			warning(
-				"'", answer, "' is not a valid altenative. Defaulting to ",
+				"'", answer, "' is not a valid alternative. Defaulting to ",
 				defbtn
 			)
 		}
diff --git a/man/questdlg.Rd b/man/questdlg.Rd
index fdd329c..be00b5a 100644
--- a/man/questdlg.Rd
+++ b/man/questdlg.Rd
@@ -4,7 +4,13 @@
 \alias{questdlg}
 \title{Prompt for multiple-choice}
 \usage{
-questdlg(quest, dlgtitle, btn = c("y", "n"), defbtn = "n")
+questdlg(
+  quest,
+  dlgtitle,
+  btn = c("y", "n"),
+  defbtn = "n",
+  accepted_ans = c("y", "yes", "n", "no")
+)
 }
 \arguments{
 \item{quest}{Question}
@@ -14,6 +20,8 @@ questdlg(quest, dlgtitle, btn = c("y", "n"), defbtn = "n")
 \item{btn}{Vector of alternatives}
 
 \item{defbtn}{Scalar with the name of the default option}
+
+\item{accepted_ans}{Vector containing accepted answers}
 }
 \description{
 This function aims to loosely mimic the behavior of the

From 7a03f851901ed8b8b1efe6280b460f0dc9c4d444 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Wed, 20 May 2020 12:15:25 +0200
Subject: [PATCH 05/11] Added uiputfile

---
 NAMESPACE        |  1 +
 R/uiputfile.R    | 21 +++++++++++++++++++++
 man/uiputfile.Rd | 17 +++++++++++++++++
 3 files changed, 39 insertions(+)
 create mode 100644 R/uiputfile.R
 create mode 100644 man/uiputfile.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 37940fb..a1e676f 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -28,5 +28,6 @@ export(strcmp)
 export(suoritaMuutos)
 export(times)
 export(uigetfile)
+export(uiputfile)
 importFrom(methods,is)
 importFrom(stats,runif)
diff --git a/R/uiputfile.R b/R/uiputfile.R
new file mode 100644
index 0000000..cb9da66
--- /dev/null
+++ b/R/uiputfile.R
@@ -0,0 +1,21 @@
+#' @title Save file
+#' @param filter accepted file extension
+#' @param title Title
+#' @description This function intends to loosely mimic the behaviour of the
+#' homonymous Matlab function.
+#' @export
+uiputfile <- function(filter = ".rda", title = "Save file") {
+	# ==========================================================================
+	# Processing input
+	# ==========================================================================
+	message(title)
+	filename <- readline(paste0('File name (end with ', filter, '): '))
+	filepath <- readline(paste0('File path (leave empty for ', getwd(), '): '))
+	if (filename == "") filename <- 0
+	if (filepath == "") filepath <- getwd()
+	# ==========================================================================
+	# Processing output
+	# ==========================================================================
+	out <- list(name = filename, path = filepath)
+	return(out)
+}
\ No newline at end of file
diff --git a/man/uiputfile.Rd b/man/uiputfile.Rd
new file mode 100644
index 0000000..7b37f76
--- /dev/null
+++ b/man/uiputfile.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/uiputfile.R
+\name{uiputfile}
+\alias{uiputfile}
+\title{Save file}
+\usage{
+uiputfile(filter = ".rda", title = "Save file")
+}
+\arguments{
+\item{filter}{accepted file extension}
+
+\item{title}{Title}
+}
+\description{
+This function intends to loosely mimic the behaviour of the
+homonymous Matlab function.
+}

From ee57a98589000f1592ffcb9fda602eb1fed98aac Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Wed, 20 May 2020 13:08:57 +0200
Subject: [PATCH 06/11] Allowing for empty title

---
 R/questdlg.R    | 2 +-
 man/questdlg.Rd | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/questdlg.R b/R/questdlg.R
index 9f7e1aa..826f6b8 100644
--- a/R/questdlg.R
+++ b/R/questdlg.R
@@ -9,7 +9,7 @@
 #' @export
 questdlg <- function(
 	quest,
-	dlgtitle,
+	dlgtitle = "",
 	btn = c('y', 'n'),
 	defbtn = 'n',
 	accepted_ans = c('y', 'yes', 'n', 'no')
diff --git a/man/questdlg.Rd b/man/questdlg.Rd
index be00b5a..e4f5fa9 100644
--- a/man/questdlg.Rd
+++ b/man/questdlg.Rd
@@ -6,7 +6,7 @@
 \usage{
 questdlg(
   quest,
-  dlgtitle,
+  dlgtitle = "",
   btn = c("y", "n"),
   defbtn = "n",
   accepted_ans = c("y", "yes", "n", "no")

From 3962c8c0e881fabd42b7bd2fb724af1c2ffa40d1 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Wed, 20 May 2020 13:09:11 +0200
Subject: [PATCH 07/11] Added listing of files

---
 R/uigetfile.R    | 8 +++++++-
 man/uigetfile.Rd | 4 +++-
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/R/uigetfile.R b/R/uigetfile.R
index 41e347d..ccddb99 100644
--- a/R/uigetfile.R
+++ b/R/uigetfile.R
@@ -2,9 +2,10 @@
 #' @description Loosely mimics the functionality of the `uigetfile` function on
 #' Matlab.
 #' @references https://se.mathworks.com/help/matlab/ref/uigetfile.html
+#' @param filter Filter listed files
 #' @param title Pre-prompt message
 #' @export
-uigetfile <- function(title =  "") {
+uigetfile <- function(filter = "", title =  "") {
 	# ==========================================================================
 	# Pre-prompt message
 	# ==========================================================================
@@ -16,6 +17,11 @@ uigetfile <- function(title =  "") {
 		paste0("Enter file path (leave empty for ", getwd(), "): ")
 	)
 	if (filepath == "") filepath <- getwd()
+	# ==========================================================================
+	# Presenting possible files
+	# ==========================================================================
+	message("Files present on that directory:")
+	print(list.files(path = filepath, pattern = filter, ignore.case = TRUE))
 	filename <- file.choose()
 	# ==========================================================================
 	# Organizing output
diff --git a/man/uigetfile.Rd b/man/uigetfile.Rd
index 34e15bb..21594ba 100644
--- a/man/uigetfile.Rd
+++ b/man/uigetfile.Rd
@@ -4,9 +4,11 @@
 \alias{uigetfile}
 \title{Select a file for loading}
 \usage{
-uigetfile(title = "")
+uigetfile(filter = "", title = "")
 }
 \arguments{
+\item{filter}{Filter listed files}
+
 \item{title}{Pre-prompt message}
 }
 \description{

From b6223750622c530ea5e4635d9fd0ab7c3a7d6faf Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Wed, 20 May 2020 15:34:40 +0200
Subject: [PATCH 08/11] Added bare-bones greedyMix

---
 NAMESPACE     |   1 +
 R/greedyMix.R | 523 +++++++++++++++++++++++++++-----------------------
 2 files changed, 287 insertions(+), 237 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index a1e676f..903031d 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -8,6 +8,7 @@ export(computeIndLogml)
 export(computePersonalAllFreqs)
 export(computeRows)
 export(etsiParas)
+export(greedyMix)
 export(inputdlg)
 export(isfield)
 export(laskeMuutokset4)
diff --git a/R/greedyMix.R b/R/greedyMix.R
index 8cb397f..c9fbfbe 100644
--- a/R/greedyMix.R
+++ b/R/greedyMix.R
@@ -1,268 +1,317 @@
-# function greedyMix(tietue)
+#' @title Clustering of individuals
+#' @param tietue Record
+#' @export
+greedyMix <- function(tietue) {
+	# ASK: graphical components. Remove?
+	# check whether fixed k mode is selected
+	# h0 <- findobj('Tag','fixk_menu')
+	# fixedK = get(h0, 'userdata');
 
-# 	% check whether fixed k mode is selected
-# 	h0 = findobj('Tag','fixk_menu');
-# 	fixedK = get(h0, 'userdata');
+	# if fixedK
+	# 	if ~(fixKWarning == 1) % call function fixKWarning
+	# 		return
+	# 	end
+	# end
 
-# 	if fixedK
-# 		if ~(fixKWarning == 1) % call function fixKWarning
-# 			return
-# 		end
-# 	end
+	# % check whether partition compare mode is selected
+	# h1 = findobj('Tag','partitioncompare_menu');
+	# partitionCompare = get(h1, 'userdata');
 
-# 	% check whether partition compare mode is selected
-# 	h1 = findobj('Tag','partitioncompare_menu');
-# 	partitionCompare = get(h1, 'userdata');
+	if (identical(tietue, -1)) {
+		input_type <- inputdlg(
+			paste(
+				'Specify the format of your data:\n',
+				'1) BAPS-format\n',
+				'2) GenePop-format\n',
+				'3) Preprocessed data\n'
+			)
+		)
+		# Converting from number into name
+		input_type_name <- switch(
+			input_type, 'BAPS-format', 'GenePop-format', 'Preprocessed data'
+		)
+		if (length(input_type_name) == 0) {
+			stop('Invalid alternative')
+		} else if (input_type_name == 'BAPS-format') {
+			pathname_filename <- uigetfile("*.txt", "Loaddata in BAPS-format")
 
+			# ASK: remove?
+			# if ~isempty(partitionCompare)
+			# 	fprintf(1,'Data: %s\n',[pathname filename]);
+			# end
 
-# 	if isequal(tietue,-1)
+			data <- load(pathname_filename)
+			# ninds <- testaaOnkoKunnollinenBapsData(data)  #TESTAUS # TODO: trans
+			if (ninds == 0) stop('Incorrect Data-file')
 
-# 		input_type = questdlg('Specify the format of your data: ',...
-# 			'Specify Data Format', ...
-# 			'BAPS-format', 'GenePop-format', 'Preprocessed data', ...
-# 			'BAPS-format');
+			# ASK: remove?
+			# h0 = findobj('Tag','filename1_text');
+			# set(h0,'String',filename); clear h0;
+			cat(
+				'When using data which are in BAPS-format,',
+				'you can specify the sampling populations of the',
+				'individuals by giving two additional files:',
+				'one containing the names of the populations,',
+				'the other containing the indices of the first',
+				'individuals of the populations.'
+			)
+			input_pops <- inputdlg(
+				prompt = 'Do you wish to specify the sampling populations? [y/N]',
+				definput = 'N'
+			)
+			if (tolower(input_pops) %in% c('yes', 'y')) {
+				popfile    <- uigetfile('*.txt', 'Load population names')
+				kysyToinen <- ifelse(popfile$name == 0, 0, 1)
+				if (kysyToinen == 1) {
+					indicesfile <- uigetfile('*.txt', 'Load population indices')
+					if (indicesfile == 0) {
+						popnames = ""
+					} else {
+						# popnames = initPopNames([namepath namefile],[indicespath indicesfile]) # TODO: translate this fun
+					}
+				} else {
+					popnames <- ""
+				}
+			} else {
+				popnames <- ""
+			}
 
-# 		switch input_type
+			# [data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data); # TODO: translate this function
+			# [Z,dist] = newGetDistances(data,rowsFromInd); # TODO: translate
 
-# 			case 'BAPS-format'
-# 				waitALittle;
-# 				[filename, pathname] = uigetfile('*.txt', 'Load data in BAPS-format');
-# 				if filename==0
-# 					return;
-# 				end
+			save_preproc <- questdlg(
+				quest = 'Do you wish to save pre-processed data?',
+				dlgtitle = 'Save pre-processed data?',
+				defbtn = 'y'
+			)
+			if (save_preproc %in% c('y', 'yes')) {
+				file_out      <- uiputfile('.rda','Save pre-processed data as')
+				kokonimi      <- paste0(file_out$path, file_out$name)
+				c             <- list()
+				c$data        <- data
+				c$rowsFromInd <- rowsFromInd
+				c$alleleCodes <- alleleCodes
+				c$noalle      <- noalle
+				c$adjprior    <- adjprior
+				c$priorTerm   <- priorTerm
+				c$dist        <- dist
+				c$popnames    <- popnames
+				c$Z           <- Z
+				save(c, file = kokonimi)
+				rm(c)
+			}
+		} else if (input_type_name == 'GenePop-format') {
+			filename_pathname <- uigetfile(
+				filter = '*.txt',
+				title = 'Load data in GenePop-format'
+			)
+			if (filename_pathname$name == 0) stop("No name provided")
 
-# 				if ~isempty(partitionCompare)
-# 					fprintf(1,'Data: %s\n',[pathname filename]);
-# 				end
+			# ASK: remove?
+			# if ~isempty(partitionCompare)
+			# 	fprintf(1,'Data: %s\n',[pathname filename]);
+			# end
 
-# 				data = load([pathname filename]);
-# 				ninds = testaaOnkoKunnollinenBapsData(data);  %TESTAUS
-# 				if (ninds==0)
-# 					disp('Incorrect Data-file.');
-# 					return;
-# 				end
-# 				h0 = findobj('Tag','filename1_text');
-# 				set(h0,'String',filename); clear h0;
+			# kunnossa = testaaGenePopData([pathname filename]); # TODO: trans
+			# if (kunnossa == 0) stop("testaaGenePopData returned 0")
+			# [data,popnames]=lueGenePopData([pathname filename]); # TODO: trans
 
-# 				input_pops = questdlg(['When using data which are in BAPS-format, '...
-# 					'you can specify the sampling populations of the individuals by '...
-# 					'giving two additional files: one containing the names of the '...
-# 					'populations, the other containing the indices of the first '...
-# 					'individuals of the populations. Do you wish to specify the '...
-# 					'sampling populations?'], ...
-# 					'Specify sampling populations?',...
-# 					'Yes', 'No', 'No');
-# 				if isequal(input_pops,'Yes')
-# 					waitALittle;
-# 					[namefile, namepath] = uigetfile('*.txt', 'Load population names');
-# 					if namefile==0
-# 						kysyToinen = 0;
-# 					else
-# 						kysyToinen = 1;
-# 					end
-# 					if kysyToinen==1
-# 						waitALittle;
-# 						[indicesfile, indicespath] = uigetfile('*.txt', 'Load population indices');
-# 						if indicesfile==0
-# 							popnames = [];
-# 						else
-# 							popnames = initPopNames([namepath namefile],[indicespath indicesfile]);
-# 						end
-# 					else
-# 						popnames = [];
-# 					end
-# 				else
-# 					popnames = [];
-# 				end
+# 			h0 = findobj('Tag','filename1_text');
+# 			set(h0,'String',filename); clear h0;
 
-# 				[data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data);
-# 				[Z,dist] = newGetDistances(data,rowsFromInd);
+# 			[data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data); # TODO:trans
+# 			[Z,dist] = newGetDistances(data,rowsFromInd); # TODO: trans
+			save_preproc <- questdlg(
+				quest = 'Do you wish to save pre-processed data?',
+				dlgtitle = 'Save pre-processed data?',
+				defbtn = 'y'
+			)
+			if (save_preproc %in% c('y', 'Yes')) {
+				file_out      <- uiputfile('.rda','Save pre-processed data as')
+				kokonimi      <- paste0(file_out$path, file_out$name)
+				c$data        <- data
+				c$rowsFromInd <- rowsFromInd
+				c$alleleCodes <- alleleCodes
+				c$noalle      <- noalle
+				c$adjprior    <- adjprior
+				c$priorTerm   <- priorTerm
+				c$dist        <- dist
+				c$popnames    <- popnames
+				c$Z           <- Z
+				save(c, file = kokonimi)
+				rm(c)
+			}
+		} else if (input_type_name == 'Preprocessed data') {
+			file_in <- uigetfile(
+				filter = '*.txt',
+				title = 'Load pre-processed data in GenePop-format'
+			)
+			if (file_in$name == 0) stop("No name provided")
 
-# 				save_preproc = questdlg('Do you wish to save pre-processed data?',...
-# 					'Save pre-processed data?',...
-# 					'Yes','No','Yes');
-# 				if isequal(save_preproc,'Yes');
-# 					waitALittle;
-# 					[filename, pathname] = uiputfile('*.mat','Save pre-processed data as');
-# 					kokonimi = [pathname filename];
-# 					c.data = data; c.rowsFromInd = rowsFromInd; c.alleleCodes = alleleCodes;
-# 					c.noalle = noalle; c.adjprior = adjprior; c.priorTerm = priorTerm;
-# 					c.dist = dist; c.popnames = popnames; c.Z = Z;
-# 	%                 save(kokonimi,'c');
-# 					save(kokonimi,'c','-v7.3'); % added by Lu Cheng, 08.06.2012
-# 					clear c;
-# 				end;
+			# ASK: remove?
+			# h0 = findobj('Tag','filename1_text');
+			# set(h0,'String',filename); clear h0;
+			# if ~isempty(partitionCompare)
+			# 	fprintf(1,'Data: %s\n',[pathname filename]);
+			# end
 
-# 			case 'GenePop-format'
-# 				waitALittle;
-# 				[filename, pathname] = uigetfile('*.txt', 'Load data in GenePop-format');
-# 				if filename==0
-# 					return;
-# 				end
-# 				if ~isempty(partitionCompare)
-# 					fprintf(1,'Data: %s\n',[pathname filename]);
-# 				end
-# 				kunnossa = testaaGenePopData([pathname filename]);
-# 				if kunnossa==0
-# 					return
-# 				end
-# 				[data,popnames]=lueGenePopData([pathname filename]);
+			struct_array <- readRDS(paste0(file_in$path, file_in$name))
+			if (isfield(struct_array,'c')) { # Matlab versio
+				c <- struct_array$c
+				if (!isfield(c,'dist')) stop('Incorrect file format')
+			} else if (isfield(struct_array,'dist')) { #Mideva versio
+				c <- struct_array
+			} else {
+				stop('Incorrect file format')
+			}
+			data        <- double(c$data)
+			rowsFromInd <- c$rowsFromInd
+			alleleCodes <- c$alleleCodes
+			noalle      <- c$noalle
+			adjprior    <- c$adjprior
+			priorTerm   <- c$priorTerm
+			dist        <- c$dist
+			popnames    <- c$popnames
+			Z           <- c$Z
+			rm(c)
+		}
+	} else {
+		data        <- double(tietue$data)
+		rowsFromInd <- tietue$rowsFromInd
+		alleleCodes <- tietue$alleleCodes
+		noalle      <- tietue$noalle
+		adjprior    <- tietue$adjprior
+		priorTerm   <- tietue$priorTerm
+		dist        <- tietue$dist
+		popnames    <- tietue$popnames
+		Z           <- tietue$Z
+		rm(tietue)
+	}
 
-# 				h0 = findobj('Tag','filename1_text');
-# 				set(h0,'String',filename); clear h0;
+	# ==========================================================================
+	# Declaring global variables
+	# ==========================================================================
+	PARTITION       <- vector()
+	COUNTS          <- vector()
+	SUMCOUNTS       <- vector()
+	POP_LOGML       <- vector()
+	clearGlobalVars <- vector()
+	# ==========================================================================
 
-# 				[data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data);
-# 				[Z,dist] = newGetDistances(data,rowsFromInd);
-# 				save_preproc = questdlg('Do you wish to save pre-processed data?',...
-# 					'Save pre-processed data?',...
-# 					'Yes','No','Yes');
-# 				if isequal(save_preproc,'Yes');
-# 					waitALittle;
-# 					[filename, pathname] = uiputfile('*.mat','Save pre-processed data as');
-# 					kokonimi = [pathname filename];
-# 					c.data = data; c.rowsFromInd = rowsFromInd; c.alleleCodes = alleleCodes;
-# 					c.noalle = noalle; c.adjprior = adjprior; c.priorTerm = priorTerm;
-# 					c.dist = dist; c.popnames = popnames; c.Z = Z;
-# 	%                 save(kokonimi,'c');
-# 					save(kokonimi,'c','-v7.3'); % added by Lu Cheng, 08.06.2012
-# 					clear c;
-# 				end;
+	c$data        <- data
+	c$noalle      <- noalle
+	c$adjprior    <- adjprior
+	c$priorTerm   <- priorTerm
+	c$dist        <- dist
+	c$Z           <- Z
+	c$rowsFromInd <- rowsFromInd
 
-# 			case 'Preprocessed data'
-# 				waitALittle;
-# 				[filename, pathname] = uigetfile('*.mat', 'Load pre-processed data');
-# 				if filename==0
-# 					return;
-# 				end
-# 				h0 = findobj('Tag','filename1_text');
-# 				set(h0,'String',filename); clear h0;
-# 				if ~isempty(partitionCompare)
-# 					fprintf(1,'Data: %s\n',[pathname filename]);
-# 				end
+	ninds  <- length(unique(data[, ncol(data)]))
+	ekat   <- t(seq(1, ninds, rowsFromInd) * rowsFromInd)
+	c$rows <- c(ekat, ekat + rowsFromInd - 1)
 
-# 				struct_array = load([pathname filename]);
-# 				if isfield(struct_array,'c')  %Matlab versio
-# 					c = struct_array.c;
-# 					if ~isfield(c,'dist')
-# 						disp('Incorrect file format');
-# 						return
-# 					end
-# 				elseif isfield(struct_array,'dist')  %Mideva versio
-# 					c = struct_array;
-# 				else
-# 					disp('Incorrect file format');
-# 					return;
-# 				end
-# 				data = double(c.data); rowsFromInd = c.rowsFromInd; alleleCodes = c.alleleCodes;
-# 				noalle = c.noalle; adjprior = c.adjprior; priorTerm = c.priorTerm;
-# 				dist = c.dist; popnames = c.popnames; Z = c.Z;
-# 				clear c;
-# 				otherwise
-# 				return
-# 		end
+	# partition compare
+	if (!is.null(partitionCompare)) {
+		nsamplingunits <- size(c$rows, 1)
+		partitions     <- partitionCompare$partitions
+		npartitions    <- size(partitions, 2)
+		partitionLogml <- zeros(1, npartitions)
+		for (i in seq_len(npartitions)) {
+			# number of unique partition lables
+			npops <- length(unique(partitions[, i]))
 
-# 	else
-# 		data = double(tietue.data); rowsFromInd = tietue.rowsFromInd; alleleCodes = tietue.alleleCodes;
-# 		noalle = tietue.noalle; adjprior = tietue.adjprior; priorTerm = tietue.priorTerm;
-# 		dist = tietue.dist; popnames = tietue.popnames; Z = tietue.Z;
-# 		clear tietue;
-# 	end
+			partitionInd <- zeros(ninds * rowsFromInd, 1)
+			partitionSample <- partitions[, i]
+			for (j in seq_len(nsamplingunits)) {
+				partitionInd[c$rows[j, 1]:c$rows[j, 2]] <- partitionSample[j]
+			}
+			# partitionLogml[i] = initialCounts(
+			# 	partitionInd,
+			# 	data[, seq_len(end - 1)],
+			# 	npops,
+			# 	c$rows,
+			# 	noalle,
+			# 	adjprior
+			# ) #TODO translate
+		}
+		# return the logml result
+		partitionCompare$logmls <- partitionLogml
+		# set(h1, 'userdata', partitionCompare) # ASK remove?
+		return()
+	}
 
+	# ASK remove (graphical part)?
+	# if (fixedK) {
+	# 	#logml_npops_partitionSummary <- indMix_fixK(c) # TODO translate?
+	# } else {
+	# 	#logml_npops_partitionSummary <- indMix(c) # TODO translate?
+	# }
+	# if (logml_npops_partitionSummary$logml == 1) return()
 
-# 	global PARTITION; global COUNTS;
-# 	global SUMCOUNTS; global POP_LOGML;
-# 	clearGlobalVars;
+	data <- data[, seq_len(ncol(data) - 1)]
 
-# 	c.data=data;
-# 	c.noalle = noalle; c.adjprior = adjprior; c.priorTerm = priorTerm;
-# 	c.dist=dist; c.Z=Z; c.rowsFromInd = rowsFromInd;
+	# ASK: remove?
+	# h0 = findobj('Tag','filename1_text');  inp = get(h0,'String');
+	# h0 = findobj('Tag','filename2_text');
+	# outp = get(h0,'String');
 
-# 	ninds = length(unique(data(:,end)));
-# 	ekat = (1:rowsFromInd:ninds*rowsFromInd)';
-# 	c.rows = [ekat ekat+rowsFromInd-1];
+	# changesInLogml <- writeMixtureInfo(
+	# 	logml, rowsFromInd, data, adjprior, priorTerm, outp, inp,
+	# 	popnames, fixedK
+	# ) # TODO translate
 
-# 	% partition compare
-# 	if ~isempty(partitionCompare)
-# 		nsamplingunits = size(c.rows,1);
-# 		partitions = partitionCompare.partitions;
-# 		npartitions = size(partitions,2);
-# 		partitionLogml = zeros(1,npartitions);
-# 		for i = 1:npartitions
-# 			% number of unique partition lables
-# 			npops = length(unique(partitions(:,i)));
-
-# 			partitionInd = zeros(ninds*rowsFromInd,1);
-# 			partitionSample = partitions(:,i);
-# 			for j = 1:nsamplingunits
-# 				partitionInd([c.rows(j,1):c.rows(j,2)]) = partitionSample(j);
-# 			end
-# 			partitionLogml(i) = ...
-# 				initialCounts(partitionInd, data(:,1:end-1), npops, c.rows, noalle, adjprior);
-
-# 		end
-# 		% return the logml result
-# 		partitionCompare.logmls = partitionLogml;
-# 		set(h1, 'userdata', partitionCompare);
-# 		return
-# 	end
-
-# 	if fixedK
-# 		[logml, npops, partitionSummary]=indMix_fixK(c);
-# 	else
-# 		[logml, npops, partitionSummary]=indMix(c);
-# 	end
-
-# 	if logml==1
-# 		return
-# 	end
-
-# 	data = data(:,1:end-1);
-
-# 	h0 = findobj('Tag','filename1_text');  inp = get(h0,'String');
-# 	h0 = findobj('Tag','filename2_text');
-# 	outp = get(h0,'String');
-# 	changesInLogml = writeMixtureInfo(logml, rowsFromInd, data, adjprior, priorTerm, ...
-# 		outp,inp,partitionSummary, popnames, fixedK);
-
-# 	viewMixPartition(PARTITION, popnames);
-
-# 	talle = questdlg(['Do you want to save the mixture populations ' ...
-# 		'so that you can use them later in admixture analysis?'], ...
-# 		'Save results?','Yes','No','Yes');
-# 	if isequal(talle,'Yes')
-# 		waitALittle;
-# 		[filename, pathname] = uiputfile('*.mat','Save results as');
-
-# 		% -------------------------------------------
-# 		% Added by Jing, 26.12.2005
-# 		if (sum(filename)==0) || (sum(pathname)==0)
-# 			% Cancel was pressed
-# 			return;
-# 		else
-# 			% copy 'baps4_output.baps' into the text file with the same name.
-# 			if exist('baps4_output.baps','file')
-# 			copyfile('baps4_output.baps',[pathname filename '.txt'])
-# 			delete('baps4_output.baps')
-# 			end
-# 		end;
-# 		% -------------------------------------------
-
-# 		c.PARTITION = PARTITION; c.COUNTS = COUNTS; c.SUMCOUNTS = SUMCOUNTS;
-# 		c.alleleCodes = alleleCodes; c.adjprior = adjprior; c.popnames = popnames;
-# 		c.rowsFromInd = rowsFromInd; c.data = data; c.npops = npops;
-# 		c.noalle = noalle; c.mixtureType = 'mix';
-# 		c.logml = logml; c.changesInLogml = changesInLogml;
-# 	%     save([pathname filename], 'c');
-# 		save([pathname filename], 'c', '-v7.3'); % added by Lu Cheng, 08.06.2012
-# 	else
-# 		if exist('baps4_output.baps','file')
-# 		delete('baps4_output.baps')
-# 		end
-# 	end
+	# viewMixPartition(PARTITION, popnames) # TODO translate function
 
+	talle <- questdlg(
+		quest = paste(
+			'Do you want to save the mixture populations',
+			'so that you can use them later in admixture analysis?'
+		),
+		dlgtitle = 'Save results?',
+		defbtn = 'y'
+	)
+	if (talle %in% c('Yes', 'y')) {
+		filename_pathname <- uiputfile('.mat','Save results as')
 
+	# ==========================================================================
+		cond <- (sum(filename_pathname$name) == 0) |
+		(sum(filename_pathname$path) == 0)
+		if (cond) {
+			# Cancel was pressed
+			return()
+		} else {
+			# copy 'baps4_output.baps' into the text file with the same name.
+			if (file.exists('baps4_output.baps')) {
+				file.copy(
+					from = 'baps4_output.baps',
+					to = paste0(
+						filename_pathname$path, filename_pathname$name, '.txt'
+					)
+				)
+				file.remove('baps4_output.baps')
+			}
+		}
+	# ==========================================================================
 
+		c$PARTITION      <- PARTITION
+		c$COUNTS         <- COUNTS
+		c$SUMCOUNTS      <- SUMCOUNTS
+		c$alleleCodes    <- alleleCodes
+		c$adjprior       <- adjprior
+		c$popnames       <- popnames
+		c$rowsFromInd    <- rowsFromInd
+		c$data           <- data
+		c$npops          <- npops
+		c$noalle         <- noalle
+		c$mixtureType    <- 'mix'
+		c$logml          <- logml
+		c$changesInLogml <- changesInLogml
 
+		save(c, file = paste0(filename_pathname$path, filename_pathname$name))
+	} else {
+		if (file.exists('baps4_output.baps')) file.remove('baps4_output.baps')
+	}
+}
 
 # 	%-------------------------------------------------------------------------------------
 # 	%-------------------------------------------------------------------------------------

From 3fcd4affcb5257b41fabad41900cf8d966a0549f Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Mon, 8 Jun 2020 13:42:36 +0200
Subject: [PATCH 09/11] Added arguments to limit user interaction

---
 R/greedyMix.R    | 107 ++++++++++++++++++++++++++++++++---------------
 man/greedyMix.Rd |  11 ++++-
 2 files changed, 83 insertions(+), 35 deletions(-)

diff --git a/R/greedyMix.R b/R/greedyMix.R
index c9fbfbe..5731d9d 100644
--- a/R/greedyMix.R
+++ b/R/greedyMix.R
@@ -1,7 +1,14 @@
 #' @title Clustering of individuals
 #' @param tietue Record
+#' @param format Format of the data ("BAPS", "GenePop" or "Preprocessed")
+#' @param savePreProcessed Save the pre-processed data?
 #' @export
-greedyMix <- function(tietue) {
+greedyMix <- function(
+	tietue,
+	format           = NULL,
+	savePreProcessed = NULL,
+	filePreProcessed = NULL
+) {
 	# ASK: graphical components. Remove?
 	# check whether fixed k mode is selected
 	# h0 <- findobj('Tag','fixk_menu')
@@ -17,32 +24,46 @@ greedyMix <- function(tietue) {
 	# h1 = findobj('Tag','partitioncompare_menu');
 	# partitionCompare = get(h1, 'userdata');
 
-	if (identical(tietue, -1)) {
-		input_type <- inputdlg(
-			paste(
-				'Specify the format of your data:\n',
-				'1) BAPS-format\n',
-				'2) GenePop-format\n',
-				'3) Preprocessed data\n'
+	if (is(tietue, "list") | is(tietue, "character")) {
+		# ----------------------------------------------------------------------
+		# Defining type of file
+		# ----------------------------------------------------------------------
+		if (is.null(format)) {
+			input_type <- inputdlg(
+				paste(
+					'Specify the format of your data:\n',
+					'1) BAPS-format\n',
+					'2) GenePop-format\n',
+					'3) Preprocessed data\n'
+				)
 			)
-		)
-		# Converting from number into name
-		input_type_name <- switch(
-			input_type, 'BAPS-format', 'GenePop-format', 'Preprocessed data'
-		)
+			# Converting from number into name
+			input_type_name <- switch(
+				input_type, 'BAPS-format', 'GenePop-format', 'Preprocessed data'
+			)
+		} else {
+			input_type_name <- paste0(format, "-format")
+		}
+		# ----------------------------------------------------------------------
+		# Treating BAPS-formatted files
+		# ----------------------------------------------------------------------
 		if (length(input_type_name) == 0) {
 			stop('Invalid alternative')
 		} else if (input_type_name == 'BAPS-format') {
-			pathname_filename <- uigetfile("*.txt", "Loaddata in BAPS-format")
+			if (!is(tietue, "character")) {
+				pathname_filename <- uigetfile("*.txt", "Loaddata in BAPS-format")
+			} else {
+				pathname_filename <- tietue
+			}
 
 			# ASK: remove?
 			# if ~isempty(partitionCompare)
 			# 	fprintf(1,'Data: %s\n',[pathname filename]);
 			# end
 
-			data <- load(pathname_filename)
+			data <- read.delim(pathname_filename) # ASK: what is the delimiter?
 			# ninds <- testaaOnkoKunnollinenBapsData(data)  #TESTAUS # TODO: trans
-			if (ninds == 0) stop('Incorrect Data-file')
+			# if (ninds == 0) stop('Incorrect Data-file')
 
 			# ASK: remove?
 			# h0 = findobj('Tag','filename1_text');
@@ -78,13 +99,16 @@ greedyMix <- function(tietue) {
 
 			# [data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data); # TODO: translate this function
 			# [Z,dist] = newGetDistances(data,rowsFromInd); # TODO: translate
-
-			save_preproc <- questdlg(
-				quest = 'Do you wish to save pre-processed data?',
-				dlgtitle = 'Save pre-processed data?',
-				defbtn = 'y'
-			)
-			if (save_preproc %in% c('y', 'yes')) {
+			if (is.null(savePreProcessed)) {
+				save_preproc <- questdlg(
+					quest = 'Do you wish to save pre-processed data?',
+					dlgtitle = 'Save pre-processed data?',
+					defbtn = 'y'
+				)
+			} else {
+				save_preproc <- savePreProcessed
+			}
+			if (save_preproc %in% c('y', 'yes', TRUE)) {
 				file_out      <- uiputfile('.rda','Save pre-processed data as')
 				kokonimi      <- paste0(file_out$path, file_out$name)
 				c             <- list()
@@ -100,12 +124,19 @@ greedyMix <- function(tietue) {
 				save(c, file = kokonimi)
 				rm(c)
 			}
+		# ----------------------------------------------------------------------
+		# Treating GenePop-formatted files
+		# ----------------------------------------------------------------------
 		} else if (input_type_name == 'GenePop-format') {
-			filename_pathname <- uigetfile(
-				filter = '*.txt',
-				title = 'Load data in GenePop-format'
-			)
-			if (filename_pathname$name == 0) stop("No name provided")
+			if (!is(tietue, "character")) {
+				filename_pathname <- uigetfile(
+					filter = '*.txt',
+					title = 'Load data in GenePop-format'
+				)
+				if (filename_pathname$name == 0) stop("No name provided")
+			} else {
+				filename_pathname <- tietue
+			}
 
 			# ASK: remove?
 			# if ~isempty(partitionCompare)
@@ -121,14 +152,19 @@ greedyMix <- function(tietue) {
 
 # 			[data, rowsFromInd, alleleCodes, noalle, adjprior, priorTerm] = handleData(data); # TODO:trans
 # 			[Z,dist] = newGetDistances(data,rowsFromInd); # TODO: trans
-			save_preproc <- questdlg(
-				quest = 'Do you wish to save pre-processed data?',
-				dlgtitle = 'Save pre-processed data?',
-				defbtn = 'y'
-			)
-			if (save_preproc %in% c('y', 'Yes')) {
+			if (is.null(savePreProcessed)) {
+				save_preproc <- questdlg(
+					quest = 'Do you wish to save pre-processed data?',
+					dlgtitle = 'Save pre-processed data?',
+					defbtn = 'y'
+				)
+			} else {
+				save_preproc <- savePreProcessed
+			}
+			if (save_preproc %in% c('y', 'Yes', TRUE)) {
 				file_out      <- uiputfile('.rda','Save pre-processed data as')
 				kokonimi      <- paste0(file_out$path, file_out$name)
+				# FIXME: translate functions above so the objects below exist
 				c$data        <- data
 				c$rowsFromInd <- rowsFromInd
 				c$alleleCodes <- alleleCodes
@@ -141,6 +177,9 @@ greedyMix <- function(tietue) {
 				save(c, file = kokonimi)
 				rm(c)
 			}
+		# ----------------------------------------------------------------------
+		# Handling Pre-processed data
+		# ----------------------------------------------------------------------
 		} else if (input_type_name == 'Preprocessed data') {
 			file_in <- uigetfile(
 				filter = '*.txt',
diff --git a/man/greedyMix.Rd b/man/greedyMix.Rd
index 71ef088..8909046 100644
--- a/man/greedyMix.Rd
+++ b/man/greedyMix.Rd
@@ -4,10 +4,19 @@
 \alias{greedyMix}
 \title{Clustering of individuals}
 \usage{
-greedyMix(tietue)
+greedyMix(
+  tietue,
+  format = NULL,
+  savePreProcessed = NULL,
+  filePreProcessed = NULL
+)
 }
 \arguments{
 \item{tietue}{Record}
+
+\item{format}{Format of the data ("BAPS", "GenePop" or "Preprocessed")}
+
+\item{savePreProcessed}{Save the pre-processed data?}
 }
 \description{
 Clustering of individuals

From 8a4b2d8fc3ddb70a64a98a4be1d2e66b5845de33 Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Mon, 8 Jun 2020 15:41:52 +0200
Subject: [PATCH 10/11] Added testaaGenePopData function

---
 R/greedyMix.R            | 81 ----------------------------------------
 R/testaaGenePopData.R    | 63 +++++++++++++++++++++++++++++++
 man/testaaGenePopData.Rd | 11 ++++++
 3 files changed, 74 insertions(+), 81 deletions(-)
 create mode 100644 R/testaaGenePopData.R
 create mode 100644 man/testaaGenePopData.Rd

diff --git a/R/greedyMix.R b/R/greedyMix.R
index 5731d9d..201e045 100644
--- a/R/greedyMix.R
+++ b/R/greedyMix.R
@@ -1613,87 +1613,6 @@ greedyMix <- function(
 # 		emptyPop = min(find(popDiff > 1));
 # 	end
 
-# 	%--------------------------------------------------------------------
-
-
-# 	function kunnossa = testaaGenePopData(tiedostonNimi)
-# 	% kunnossa == 0, jos data ei ole kelvollinen genePop data.
-# 	% Muussa tapauksessa kunnossa == 1.
-
-# 	kunnossa = 0;
-# 	fid = fopen(tiedostonNimi);
-# 	line1 = fgetl(fid);  %ensimm�inen rivi
-# 	line2 = fgetl(fid);  %toinen rivi
-# 	line3 = fgetl(fid);  %kolmas
-
-# 	if (isequal(line1,-1) | isequal(line2,-1) | isequal(line3,-1))
-# 		disp('Incorrect file format 1168'); fclose(fid);
-# 		return
-# 	end
-# 	if (testaaPop(line1)==1 | testaaPop(line2)==1)
-# 		disp('Incorrect file format 1172'); fclose(fid);
-# 		return
-# 	end
-# 	if testaaPop(line3)==1
-# 		%2 rivi t�ll�in lokusrivi
-# 		nloci = rivinSisaltamienMjonojenLkm(line2);
-# 		line4 = fgetl(fid);
-# 		if isequal(line4,-1)
-# 			disp('Incorrect file format 1180'); fclose(fid);
-# 			return
-# 		end
-# 		if ~any(line4==',')
-# 			% Rivin nelj?t�ytyy sis�lt�� pilkku.
-# 			disp('Incorrect file format 1185'); fclose(fid);
-# 			return
-# 		end
-# 		pointer = 1;
-# 		while ~isequal(line4(pointer),',')  %Tiedet��n, ett?pys�htyy
-# 			pointer = pointer+1;
-# 		end
-# 		line4 = line4(pointer+1:end);  %pilkun j�lkeinen osa
-# 		nloci2 = rivinSisaltamienMjonojenLkm(line4);
-# 		if (nloci2~=nloci)
-# 			disp('Incorrect file format 1195'); fclose(fid);
-# 			return
-# 		end
-# 	else
-# 		line = fgetl(fid);
-# 		lineNumb = 4;
-# 		while (testaaPop(line)~=1 & ~isequal(line,-1))
-# 			line = fgetl(fid);
-# 			lineNumb = lineNumb+1;
-# 		end
-# 		if isequal(line,-1)
-# 			disp('Incorrect file format 1206'); fclose(fid);
-# 			return
-# 		end
-# 		nloci = lineNumb-2;
-# 		line4 = fgetl(fid);  %Eka rivi pop sanan j�lkeen
-# 		if isequal(line4,-1)
-# 			disp('Incorrect file format 1212'); fclose(fid);
-# 			return
-# 		end
-# 		if ~any(line4==',')
-# 			% Rivin t�ytyy sis�lt�� pilkku.
-# 			disp('Incorrect file format 1217'); fclose(fid);
-# 			return
-# 		end
-# 		pointer = 1;
-# 		while ~isequal(line4(pointer),',')  %Tiedet��n, ett?pys�htyy.
-# 			pointer = pointer+1;
-# 		end
-
-# 		line4 = line4(pointer+1:end);  %pilkun j�lkeinen osa
-# 		nloci2 = rivinSisaltamienMjonojenLkm(line4);
-# 		if (nloci2~=nloci)
-# 			disp('Incorrect file format 1228'); fclose(fid);
-# 			return
-# 		end
-# 	end
-# 	kunnossa = 1;
-# 	fclose(fid);
-
 # 	%------------------------------------------------------
 
 
diff --git a/R/testaaGenePopData.R b/R/testaaGenePopData.R
new file mode 100644
index 0000000..4540493
--- /dev/null
+++ b/R/testaaGenePopData.R
@@ -0,0 +1,63 @@
+#' @title Tests GenePop data
+testaaGenePopData <- function(tiedostonNimi) {
+	# kunnossa == 0, jos data ei ole kelvollinen genePop data.
+	# Muussa tapauksessa kunnossa == 1.
+
+	kunnossa <- 0
+	if (file.exists(paste0(tiedostonNimi, ".rda"))) {
+		fid   <- load(tiedostonNimi)
+		line1 <- readLines(fid)[1] # ensimmäinen rivi
+		line2 <- readLines(fid)[2] # toinen rivi
+		line3 <- readLines(fid)[3] # kolmas
+	} else {
+		fid <- line1 <- line2 <- line3 <- -1
+	}
+
+	if (line1 == -1 | line2 == -1 | line3 == -1) {
+		stop('Incorrect file format 1168')
+	}
+	if (testaaPop(line1) == 1 | testaaPop(line2) == 1) { # TODO: translate function
+		stop('Incorrect file format 1172')
+	}
+	if (testaaPop(line3) == 1) {
+		# 2 rivi t�ll�in lokusrivi
+		nloci <- rivinSisaltamienMjonojenLkm(line2) # TODO: translate function
+		line4 <- readLines(fid)[4]
+		if (line4 == -1) stop('Incorrect file format 1180')
+		if (!grepl(',', line4)) {
+			# Rivin nelj?t�ytyy sis�lt�� pilkku.
+			stop('Incorrect file format 1185')
+		}
+		pointer <- 1
+		while (line4[pointer] != ',') { # Tiedet��n, ett?pys�htyy
+			pointer <- pointer + 1
+		}
+		line4 <- line4[(pointer + 1):nchar(line4)] # pilkun j�lkeinen osa
+		nloci2 <- rivinSisaltamienMjonojenLkm(line4)
+		if (nloci2 != nloci) stop('Incorrect file format 1195')
+	} else {
+		line <- readLines(fid)[4]
+		lineNumb <- 4
+		while (testaaPop(line) != 1 & line != -1) {
+			line <- readLines(fid)[lineNumb]
+			lineNumb <- lineNumb + 1
+		}
+		if (line == -1) stop('Incorrect file format 1206')
+		nloci <- lineNumb - 2
+		line4 <- readLines(fid)[4] # Eka rivi pop sanan j�lkeen
+		if (line4 == -1) stop('Incorrect file format 1212')
+		if (!grepl(',', line4)) {
+			# Rivin t�ytyy sis�lt�� pilkku.
+			stop('Incorrect file format 1217')
+		}
+		pointer <- 1
+		while (line4[pointer] != ',') { # Tiedet��n, ett?pys�htyy
+			pointer <- pointer + 1
+		}
+		line4 <- line4[(pointer + 1):nchar(line4)] # pilkun j�lkeinen osa
+		nloci2 <- rivinSisaltamienMjonojenLkm(line4)
+		if (nloci2 != nloci) stop('Incorrect file format 1228')
+	}
+	kunnossa <- 1
+	return(kunnossa)
+}
\ No newline at end of file
diff --git a/man/testaaGenePopData.Rd b/man/testaaGenePopData.Rd
new file mode 100644
index 0000000..167b33c
--- /dev/null
+++ b/man/testaaGenePopData.Rd
@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/testaaGenePopData.R
+\name{testaaGenePopData}
+\alias{testaaGenePopData}
+\title{Tests GenePop data}
+\usage{
+testaaGenePopData(tiedostonNimi)
+}
+\description{
+Tests GenePop data
+}

From 4b2cba59bd4d34a64ec20c17b304164a3cd4d1fb Mon Sep 17 00:00:00 2001
From: Waldir Leoncio <waldir.leoncio@gmail.com>
Date: Wed, 24 Jun 2020 11:13:52 +0200
Subject: [PATCH 11/11] Added function

---
 R/greedyMix.R                     | 15 ---------------
 R/testaaOnkoKunnollinenBapsData.R | 21 +++++++++++++++++++++
 2 files changed, 21 insertions(+), 15 deletions(-)
 create mode 100644 R/testaaOnkoKunnollinenBapsData.R

diff --git a/R/greedyMix.R b/R/greedyMix.R
index 201e045..39c99ac 100644
--- a/R/greedyMix.R
+++ b/R/greedyMix.R
@@ -1583,21 +1583,6 @@ greedyMix <- function(
 # 	apu = (apu(:,1)-1).*ninds - apu(:,1) ./ 2 .* (apu(:,1)-1) + (apu(:,2)-apu(:,1));
 # 	dist2 = dist(apu);
 
-# 	%--------------------------------------------------------
-
-# 	function ninds = testaaOnkoKunnollinenBapsData(data)
-# 	%Tarkastaa onko viimeisess?sarakkeessa kaikki
-# 	%luvut 1,2,...,n johonkin n:��n asti.
-# 	%Tarkastaa lis�ksi, ett?on v�hint��n 2 saraketta.
-# 	if size(data,1)<2
-# 		ninds = 0; return;
-# 	end
-# 	lastCol = data(:,end);
-# 	ninds = max(lastCol);
-# 	if ~isequal((1:ninds)',unique(lastCol))
-# 		ninds = 0; return;
-# 	end
-
 # 	%--------------------------------------------------------------------------
 
 # 	function [emptyPop, pops] = findEmptyPop(npops)
diff --git a/R/testaaOnkoKunnollinenBapsData.R b/R/testaaOnkoKunnollinenBapsData.R
new file mode 100644
index 0000000..8cdc5f3
--- /dev/null
+++ b/R/testaaOnkoKunnollinenBapsData.R
@@ -0,0 +1,21 @@
+#' @title TestBAPS data
+#' @description Test if loaded BAPS data is proper
+#' @param data dataset
+#' @return ninds
+#' @export
+testaaOnkoKunnollinenBapsData <- function(data) {
+	# Tarkastaa onko viimeisess?sarakkeessa kaikki
+	# luvut 1,2,...,n johonkin n:��n asti.
+	# Tarkastaa lis�ksi, ett?on v�hint��n 2 saraketta.
+	if (size[data, 1] < 2) {
+		ninds <- 0
+		return(ninds)
+	}
+	lastCol <- data[, ncol(data)]
+	ninds <- max(lastCol)
+	if (t(1:ninds) != unique(lastCol)) {
+		ninds <- 0
+		return(ninds)
+	}
+	return(ninds)
+}
\ No newline at end of file