#!/usr/bin/r -t
# -*- mode: R; ess-indent-level: 4; indent-tabs-mode: nil; -*-
#
# Copyright (C) 2010 - 2014 Dirk Eddelbuettel and Romain Francois
#
# This file is part of Rcpp.
#
# Rcpp is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# Rcpp is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Rcpp. If not, see .
.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
if (.runThisTest) {
.setUp <- Rcpp:::unitTestSetup("sugar.cpp")
test.sugar.abs <- function( ){
x <- rnorm(10)
y <- -10:10
checkEquals( runit_abs(x,y) , list( abs(x), abs(y) ) )
}
test.sugar.all.one.less <- function( ){
checkTrue( runit_all_one_less( 1 ) )
checkTrue( ! runit_all_one_less( 1:10 ) )
checkTrue( is.na( runit_all_one_less( NA ) ) )
checkTrue( is.na( runit_all_one_less( c( NA, 1) ) ) )
checkTrue( ! runit_all_one_less( c( 6, NA) ) )
}
test.sugar.all.one.greater <- function( ){
checkTrue( ! runit_all_one_greater( 1 ) )
checkTrue( ! runit_all_one_greater( 1:10 ) )
checkTrue( runit_all_one_greater( 6:10 ) )
checkTrue( ! runit_all_one_greater( c(NA, 1) ) )
checkTrue( is.na( runit_all_one_greater( c(NA, 6) ) ) )
}
test.sugar.all.one.less.or.equal <- function( ){
checkTrue( runit_all_one_less_or_equal( 1 ) )
checkTrue( ! runit_all_one_less_or_equal( 1:10 ) )
checkTrue( is.na( runit_all_one_less_or_equal( NA ) ) )
checkTrue( is.na( runit_all_one_less_or_equal( c( NA, 1) ) ) )
checkTrue( ! runit_all_one_less_or_equal( c( 6, NA) ) )
checkTrue( runit_all_one_less_or_equal( 5 ) )
}
test.sugar.all.one.greater.or.equal <- function( ){
fx <- runit_all_one_greater_or_equal
checkTrue( ! fx( 1 ) )
checkTrue( ! fx( 1:10 ) )
checkTrue( fx( 6:10 ) )
checkTrue( fx( 5 ) )
checkTrue( ! fx( c(NA, 1) ) )
checkTrue( is.na( fx( c(NA, 6) ) ) )
}
test.sugar.all.one.equal <- function( ){
fx <- runit_all_one_equal
checkTrue( ! fx( 1 ) )
checkTrue( ! fx( 1:2 ) )
checkTrue( fx( rep(5,4) ) )
checkTrue( is.na( fx( c(5,NA) ) ) )
checkTrue(! fx( c(NA, 1) ) )
}
test.sugar.all.one.not.equal <- function( ){
fx <- runit_all_not_equal_one
checkTrue( fx( 1 ) )
checkTrue( fx( 1:2 ) )
checkTrue( ! fx( 5 ) )
checkTrue( is.na( fx( c(NA, 1) ) ) )
checkTrue( ! fx( c(NA, 5) ) )
}
test.sugar.all.less <- function( ){
fx <- runit_all_less
checkTrue( ! fx( 1, 0 ) )
checkTrue( fx( 1:10, 2:11 ) )
checkTrue( fx( 0, 1 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.all.greater <- function( ){
fx <- runit_all_greater
checkTrue( fx( 1, 0 ) )
checkTrue( fx( 2:11, 1:10 ) )
checkTrue( ! fx( 0, 1 ) )
checkTrue( ! fx( 0:9, c(0:8,10) ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.all.less.or.equal <- function( ){
fx <- runit_all_less_or_equal
checkTrue( fx( 1, 1 ) )
checkTrue( ! fx( 1:2, c(1,1) ) )
checkTrue( fx( 0, 1 ) )
checkTrue( ! fx( 1, 0 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.all.greater.or.equal <- function( ){
fx <- runit_all_greater_or_equal
checkTrue( fx( 1, 1 ) )
checkTrue( fx( 1:2, c(1,1) ) )
checkTrue( ! fx( 0, 1 ) )
checkTrue( fx( 1, 0 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.all.equal <- function( ){
fx <- runit_all_equal
checkTrue( fx( 1, 1 ) )
checkTrue( ! fx( 1:2, c(1,1) ) )
checkTrue( ! fx( 0, 1 ) )
checkTrue( ! fx( 1, 0 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.all.not.equal <- function( ){
fx <- runit_all_not_equal
checkTrue( ! fx( 1, 1 ) )
checkTrue( ! fx( 1:2, c(1,1) ) )
checkTrue( fx( 0, 1 ) )
checkTrue( fx( 1, 0 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.any.less <- function( ){
fx <- runit_any_less
checkTrue( ! fx( 1, 0 ) )
checkTrue( fx( 1:10, 2:11 ) )
checkTrue( fx( 0, 1 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.any.greater <- function( ){
fx <- runit_any_greater
checkTrue( fx( 1, 0 ) )
checkTrue( fx( 2:11, 1:10 ) )
checkTrue( ! fx( 0, 1 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.any.less.or.equal <- function( ){
fx <- runit_any_less_or_equal
checkTrue( fx( 1, 1 ) )
checkTrue( fx( 1:2, c(1,1) ) )
checkTrue( fx( 0, 1 ) )
checkTrue( ! fx( 1, 0 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.any.greater.or.equal <- function( ){
fx <- runit_any_greater_or_equal
checkTrue( fx( 1, 1 ) )
checkTrue( fx( 1:2, c(1,1) ) )
checkTrue( ! fx( 0, 1 ) )
checkTrue( fx( 1, 0 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.any.equal <- function( ){
fx <- runit_any_equal
checkTrue( fx( 1, 1 ) )
checkTrue( fx( 1:2, c(1,1) ) )
checkTrue( ! fx( 0, 1 ) )
checkTrue( ! fx( 1, 0 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.any.not.equal <- function( ){
fx <- runit_any_not_equal
checkTrue( ! fx( 1, 1 ) )
checkTrue( fx( 1:2, c(1,1) ) )
checkTrue( fx( 0, 1 ) )
checkTrue( fx( 1, 0 ) )
checkTrue( is.na( fx( NA, 1 ) ) )
}
test.sugar.constructor <- function( ){
fx <- runit_constructor
checkEquals( fx( 1, 0 ), FALSE )
checkEquals( fx( 1:10, 2:11 ), rep(TRUE,10) )
checkEquals( fx( 0, 1 ), TRUE )
checkTrue( identical( fx( NA, 1 ), NA ) )
}
test.sugar.assignment <- function( ){
fx <- runit_assignment
checkEquals( fx( 1, 0 ), FALSE )
checkEquals( fx( 1:10, 2:11 ), rep(TRUE,10) )
checkEquals( fx( 0, 1 ), TRUE )
checkTrue( identical( fx( NA, 1 ), NA ) )
}
test.sugar.diff <- function( ){
x <- as.integer(round(rnorm(100,1,100)))
checkEquals( runit_diff_int(x) , diff(x) )
x <- rnorm( 100 )
checkEquals( runit_diff(x) , diff(x) )
y <- rnorm(100)
pred <- sample( c(T,F), 99, replace = TRUE )
checkEquals( runit_diff_ifelse(pred, x, y ), ifelse( pred, diff(x), diff(y) ) )
}
test.sugar.exp <- function( ){
fx <- runit_exp
x <- rnorm(10)
y <- -10:10
checkEquals( fx(x,y) , list( exp(x), exp(y) ) )
}
test.sugar.floor <- function( ){
fx <- runit_floor
x <- rnorm(10)
y <- -10:10
checkEquals( fx(x,y) , list( floor(x), floor(y) ) )
}
test.sugar.ceil <- function( ){
fx <- runit_ceil
x <- rnorm(10)
y <- -10:10
checkEquals( fx(x,y) , list( ceiling(x), ceiling(y) ) )
}
test.sugar.pow <- function( ){
fx <- runit_pow
x <- rnorm(10)
y <- -10:10
checkEquals( fx(x,y) , list( x^3L , y^2.3 ) )
}
test.sugar.ifelse <- function( ){
fx <- runit_ifelse
x <- 1:10
y <- 10:1
checkEquals( fx( x, y), list(
"vec_vec" = ifelse( x x, x <= 2, 2 != x), "sugar vector scalar logical operations")
}
test.vector.vector.ops <- function( ){
x <- rnorm(10)
y <- runif(10)
checkEquals(vector_vector_ops(x,y), list(x + y, y - x, x * y, y / x), "sugar vector vector operations")
}
test.vector.vector.logical <- function( ){
x <- rnorm(10)
y <- runif(10)
checkEquals(vector_vector_logical(x,y), list(x < y, x > y, x <= y, x >= y, x == y, x != y), "sugar vector vector operations")
}
}