diff --git a/NAMESPACE b/NAMESPACE index 73534fe..9c77f97 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -52,6 +52,7 @@ importFrom(matlab2r,isspace) importFrom(matlab2r,max) importFrom(matlab2r,min) importFrom(matlab2r,ones) +importFrom(matlab2r,questdlg) importFrom(matlab2r,rand) importFrom(matlab2r,repmat) importFrom(matlab2r,reshape) diff --git a/R/findOutRowsFromInd.R b/R/findOutRowsFromInd.R new file mode 100644 index 0000000..fd0cc31 --- /dev/null +++ b/R/findOutRowsFromInd.R @@ -0,0 +1,26 @@ +findOutRowsFromInd <- function(popnames, rows, ploidisuus = NULL) { + if (is.null(ploidisuus)) { + ploidisuus <- questdlg( + quest = 'Specify the type of individuals in the data', + dlgtitle = 'Individual type?', + btn = c('Haploid', 'Diploid', 'Tetraploid'), + defbtn = 'Diploid' + ) + } + + rowsFromInd <- switch(ploidisuus, + 'Haploid' = 1, + 'Diploid' = 2, + 'Tetraploid' = 4 + ) + + popnames2 <- popnames * NA + if (!is.null(popnames)) { + for (i in seq_len(size(rows, 1))) { + popnames2[i, 1] <- popnames[i, 1] + rivi <- rows[i, 1]:rows[i, 2] + popnames2[i, 2] <- rivi[rowsFromInd] / rowsFromInd + } + } + return(list(popnames2 = popnames2, rowsFromInd = rowsFromInd)) +} diff --git a/R/rBAPS-package.R b/R/rBAPS-package.R index ee56dc4..c9fde26 100644 --- a/R/rBAPS-package.R +++ b/R/rBAPS-package.R @@ -5,6 +5,8 @@ #' @note Found a bug? Want to suggest a feature? Contribute to the scientific #' and open source communities by opening an issue on our home page. #' Check the "BugReports" field on the package description for the URL. -#' @importFrom matlab2r blanks cell colon find inputdlg isempty isfield isspace max min ones rand repmat reshape size sortrows squeeze strcmp times zeros +#' @importFrom matlab2r blanks cell colon find inputdlg +#' isempty isfield isspace max min ones questdlg rand repmat reshape +#' size sortrows squeeze strcmp times zeros #' @importFrom stats runif NULL diff --git a/tests/testthat/test-greedyPopMix.R b/tests/testthat/test-greedyPopMix.R new file mode 100644 index 0000000..a770d12 --- /dev/null +++ b/tests/testthat/test-greedyPopMix.R @@ -0,0 +1,11 @@ +context("greedyPopMix functions") + +test_that("Auxiliary functions work properly", { + x <- matrix(11:16, 3) + y <- matrix(2:7, 3) + z <- list( + popnames2 = matrix(c(11:13, seq(1.5, 2.5, 0.5)), 3), + rowsFromInd = 2 + ) + expect_equal(findOutRowsFromInd(x, y, "Diploid"), z) +})