1
2##  Copyright (C) 2010 - 2019  Dirk Eddelbuettel and Romain Francois
3##
4##  This file is part of Rcpp.
5##
6##  Rcpp is free software: you can redistribute it and/or modify it
7##  under the terms of the GNU General Public License as published by
8##  the Free Software Foundation, either version 2 of the License, or
9##  (at your option) any later version.
10##
11##  Rcpp is distributed in the hope that it will be useful, but
12##  WITHOUT ANY WARRANTY; without even the implied warranty of
13##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14##  GNU General Public License for more details.
15##
16##  You should have received a copy of the GNU General Public License
17##  along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
18
19if (Sys.getenv("RunAllRcppTests") != "yes") exit_file("Set 'RunAllRcppTests' to 'yes' to run.")
20
21Rcpp::sourceCpp("cpp/algorithm.cpp")
22
23#    test.sum <- function() {
24v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
25expect_equal(sum(v), sumTest(v, 1, 5))
26v <- c(NA, 1.0, 2.0, 3.0, 4.0)
27expect_equal(sum(v), sumTest(v, 1, 5))
28
29#    test.sum.nona <- function() {
30v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
31expect_equal(sum(v), sumTest_nona(v, 1, 5))
32
33#    test.prod <- function() {
34v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
35expect_equal(prod(v), prodTest(v, 1, 5))
36v <- c(NA, 1.0, 2.0, 3.0, 4.0)
37expect_equal(prod(v), prodTest(v, 1, 5))
38
39#test.prod.nona <- function() {
40v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
41expect_equal(prod(v), prodTest_nona(v, 1, 5))
42
43#test.log <- function() {
44v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
45expect_equal(log(v), logTest(v))
46v <- c(NA, 1.0, 2.0, 3.0, 4.0)
47expect_equal(log(v), logTest(v))
48
49#    test.exp <- function() {
50v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
51expect_equal(exp(v), expTest(v))
52v <- c(NA, 1.0, 2.0, 3.0, 4.0)
53expect_equal(exp(v), expTest(v))
54
55#    test.sqrt <- function() {
56v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
57expect_equal(sqrt(v), sqrtTest(v))
58v <- c(NA, 1.0, 2.0, 3.0, 4.0)
59expect_equal(sqrt(v), sqrtTest(v))
60
61#    test.min <- function() {
62v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
63expect_equal(min(v), minTest(v))
64v <- c(NA, 1.0, 2.0, 3.0, 4.0)
65expect_equal(min(v), minTest(v))
66
67#    test.min.nona <- function() {
68v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
69expect_equal(min(v), minTest_nona(v))
70
71#    test.min.int <- function() {
72v <- c(1, 2, 3, 4, 5)
73expect_equal(min(v), minTest_int(v))
74v <- c(NA, 1, 2, 3, 4)
75expect_equal(min(v), minTest_int(v))
76
77#    test.min.int.nona <- function() {
78v <- c(1, 2, 3, 4, 5)
79expect_equal(min(v), minTest_int_nona(v))
80
81#    test.max <- function() {
82v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
83expect_equal(max(v), maxTest(v))
84v <- c(NA, 1.0, 2.0, 3.0, 4.0)
85expect_equal(max(v), maxTest(v))
86
87#    test.max.nona <- function() {
88v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
89expect_equal(max(v), maxTest_nona(v))
90
91#    test.max.int <- function() {
92v <- c(1, 2, 3, 4, 5)
93expect_equal(max(v), maxTest_int(v))
94v <- c(NA, 1, 2, 3, 4)
95expect_equal(max(v), maxTest_int(v))
96
97#    test.max.int.nona <- function() {
98v <- c(1, 2, 3, 4, 5)
99expect_equal(max(v), maxTest_int_nona(v))
100
101#    test.mean <- function() {
102v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
103expect_equal(mean(v), meanTest(v))
104v <- c(1.0, 2.0, 3.0, 4.0, NA)
105expect_equal(mean(v), meanTest(v))
106v <- c(1.0, 2.0, 3.0, 4.0, NaN)
107expect_equal(mean(v), meanTest(v))
108v <- c(1.0, 2.0, 3.0, 4.0, 1.0/0.0)
109expect_equal(mean(v), meanTest(v))
110v <- c(1.0, 2.0, 3.0, 4.0, -1.0/0.0)
111expect_equal(mean(v), meanTest(v))
112v <- c(1.0, 2.0, 1.0/0.0, NA, NaN)
113expect_equal(mean(v), meanTest(v))
114v <- c(1.0, 2.0, 1.0/0.0, NaN, NA)
115
116#    test.mean.int <- function() {
117v <- c(1, 2, 3, 4, 5)
118expect_equal(mean(v), meanTest_int(v))
119v <- c(1, 2, 3, 4, NA)
120expect_equal(mean(v), meanTest_int(v))
121
122#test.mean.logical <- function() {
123v <- c(TRUE, FALSE, FALSE)
124expect_equal(mean(v), meanTest_logical(v))
125v <- c(TRUE, FALSE, FALSE, NA)
126expect_equal(mean(v), meanTest_logical(v))
127