1 /* 2 # xts: eXtensible time-series 3 # 4 # Copyright (C) 2008 Jeffrey A. Ryan jeff.a.ryan @ gmail.com 5 # 6 # Contributions from Joshua M. Ulrich 7 # 8 # This program is free software: you can redistribute it and/or modify 9 # it under the terms of the GNU General Public License as published by 10 # the Free Software Foundation, either version 2 of the License, or 11 # (at your option) any later version. 12 # 13 # This program is distributed in the hope that it will be useful, 14 # but WITHOUT ANY WARRANTY; without even the implied warranty of 15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 # GNU General Public License for more details. 17 # 18 # You should have received a copy of the GNU General Public License 19 # along with this program. If not, see <http://www.gnu.org/licenses/>. 20 */ 21 22 23 #include <R.h> 24 #include <Rinternals.h> 25 #include <Rdefines.h> 26 #include "xts.h" 27 number_of_cols(SEXP args)28SEXP number_of_cols (SEXP args) 29 { 30 SEXP tcols; 31 int P=0; 32 33 args = CDR(args); // calling function name 34 35 PROTECT(tcols = allocVector(INTSXP, length(args))); P++; 36 int i=0; 37 for(;args != R_NilValue; i++, args=CDR(args)) { 38 /* if( TAG(args) == R_NilValue ) { */ 39 if( length(CAR(args)) > 0) { 40 INTEGER(tcols)[i] = ncols(CAR(args)); 41 } else INTEGER(tcols)[i] = (int)0; 42 /* } */ 43 } 44 UNPROTECT(P); 45 return tcols; 46 } 47