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/DataFrame.cpp") 22 23#test.DataFrame.FromSEXP <- function() { 24DF <- data.frame(a=1:3, b=c("a","b","c")) 25expect_equal( FromSEXP(DF), DF, info = "DataFrame pass-through") 26 27# test.DataFrame.index.byName <- function() { 28DF <- data.frame(a=1:3, b=c("a","b","c")) 29expect_equal( index_byName(DF, "a"), DF$a, info = "DataFrame column by name 'a'") 30expect_equal( index_byName(DF, "b"), DF$b, info = "DataFrame column by name 'b'") 31 32# test.DataFrame.index.byPosition <- function() { 33DF <- data.frame(a=1:3, b=c("a","b","c")) 34expect_equal( index_byPosition(DF, 0), DF$a, info = "DataFrame column by position 0") 35expect_equal( index_byPosition(DF, 1), DF$b, info = "DataFrame column by position 1") 36 37# test.DataFrame.string.element <- function() { 38DF <- data.frame(a=1:3, b=c("a","b","c"), stringsAsFactors=FALSE) 39expect_equal( string_element(DF), DF[2,"b"], info = "DataFrame string element") 40 41# test.DataFrame.CreateOne <- function() { 42DF <- data.frame(a=1:3) 43expect_equal( createOne(), DF, info = "DataFrame create1") 44 45# test.DataFrame.CreateTwo <- function() { 46DF <- data.frame(a=1:3, b=c("a","b","c")) 47expect_equal( createTwo(), DF, info = "DataFrame create2") 48 49# test.DataFrame.SlotProxy <- function(){ 50setClass("track", representation(x="data.frame", y = "function")) 51df <- data.frame( x = 1:10, y = 1:10 ) 52tr1 <- new( "track", x = df, y = rnorm ) 53expect_true( identical( SlotProxy(tr1, "x"), df ), info = "DataFrame( SlotProxy )" ) 54expect_error( SlotProxy(tr1, "y"), info = "DataFrame( SlotProxy ) -> exception" ) 55 56# test.DataFrame.AttributeProxy <- function(){ 57df <- data.frame( x = 1:10, y = 1:10 ) 58tr1 <- structure( list(), x = df, y = rnorm ) 59expect_true( identical( AttributeProxy(tr1, "x"), df) , info = "DataFrame( AttributeProxy )" ) 60expect_error( AttributeProxy(tr1, "y"), info = "DataFrame( AttributeProxy ) -> exception" ) 61 62# test.DataFrame.CreateTwo.stringsAsFactors <- function() { 63DF <- data.frame(a=1:3, b=c("a","b","c"), stringsAsFactors = FALSE ) 64expect_equal( createTwoStringsAsFactors(), DF, info = "DataFrame create2 stringsAsFactors = false") 65 66# test.DataFrame.nrow <- function(){ 67df <- data.frame( x = 1:10, y = 1:10 ) 68expect_equal( DataFrame_nrow( df ), rep(nrow(df), 2) ) 69 70# test.DataFrame.ncol <- function(){ 71df <- data.frame( x = 1:10, y = 1:10 ) 72expect_equal( DataFrame_ncol( df ), rep(ncol(df), 2) ) 73 74# test.DataFrame.PushBackNamed <- function(){ 75df <- data.frame( u = c(0, 0), v = c(0, 0) ) 76expect_true( is.data.frame( DataFrame_PushBackNamed() ) ) 77expect_equal( DataFrame_PushBackNamed(), df ) 78 79# test.DataFrame.PushBackUnamed <- function(){ 80df <- data.frame( u = c(0, 0), c(0, 0) ) 81expect_true( is.data.frame( DataFrame_PushBackUnnamed() ) ) 82expect_equal( DataFrame_PushBackUnnamed(), df ) 83 84# test.DataFrame.PushFrontNamed <- function(){ 85df <- data.frame( v = c(0, 0), u = c(0, 0) ) 86expect_true( is.data.frame( DataFrame_PushFrontNamed() ) ) 87expect_equal( DataFrame_PushFrontNamed(), df ) 88 89# test.DataFrame.PushFrontUnnamed <- function(){ 90df <- data.frame( c(0, 0), u = c(0, 0) ) 91expect_true( is.data.frame( DataFrame_PushFrontUnnamed() ) ) 92expect_equal( DataFrame_PushFrontUnnamed(), df ) 93 94 95# test.DataFrame.PushFrontDataFrame <- function(){ 96df <- data.frame( w = c(0, 0), x = c(0, 0), u = c(0, 0), v = c(0, 0) ) 97expect_true( is.data.frame( DataFrame_PushFrontDataFrame() ) ) 98expect_equal( DataFrame_PushFrontDataFrame(), df ) 99 100# test.DataFrame.PushBackDataFrame <- function(){ 101df <- data.frame( u = c(0, 0), v = c(0, 0), w = c(0, 0), x = c(0, 0) ) 102expect_true( is.data.frame( DataFrame_PushBackDataFrame() ) ) 103expect_equal( DataFrame_PushBackDataFrame(), df ) 104 105# test.DataFrame.PushWrongSize <- function(){ 106df <- data.frame( u = c(0, 0), v = c(0, 0), w = c(0, 0), x = c(0, 0) ) 107expect_warning( DataFrame_PushWrongSize() ) 108 109# test.DataFrame.PushReplicateLength <- function(){ 110df <- data.frame( u = c(1, 0), v = c(0, 0, 0, 0), x = c(2) ) 111expect_true( is.data.frame( DataFrame_PushReplicateLength() ) ) 112expect_equal( DataFrame_PushReplicateLength(), df ) 113 114# test.DataFrame.PushZeroLength <- function(){ 115expect_warning( DataFrame_PushZeroLength()) 116