max/ourMELONS
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'fix-tests' into develop

Browse source
This commit is contained in:
Waldir Leoncio 2021-01-15 09:39:02 +01:00
commit bfea191db2
6 changed files with 37 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
R/computePersonalAllFreqs.R
View file

@ -10,11 +10,14 @@
#' @export #' @export
computePersonalAllFreqs <- function(ind, data, allFreqs, rowsFromInd) { computePersonalAllFreqs <- function(ind, data, allFreqs, rowsFromInd) {
if (is.null(dim(COUNTS))) {
nloci <- npops <- 1
} else {
nloci <- ifelse(is.na(dim(COUNTS)[2]), 1, dim(COUNTS)[2]) nloci <- ifelse(is.na(dim(COUNTS)[2]), 1, dim(COUNTS)[2])
npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3]) npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
}
rows <- as.matrix(t(data))[computeRows(rowsFromInd, ind, 1), , drop = FALSE] rows <- as.matrix(t(data))[computeRows(rowsFromInd, ind, 1), , drop = FALSE]
omaFreqs <- zeros(npops, rowsFromInd * nloci) omaFreqs <- zeros(npops, rowsFromInd * nloci)
pointer <- 1 pointer <- 1
for (loc in 1:dim(rows)[2]) { for (loc in 1:dim(rows)[2]) {

4
R/laskeMuutokset12345.R
View file

@ -9,7 +9,11 @@
#' @param logml log maximum likelihood #' @param logml log maximum likelihood
#' @export #' @export
laskeMuutokset4 <- function (osuus, osuusTaulu, omaFreqs, logml) { laskeMuutokset4 <- function (osuus, osuusTaulu, omaFreqs, logml) {
if (is.null(dim(COUNTS))) {
npops <- 1
} else {
npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3]) npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
}
notEmpty <- which(osuusTaulu > 0.005) notEmpty <- which(osuusTaulu > 0.005)
muutokset <- zeros(npops) muutokset <- zeros(npops)
empties <- !notEmpty empties <- !notEmpty

11
R/setdiff_MATLAB.R
View file

@ -9,7 +9,16 @@ setdiff_MATLAB <- function(A, B, legacy = FALSE) {
if (is(A, "numeric") & is(B, "numeric")) { if (is(A, "numeric") & is(B, "numeric")) {
values <- sort(unique(A[is.na(match(A, B))])) values <- sort(unique(A[is.na(match(A, B))]))
} else if (is(A, "data.frame") & is(B, "data.frame")) { } else if (is(A, "data.frame") & is(B, "data.frame")) {
stop("Not implemented for data frames") C <- A
exclude_rows <- vector()
for (r1 in seq_len(nrow(A))) {
for (r2 in seq_len(nrow(B))) {
if (all(A[r1, ] == B[r2, ])) {
exclude_rows <- append(exclude_rows, r1)
}
}
}
values <- C[-exclude_rows, ]
} }
# TODO: add support for indices (if necessary) # TODO: add support for indices (if necessary)
return(values) return(values)

4
R/suoritaMuutos.R
View file

@ -5,7 +5,11 @@
#' @param indeksi index #' @param indeksi index
#' @export #' @export
suoritaMuutos <- function (osuusTaulu, osuus, indeksi) { suoritaMuutos <- function (osuusTaulu, osuus, indeksi) {
if (is.null(dim(COUNTS))) {
npops <- 1
} else {
npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3]) npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
}
i1 <- indeksi %% npops i1 <- indeksi %% npops
if (is.na(i1) | i1 == 0) i1 <- npops if (is.na(i1) | i1 == 0) i1 <- npops

5
tests/testthat/test-convertedBaseFunctions.R
View file

@ -223,7 +223,7 @@ test_that("setdiff works as expected", {
A <- c(3, 6, 2, 1, 5, 1, 1) A <- c(3, 6, 2, 1, 5, 1, 1)
B <- c(2, 4, 6) B <- c(2, 4, 6)
C <- c(1, 3, 5) C <- c(1, 3, 5)
# expect_equal(setdiff_MATLAB(A, B), C) # TODO: export setdiff_MATLAB expect_equal(setdiff_MATLAB(A, B), C) # TODO: export setdiff_MATLAB
A <- data.frame( A <- data.frame(
Var1 = 1:5, Var1 = 1:5,
Var2 = LETTERS[1:5], Var2 = LETTERS[1:5],
@ -239,6 +239,7 @@ test_that("setdiff works as expected", {
Var2 = c('B', 'D'), Var2 = c('B', 'D'),
Var3 = c(TRUE, TRUE) Var3 = c(TRUE, TRUE)
) )
# expect_equal(setdiff_MATLAB(A, B), C) # TODO: implement for data frames row.names(C) <- c(2L, 4L)
expect_equal(setdiff_MATLAB(A, B), C) # TODO: implement for data frames
# TODO: add more examples from https://se.mathworks.com/help/matlab/ref/double.setdiff.html;jsessionid=0d8d42582d4d299b8224403899f1 # TODO: add more examples from https://se.mathworks.com/help/matlab/ref/double.setdiff.html;jsessionid=0d8d42582d4d299b8224403899f1
}) })