#!/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") } }