Merge branch 'fix-tests' into develop

R/computePersonalAllFreqs.R

@@ -10,11 +10,14 @@
 #' @export
 
 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])
         npops <- ifelse(is.na(dim(COUNTS)[3]), 1, dim(COUNTS)[3])
+    }
 
     rows <- as.matrix(t(data))[computeRows(rowsFromInd, ind, 1), , drop = FALSE]
-
     omaFreqs <- zeros(npops, rowsFromInd * nloci)
     pointer <- 1
     for (loc in 1:dim(rows)[2]) {

R/laskeMuutokset12345.R

@@ -9,7 +9,11 @@
 #' @param logml log maximum likelihood
 #' @export
 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])
+	}
 	notEmpty <- which(osuusTaulu > 0.005)
 	muutokset <- zeros(npops)
 	empties <- !notEmpty

R/setdiff_MATLAB.R

@@ -9,7 +9,16 @@ setdiff_MATLAB <- function(A, B, legacy = FALSE) {
 	if (is(A, "numeric") & is(B, "numeric")) {
 		values <- sort(unique(A[is.na(match(A, B))]))
 	} 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)
 	return(values)

R/suoritaMuutos.R

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

tests/testthat/test-convertedBaseFunctions.R

@@ -223,7 +223,7 @@ test_that("setdiff works as expected", {
 	A <- c(3, 6, 2, 1, 5, 1, 1)
 	B <- c(2, 4, 6)
 	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(
 		Var1 = 1:5,
 		Var2 = LETTERS[1:5],
@@ -239,6 +239,7 @@ test_that("setdiff works as expected", {
 		Var2 = c('B', 'D'),
 		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
 })