SEXP make_d(SEXP year, SEXP month, SEXP day) {
if(!isInteger(year)) error("year must be integer");
if(!isInteger(month)) error("month must be integer");
if(!isInteger(day)) error("day must be integer");
R_len_t n = LENGTH(year);
if(n != LENGTH(month)) error("length of 'month' vector is not the same as that of 'year'");
if(n != LENGTH(day)) error("length of 'day' vector is not the same as that of 'year'");
int* pyear = INTEGER(year);
int* pmonth = INTEGER(month);
int* pday = INTEGER(day);
SEXP res = allocVector(REALSXP, n);
double *data = REAL(res);
for(int i = 0; i < n; i++) {
// main accumulator
double SECS = 0.0;
int y = pyear[i];
int m = pmonth[i];
int d = pday[i];
if(y == NA_INTEGER || m == NA_INTEGER || d == NA_INTEGER) {
data[i] = NA_REAL;
} else {
if ( 0 < m && m < 13 )
SECS += sm[m];
else {
data[i] = NA_REAL;
continue;
}
if ( 0 < d && d < 32 )
SECS += (d - 1) * 86400;
else {
data[i] = NA_REAL;
continue;
}
int is_leap = IS_LEAP(y);
if(check_ymd(y, m, d, is_leap)){
SECS += d30;
y -= 2000;
SECS += y * yearlen;
SECS += adjust_leap_years(y, m, is_leap);
data[i] = SECS;
} else {
data[i] = NA_REAL;
}
}
}
return res;
}
SEXP make_dt(SEXP year, SEXP month, SEXP day, SEXP hour, SEXP minute, SEXP second) {
if(!isInteger(year)) error("year must be integer");
if(!isInteger(month)) error("month must be integer");
if(!isInteger(day)) error("day must be integer");
if(!isInteger(hour)) error("hour must be integer");
if(!isInteger(minute)) error("minute must be integer");
if(!isNumeric(second)) error("second must be numeric");
R_len_t n = LENGTH(year);
if(n != LENGTH(month)) error("length of 'month' vector is not the same as that of 'year'");
if(n != LENGTH(day)) error("length of 'day' vector is not the same as that of 'year'");
if(n != LENGTH(hour)) error("length of 'hour' vector is not the same as that of 'year'");
if(n != LENGTH(minute)) error("length of 'minute' vector is not the same as that of 'year'");
if(n != LENGTH(second)) error("length of 'second' vector is not the same as that of 'year'");
int* pyear = INTEGER(year);
int* pmonth = INTEGER(month);
int* pday = INTEGER(day);
int* phour = INTEGER(hour);
int* pminute = INTEGER(minute);
int int_second = TYPEOF(second) == INTSXP;
SEXP res = allocVector(REALSXP, n);
double *data = REAL(res);
for(int i = 0; i < n; i++) {
// main accumulator
double SECS = 0.0;
int y = pyear[i];
int m = pmonth[i];
int d = pday[i];
int H = phour[i];
int M = pminute[i];
int naS;
double S;
if(int_second){
S = (double) INTEGER(second)[i];
naS = INTEGER(second)[i] == NA_INTEGER;
} else {
S = REAL(second)[i];
naS = ISNA(S);
}
if(naS || y == NA_INTEGER || m == NA_INTEGER || d == NA_INTEGER || H == NA_INTEGER || M == NA_INTEGER) {
data[i] = NA_REAL;
} else {
if ( 0 < m && m < 13 )
SECS += sm[m];
else {
data[i] = NA_REAL;
continue;
}
if ( 0 < d && d < 32 )
SECS += (d - 1) * 86400;
else {
data[i] = NA_REAL;
continue;
}
if( H < 25 )
SECS += H * 3600;
else {
data[i] = NA_REAL;
continue;
}
if ( M < 61 )
SECS += M * 60;
else{
data[i] = NA_REAL;
continue;
}
// allow leap seconds
if ( S < 62 ) {
SECS += S;
} else {
data[i] = NA_REAL;
continue;
}
int is_leap = LEAP(y);
if(check_ymd(y, m, d, is_leap)){
SECS += d30;
y -= 2000;
SECS += y * yearlen;
SECS += adjust_leap_years(y, m, is_leap);
data[i] = SECS;
} else {
data[i] = NA_REAL;
}
}
}
return res;
}
SEXP parse_dt(SEXP str, SEXP ord, SEXP formats, SEXP lt) {
// STR: character vector of date-times.
// ORD: formats (as in strptime) or orders (as in parse_date_time)
// FORMATS: TRUE if ord is a string of formats (as in strptime)
// LT: TRUE - return POSIXlt type list, FALSE - return POSIXct seconds
if ( !isString(str) ) error("Date-time must be a character vector");
if ( !isString(ord) || (LENGTH(ord) > 1))
error("Format argument must be a character vector of length 1");
R_len_t n = LENGTH(str);
int is_fmt = *LOGICAL(formats);
int out_lt = *LOGICAL(lt);
SEXP oYEAR, oMONTH, oDAY, oHOUR, oMIN, oSEC;
if(out_lt){
oYEAR = PROTECT(allocVector(INTSXP, n));
oMONTH = PROTECT(allocVector(INTSXP, n));
oDAY = PROTECT(allocVector(INTSXP, n));
oHOUR = PROTECT(allocVector(INTSXP, n));
oMIN = PROTECT(allocVector(INTSXP, n));
oSEC = PROTECT(allocVector(REALSXP, n));
} else {
oSEC = PROTECT(allocVector(REALSXP, n));
}
const char *O = CHAR(STRING_ELT(ord, 0));
for (int i = 0; i < n; i++) {
const char *c = CHAR(STRING_ELT(str, i));
const char *o = O;
double secs = 0.0; // only accumulator for POSIXct case
int y = 0, q = 0, m = 0, d = 0, H = 0, M = 0 , S = 0;
int succeed = 1, O_format = 0, pm = 0, am = 0; // control logical
// read order/format character by character
while( *o && succeed ) {
if( is_fmt && (*o != '%')) {
// with fmt: non formatting characters should match exactly
if ( *c == *o ) { c++; o++; } else succeed = 0;
} else {
if ( is_fmt ){
o++; // skip %
} else if ( *o != 'O' && *o != 'z' && *o != 'p' && *o != 'm' && *o != 'b' && *o != 'B') {
// skip non-digits
// O, z, p formats are treated specially below
while (*c && !DIGIT(*c)) c++;
}
if ( *o == 'O' ) {
// Special two letter orders/formats:
// Ou (Z), Oz (-0800), OO (-08:00) and Oo (-08)
O_format = 1;
o++;
} else {
O_format = 0;
}
if (!(DIGIT(*c) || O_format || *o == 'z' || *o == 'p' || *o == 'm' || *o == 'b' || *o == 'B')) {
succeed = 0;
} else {
/* Rprintf("c=%c o=%c\n", *c, *o); */
switch( *o ) {
case 'Y': // year in yyyy format
y = parse_int(&c, 4, TRUE);
if (y < 0)
succeed = 0;
break;
case 'y': // year in yy format
y = parse_int(&c, 2, FALSE);
if (y < 0)
succeed = 0;
else if (y <= 68)
y += 2000;
else
y += 1900;
break;
case 'q': // quarter
q = parse_int(&c, 2, FALSE);
if (!(0 < q && q < 5)) succeed = 0;
break;
case 'm': // month (allowing all months formats - m, b and B)
SKIP_NON_ALPHANUMS(c);
m = parse_int(&c, 2, FALSE);
if (m == -1) { // failed
m = parse_alpha_month(&c);
if (m == 0) { // failed
SKIP_NON_DIGITS(c);
m = parse_int(&c, 2, FALSE);
}
}
if (!(0 < m && m < 13))
succeed = 0;
break;
case 'b': // alpha English months (both abbreviated and long versions)
case 'B':
/* SKIP_NON_ALPHANUMS(c); */
m = parse_alpha_month(&c);
succeed = m;
/* Rprintf("succ=%d c=%c\n", succeed, *c); */
break;
case 'd': // day
d = parse_int(&c, 2, FALSE);
if (!(0 < d && d < 32)) succeed = 0;
break;
case 'H': // hour 24
H = parse_int(&c, 2, FALSE);
if (H > 24) succeed = 0;
break;
case 'I': // hour 12
H = parse_int(&c, 2, FALSE);
if (H > 12) succeed = 0;
break;
case 'M': // minute
M = parse_int(&c, 2, FALSE);
if (M > 59) succeed = 0;
break;
case 'S': // second
if( O_format && !is_fmt ){
while (*c && !DIGIT(*c)) c++;
if (!*c) {
succeed = 0;
break;
}
}
S = parse_int(&c, 2, FALSE);
if (S < 62){ // allow leap seconds
secs += S;
if (O_format){
// Parse milliseconds; both . and , as decimal separator are allowed
if( *c == '.' || *c == ','){
double ms = 0.0, msfact = 0.1;
c++;
while (DIGIT(*c)) { ms = ms + (*c - '0')*msfact; msfact *= 0.1; c++; }
secs += ms;
}
}
} else succeed = 0;
break;
case 'p': // AM/PM Both standard 'p' and lubridate 'Op' format
SKIP_NON_ALPHANUMS(c);
if (O_format) {
// with Op format, p is optional (for order parsimony reasons)
if (!(*c == 'P' || *c == 'p' || *c == 'A' || *c == 'a'))
break;
}
if (*c == 'P' || *c == 'p') {
pm = 1;
c++;
} else if (*c == 'A' || *c == 'a'){
am = 1;
c++;
} else {
succeed = 0;
}
if (succeed && !(*c && (*c == 'M' || *c == 'm'))){
succeed = 0;
}
if (succeed) c++;
break;
case 'u':
// %Ou: "2013-04-16T04:59:59Z"
if( O_format )
if( *c == 'Z' || *c == 'z') c++;
else succeed = 0;
else succeed = 0;
break;
case 'z':
// for %z: "+O100" or "+O1" or "+01:00"
if( !O_format ) {
if( !is_fmt ) {
while (*c && *c != '+' && *c != '-' && *c != 'Z') c++; // skip non + -
if( !*c ) { succeed = 0; break; };
}
int Z = 0, sig;
if( *c == 'Z') {c++; break;}
else if ( *c == '+' ) sig = -1;
else if ( *c == '-') sig = 1;
else {succeed = 0; break;}
c++;
Z = parse_int(&c, 2, FALSE);
if (Z < 0) {succeed = 0; break;}
secs += sig*Z*3600;
if( *c == ':' ){
c++;
if ( !DIGIT(*c) ) {succeed = 0; break;}
}
if( DIGIT(*c) ){
Z = 0;
Z = parse_int(&c, 2, FALSE);
secs += sig*Z*60;
}
break;
}
// else O_format %Oz: "+0100"; pass through
case 'O':
// %OO: "+01:00"
case 'o':
// %Oo: "+01"
if( O_format ){
while (*c && *c != '+' && *c != '-' ) c++; // skip non + -
int Z = 0, sig;
if ( *c == '+' ) sig = -1;
else if ( *c == '-') sig = 1;
else { succeed = 0; break; }
c++;
Z = parse_int(&c, 2, FALSE);
if (Z < 0) {succeed = 0; break;}
secs += sig*Z*3600;
if( *o == 'O'){
if ( *c == ':') c++;
else { succeed = 0; break; }
}
if ( *o != 'o' ){ // z or O
Z = parse_int(&c, 2, FALSE);
if (Z < 0) {succeed = 0; break;}
secs += sig*Z*60;
}
} else error("Unrecognized format '%c' supplied", *o);
break;
default:
error("Unrecognized format %c supplied", *o);
}
o++;
}
}
}
// skip all remaining non digits
if( !is_fmt )
while (*c && !DIGIT(*c)) c++;
// If at least one subparser hasn't finished it's a failure.
if ( *c || *o ) succeed = 0;
int is_leap;
// adjust months for quarter
if (q > 1)
m += (q - 1) * 3 + 1;
if (succeed) {
// leap year every 400 years; no leap every 100 years
is_leap = IS_LEAP(y);
// check month
if (m == 2){
// no check for d > 0 because we allow missing days in parsing
if (is_leap)
succeed = d < 30;
else
succeed = d < 29;
} else {
succeed = d <= mdays[m];
}
}
// allow missing months and days
if (m == 0) m = 1;
if (d == 0) d = 1;
if(pm){
if(H > 12)
succeed = 0;
else if (H < 12)
H += 12;
}
if (am){
if (H > 12)
succeed = 0;
else if (H == 12)
H = 0;
}
if (succeed) {
if(out_lt){
INTEGER(oYEAR)[i] = y - 1900;
INTEGER(oMONTH)[i] = m - 1;
INTEGER(oDAY)[i] = d;
INTEGER(oHOUR)[i] = H;
INTEGER(oMIN)[i] = M;
REAL(oSEC)[i] = secs;
} else {
secs += sm[m];
secs += (d - 1) * 86400;
secs += H * 3600;
secs += M * 60;
// process leap years
y -= 2000;
secs += y * yearlen;
secs += adjust_leap_years(y, m, is_leap);
REAL(oSEC)[i] = secs + d30;
}
} else {
if(out_lt){
INTEGER(oYEAR)[i] = NA_INTEGER;
INTEGER(oMONTH)[i] = NA_INTEGER;
INTEGER(oDAY)[i] = NA_INTEGER;
INTEGER(oHOUR)[i] = NA_INTEGER;
INTEGER(oMIN)[i] = NA_INTEGER;
REAL(oSEC)[i] = NA_REAL;
} else {
REAL(oSEC)[i] = NA_REAL;
}
}
}
if (out_lt){
SEXP names, out;
PROTECT(names = allocVector(STRSXP, 6));
for(int i = 0; i < 6; i++)
SET_STRING_ELT(names, i, mkChar(ltnames[i]));
PROTECT(out = allocVector(VECSXP, 6));
SET_VECTOR_ELT(out, 0, oSEC);
SET_VECTOR_ELT(out, 1, oMIN);
SET_VECTOR_ELT(out, 2, oHOUR);
SET_VECTOR_ELT(out, 3, oDAY);
SET_VECTOR_ELT(out, 4, oMONTH);
SET_VECTOR_ELT(out, 5, oYEAR);
setAttrib(out, R_NamesSymbol, names);
UNPROTECT(8);
return out;
} else {
UNPROTECT(1);
return oSEC;
}
}