Added tests, fixed subfunctions (#3)
This commit is contained in:
parent
606078c355
commit
a8cae95c82
4 changed files with 38 additions and 19 deletions
|
|
@ -4,13 +4,12 @@ dec2bitv <- function(d, n) {
|
||||||
# n is an optional minimum length on the bit vector.
|
# n is an optional minimum length on the bit vector.
|
||||||
# If d is a vector, each row of the output array will be a bit vector.
|
# If d is a vector, each row of the output array will be a bit vector.
|
||||||
|
|
||||||
if (nargin() < 2) {
|
if (!exists("n") || n == 0) {
|
||||||
n <- 1 # Need at least one digit even for 0.
|
n <- 1 # Need at least one digit even for 0.
|
||||||
}
|
}
|
||||||
d <- d[]
|
|
||||||
|
|
||||||
f <- e <- NA
|
f <- e <- NA
|
||||||
c(f, e) %<-% matlab2r::log2(max(d)) # How many digits do we need to represent the numbers?
|
c(f, e) %<-% matlab2r::log2(base::max(d)) # How many digits do we need to represent the numbers?
|
||||||
bits <- floor(d * 2 ^ (seq(1 - max(n, e), 0))) %% 2
|
bits <- floor(d * 2 ^ (seq(1 - base::max(n, e), 0))) %% 2
|
||||||
return(bits)
|
return(bits)
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -8,22 +8,22 @@ myintersect <- function(A, B) {
|
||||||
if (is.null(A)) {
|
if (is.null(A)) {
|
||||||
ma <- 0
|
ma <- 0
|
||||||
} else {
|
} else {
|
||||||
ma <- max(A)
|
ma <- base::max(A)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (is.null(B)) {
|
if (is.null(B)) {
|
||||||
mb <- 0
|
mb <- 0
|
||||||
} else {
|
} else {
|
||||||
mb <- max(B)
|
mb <- base::max(B)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (ma == 0 | mb == 0) {
|
if (ma == 0 || mb == 0) {
|
||||||
C <- vector()
|
C <- vector()
|
||||||
} else {
|
} else {
|
||||||
# bits <- sparse(1, max(ma, mb))
|
# bits <- sparse(1, max(ma, mb))
|
||||||
bits <- zeros(1, max(ma, mb))
|
bits <- zeros(1, base::max(ma, mb))
|
||||||
bits[A] <- 1
|
bits[as.vector(A)] <- 1
|
||||||
C <- B[as.logical(bits[B])]
|
C <- B[as.logical(bits[as.vector(B)])]
|
||||||
}
|
}
|
||||||
return(C)
|
return(sort(C))
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,8 @@
|
||||||
myisvector <- function(V) {
|
myisvector <- function(V) {
|
||||||
# Kuten isvector(V)
|
# Kuten isvector(V)
|
||||||
|
V <- as.matrix(V)
|
||||||
|
A <- c(nrow(V), ncol(V))
|
||||||
|
|
||||||
A <- size(V)
|
r <- (base::max(size(A)) == 2) & (base::min(A) == 1)
|
||||||
r <- (length(A) == 2) & (min(A) == 1)
|
|
||||||
return(r)
|
return(r)
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -35,19 +35,38 @@ test_that("testaaKoordinaatit works as expected", {
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("lakseKlitik() and subfunctions produce expected output", {
|
test_that("lakseKlitik() and subfunctions produce expected output", {
|
||||||
|
expect_equal(neighbors(matrix(c(11, 22, 33, 44), 2), 2), c(1, 2))
|
||||||
|
expect_equal(myintersect(matrix(1:4, 2), matrix(2:5, 2)), 2:4)
|
||||||
|
expect_equal(myintersect(matrix(1:4, 2), matrix(5:8, 2)), integer(0))
|
||||||
|
expect_equal(myintersect(matrix(1:4, 2), matrix(4:7, 2)), 4)
|
||||||
|
expect_true(myisvector(runif(1)))
|
||||||
|
expect_true(myisvector(matrix(runif(1))))
|
||||||
|
expect_true(myisvector(runif(2)))
|
||||||
|
expect_true(myisvector(matrix(runif(2))))
|
||||||
|
expect_true(myisvector(rand(2, 1)))
|
||||||
|
expect_true(myisvector(rand(1, 2)))
|
||||||
|
expect_false(myisvector(rand(2, 2)))
|
||||||
|
expect_equal(mysize(rand(1, 1)), 1)
|
||||||
|
expect_equal(mysize(rand(2, 1)), 2)
|
||||||
|
expect_equal(mysize(rand(1, 2)), 2)
|
||||||
|
expect_equal(mysize(rand(2, 2)), c(2, 2))
|
||||||
|
expect_equal(dec2bitv(1, 2), c(0, 1))
|
||||||
|
expect_equal(dec2bitv(5, 2), c(1, 0, 1))
|
||||||
|
expect_equal(dec2bitv(5, 5), c(0, 0, 1, 0, 1))
|
||||||
|
expect_equal(dec2bitv(5, 1), c(1, 0, 1))
|
||||||
|
expect_equal(dec2bitv(5, 0), c(1, 0, 1))
|
||||||
|
expect_equal(dec2bitv(10, 1), c(1, 0, 1, 0))
|
||||||
|
expect_equal(dec2bitv(10, 5), c(0, 1, 0, 1, 0))
|
||||||
|
expect_equal(dec2bitv(10, 10), c(0, 0, 0, 0, 0, 0, 1, 0, 1, 0))
|
||||||
|
# TODO: test ind2subv()
|
||||||
|
# TODO: test argmin()
|
||||||
# TODO: test elim_order()
|
# TODO: test elim_order()
|
||||||
# TODO: test triangulate()
|
# TODO: test triangulate()
|
||||||
# TODO: test neighbors()
|
|
||||||
# TODO: test myintersect()
|
|
||||||
# TODO: test mysubset()
|
# TODO: test mysubset()
|
||||||
# TODO: test findCliques()
|
# TODO: test findCliques()
|
||||||
# TODO: test cliques_to_jtree()
|
# TODO: test cliques_to_jtree()
|
||||||
# TODO: test minimum_spanning_tree()
|
# TODO: test minimum_spanning_tree()
|
||||||
# TODO: test myunion()
|
# TODO: test myunion()
|
||||||
# TODO: test argmin()
|
|
||||||
# TODO: test mysize()
|
|
||||||
# TODO: test ind2subv()
|
|
||||||
# TODO: test myisvector()
|
|
||||||
# TODO: ... and anythin left from findCliques.m
|
# TODO: ... and anythin left from findCliques.m
|
||||||
# TODO: test lakseKlitik()
|
# TODO: test lakseKlitik()
|
||||||
})
|
})
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue