coerce.cpp

Go to the documentation of this file.

// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
//
// coerce.cpp: Rcpp R/C++ interface class library -- coercion
//
// Copyright (C) 2010 - 2011 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 <http://www.gnu.org/licenses/>.

#include <RcppCommon.h>

namespace Rcpp{ 
namespace internal{

template <> int r_coerce<INTSXP,INTSXP>(int from) { return from ; }
template <> int r_coerce<LGLSXP,LGLSXP>(int from) { return from ; }
template <> double r_coerce<REALSXP,REALSXP>(double from) { return from ; }
template <> Rcomplex r_coerce<CPLXSXP,CPLXSXP>(Rcomplex from) { return from ; }
template <> Rbyte r_coerce<RAWSXP,RAWSXP>(Rbyte from) { return from ; }

// -> INTSXP
template <> int r_coerce<LGLSXP,INTSXP>(int from){
        return (from==NA_LOGICAL) ? NA_INTEGER : from ;
}
template <> int r_coerce<REALSXP,INTSXP>(double from){
        if (ISNAN(from)) return NA_INTEGER;
        else if (from > INT_MAX || from <= INT_MIN ) {
                return NA_INTEGER;
        }
        return static_cast<int>(from);

}
template <> int r_coerce<CPLXSXP,INTSXP>(Rcomplex from){
        return r_coerce<REALSXP,INTSXP>(from.r) ;
}
template <> int r_coerce<RAWSXP,INTSXP>(Rbyte from){
        return static_cast<int>(from);
}

// -> REALSXP
template <> double r_coerce<LGLSXP,REALSXP>(int from){
        return from == NA_LOGICAL ? NA_REAL : static_cast<double>(from) ;
}
template <> double r_coerce<INTSXP,REALSXP>(int from){
        return from == NA_INTEGER ? NA_REAL : static_cast<double>(from) ; 
}
template <> double r_coerce<CPLXSXP,REALSXP>(Rcomplex from){
        return from.r ;
}
template <> double r_coerce<RAWSXP,REALSXP>(Rbyte from){
        return static_cast<double>(from) ;
}

// -> LGLSXP
template <> int r_coerce<REALSXP,LGLSXP>(double from){
        return ( from == NA_REAL ) ? NA_LOGICAL : (from!=0.0);
}
template <> int r_coerce<INTSXP,LGLSXP>(int from){
        return ( from == NA_INTEGER ) ? NA_LOGICAL : (from!=0);
}
template <> int r_coerce<CPLXSXP,LGLSXP>(Rcomplex from){
        if( from.r == NA_REAL ) return NA_LOGICAL ;
        if( from.r == 0.0 || from.i == 0.0 ) return FALSE ;
        return TRUE ;
}
template <> int r_coerce<RAWSXP,LGLSXP>(Rbyte from){
        if( from != static_cast<Rbyte>(0) ) return TRUE ;
        return FALSE ;
}

// -> RAWSXP
template <> Rbyte r_coerce<REALSXP,RAWSXP>(double from){
        if( from == NA_REAL) return static_cast<Rbyte>(0) ; 
        return r_coerce<INTSXP,RAWSXP>(static_cast<int>(from)) ;
}
template <> Rbyte r_coerce<INTSXP,RAWSXP>(int from){
        return (from < 0 || from > 255) ? static_cast<Rbyte>(0) : static_cast<Rbyte>(from) ;
}
template <> Rbyte r_coerce<CPLXSXP,RAWSXP>(Rcomplex from){
        return r_coerce<REALSXP,RAWSXP>(from.r) ;
}
template <> Rbyte r_coerce<LGLSXP,RAWSXP>(int from){
        return static_cast<Rbyte>(from == TRUE) ;
}

// -> CPLXSXP
template <> Rcomplex r_coerce<REALSXP,CPLXSXP>(double from){
        Rcomplex c ;
        if( from == NA_REAL ){
                c.r = NA_REAL; 
                c.i = NA_REAL;
        } else{
                c.r = from ;
                c.i = 0.0 ;
        }
        return c ;
}
template <> Rcomplex r_coerce<INTSXP,CPLXSXP>(int from){
        Rcomplex c ;
        if( from == NA_INTEGER ){
                c.r = NA_REAL; 
                c.i = NA_REAL;
        } else{
                c.r = static_cast<double>(from) ;
                c.i = 0.0 ;
        }
        return c ;
}
template <> Rcomplex r_coerce<RAWSXP,CPLXSXP>(Rbyte from){
        Rcomplex c ;
        c.r = static_cast<double>(from);
        c.i = 0.0 ;
        return c ;
}
template <> Rcomplex r_coerce<LGLSXP,CPLXSXP>(int from){
        Rcomplex c ;
        if( from == TRUE ){
                c.r = 1.0 ; c.i = 0.0 ;
        } else if( from == FALSE ){
                c.r = c.i = 0.0 ;
        } else { /* NA */
                c.r = c.i = NA_REAL;
        }
        return c ;
}


} // internal
} // Rcpp