Each section provides a function that supposedly works as expected, but quickly proves to misbehave.
The exercise aims at first writing some dedicated testing functions that will identify the problems
and then update the function so that it passes the specific tests. This practice is called unit testing
and we use the RUnit
package for this. For details on unit testing using RUnit
see http://bioconductor.org/developers/how-to/unitTesting-guidelines/.
## Example
isIn <- function(x, y) {
sel <- match(x, y)
y[sel]
}
## Expected
x <- sample(LETTERS, 5)
isIn(x, LETTERS)
## Bug!
isIn(c(x, "a"), LETTERS)
## Unit test:
library("RUnit")
test_isIn <- function() {
x <- c("A", "B", "Z")
checkIdentical(x, isIn(x, LETTERS))
checkIdentical(x, isIn(c(x, "a"), LETTERS))
}
test_isIn()
## updated function
isIn <- function(x, y) {
sel <- x %in% y
x[sel]
}
test_isIn()
## Example
isExactIn <- function(x, y)
y[grep(x, y)]
## Expected
isExactIn("a", letters)
## Bugs
isExactIn("a", c("abc", letters))
isExactIn(c("a", "z"), c("abc", letters))
## Unit test:
library("RUnit")
test_isExactIn <- function() {
checkIdentical("a", isExactIn("a", letters))
checkIdentical("a", isExactIn("a", c("abc", letters)))
checkIdentical(c("a", "z"), isExactIn(c("a", "z"), c("abc", letters)))
}
test_isExactIn()
## updated function:
isExactIn <- function(x, y)
x[x %in% y]
test_isExactIn()
## Example
ifcond <- function(x, y) {
if (x > y) {
ans <- x*x - y*y
} else {
ans <- x*x + y*y
}
ans
}
## Expected
do(3, 2)
do(2, 2)
do(1, 2)
## Bug!
do(3:1, c(2, 2, 2))
## Unit test:
library("RUnit")
test_ifcond <- function() {
checkIdentical(5, ifcond(3, 2))
checkIdentical(8, ifcond(2, 2))
checkIdentical(5, ifcond(1, 2))
checkIdentical(c(5, 8, 5), ifcond(3:1, c(2, 2, 2)))
}
test_ifcond()
## updated function:
ifcond <- function(x, y)
ifelse(x > y, x*x - y*y, x*x + y*y)
test_ifcond()
## Example
distances <- function(point, pointVec) {
x <- point[1]
y <- point[2]
xVec <- pointVec[,1]
yVec <- pointVec[,2]
dist <- sqrt((xVec - x)^2 + (yVec - y)^2)
return(dist)
}
## Expected
x <- rnorm(5)
y <- rnorm(5)
m <- cbind(x, y)
p <- m[1, ]
distances(p, m)
## Bug!
dd <- data.frame(x, y)
q <- dd[1, ]
distances(q, dd)
## Unit test:
library("RUnit")
test_distances <- function() {
x <- y <- c(0, 1, 2)
m <- cbind(x, y)
p <- m[1, ]
dd <- data.frame(x, y)
q <- dd[1, ]
expct <- c(0, sqrt(c(2, 8)))
checkIdentical(expct, distances(p, m))
checkIdentical(expct, distances(q, dd))
}
test_distances()
## updated function
distances <- function(point, pointVec) {
point <- as.numeric(point)
x <- point[1]
y <- point[2]
xVec <- pointVec[,1]
yVec <- pointVec[,2]
dist <- sqrt((xVec - x)^2 + (yVec - y)^2)
return(dist)
}
test_distances()
## Example
sqrtabs <- function(x) {
v <- abs(x)
sapply(1:length(v), function(i) sqrt(v[i]))
}
## Expected
all(sqrtabs(c(-4, 0, 4)) == c(2, 0, 2))
## Bug!
sqrtabs(numeric())
## Unit test:
library(RUnit)
test_sqrtabs <- function() {
checkIdentical(c(2, 0, 2), sqrtabs(c(-4, 0, 4)))
checkIdentical(numeric(), sqrtabs(numeric()))
}
test_sqrtabs()
## updated function:
sqrtabs <- function(x) {
v <- abs(x)
sapply(seq_along(v), function(i) sqrt(v[i]))
}
test_sqrtabs() # nope!
sqrtabs <- function(x) {
v <- abs(x)
vapply(seq_along(v), function(i) sqrt(v[i]), 0)
}
test_sqrtabs() # yes!