DataFrame.h

Go to the documentation of this file.

 
// DataFrame.h: Rcpp R/C++ interface class library -- data frames
//
// Copyright (C) 2010 - 2026  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/>.
 
#ifndef Rcpp__DataFrame_h
#define Rcpp__DataFrame_h
 
namespace Rcpp{
 
    namespace internal{
        inline SEXP empty_data_frame(){
            Shield<SEXP> df( Rf_allocVector(VECSXP, 0) );
            Rf_setAttrib(df, R_NamesSymbol, Rf_allocVector(STRSXP, 0));
            Rf_setAttrib(df, R_RowNamesSymbol, Rf_allocVector(INTSXP, 0));
            Rf_setAttrib(df, R_ClassSymbol, Rf_mkString("data.frame"));
            return df;
        }
    }
 
    template <template <class> class StoragePolicy>
    class DataFrame_Impl : public Vector<VECSXP, StoragePolicy> {
    public:
        typedef Vector<VECSXP, StoragePolicy> Parent ;
 
        DataFrame_Impl() : Parent( internal::empty_data_frame() ){}
        DataFrame_Impl(SEXP x) : Parent(x) {
            set__(x);
        }
        DataFrame_Impl( const DataFrame_Impl& other) : Parent() {
            set__(other) ;
        }
 
        template <typename T>
        DataFrame_Impl( const T& obj ) ;
 
        DataFrame_Impl& operator=( DataFrame_Impl& other){
            if (*this != other) set__(other);
            return *this;
        }
 
        DataFrame_Impl& operator=( SEXP x){
            set__(x) ;
            return *this ;
        }
 
        // By definition, the number of rows in a data.frame is contained
        // in its row.names attribute. Since R 3.5.0 this is returned as a
        // compact sequence from which we can just take the (x)length
        // But as this makes an allocation an even simpler check on length as
        // discussed in #1430 is also possible and preferable. We also switch
        // to returning R_xlen_t which as upcast from int is safe
        inline R_xlen_t nrow() const {
#if R_VERSION < R_Version(4,6,0)
            Shield<SEXP> rn{Rf_getAttrib(Parent::get__(), R_RowNamesSymbol)};
            return Rf_xlength(rn);
#else
            return R_nrow(Parent::get__());
#endif
        }
 
        template <typename T>
        void push_back( const T& object){
            Parent::push_back(object);
            set_type_after_push();
        }
 
        template <typename T>
        void push_back( const T& object, const std::string& name ){
            Parent::push_back(object, name);
            set_type_after_push();
        }
 
        template <typename T>
        void push_front( const T& object){
            Parent::push_front(object);
            set_type_after_push();
        }
 
        template <typename T>
        void push_front( const T& object, const std::string& name){
            Parent::push_front(object, name);
            set_type_after_push();
        }
 
        // Offer multiple variants to accomodate both old interface here and signatures in other classes
        inline R_xlen_t nrows() const { return DataFrame_Impl::nrow(); }
        inline R_xlen_t rows()  const { return DataFrame_Impl::nrow(); }
 
        inline R_xlen_t ncol()  const { return DataFrame_Impl::length(); }
        inline R_xlen_t cols()  const { return DataFrame_Impl::length(); }
 
        static DataFrame_Impl create(){
            return DataFrame_Impl() ;
        }
        template <typename... T>
        static DataFrame_Impl create(const T&... args) {
            return DataFrame_Impl::from_list(Parent::create(args...));
        }
 
    private:
        void set__(SEXP x){
            if( ::Rf_inherits( x, "data.frame" )){
                Parent::set__( x ) ;
            } else{
                Shield<SEXP> y(internal::convert_using_rfunction( x, "as.data.frame" )) ;
                Parent::set__( y ) ;
            }
        }
 
        void set_type_after_push(){
            R_xlen_t max_rows = 0;
            bool invalid_column_size = false;
            List::iterator it;
            // Get the maximum number of rows
            for (it = Parent::begin(); it != Parent::end(); ++it) {
                if (Rf_xlength(*it) > max_rows) {
                    max_rows = Rf_xlength(*it);
                }
            }
            if (max_rows > 0) {
                for (it = Parent::begin(); it != Parent::end(); ++it) {
                    if (Rf_xlength(*it) == 0 || ( Rf_xlength(*it) > 1 && max_rows % Rf_xlength(*it) != 0 )) {
                        // We have a column that is not an integer fraction of the largest
                        invalid_column_size = true;
                    }
                }
            }
            if (invalid_column_size) {
                warning("Column sizes are not equal in DataFrame::push_back, object degrading to List\n");
            } else {
                set__(Parent::get__());
            }
        }
 
        static DataFrame_Impl from_list( Parent obj ){
            bool use_default_strings_as_factors = true ;
            bool strings_as_factors = true ;
            int strings_as_factors_index = -1 ;
            R_xlen_t n = obj.size() ;
            CharacterVector names = obj.attr( "names" ) ;
            if( !names.isNULL() ){
                for( int i=0; i<n; i++){
                    if( names[i] == "stringsAsFactors" ){
                        strings_as_factors_index = i ;
                        use_default_strings_as_factors = false ;
                        if( !as<bool>(obj[i]) ) strings_as_factors = false ;
                        break ;
                    }
                }
            }
            if( use_default_strings_as_factors )
                return DataFrame_Impl(obj) ;
            SEXP as_df_symb = Rf_install("as.data.frame");
            SEXP strings_as_factors_symb = Rf_install("stringsAsFactors");
 
            obj.erase(strings_as_factors_index) ;
            names.erase(strings_as_factors_index) ;
            obj.attr( "names") = names ;
            Shield<SEXP> call( Rf_lang3(as_df_symb, obj, Rf_ScalarLogical(strings_as_factors) ) ) ;
            SET_TAG( CDDR(call),  strings_as_factors_symb ) ;
            Shield<SEXP> res(Rcpp_fast_eval(call, R_GlobalEnv));
            DataFrame_Impl out( res ) ;
            return out ;
 
        }
 
    } ;
 
    typedef DataFrame_Impl<PreserveStorage> DataFrame ;
}
 
#endif