Merge 2-translate-greedyPopMix into develop
This commit is contained in:
commit
e9e858c667
4 changed files with 41 additions and 1 deletions
|
|
@ -52,6 +52,7 @@ importFrom(matlab2r,isspace)
|
||||||
importFrom(matlab2r,max)
|
importFrom(matlab2r,max)
|
||||||
importFrom(matlab2r,min)
|
importFrom(matlab2r,min)
|
||||||
importFrom(matlab2r,ones)
|
importFrom(matlab2r,ones)
|
||||||
|
importFrom(matlab2r,questdlg)
|
||||||
importFrom(matlab2r,rand)
|
importFrom(matlab2r,rand)
|
||||||
importFrom(matlab2r,repmat)
|
importFrom(matlab2r,repmat)
|
||||||
importFrom(matlab2r,reshape)
|
importFrom(matlab2r,reshape)
|
||||||
|
|
|
||||||
26
R/findOutRowsFromInd.R
Normal file
26
R/findOutRowsFromInd.R
Normal file
|
|
@ -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))
|
||||||
|
}
|
||||||
|
|
@ -5,6 +5,8 @@
|
||||||
#' @note Found a bug? Want to suggest a feature? Contribute to the scientific
|
#' @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.
|
#' and open source communities by opening an issue on our home page.
|
||||||
#' Check the "BugReports" field on the package description for the URL.
|
#' 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
|
#' @importFrom stats runif
|
||||||
NULL
|
NULL
|
||||||
|
|
|
||||||
11
tests/testthat/test-greedyPopMix.R
Normal file
11
tests/testthat/test-greedyPopMix.R
Normal file
|
|
@ -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)
|
||||||
|
})
|
||||||
Loading…
Add table
Reference in a new issue