Nothing
tests/testthat/test_funDataMethods.R
In funData: An S4 Class for Functional Data
context("Test funData methods")
f1 <- funData(argvals = 1:5, X = matrix(1:20, nrow = 4))
f2 <- funData(argvals = list(1:5, 1:6), X = array(1:120, c(4,5,6)))
f3 <- funData(argvals = list(1:5, 1:6, 1:4), X = array(1:480, c(4, 5, 6, 4)))
m1 <- multiFunData(f1, f2)
i1 <- irregFunData(argvals = list(1:5, 2:4, 3:5), X = list(1:5, 2:4, -(3:1)))
fi <- as.irregFunData(f1)
# special case for data with only one observation
f1.1 <- funData(argvals = 1:5, X = matrix(1:5, nrow = 1))
f2.1 <- funData(argvals = list(1:5, 1:6), X = array(1:30,c(1,5,6)))
m1.1 <- multiFunData(list(f1.1,f2.1))
test_that("print",{
expect_known_output(print(f1), file = "outputs/print_funData.out")
expect_known_output(print(m1), file = "outputs/print_multiFunData.out")
expect_known_output(print(i1), file = "outputs/print_irregFunData.out")
})
test_that("str",{
m2 <- m1
names(m2) <- letters[1:length(m2)]
expect_known_output(str(f1), file = "outputs/str_funData.out")
expect_known_output(str(m1), file = "outputs/str_multiFunData.out")
expect_known_output(str(m2), file = "outputs/str_multiFunData_2.out")
expect_known_output(str(i1), file = "outputs/str_irregFunData.out")
expect_known_output(str(i1, list.len = 1), file = "outputs/str_irregFunData_len1.out")
})
test_that("summary",{
# Check errors:
expect_error(funData:::print.summary.funData(summary(m1)),
"Argument is not of class 'summary.funData'.")
expect_error(funData:::print.summary.multiFunData(summary(f1)),
"Argument is not of class 'summary.multiFunData'.")
expect_error(funData:::print.summary.irregFunData(summary(f1)),
"Argument is not of class 'summary.irregFunData'.")
# Check functionality:
fName <- f1
names(fName) <- letters[1:nObs(fName)]
expect_known_output(print(summary(f1)), file = "outputs/summary_funData.out")
expect_known_output(print(summary(fName)), file = "outputs/summary_funData_names.out")
expect_known_output(print(summary(m1)), file = "outputs/summary_multiFunData.out")
expect_known_output(print(summary(i1)), file = "outputs/summary_irregFunData.out")
expect_known_output(print(summary(as.irregFunData(fName))), file = "outputs/summary_irregFunData_names.out")
})
test_that("names",{
# Check errors:
expect_error(names(f1) <- letters[1:3], "Names must have the same length as funData object.")
expect_error(names(m1) <- letters[1:3], "Names must have the same length as multiFunData object.")
expect_error(names(i1) <- letters[1:5], "Names must have the same length as irregFunData object.")
# Check functionality:
# funData (1D)
names1 <- paste("Obs", 1:4)
expect_equal({names(f1) <- names1}, names1)
expect_equal(names(f1), names1)
# multiFunData
namesM <- paste("Element", 1:2)
expect_equal({names(m1) <- namesM}, namesM)
expect_equal(names(m1), namesM)
# irregFunData
namesI <- paste("Obs", 1:3)
expect_equal({names(i1) <- namesI}, namesI)
expect_equal(names(i1), names(i1@argvals))
expect_equal(names(i1), names(i1@X))
})
test_that("dimSupp", {
# Check functionality:
# univariate FD object (one-dim)
expect_equal(dimSupp(f1), 1)
# univariate FDobject (two-dim)
expect_equal(dimSupp(f2), 2)
# multivariate FD object
expect_equal(dimSupp(m1), c(1, 2))
# irreg FD object
expect_equal(dimSupp(i1), 1)
})
test_that("nObs", {
# Check functionality:
# univariate FD object (one-dim)
expect_equal(nObs(f1), 4)
# univariate FD object (two-dim)
expect_equal(nObs(f2), 4)
# multivariate FD object
expect_equal(nObs(m1), 4)
# irreg FD object
expect_equal(nObs(i1),3)
})
test_that("nObsPoints", {
# Check functionality:
# univariate FD object (one-dim)
expect_equal(nObsPoints(f1), 5)
# univariate FD object (two-dim)
expect_equal(nObsPoints(f2), c(5,6))
# multivariate FD object
expect_equal(nObsPoints(m1), list(5,c(5,6)))
# irreg FD object
expect_equal(nObsPoints(i1), c(5,3,3))
})
test_that("extractObs", {
# Check errors:
# univariate FD object (one-dim)
expect_error(extractObs(f1, obs = "5"),
"Supply observations as numeric vector") # observation does not exist
expect_error(extractObs(f1, obs = 5),
"Trying to extract observations that do not exist!") # observation does not exist
expect_error(extractObs(f1, argvals = list(4:6)),
"Trying to extract x-values that do not exist!") # argvals do not exist
expect_error(extractObs(f1, argvals = "a"), # wrong data type
"Supply argvals for extracted observations either as list or as numeric vector (only if support is one-dimensional)", fixed = TRUE) # fixed, as '(...)' is interpreted as regexp
# univariate FD object (two-dim)
expect_error(extractObs(f2, argvals = 1:5),
"Supply argvals for extracted observations either as list or as numeric vector (only if support is one-dimensional", fixed = TRUE) # fixed, as '(...)' is interpreted as regexp
# univariate FD object (> 3-dim)
expect_error(extractObs(funData(argvals = list(1:2,2:3,3:4,4:5), X = (1:5) %o% (1:2) %o% (2:3) %o% (3:4) %o% (4:5))),
"extracting observations is not implemented yet for functional data of dimension > 3")
# multi FD object
expect_error(extractObs(m1, argvals = "1"), "extractObs for multiFunData: argvals must be supplied as list (or missing).", fixed = TRUE) # fixed, as '(...)' is interpreted as regexp
# irreg FD object
expect_error(extractObs(i1, obs = list(1:3)),
"Supply observations as numeric vector")
expect_error(extractObs(i1, obs = 4),
"Trying to extract observations that do not exist!")
expect_error(extractObs(extractObs(i1, argvals = "1")),
"Supply argvals for extracted observations either as list or as numeric vector")
expect_error(extractObs(i1, argvals = 6),
"Trying to extract x-values that do not exist!")
expect_warning(extractObs(i1, argvals = c(1,5)),
"Some functions were not observed on the given argvals and therefore removed.")
# Check functionality:
# univariate FD object (one-dim)
expect_equal(extractObs(f1, obs = 1:2), funData(argvals = 1:5, matrix(1:20, nrow = 4)[1:2, ]))
expect_equal(extractObs(f1, argvals = 1:2), funData(argvals = 1:2, matrix(1:20, nrow = 4)[, 1:2]))
expect_equal(extractObs(f1, argvals = 1:2), extractObs(f1, argvals = list(1:2)))
# univariate FDobject (two-dim)
expect_equal(extractObs(f2, obs = 2), funData(argvals = list(1:5, 1:6), X = array(1:120, c(4, 5, 6))[2, , , drop = FALSE]))
expect_equal(extractObs(f2, argvals = list(1:3, 4:6)), funData(argvals = list(1:3, 4:6), X = array(1:120, c(4, 5, 6))[, 1:3, 4:6]))
# univariate FDobject (three-dim)
expect_equal(extractObs(f3, obs = 4), funData(argvals = f3@argvals, X = f3@X[4, , , , drop = FALSE]))
expect_equal(extractObs(f3, argvals = list(1:3, 4:6, 2:4)), funData(argvals = list(1:3, 4:6, 2:4), X = f3@X[, 1:3, 4:6, 2:4]))
# multivariate FD object
expect_equal(extractObs(m1, obs = 2), multiFunData(extractObs(m1[[1]], obs = 2), extractObs(m1[[2]], obs = 2)))
expect_equal(extractObs(m1, obs = list(2,3)), multiFunData(extractObs(m1[[1]], obs = 2), extractObs(m1[[2]], obs = 3)))
# irreg FD object
expect_equal(extractObs(i1, argvals = list(3:4)), extractObs(i1, argvals = 3:4))
expect_equal(extractObs(i1, obs = 1), irregFunData(argvals = list(1:5), X = list(1:5)))
expect_equal(extractObs(i1, argvals = 2:3), irregFunData(argvals = list(2:3, 2:3, 3), X = list(2:3, 2:3, -3)))
# alternative via []
expect_equal(extractObs(f1, obs = 1:2), f1[1:2])
expect_equal(extractObs(f1, argvals = 1:2), f1[argvals = 1:2])
expect_equal(f1, f1[]) # default: select all observations
expect_equal(extractObs(f2, obs = 2), f2[2])
expect_equal(extractObs(f2, argvals = list(1:3, 4:6)), f2[argvals = list(1:3, 4:6)])
expect_equal(extractObs(f3, obs = 4),f3[4])
expect_equal(extractObs(f3, argvals = list(1:3, 4:6, 2:4)), f3[argvals = list(1:3, 4:6, 2:4)])
expect_equal(extractObs(m1, obs = 2), m1[2])
expect_equal(extractObs(i1, obs = 1), i1[1])
expect_equal(extractObs(i1, argvals = 2:3), i1[argvals = 2:3])
# alias: subset
expect_equal(extractObs(f1, obs = 1:2), subset(f1, obs = 1:2))
expect_equal(extractObs(f1, argvals = 1:2), subset(f1, argvals = 1:2))
expect_equal(extractObs(f2, obs = 2), subset(f2, obs = 2))
expect_equal(extractObs(f2, argvals = list(1:3, 4:6)), subset(f2, argvals = list(1:3, 4:6)))
expect_equal(extractObs(f3, obs = 4), subset(f3, obs = 4))
expect_equal(extractObs(f3, argvals = list(1:3, 4:6, 2:4)), subset(f3, argvals = list(1:3, 4:6, 2:4)))
expect_equal(extractObs(m1, obs = 2), subset(m1, obs = 2))
expect_equal(extractObs(i1, obs = 1), subset(i1, obs = 1))
expect_equal(extractObs(i1, argvals = 2:3), subset(i1, argvals = 2:3))
})
test_that("Arith", {
# Check errors:
# univariateFD, univariate FD
expect_error(f1 + extractObs(f1,1:2),
"nObs of funData objects is neither equal nor one.")
expect_error(f1 - extractObs(f1, argvals = 1:2),
"Functions must be defined on the same domain!")
#multivaraite FD
expect_error(m1 - as.multiFunData(f1),
"Multivariate functional data must have same length!")
# irreg & irreg
expect_error(extractObs(i1, obs = 2) + i1,
"Multiple functions must be defined on subdomain of single function.")
expect_error(i1 + extractObs(i1, obs = 2),
"Multiple functions must be defined on subdomain of single function.")
expect_error(i1 + extractObs(i1, obs = 1:2),
"IrregFunData objects must have either the same number of observations or just one.")
expect_error(i1 + irregFunData(argvals = lapply(i1@argvals, function(l){l+1}), X = i1@X),
"Arithmetics for two irregular functional data objects are defined only for functions on the same domain.")
# irreg & reg
expect_error(i1 + extractObs(f1, argvals = 3:4, obs = 1:3),
"irregFunData object must be defined on a subdomain of the funData object!")
expect_error(i1+f1,
"funData object must have either one observation or the same number of observations as the irregFunData object")
expect_error(extractObs(f1, argvals = 3:4, obs = 1:3) + i1,
"irregFunData object must be defined on a subdomain of the funData object!")
expect_error(f1 + i1,
"funData object must have either one observation or the same number of observations as the irregFunData object")
# Check functionality:
# univariate & univariate
expect_equal(f1+f1, funData(f1@argvals,f1@X+f1@X))
expect_equal(f1-f1, funData(f1@argvals,f1@X-f1@X))
expect_equal(f1*f1, funData(f1@argvals,f1@X*f1@X))
expect_equal(f1/f1, funData(f1@argvals,f1@X/f1@X))
# univariate & scalar
expect_equal(f1+f1, 2*f1)
expect_equal(f1+f1, f1*2)
expect_equal(f1-f1, 0*f1)
expect_equal(f1-f1, f1*0)
expect_equal(f1*f1, f1^2)
expect_equal(f1/f1, 0*f1+1)
expect_equal(f1/f1, 1+ f1*0)
# univariate with e1/e2 having only one observation
expect_equal(extractObs(f1 + extractObs(f1,1),1), extractObs(2*f1,1), check.attributes = FALSE)
expect_equal(extractObs(f2 + extractObs(f2,1),1), extractObs(2*f2,1), check.attributes = FALSE)
expect_equal(extractObs(extractObs(f1,1),1) + f1, extractObs(2*f1,1), check.attributes = FALSE)
expect_equal(extractObs(extractObs(f2,1),1) + f2, extractObs(2*f2,1), check.attributes = FALSE)
# multivariate & multivariate
expect_equal(m1+m1, multiFunData(mapply("+", m1, m1)))
expect_equal(m1-m1, multiFunData(mapply("-", m1, m1)))
expect_equal(m1*m1, multiFunData(mapply("*", m1, m1)))
expect_equal(m1/m1, multiFunData(mapply("/", m1, m1)))
# multivariate & scalar
expect_equal(m1+m1, 2*m1)
expect_equal(m1+m1, m1*2)
expect_equal(m1-m1, 0*m1)
expect_equal(m1-m1, m1*0)
expect_equal(m1*m1, m1^2)
expect_equal(m1/m1, 0*m1+1)
expect_equal(m1/m1, 1 + m1*0)
# irreg & irreg
x1 <- unique(unlist(i1@argvals))
expect_equal(i1+i1, irregFunData(i1@argvals,mapply('+', i1@X, i1@X)))
expect_equal(i1-i1, irregFunData(i1@argvals,mapply('-', i1@X, i1@X)))
expect_equal(i1*i1, irregFunData(i1@argvals,mapply('*', i1@X, i1@X)))
expect_equal(i1/i1, irregFunData(i1@argvals,mapply('/', i1@X, i1@X)))
expect_equal(i1 + irregFunData(argvals = list(x1), X = list(rep(0, length(x1)))), i1)
expect_equal(irregFunData(argvals = list(x1), X = list(rep(1, length(x1)))) + i1, 1+ i1)
# irreg & reg
expect_equal(i1 + extractObs(f1, obs = 1:3), extractObs(f1, obs = 1:3) + i1) # same number of observations
expect_equal(i1 + extractObs(f1, obs = 1), extractObs(f1, obs = 1) + i1) # funData object has only one observation
# irreg & scalar
expect_equal(i1+i1, 2*i1)
expect_equal(i1+i1, i1*2)
expect_equal(i1-i1, 0*i1)
expect_equal(i1-i1, i1*0)
expect_equal(i1*i1, i1^2)
expect_equal(i1/i1, 0*i1+1)
expect_equal(i1/i1, 1 + i1*0)
})
test_that("Math", {
# Check functionality:
# funData
expect_equal(exp(f1), funData(f1@argvals, exp(f1@X)))
expect_equal(sin(f1)^2 + cos(f1)^2, 0*f1+1) # combination of Arith and math
# irregFunData
expect_equal(exp(i1), irregFunData(i1@argvals, lapply(i1@X,exp)))
expect_equal(sin(i1)^2 + cos(i1)^2, 0*i1+1) # combination of Arith and math
# multiFunData
expect_equal(exp(m1), multiFunData(exp(f1), exp(f2)))
expect_equal(sin(m1)^2 + cos(m1)^2, 0*m1+1) # combination of Arith and math
})
test_that("norm", {
# Check errors:
# univariate FD object
expect_error(norm(f1, squared = "Yes"), "Parameter 'squared' must be passed as a logical.")
expect_error(norm(f1, squared = c(TRUE, FALSE)), "Parameter 'squared' must be passed as a logical.")
expect_error(norm(f1, weight = "1"), "Parameter 'weight' must be passed as a positive number.")
expect_error(norm(f1, weight = 1:2), "Parameter 'weight' must be passed as a positive number.")
expect_error(norm(f1, weight = -1), "Parameter 'weight' must be passed as a positive number.")
# multivariate FD object
expect_error(norm(m1, weight = c(1,"2")),
"Parameter 'weight' must be passed as a vector of 2 positive numbers.")
expect_error(norm(m1, weight = 1:3),
"Parameter 'weight' must be passed as a vector of 2 positive numbers.")
expect_error(norm(m1, weight = c(-1,1)),
"Parameter 'weight' must be passed as a vector of 2 positive numbers.")
# irreg FD object
expect_error(norm(i1, squared = "Yes"), "Parameter 'squared' must be passed as a logical.")
expect_error(norm(i1, squared = c(TRUE, TRUE)), "Parameter 'squared' must be passed as a logical.")
expect_error(norm(i1, weight = "1"), "Parameter 'weight' must be passed as a positive number.")
expect_error(norm(i1, weight = 1:2), "Parameter 'weight' must be passed as a positive number.")
expect_error(norm(i1, weight = -1), "Parameter 'weight' must be passed as a positive number.")
# Check functionality:
# univariate FD object
expect_equal(norm(f1), # all observations
apply((f1^2)@X, 1, function(f, argvals, method){funData:::.intWeights(argvals, method) %*% f}, argvals = f1@argvals[[1]], method = "trapezoidal") )
expect_equal(norm(f1)[1:3], norm(f1, obs = 1:3)) # only some observations
expect_equal(norm(f1, squared = FALSE)[2], sqrt(norm(f1)[2])) # squared option
expect_equal(norm(f1, weight = 2), 2*norm(f1)) # weight (makes little sense for univariate funData objects...)
# multivariate FD object
expect_equal(norm(m1), rowSums(sapply(m1, norm, simplify = TRUE))) # all observations
expect_equal(norm(m1)[1], norm(m1, obs = 1)) # only one observation
expect_equal(norm(m1, squared = FALSE), sqrt(rowSums(sapply(m1, norm, squared = TRUE, simplify = TRUE)))) # squared option
expect_equal(norm(m1, weight = c(2,1)), norm(multiFunData(sqrt(2)*f1,f2))) # with weight
# irreg FD object
expect_equal(norm(i1), c(42,19,9), tolerance = 1e-5) # result calculated explicitly
expect_equal(norm(i1, fullDom = TRUE), c(42,42,43), tolerance = 1e-5) # result calculated explicitly
expect_equal(norm(i1, weight = 2), 2*norm(i1)) # weight (makes little sense for univariate funData objects...)
})
test_that("scalarProduct", {
# Check errors:
expect_error(scalarProduct(m1, as.multiFunData(f1)),
"multiFunData objects must have the same number of elements.")
expect_error(scalarProduct(m1, m1, weight = 1:3),
"Weight vector must have the same number of elements as the multiFunData objects.")
expect_error(scalarProduct(m1, m1, weight = c(-1,1)),
"Weights must be non-negative.")
expect_error(scalarProduct(m1, m1, weight = c(0,0)),
"At least one weighting factor must be different from 0.")
# Check functionality:
# univariate FD objects
s <- scalarProduct(f1, 2*f1)
expect_equal(length(s), nObs(f1))
expect_equal(s[1], 840, tol = 1e-5)
expect_equal(scalarProduct(f1,f1), norm(f1, squared = TRUE))
# multivariate FD object
expect_equal(scalarProduct(m1,m1), norm(m1, squared = TRUE))
expect_equal(scalarProduct(m1,m1, weight = c(1,2)), norm(m1, squared = TRUE, weight = c(1,2))) # with weights
expect_equal(scalarProduct(as.multiFunData(f1),as.multiFunData(f1)), norm(f1, squared = TRUE)) # special case: only one element
# irreg FD object
expect_equal(scalarProduct(i1,i1), norm(i1, squared = TRUE))
expect_equal(norm(i1, squared = FALSE)^2, norm(i1, squared = TRUE)) # check squared
})
test_that("integrate", {
# Check errors:
expect_error(integrate(funData(argvals = list(1:2,1:3,1:4,1:5), X = array(rnorm(120), dim = c(1,2,3,4,5)))),
"Integration is not yet defined for functional data objects with dim > 3")
expect_error(integrate(f1, method = 1),"Parameter 'method' must be a string.")
expect_error(integrate(f1, method = c("m1", "m2")),"Parameter 'method' must be a string.")
expect_error(integrate(i1, fullDom = "Yes"),"Parameter 'fullDom' must be a logical.")
expect_error(integrate(i1, fullDom = c(TRUE, FALSE)),"Parameter 'fullDom' must be a logical.")
expect_warning(integrate(extractObs(f1, argvals = 1:2)), # method = trapezoidal and not enough observation points
"Trapezoidal quadrature is not applicable for functions with < 3 observation points. 'method' changed to 'midpoint'.")
# Check functionality:
# univariate FD objects
expect_equal(integrate(f1)[1], sum(funData:::.intWeights(f1@argvals[[1]], "trapezoidal")*f1@X[1,]))
expect_equal(integrate(f2)[1], as.numeric(t(funData:::.intWeights(f2@argvals[[1]], "trapezoidal")) %*%
f2@X[1,,] %*% funData:::.intWeights(f2@argvals[[2]], "trapezoidal")))
expect_equal(integrate(f3)[1], 14340)
# multivariate FD objects
expect_equal(integrate(m1), as.numeric(integrate(f1) + integrate(f2)))
expect_equal(integrate(m1.1), as.numeric(integrate(f1.1) + integrate(f2.1)))
# irreg FD object
expect_equal(integrate(i1), c(12,6,-4), tolerance = 1e-5)
expect_equal(integrate(i1, fullDom = TRUE), c(12,12,-12), tolerance = 1e-5)
expect_equal( integrate(extractObs(i1, argvals = 1:3), fullDom = TRUE), c(4,4,6)) # fullDom uses extrapolate and 3rd obs has only one observation point
# check generic default (from stats::integrate help page)
expect_equal(integrate(dnorm, -1.96, 1.96)$value, 2*pnorm(1.96)- 1)
})
test_that("integrate3D",{
x <- seq(0,1, 0.02); nX <- length(x)
y <- seq(-0.5,0.5, 0.02); nY <- length(y)
z <- seq(1,2,0.02); nZ <- length(z)
A <- array(NA, c(nX, nY, nZ))
for(ix in 1:nX)
for(iy in 1:nY)
for(iz in 1:nZ)
A[ix,iy,iz] <- x[ix]*cos(pi*y[iy])*z[iz]^2
expect_equal(funData:::integrate3D(A, argvals = list(x,y,z)), 7/(3*pi), tolerance = 1e-3)
})
test_that("set/get", {
# Check errors:
# univariate FD object (one-dim)
expect_error({argvals(f1) <- 1:6},
"argvals and X have different number of sampling points! X-Dimensions must be of the form N x M1 x ... x Md") # wrong number of sampling points (argvals)
expect_error({X(f1) <- matrix(1:24, nrow = 4)},
"argvals and X have different number of sampling points! X-Dimensions must be of the form N x M1 x ... x Md") # wrong number of sampling points (X)
expect_warning({tmp <- f1; X(tmp) <- matrix(1:25, nrow = 5)}, 'Number of observations has changed') # warning: more observations
# univariate FD object (two-dim)
expect_error({argvals(f2) <- 1:5},
"argvals and X element have different support dimensions! X-Dimensions must be of the form N x M1 x ... x Md") # wrong dimension (argvals)
expect_error({X(f2) <- matrix(1:20, nrow = 4)},
"argvals and X element have different support dimensions! X-Dimensions must be of the form N x M1 x ... x Md") # wrong dimension (X)
# multivariate FD object
expect_error({argvals(m1) <- list(1+1:5, list(2+1:5, 3+1:6), 4+1:5)}, 'multiFunData object and new argvals must have the same length') # wrong length (argvals, multiFunData)
expect_error({X(m1) <- list(X(f1), X(f2), matrix(1:12, nrow = 4))}, 'multiFunData object and new X must have the same length') # wrong length (X, multiFunData)
expect_error({X(m1) <- list(matrix(1:25, nrow = 5), array(1:120, c(4,5,6)))}, 'New X object must have the same number of observations in all elements!') # different number of observations
expect_warning({X(m1) <- list(matrix(1:25, nrow = 5), array(1:150, c(5,5,6)))}, 'Number of observations has changed') # warning: more observations
# irreg FD object
expect_error({argvals(i1) <- list(1:4)}, "New argvals must be a list of the same length as the original argvals.")
expect_error({argvals(i1) <- list(1:6, 1:3, 1:10)}, "New argvals must have the same structure as the original argvals.")
expect_error({X(i1) <- list(1:4)}, "New X must be a list of the same length as the original X.")
expect_error({X(i1) <- list(1:6, 1:3, 1:10)}, "New X must have the same structure as the original X.")
# Check functionality:
# univariate FD object (one-dim)
expect_equal({argvals(f1) <- list(1+1:5)}, list(1+1:5))
expect_equal({argvals(f1) <- 1+1:5; argvals(f1)}, list(1+1:5)) # special case: one-dimensional domain
expect_equal({X(f1) <- matrix(1+1:20, nrow = 4)}, matrix(1+1:20, nrow = 4))
# univariate FD object (two-dim)
expect_equal({argvals(f2) <- list(1+1:5, 2+1:6)}, list(1+1:5, 2+1:6))
# multivariate FD object
expect_equal({argvals(m1) <- list(list(2+1:5), list(1+1:5, 3+1:6))}, list(list(2+1:5), list(1+1:5, 3+1:6)))
expect_equal({X(m1) <- list(matrix(1+1:20, nrow = 4), array(2+1:120, c(4,5,6)))}, list(matrix(1+1:20, nrow = 4), array(2+1:120, c(4,5,6))))
expect_equal({argvals(m1) <- list(1+1:5, list(2+1:5, 3+1:6)); argvals(m1)}, list(list(1+1:5), list(2+1:5, 3+1:6))) # special case: one-dimensional domains
# irreg FD object
expect_equal({argvals(i1) <- list(0:4, 0:2, 1:3)}, list(0:4, 0:2, 1:3))
expect_equal({X(i1) <- list(0:4, 0:2, 1:3)}, list(0:4, 0:2, 1:3))
# check multivariate functions with one element
expect_equal(argvals(f1), argvals(as.multiFunData(f1))[[1]])
# check deprecated functions
expect_warning(tmp <- getArgvals(f1)); expect_equal(tmp, argvals(f1))
expect_warning(tmp <- getArgvals(f2)); expect_equal(tmp, argvals(f2))
expect_warning(tmp <- getArgvals(m1)); expect_equal(tmp, argvals(m1))
expect_warning(tmp <- getArgvals(i1)); expect_equal(tmp, argvals(i1))
expect_warning(tmp <- getX(f1)); expect_equal(tmp, X(f1))
expect_warning(tmp <- getX(f2)); expect_equal(tmp, X(f2))
expect_warning(tmp <- getX(m1)); expect_equal(tmp, X(m1))
expect_warning(tmp <- getX(i1)); expect_equal(tmp, X(i1))
expect_warning(tmp <- setArgvals(f1, list(1+1:5))); expect_equal( {argvals(f1) <- list(1+1:5); f1}, tmp)
expect_warning(tmp <- setArgvals(f1, 1+1:5)); expect_equal( {argvals(f1) <- list(1+1:5); f1}, tmp) # special case: one-dimensional domain
expect_warning(tmp <- setArgvals(f2, list(1+1:5, 2+1:6))); expect_equal( {argvals(f2) <- list(1+1:5, 2+1:6); f2}, tmp)
expect_warning(tmp <- setArgvals(m1, list(list(2+1:5), list(1+1:5, 3+1:6)))); expect_equal( {argvals(m1) <- list(list(2+1:5), list(1+1:5, 3+1:6)); m1}, tmp)
expect_warning(tmp <- setArgvals(m1, list(1+1:5, list(2+1:5, 3+1:6)))); expect_equal( {argvals(m1) <- list(list(1+1:5), list(2+1:5, 3+1:6)); m1}, tmp) # special case: one-dimensional domains
expect_warning(tmp <- setArgvals(i1, list(0:4, 0:2, 1:3))); expect_equal( {argvals(i1) <- list(0:4, 0:2, 1:3); i1}, tmp)
expect_warning(tmp <- setX(f1, matrix(1+1:20, nrow = 4))); expect_equal( {X(f1) <- matrix(1+1:20, nrow = 4); f1}, tmp)
expect_warning(tmp <- setX(m1, list(matrix(1+1:20, nrow = 4), array(2+1:120, c(4,5,6))))); expect_equal( {X(m1) <- list(matrix(1+1:20, nrow = 4), array(2+1:120, c(4,5,6))); m1}, tmp)
expect_warning(tmp <- setX(i1, list(0:4, 0:2, 1:3))); expect_equal( {X(i1) <- list(0:4, 0:2, 1:3); i1}, tmp)
})
test_that("flipFun", {
# Check errors:
# univariate FD object
expect_error(flipFuns(f1,funData(argvals = list(1:5), X = array(1:30,c(6,5)))),
'Functions must have the same number of observations or use a single function as reference.') # not the same number of observations
expect_error(flipFuns(f1,f2),
'Functions must have the dimension.') # not the same dimension
expect_error(flipFuns(f1,funData(argvals = list(2:6), X = array(1:20,c(4,5)))),
'Functions must be defined on the same domain.') # not the same domain
expect_error(flipFuns(f3, 2*f3),
"Function is only implemented for data of dimension <= 2")
# multivariate FD
expect_error(flipFuns(m1, as.multiFunData(f1)),
"multiFunData objects must have the same length")
expect_error(flipFuns(m1, extractObs(m1, 1:2)),
"Functions must have the same number of observations or use a single function as reference.")
expect_error(flipFuns(m1, multiFunData(f2,f1)),
"Functions must have the dimension.")
expect_error(flipFuns(m1, multiFunData(extractObs(f1, argvals = 1:4), f2)),
"Functions must be defined on the same domain.")
# irreg FD object (regular reference)
expect_error(flipFuns(f2,i1),
"Function is only implemented for irregular data with one-dimensional support")
expect_error(flipFuns(extractObs(f1, 1:2), i1),
"Functions must have the same number of observations or use a single function as reference.")
expect_error(flipFuns(extractObs(f1, argvals = 1:3), fi),
"Irregular functions must be defined on a sub-domain of the reference function(s).", fixed = TRUE)# fixed, as '(...)' is interpreted as regexp
# irreg FD object (irregular reference)
expect_error(flipFuns(extractObs(i1, 1:2), i1),
"Functions must have the same number of observations or use a single function as reference.")
expect_error(flipFuns(extractObs(i1, argvals = 1:3), i1),
"New functions must be defined on a sub-domain of the reference function(s).", fixed = TRUE) # fixed, as '(...)' is interpreted as regexp
# Check functionality:
# univariate FD object (one-dim)
expect_equal(flipFuns(f1, -1*f1), f1)
# univariate FD object (two-dim)
expect_equal(flipFuns(f2, -1*f2), f2)
# multivariate FD object
expect_equal(flipFuns(m1, -1*m1), m1)
# irreg FD object
expect_equal(flipFuns(f1,fi),fi) # regular reference for each observation
expect_equal(flipFuns(extractObs(f1, obs = 1), fi), fi) # single regular reference function
expect_equal(flipFuns(i1, -1*i1), i1) # irreg reference for each observation
expect_equal(flipFuns(extractObs(fi, obs = 1), -1*fi), fi) # irreg reference for each observation
})
test_that("meanFunction",{
set.seed(2)
f1NA <- f1; f1NA@X[sample(prod(dim(f1NA@X)), 5)] <- NA
# Check errors:
# funData
expect_error(meanFunction(f1, na.rm = "Yes"), "Parameter 'na.rm' must be a logical.")
expect_error(meanFunction(f1, na.rm = c(TRUE, FALSE)), "Parameter 'na.rm' must be a logical.")
# irreg FD object
expect_error(meanFunction(i1, na.rm = "Yes"), "Parameter 'na.rm' must be a logical.")
expect_error(meanFunction(i1, na.rm = c(TRUE, FALSE)), "Parameter 'na.rm' must be a logical.")
expect_error(meanFunction(irregFunData(argvals = list(1:3,1:5), X = list(1:3,1:5))),
"Mean function defined only for irregular functional data objects on the same domain.")
expect_error(meanFunction(i1, na.rm = TRUE),
"Option na.rm = TRUE is not implemented for mean functions of irregular data.")
# Check functionality:
# univariate FD object (one-dim)
expect_equal(meanFunction(f1), {mean1 <- funData(1:5, matrix(seq(2.5, 18.5, 4), nrow = 1))})
expect_equal(meanFunction(f1NA),
funData(f1NA@argvals, array(colMeans(f1NA@X), dim = c(1, length(f1@argvals[[1]])))))
# univariate FD object (two-dim)
expect_equal(meanFunction(f2), {mean2 <- funData(f2@argvals, array(seq(2.5,118.5, 4), dim = c(1,5,6)))})
# multivariate FD object
expect_equal(meanFunction(m1), multiFunData(mean1,mean2))
# irregular FD object
expect_equal(meanFunction(fi), as.irregFunData(mean1))
})
test_that("expand.int",{
expect_null(funData:::expand.int())
expect_equal(funData:::expand.int(2,5), data.frame(Var1 = rep(1:2, each = 5), Var2 = rep(1:5, times = 2)))
}
)
test_that("tensorProduct",{
# Check errors:
expect_error(tensorProduct(f1), "tensorProduct currently accepts only 2 or 3 arguments.")
expect_error(tensorProduct(f1, f2, f2, f1), "tensorProduct currently accepts only 2 or 3 arguments.")
expect_error(tensorProduct(f1, tensorProduct(f1,f2)), "tensorProduct is defined only for funData objects on one-dimensional domains!")
# Check functionality:
# tensor product of two functions
TP1 <- tensorProduct(f1, f1.1)
expect_equal(dimSupp(TP1), 2)
expect_equal(TP1@argvals, list(f1@argvals[[1]], f1.1@argvals[[1]]))
expect_equal(nObs(TP1), nObs(f1)*nObs(f1.1))
expect_equal(apply(TP1@X[1,-1,]/TP1@X[4,-1,], 1, mean), c(0.625, 0.75, 0.8125, 0.85), tol = 1e-5)
expect_equal(apply(TP1@X[1,-1,]/TP1@X[4,-1,], 1, var), rep(0,4), tol = 1e-5)
# tensor product of three functions
TP2 <- tensorProduct(f1, f1.1, f1)
expect_equal(dimSupp(TP2), 3)
expect_equal(TP2@argvals, list(f1@argvals[[1]], f1.1@argvals[[1]], f1@argvals[[1]]))
expect_equal(nObs(TP2), nObs(f1)^2*nObs(f1.1))
expect_equal(mean(TP2@X[1,-1,-1,-1]/TP2@X[2,-1,-1,-1]), 0.90159, tol = 1e-5)
expect_equal(var(TP2@X[1,-1,-1,-1]/TP2@X[2,-1,-1,-1]), 0.0018352, tol = 1e-7)
})
test_that("approxNA",{
set.seed(2)
expect_equal(integrate(f1 - as.irregFunData(approxNA(sparsify(f1, minObs = 3, maxObs = 5)))),
rep(0, nObs(f1)))
})
Try the funData package in your browser
Any scripts or data that you put into this service are public.
funData documentation built on May 29, 2024, 6:08 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("Test funData methods")
f1 <- funData(argvals = 1:5, X = matrix(1:20, nrow = 4))
f2 <- funData(argvals = list(1:5, 1:6), X = array(1:120, c(4,5,6)))
f3 <- funData(argvals = list(1:5, 1:6, 1:4), X = array(1:480, c(4, 5, 6, 4)))
m1 <- multiFunData(f1, f2)
i1 <- irregFunData(argvals = list(1:5, 2:4, 3:5), X = list(1:5, 2:4, -(3:1)))
fi <- as.irregFunData(f1)
# special case for data with only one observation
f1.1 <- funData(argvals = 1:5, X = matrix(1:5, nrow = 1))
f2.1 <- funData(argvals = list(1:5, 1:6), X = array(1:30,c(1,5,6)))
m1.1 <- multiFunData(list(f1.1,f2.1))
test_that("print",{
expect_known_output(print(f1), file = "outputs/print_funData.out")
expect_known_output(print(m1), file = "outputs/print_multiFunData.out")
expect_known_output(print(i1), file = "outputs/print_irregFunData.out")
})
test_that("str",{
m2 <- m1
names(m2) <- letters[1:length(m2)]
expect_known_output(str(f1), file = "outputs/str_funData.out")
expect_known_output(str(m1), file = "outputs/str_multiFunData.out")
expect_known_output(str(m2), file = "outputs/str_multiFunData_2.out")
expect_known_output(str(i1), file = "outputs/str_irregFunData.out")
expect_known_output(str(i1, list.len = 1), file = "outputs/str_irregFunData_len1.out")
})
test_that("summary",{
# Check errors:
expect_error(funData:::print.summary.funData(summary(m1)),
"Argument is not of class 'summary.funData'.")
expect_error(funData:::print.summary.multiFunData(summary(f1)),
"Argument is not of class 'summary.multiFunData'.")
expect_error(funData:::print.summary.irregFunData(summary(f1)),
"Argument is not of class 'summary.irregFunData'.")
# Check functionality:
fName <- f1
names(fName) <- letters[1:nObs(fName)]
expect_known_output(print(summary(f1)), file = "outputs/summary_funData.out")
expect_known_output(print(summary(fName)), file = "outputs/summary_funData_names.out")
expect_known_output(print(summary(m1)), file = "outputs/summary_multiFunData.out")
expect_known_output(print(summary(i1)), file = "outputs/summary_irregFunData.out")
expect_known_output(print(summary(as.irregFunData(fName))), file = "outputs/summary_irregFunData_names.out")
})
test_that("names",{
# Check errors:
expect_error(names(f1) <- letters[1:3], "Names must have the same length as funData object.")
expect_error(names(m1) <- letters[1:3], "Names must have the same length as multiFunData object.")
expect_error(names(i1) <- letters[1:5], "Names must have the same length as irregFunData object.")
# Check functionality:
# funData (1D)
names1 <- paste("Obs", 1:4)
expect_equal({names(f1) <- names1}, names1)
expect_equal(names(f1), names1)
# multiFunData
namesM <- paste("Element", 1:2)
expect_equal({names(m1) <- namesM}, namesM)
expect_equal(names(m1), namesM)
# irregFunData
namesI <- paste("Obs", 1:3)
expect_equal({names(i1) <- namesI}, namesI)
expect_equal(names(i1), names(i1@argvals))
expect_equal(names(i1), names(i1@X))
})
test_that("dimSupp", {
# Check functionality:
# univariate FD object (one-dim)
expect_equal(dimSupp(f1), 1)
# univariate FDobject (two-dim)
expect_equal(dimSupp(f2), 2)
# multivariate FD object
expect_equal(dimSupp(m1), c(1, 2))
# irreg FD object
expect_equal(dimSupp(i1), 1)
})
test_that("nObs", {
# Check functionality:
# univariate FD object (one-dim)
expect_equal(nObs(f1), 4)
# univariate FD object (two-dim)
expect_equal(nObs(f2), 4)
# multivariate FD object
expect_equal(nObs(m1), 4)
# irreg FD object
expect_equal(nObs(i1),3)
})
test_that("nObsPoints", {
# Check functionality:
# univariate FD object (one-dim)
expect_equal(nObsPoints(f1), 5)
# univariate FD object (two-dim)
expect_equal(nObsPoints(f2), c(5,6))
# multivariate FD object
expect_equal(nObsPoints(m1), list(5,c(5,6)))
# irreg FD object
expect_equal(nObsPoints(i1), c(5,3,3))
})
test_that("extractObs", {
# Check errors:
# univariate FD object (one-dim)
expect_error(extractObs(f1, obs = "5"),
"Supply observations as numeric vector") # observation does not exist
expect_error(extractObs(f1, obs = 5),
"Trying to extract observations that do not exist!") # observation does not exist
expect_error(extractObs(f1, argvals = list(4:6)),
"Trying to extract x-values that do not exist!") # argvals do not exist
expect_error(extractObs(f1, argvals = "a"), # wrong data type
"Supply argvals for extracted observations either as list or as numeric vector (only if support is one-dimensional)", fixed = TRUE) # fixed, as '(...)' is interpreted as regexp
# univariate FD object (two-dim)
expect_error(extractObs(f2, argvals = 1:5),
"Supply argvals for extracted observations either as list or as numeric vector (only if support is one-dimensional", fixed = TRUE) # fixed, as '(...)' is interpreted as regexp
# univariate FD object (> 3-dim)
expect_error(extractObs(funData(argvals = list(1:2,2:3,3:4,4:5), X = (1:5) %o% (1:2) %o% (2:3) %o% (3:4) %o% (4:5))),
"extracting observations is not implemented yet for functional data of dimension > 3")
# multi FD object
expect_error(extractObs(m1, argvals = "1"), "extractObs for multiFunData: argvals must be supplied as list (or missing).", fixed = TRUE) # fixed, as '(...)' is interpreted as regexp
# irreg FD object
expect_error(extractObs(i1, obs = list(1:3)),
"Supply observations as numeric vector")
expect_error(extractObs(i1, obs = 4),
"Trying to extract observations that do not exist!")
expect_error(extractObs(extractObs(i1, argvals = "1")),
"Supply argvals for extracted observations either as list or as numeric vector")
expect_error(extractObs(i1, argvals = 6),
"Trying to extract x-values that do not exist!")
expect_warning(extractObs(i1, argvals = c(1,5)),
"Some functions were not observed on the given argvals and therefore removed.")
# Check functionality:
# univariate FD object (one-dim)
expect_equal(extractObs(f1, obs = 1:2), funData(argvals = 1:5, matrix(1:20, nrow = 4)[1:2, ]))
expect_equal(extractObs(f1, argvals = 1:2), funData(argvals = 1:2, matrix(1:20, nrow = 4)[, 1:2]))
expect_equal(extractObs(f1, argvals = 1:2), extractObs(f1, argvals = list(1:2)))
# univariate FDobject (two-dim)
expect_equal(extractObs(f2, obs = 2), funData(argvals = list(1:5, 1:6), X = array(1:120, c(4, 5, 6))[2, , , drop = FALSE]))
expect_equal(extractObs(f2, argvals = list(1:3, 4:6)), funData(argvals = list(1:3, 4:6), X = array(1:120, c(4, 5, 6))[, 1:3, 4:6]))
# univariate FDobject (three-dim)
expect_equal(extractObs(f3, obs = 4), funData(argvals = f3@argvals, X = f3@X[4, , , , drop = FALSE]))
expect_equal(extractObs(f3, argvals = list(1:3, 4:6, 2:4)), funData(argvals = list(1:3, 4:6, 2:4), X = f3@X[, 1:3, 4:6, 2:4]))
# multivariate FD object
expect_equal(extractObs(m1, obs = 2), multiFunData(extractObs(m1[[1]], obs = 2), extractObs(m1[[2]], obs = 2)))
expect_equal(extractObs(m1, obs = list(2,3)), multiFunData(extractObs(m1[[1]], obs = 2), extractObs(m1[[2]], obs = 3)))
# irreg FD object
expect_equal(extractObs(i1, argvals = list(3:4)), extractObs(i1, argvals = 3:4))
expect_equal(extractObs(i1, obs = 1), irregFunData(argvals = list(1:5), X = list(1:5)))
expect_equal(extractObs(i1, argvals = 2:3), irregFunData(argvals = list(2:3, 2:3, 3), X = list(2:3, 2:3, -3)))
# alternative via []
expect_equal(extractObs(f1, obs = 1:2), f1[1:2])
expect_equal(extractObs(f1, argvals = 1:2), f1[argvals = 1:2])
expect_equal(f1, f1[]) # default: select all observations
expect_equal(extractObs(f2, obs = 2), f2[2])
expect_equal(extractObs(f2, argvals = list(1:3, 4:6)), f2[argvals = list(1:3, 4:6)])
expect_equal(extractObs(f3, obs = 4),f3[4])
expect_equal(extractObs(f3, argvals = list(1:3, 4:6, 2:4)), f3[argvals = list(1:3, 4:6, 2:4)])
expect_equal(extractObs(m1, obs = 2), m1[2])
expect_equal(extractObs(i1, obs = 1), i1[1])
expect_equal(extractObs(i1, argvals = 2:3), i1[argvals = 2:3])
# alias: subset
expect_equal(extractObs(f1, obs = 1:2), subset(f1, obs = 1:2))
expect_equal(extractObs(f1, argvals = 1:2), subset(f1, argvals = 1:2))
expect_equal(extractObs(f2, obs = 2), subset(f2, obs = 2))
expect_equal(extractObs(f2, argvals = list(1:3, 4:6)), subset(f2, argvals = list(1:3, 4:6)))
expect_equal(extractObs(f3, obs = 4), subset(f3, obs = 4))
expect_equal(extractObs(f3, argvals = list(1:3, 4:6, 2:4)), subset(f3, argvals = list(1:3, 4:6, 2:4)))
expect_equal(extractObs(m1, obs = 2), subset(m1, obs = 2))
expect_equal(extractObs(i1, obs = 1), subset(i1, obs = 1))
expect_equal(extractObs(i1, argvals = 2:3), subset(i1, argvals = 2:3))
})
test_that("Arith", {
# Check errors:
# univariateFD, univariate FD
expect_error(f1 + extractObs(f1,1:2),
"nObs of funData objects is neither equal nor one.")
expect_error(f1 - extractObs(f1, argvals = 1:2),
"Functions must be defined on the same domain!")
#multivaraite FD
expect_error(m1 - as.multiFunData(f1),
"Multivariate functional data must have same length!")
# irreg & irreg
expect_error(extractObs(i1, obs = 2) + i1,
"Multiple functions must be defined on subdomain of single function.")
expect_error(i1 + extractObs(i1, obs = 2),
"Multiple functions must be defined on subdomain of single function.")
expect_error(i1 + extractObs(i1, obs = 1:2),
"IrregFunData objects must have either the same number of observations or just one.")
expect_error(i1 + irregFunData(argvals = lapply(i1@argvals, function(l){l+1}), X = i1@X),
"Arithmetics for two irregular functional data objects are defined only for functions on the same domain.")
# irreg & reg
expect_error(i1 + extractObs(f1, argvals = 3:4, obs = 1:3),
"irregFunData object must be defined on a subdomain of the funData object!")
expect_error(i1+f1,
"funData object must have either one observation or the same number of observations as the irregFunData object")
expect_error(extractObs(f1, argvals = 3:4, obs = 1:3) + i1,
"irregFunData object must be defined on a subdomain of the funData object!")
expect_error(f1 + i1,
"funData object must have either one observation or the same number of observations as the irregFunData object")
# Check functionality:
# univariate & univariate
expect_equal(f1+f1, funData(f1@argvals,f1@X+f1@X))
expect_equal(f1-f1, funData(f1@argvals,f1@X-f1@X))
expect_equal(f1*f1, funData(f1@argvals,f1@X*f1@X))
expect_equal(f1/f1, funData(f1@argvals,f1@X/f1@X))
# univariate & scalar
expect_equal(f1+f1, 2*f1)
expect_equal(f1+f1, f1*2)
expect_equal(f1-f1, 0*f1)
expect_equal(f1-f1, f1*0)
expect_equal(f1*f1, f1^2)
expect_equal(f1/f1, 0*f1+1)
expect_equal(f1/f1, 1+ f1*0)
# univariate with e1/e2 having only one observation
expect_equal(extractObs(f1 + extractObs(f1,1),1), extractObs(2*f1,1), check.attributes = FALSE)
expect_equal(extractObs(f2 + extractObs(f2,1),1), extractObs(2*f2,1), check.attributes = FALSE)
expect_equal(extractObs(extractObs(f1,1),1) + f1, extractObs(2*f1,1), check.attributes = FALSE)
expect_equal(extractObs(extractObs(f2,1),1) + f2, extractObs(2*f2,1), check.attributes = FALSE)
# multivariate & multivariate
expect_equal(m1+m1, multiFunData(mapply("+", m1, m1)))
expect_equal(m1-m1, multiFunData(mapply("-", m1, m1)))
expect_equal(m1*m1, multiFunData(mapply("*", m1, m1)))
expect_equal(m1/m1, multiFunData(mapply("/", m1, m1)))
# multivariate & scalar
expect_equal(m1+m1, 2*m1)
expect_equal(m1+m1, m1*2)
expect_equal(m1-m1, 0*m1)
expect_equal(m1-m1, m1*0)
expect_equal(m1*m1, m1^2)
expect_equal(m1/m1, 0*m1+1)
expect_equal(m1/m1, 1 + m1*0)
# irreg & irreg
x1 <- unique(unlist(i1@argvals))
expect_equal(i1+i1, irregFunData(i1@argvals,mapply('+', i1@X, i1@X)))
expect_equal(i1-i1, irregFunData(i1@argvals,mapply('-', i1@X, i1@X)))
expect_equal(i1*i1, irregFunData(i1@argvals,mapply('*', i1@X, i1@X)))
expect_equal(i1/i1, irregFunData(i1@argvals,mapply('/', i1@X, i1@X)))
expect_equal(i1 + irregFunData(argvals = list(x1), X = list(rep(0, length(x1)))), i1)
expect_equal(irregFunData(argvals = list(x1), X = list(rep(1, length(x1)))) + i1, 1+ i1)
# irreg & reg
expect_equal(i1 + extractObs(f1, obs = 1:3), extractObs(f1, obs = 1:3) + i1) # same number of observations
expect_equal(i1 + extractObs(f1, obs = 1), extractObs(f1, obs = 1) + i1) # funData object has only one observation
# irreg & scalar
expect_equal(i1+i1, 2*i1)
expect_equal(i1+i1, i1*2)
expect_equal(i1-i1, 0*i1)
expect_equal(i1-i1, i1*0)
expect_equal(i1*i1, i1^2)
expect_equal(i1/i1, 0*i1+1)
expect_equal(i1/i1, 1 + i1*0)
})
test_that("Math", {
# Check functionality:
# funData
expect_equal(exp(f1), funData(f1@argvals, exp(f1@X)))
expect_equal(sin(f1)^2 + cos(f1)^2, 0*f1+1) # combination of Arith and math
# irregFunData
expect_equal(exp(i1), irregFunData(i1@argvals, lapply(i1@X,exp)))
expect_equal(sin(i1)^2 + cos(i1)^2, 0*i1+1) # combination of Arith and math
# multiFunData
expect_equal(exp(m1), multiFunData(exp(f1), exp(f2)))
expect_equal(sin(m1)^2 + cos(m1)^2, 0*m1+1) # combination of Arith and math
})
test_that("norm", {
# Check errors:
# univariate FD object
expect_error(norm(f1, squared = "Yes"), "Parameter 'squared' must be passed as a logical.")
expect_error(norm(f1, squared = c(TRUE, FALSE)), "Parameter 'squared' must be passed as a logical.")
expect_error(norm(f1, weight = "1"), "Parameter 'weight' must be passed as a positive number.")
expect_error(norm(f1, weight = 1:2), "Parameter 'weight' must be passed as a positive number.")
expect_error(norm(f1, weight = -1), "Parameter 'weight' must be passed as a positive number.")
# multivariate FD object
expect_error(norm(m1, weight = c(1,"2")),
"Parameter 'weight' must be passed as a vector of 2 positive numbers.")
expect_error(norm(m1, weight = 1:3),
"Parameter 'weight' must be passed as a vector of 2 positive numbers.")
expect_error(norm(m1, weight = c(-1,1)),
"Parameter 'weight' must be passed as a vector of 2 positive numbers.")
# irreg FD object
expect_error(norm(i1, squared = "Yes"), "Parameter 'squared' must be passed as a logical.")
expect_error(norm(i1, squared = c(TRUE, TRUE)), "Parameter 'squared' must be passed as a logical.")
expect_error(norm(i1, weight = "1"), "Parameter 'weight' must be passed as a positive number.")
expect_error(norm(i1, weight = 1:2), "Parameter 'weight' must be passed as a positive number.")
expect_error(norm(i1, weight = -1), "Parameter 'weight' must be passed as a positive number.")
# Check functionality:
# univariate FD object
expect_equal(norm(f1), # all observations
apply((f1^2)@X, 1, function(f, argvals, method){funData:::.intWeights(argvals, method) %*% f}, argvals = f1@argvals[[1]], method = "trapezoidal") )
expect_equal(norm(f1)[1:3], norm(f1, obs = 1:3)) # only some observations
expect_equal(norm(f1, squared = FALSE)[2], sqrt(norm(f1)[2])) # squared option
expect_equal(norm(f1, weight = 2), 2*norm(f1)) # weight (makes little sense for univariate funData objects...)
# multivariate FD object
expect_equal(norm(m1), rowSums(sapply(m1, norm, simplify = TRUE))) # all observations
expect_equal(norm(m1)[1], norm(m1, obs = 1)) # only one observation
expect_equal(norm(m1, squared = FALSE), sqrt(rowSums(sapply(m1, norm, squared = TRUE, simplify = TRUE)))) # squared option
expect_equal(norm(m1, weight = c(2,1)), norm(multiFunData(sqrt(2)*f1,f2))) # with weight
# irreg FD object
expect_equal(norm(i1), c(42,19,9), tolerance = 1e-5) # result calculated explicitly
expect_equal(norm(i1, fullDom = TRUE), c(42,42,43), tolerance = 1e-5) # result calculated explicitly
expect_equal(norm(i1, weight = 2), 2*norm(i1)) # weight (makes little sense for univariate funData objects...)
})
test_that("scalarProduct", {
# Check errors:
expect_error(scalarProduct(m1, as.multiFunData(f1)),
"multiFunData objects must have the same number of elements.")
expect_error(scalarProduct(m1, m1, weight = 1:3),
"Weight vector must have the same number of elements as the multiFunData objects.")
expect_error(scalarProduct(m1, m1, weight = c(-1,1)),
"Weights must be non-negative.")
expect_error(scalarProduct(m1, m1, weight = c(0,0)),
"At least one weighting factor must be different from 0.")
# Check functionality:
# univariate FD objects
s <- scalarProduct(f1, 2*f1)
expect_equal(length(s), nObs(f1))
expect_equal(s[1], 840, tol = 1e-5)
expect_equal(scalarProduct(f1,f1), norm(f1, squared = TRUE))
# multivariate FD object
expect_equal(scalarProduct(m1,m1), norm(m1, squared = TRUE))
expect_equal(scalarProduct(m1,m1, weight = c(1,2)), norm(m1, squared = TRUE, weight = c(1,2))) # with weights
expect_equal(scalarProduct(as.multiFunData(f1),as.multiFunData(f1)), norm(f1, squared = TRUE)) # special case: only one element
# irreg FD object
expect_equal(scalarProduct(i1,i1), norm(i1, squared = TRUE))
expect_equal(norm(i1, squared = FALSE)^2, norm(i1, squared = TRUE)) # check squared
})
test_that("integrate", {
# Check errors:
expect_error(integrate(funData(argvals = list(1:2,1:3,1:4,1:5), X = array(rnorm(120), dim = c(1,2,3,4,5)))),
"Integration is not yet defined for functional data objects with dim > 3")
expect_error(integrate(f1, method = 1),"Parameter 'method' must be a string.")
expect_error(integrate(f1, method = c("m1", "m2")),"Parameter 'method' must be a string.")
expect_error(integrate(i1, fullDom = "Yes"),"Parameter 'fullDom' must be a logical.")
expect_error(integrate(i1, fullDom = c(TRUE, FALSE)),"Parameter 'fullDom' must be a logical.")
expect_warning(integrate(extractObs(f1, argvals = 1:2)), # method = trapezoidal and not enough observation points
"Trapezoidal quadrature is not applicable for functions with < 3 observation points. 'method' changed to 'midpoint'.")
# Check functionality:
# univariate FD objects
expect_equal(integrate(f1)[1], sum(funData:::.intWeights(f1@argvals[[1]], "trapezoidal")*f1@X[1,]))
expect_equal(integrate(f2)[1], as.numeric(t(funData:::.intWeights(f2@argvals[[1]], "trapezoidal")) %*%
f2@X[1,,] %*% funData:::.intWeights(f2@argvals[[2]], "trapezoidal")))
expect_equal(integrate(f3)[1], 14340)
# multivariate FD objects
expect_equal(integrate(m1), as.numeric(integrate(f1) + integrate(f2)))
expect_equal(integrate(m1.1), as.numeric(integrate(f1.1) + integrate(f2.1)))
# irreg FD object
expect_equal(integrate(i1), c(12,6,-4), tolerance = 1e-5)
expect_equal(integrate(i1, fullDom = TRUE), c(12,12,-12), tolerance = 1e-5)
expect_equal( integrate(extractObs(i1, argvals = 1:3), fullDom = TRUE), c(4,4,6)) # fullDom uses extrapolate and 3rd obs has only one observation point
# check generic default (from stats::integrate help page)
expect_equal(integrate(dnorm, -1.96, 1.96)$value, 2*pnorm(1.96)- 1)
})
test_that("integrate3D",{
x <- seq(0,1, 0.02); nX <- length(x)
y <- seq(-0.5,0.5, 0.02); nY <- length(y)
z <- seq(1,2,0.02); nZ <- length(z)
A <- array(NA, c(nX, nY, nZ))
for(ix in 1:nX)
for(iy in 1:nY)
for(iz in 1:nZ)
A[ix,iy,iz] <- x[ix]*cos(pi*y[iy])*z[iz]^2
expect_equal(funData:::integrate3D(A, argvals = list(x,y,z)), 7/(3*pi), tolerance = 1e-3)
})
test_that("set/get", {
# Check errors:
# univariate FD object (one-dim)
expect_error({argvals(f1) <- 1:6},
"argvals and X have different number of sampling points! X-Dimensions must be of the form N x M1 x ... x Md") # wrong number of sampling points (argvals)
expect_error({X(f1) <- matrix(1:24, nrow = 4)},
"argvals and X have different number of sampling points! X-Dimensions must be of the form N x M1 x ... x Md") # wrong number of sampling points (X)
expect_warning({tmp <- f1; X(tmp) <- matrix(1:25, nrow = 5)}, 'Number of observations has changed') # warning: more observations
# univariate FD object (two-dim)
expect_error({argvals(f2) <- 1:5},
"argvals and X element have different support dimensions! X-Dimensions must be of the form N x M1 x ... x Md") # wrong dimension (argvals)
expect_error({X(f2) <- matrix(1:20, nrow = 4)},
"argvals and X element have different support dimensions! X-Dimensions must be of the form N x M1 x ... x Md") # wrong dimension (X)
# multivariate FD object
expect_error({argvals(m1) <- list(1+1:5, list(2+1:5, 3+1:6), 4+1:5)}, 'multiFunData object and new argvals must have the same length') # wrong length (argvals, multiFunData)
expect_error({X(m1) <- list(X(f1), X(f2), matrix(1:12, nrow = 4))}, 'multiFunData object and new X must have the same length') # wrong length (X, multiFunData)
expect_error({X(m1) <- list(matrix(1:25, nrow = 5), array(1:120, c(4,5,6)))}, 'New X object must have the same number of observations in all elements!') # different number of observations
expect_warning({X(m1) <- list(matrix(1:25, nrow = 5), array(1:150, c(5,5,6)))}, 'Number of observations has changed') # warning: more observations
# irreg FD object
expect_error({argvals(i1) <- list(1:4)}, "New argvals must be a list of the same length as the original argvals.")
expect_error({argvals(i1) <- list(1:6, 1:3, 1:10)}, "New argvals must have the same structure as the original argvals.")
expect_error({X(i1) <- list(1:4)}, "New X must be a list of the same length as the original X.")
expect_error({X(i1) <- list(1:6, 1:3, 1:10)}, "New X must have the same structure as the original X.")
# Check functionality:
# univariate FD object (one-dim)
expect_equal({argvals(f1) <- list(1+1:5)}, list(1+1:5))
expect_equal({argvals(f1) <- 1+1:5; argvals(f1)}, list(1+1:5)) # special case: one-dimensional domain
expect_equal({X(f1) <- matrix(1+1:20, nrow = 4)}, matrix(1+1:20, nrow = 4))
# univariate FD object (two-dim)
expect_equal({argvals(f2) <- list(1+1:5, 2+1:6)}, list(1+1:5, 2+1:6))
# multivariate FD object
expect_equal({argvals(m1) <- list(list(2+1:5), list(1+1:5, 3+1:6))}, list(list(2+1:5), list(1+1:5, 3+1:6)))
expect_equal({X(m1) <- list(matrix(1+1:20, nrow = 4), array(2+1:120, c(4,5,6)))}, list(matrix(1+1:20, nrow = 4), array(2+1:120, c(4,5,6))))
expect_equal({argvals(m1) <- list(1+1:5, list(2+1:5, 3+1:6)); argvals(m1)}, list(list(1+1:5), list(2+1:5, 3+1:6))) # special case: one-dimensional domains
# irreg FD object
expect_equal({argvals(i1) <- list(0:4, 0:2, 1:3)}, list(0:4, 0:2, 1:3))
expect_equal({X(i1) <- list(0:4, 0:2, 1:3)}, list(0:4, 0:2, 1:3))
# check multivariate functions with one element
expect_equal(argvals(f1), argvals(as.multiFunData(f1))[[1]])
# check deprecated functions
expect_warning(tmp <- getArgvals(f1)); expect_equal(tmp, argvals(f1))
expect_warning(tmp <- getArgvals(f2)); expect_equal(tmp, argvals(f2))
expect_warning(tmp <- getArgvals(m1)); expect_equal(tmp, argvals(m1))
expect_warning(tmp <- getArgvals(i1)); expect_equal(tmp, argvals(i1))
expect_warning(tmp <- getX(f1)); expect_equal(tmp, X(f1))
expect_warning(tmp <- getX(f2)); expect_equal(tmp, X(f2))
expect_warning(tmp <- getX(m1)); expect_equal(tmp, X(m1))
expect_warning(tmp <- getX(i1)); expect_equal(tmp, X(i1))
expect_warning(tmp <- setArgvals(f1, list(1+1:5))); expect_equal( {argvals(f1) <- list(1+1:5); f1}, tmp)
expect_warning(tmp <- setArgvals(f1, 1+1:5)); expect_equal( {argvals(f1) <- list(1+1:5); f1}, tmp) # special case: one-dimensional domain
expect_warning(tmp <- setArgvals(f2, list(1+1:5, 2+1:6))); expect_equal( {argvals(f2) <- list(1+1:5, 2+1:6); f2}, tmp)
expect_warning(tmp <- setArgvals(m1, list(list(2+1:5), list(1+1:5, 3+1:6)))); expect_equal( {argvals(m1) <- list(list(2+1:5), list(1+1:5, 3+1:6)); m1}, tmp)
expect_warning(tmp <- setArgvals(m1, list(1+1:5, list(2+1:5, 3+1:6)))); expect_equal( {argvals(m1) <- list(list(1+1:5), list(2+1:5, 3+1:6)); m1}, tmp) # special case: one-dimensional domains
expect_warning(tmp <- setArgvals(i1, list(0:4, 0:2, 1:3))); expect_equal( {argvals(i1) <- list(0:4, 0:2, 1:3); i1}, tmp)
expect_warning(tmp <- setX(f1, matrix(1+1:20, nrow = 4))); expect_equal( {X(f1) <- matrix(1+1:20, nrow = 4); f1}, tmp)
expect_warning(tmp <- setX(m1, list(matrix(1+1:20, nrow = 4), array(2+1:120, c(4,5,6))))); expect_equal( {X(m1) <- list(matrix(1+1:20, nrow = 4), array(2+1:120, c(4,5,6))); m1}, tmp)
expect_warning(tmp <- setX(i1, list(0:4, 0:2, 1:3))); expect_equal( {X(i1) <- list(0:4, 0:2, 1:3); i1}, tmp)
})
test_that("flipFun", {
# Check errors:
# univariate FD object
expect_error(flipFuns(f1,funData(argvals = list(1:5), X = array(1:30,c(6,5)))),
'Functions must have the same number of observations or use a single function as reference.') # not the same number of observations
expect_error(flipFuns(f1,f2),
'Functions must have the dimension.') # not the same dimension
expect_error(flipFuns(f1,funData(argvals = list(2:6), X = array(1:20,c(4,5)))),
'Functions must be defined on the same domain.') # not the same domain
expect_error(flipFuns(f3, 2*f3),
"Function is only implemented for data of dimension <= 2")
# multivariate FD
expect_error(flipFuns(m1, as.multiFunData(f1)),
"multiFunData objects must have the same length")
expect_error(flipFuns(m1, extractObs(m1, 1:2)),
"Functions must have the same number of observations or use a single function as reference.")
expect_error(flipFuns(m1, multiFunData(f2,f1)),
"Functions must have the dimension.")
expect_error(flipFuns(m1, multiFunData(extractObs(f1, argvals = 1:4), f2)),
"Functions must be defined on the same domain.")
# irreg FD object (regular reference)
expect_error(flipFuns(f2,i1),
"Function is only implemented for irregular data with one-dimensional support")
expect_error(flipFuns(extractObs(f1, 1:2), i1),
"Functions must have the same number of observations or use a single function as reference.")
expect_error(flipFuns(extractObs(f1, argvals = 1:3), fi),
"Irregular functions must be defined on a sub-domain of the reference function(s).", fixed = TRUE)# fixed, as '(...)' is interpreted as regexp
# irreg FD object (irregular reference)
expect_error(flipFuns(extractObs(i1, 1:2), i1),
"Functions must have the same number of observations or use a single function as reference.")
expect_error(flipFuns(extractObs(i1, argvals = 1:3), i1),
"New functions must be defined on a sub-domain of the reference function(s).", fixed = TRUE) # fixed, as '(...)' is interpreted as regexp
# Check functionality:
# univariate FD object (one-dim)
expect_equal(flipFuns(f1, -1*f1), f1)
# univariate FD object (two-dim)
expect_equal(flipFuns(f2, -1*f2), f2)
# multivariate FD object
expect_equal(flipFuns(m1, -1*m1), m1)
# irreg FD object
expect_equal(flipFuns(f1,fi),fi) # regular reference for each observation
expect_equal(flipFuns(extractObs(f1, obs = 1), fi), fi) # single regular reference function
expect_equal(flipFuns(i1, -1*i1), i1) # irreg reference for each observation
expect_equal(flipFuns(extractObs(fi, obs = 1), -1*fi), fi) # irreg reference for each observation
})
test_that("meanFunction",{
set.seed(2)
f1NA <- f1; f1NA@X[sample(prod(dim(f1NA@X)), 5)] <- NA
# Check errors:
# funData
expect_error(meanFunction(f1, na.rm = "Yes"), "Parameter 'na.rm' must be a logical.")
expect_error(meanFunction(f1, na.rm = c(TRUE, FALSE)), "Parameter 'na.rm' must be a logical.")
# irreg FD object
expect_error(meanFunction(i1, na.rm = "Yes"), "Parameter 'na.rm' must be a logical.")
expect_error(meanFunction(i1, na.rm = c(TRUE, FALSE)), "Parameter 'na.rm' must be a logical.")
expect_error(meanFunction(irregFunData(argvals = list(1:3,1:5), X = list(1:3,1:5))),
"Mean function defined only for irregular functional data objects on the same domain.")
expect_error(meanFunction(i1, na.rm = TRUE),
"Option na.rm = TRUE is not implemented for mean functions of irregular data.")
# Check functionality:
# univariate FD object (one-dim)
expect_equal(meanFunction(f1), {mean1 <- funData(1:5, matrix(seq(2.5, 18.5, 4), nrow = 1))})
expect_equal(meanFunction(f1NA),
funData(f1NA@argvals, array(colMeans(f1NA@X), dim = c(1, length(f1@argvals[[1]])))))
# univariate FD object (two-dim)
expect_equal(meanFunction(f2), {mean2 <- funData(f2@argvals, array(seq(2.5,118.5, 4), dim = c(1,5,6)))})
# multivariate FD object
expect_equal(meanFunction(m1), multiFunData(mean1,mean2))
# irregular FD object
expect_equal(meanFunction(fi), as.irregFunData(mean1))
})
test_that("expand.int",{
expect_null(funData:::expand.int())
expect_equal(funData:::expand.int(2,5), data.frame(Var1 = rep(1:2, each = 5), Var2 = rep(1:5, times = 2)))
}
)
test_that("tensorProduct",{
# Check errors:
expect_error(tensorProduct(f1), "tensorProduct currently accepts only 2 or 3 arguments.")
expect_error(tensorProduct(f1, f2, f2, f1), "tensorProduct currently accepts only 2 or 3 arguments.")
expect_error(tensorProduct(f1, tensorProduct(f1,f2)), "tensorProduct is defined only for funData objects on one-dimensional domains!")
# Check functionality:
# tensor product of two functions
TP1 <- tensorProduct(f1, f1.1)
expect_equal(dimSupp(TP1), 2)
expect_equal(TP1@argvals, list(f1@argvals[[1]], f1.1@argvals[[1]]))
expect_equal(nObs(TP1), nObs(f1)*nObs(f1.1))
expect_equal(apply(TP1@X[1,-1,]/TP1@X[4,-1,], 1, mean), c(0.625, 0.75, 0.8125, 0.85), tol = 1e-5)
expect_equal(apply(TP1@X[1,-1,]/TP1@X[4,-1,], 1, var), rep(0,4), tol = 1e-5)
# tensor product of three functions
TP2 <- tensorProduct(f1, f1.1, f1)
expect_equal(dimSupp(TP2), 3)
expect_equal(TP2@argvals, list(f1@argvals[[1]], f1.1@argvals[[1]], f1@argvals[[1]]))
expect_equal(nObs(TP2), nObs(f1)^2*nObs(f1.1))
expect_equal(mean(TP2@X[1,-1,-1,-1]/TP2@X[2,-1,-1,-1]), 0.90159, tol = 1e-5)
expect_equal(var(TP2@X[1,-1,-1,-1]/TP2@X[2,-1,-1,-1]), 0.0018352, tol = 1e-7)
})
test_that("approxNA",{
set.seed(2)
expect_equal(integrate(f1 - as.irregFunData(approxNA(sparsify(f1, minObs = 3, maxObs = 5)))),
rep(0, nObs(f1)))
})
Try the funData package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.