PageRenderTime 2013ms CodeModel.GetById 630ms app.highlight 650ms RepoModel.GetById 638ms app.codeStats 0ms

/src/merge.c

https://github.com/R-Finance/xts
C | 1238 lines | 1012 code | 77 blank | 149 comment | 165 complexity | 264cbdd119727acfbf1076419073fd4f MD5 | raw file
   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 3 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
  28/* 
  29
  30  This is a merge_join algorithm used to
  31  allow two xts objects to be merged as one
  32  along a common index efficiently and fast
  33
  34  The code is branched for REAL and INTEGER indexed values
  35  which allows for efficient memory usage and minimal
  36  testing/coercion
  37
  38  
  39  Copyright Jeffrey A. Ryan 2008
  40
  41*/
  42/* do_merge_xts {{{ */
  43SEXP do_merge_xts (SEXP x, SEXP y,
  44                   SEXP all,
  45                   SEXP fill,
  46                   SEXP retclass,
  47                   SEXP colnames, 
  48                   SEXP suffixes,
  49                   SEXP retside,
  50                   SEXP env,
  51                   int coerce)
  52{
  53  int nrx, ncx, nry, ncy, len;
  54  int left_join, right_join;
  55  int i = 0, j = 0, xp = 1, yp = 1; /* x and y positions in index */
  56  int mode;
  57  int ij_original, ij_result;
  58  int p = 0;
  59  SEXP xindex, yindex, index, result, attr, len_xindex;
  60  SEXP s, t, unique;
  61
  62  int *int_result=NULL, *int_x=NULL, *int_y=NULL, int_fill=0;
  63  int *int_index=NULL, *int_xindex=NULL, *int_yindex=NULL;
  64  double *real_result=NULL, *real_x=NULL, *real_y=NULL;
  65  double *real_index=NULL, *real_xindex=NULL, *real_yindex=NULL;
  66
  67  /* we do not check that 'x' is an xts object.  Dispatch and mergeXts
  68    (should) make this unecessary.  So we just get the index value 
  69
  70    This assumption seems to be invalid when dispatched from cbind.xts
  71    So we need to check that the objects are not NULL, or at least
  72    treat NULL objects as zero-width with an index that matches the non-null
  73   
  74    2009/01/07: calling merge(NA,x) or merge(1,1,xts) causes a segfault;
  75                calling merge(1,x) causes the xts-info (none!) from the 1st arg
  76                to be used, resulting in a classless object. [fixed - jar]
  77  */
  78  if( isNull(x) || isNull(y) ) {
  79    if(!isNull(x)) return(x);
  80    return(y);
  81  }
  82
  83  PROTECT( xindex = getAttrib(x, install("index")) );
  84
  85  /* convert to xts object if needed */
  86  if( !isXts(y) ) {
  87    PROTECT(s = t = allocList(4)); p++;
  88    SET_TYPEOF(s, LANGSXP);
  89    SETCAR(t, install("try.xts")); t = CDR(t);
  90    SETCAR(t, y); t = CDR(t);
  91    PROTECT( len_xindex = allocVector(INTSXP, 1)); p++;
  92    INTEGER(len_xindex)[0] = length(xindex);
  93    SETCAR(t, len_xindex);
  94    SET_TAG(t, install("length.out")); t = CDR(t);
  95    SETCAR(t, install(".merge.xts.scalar"));
  96    SET_TAG(t, install("error"));
  97    PROTECT(y = eval(s, env)); p++;
  98  } /* end conversion process */
  99
 100  mode = TYPEOF(x);
 101
 102  if( isXts(y) ) {
 103    PROTECT( yindex = getAttrib(y, xts_IndexSymbol) );
 104  } else {
 105    PROTECT( yindex = getAttrib(x, xts_IndexSymbol) );
 106  }
 107
 108  if( TYPEOF(retside) != LGLSXP )
 109    error("retside must be a logical value of TRUE or FALSE");
 110
 111  nrx = nrows(x);
 112  ncx = ncols(x);
 113  /* if object is zero-width */
 114  if( LENGTH(x)==0 || INTEGER(retside)[0]==0 ) {
 115    nrx = nrows(xindex);
 116    ncx = 0;
 117  }
 118  
 119  nry = nrows(y);
 120  ncy = ncols(y);
 121  /* if object is zero-width */
 122  if( LENGTH(y)==0 || INTEGER(retside)[1]==0) {
 123    nry = nrows(yindex);
 124    ncy = 0;
 125  }
 126
 127  len = nrx + nry;
 128
 129  /* at present we are failing the call if the indexing is of
 130     mixed type.  This should probably instead simply coerce
 131     to REAL so as not to lose any information (at the expense
 132     of conversion cost and memory), and issue a warning. */
 133  if( TYPEOF(xindex) != TYPEOF(yindex) )
 134  {
 135    PROTECT(xindex = coerceVector(xindex, REALSXP)); p++;
 136    PROTECT(yindex = coerceVector(yindex, REALSXP)); p++;
 137  }
 138
 139  if( TYPEOF(all) != LGLSXP )
 140    error("all must be a logical value of TRUE or FALSE");
 141
 142  left_join = INTEGER(all)[ 0 ];
 143  right_join = INTEGER(all)[ 1 ];
 144
 145  /* determine num_rows of final merged xts object
 146     
 147     this seems to only cost 1/1000 of a sec per
 148     1e6 observations.  Acceptable 'waste' given
 149     that now we can properly allocate space
 150     for our results
 151
 152     We also check the index type and use the appropriate macros
 153   */
 154  
 155  if( TYPEOF(xindex) == REALSXP ) { 
 156  real_xindex = REAL(xindex);
 157  real_yindex = REAL(yindex);
 158  while( (xp + yp) <= (len + 1) ) {
 159    if( xp > nrx ) {
 160      yp++;
 161      if(right_join) i++;
 162    } else
 163    if( yp > nry ) {
 164      xp++;
 165      if(left_join) i++;
 166    } else
 167    if( real_xindex[ xp-1 ] == real_yindex[ yp-1 ] ) {
 168      /* INNER JOIN  --- only result if all=FALSE */
 169      yp++;
 170      xp++;
 171      i++;
 172    } else
 173    if( real_xindex[ xp-1 ] < real_yindex[ yp-1 ] ) {
 174      /* LEFT JOIN */
 175      xp++;
 176      if(left_join) i++;
 177    } else
 178    if( real_xindex[ xp-1 ] > real_yindex[ yp-1 ] ) {
 179      /* RIGHT JOIN */
 180      yp++;
 181      if(right_join) i++;
 182    } else
 183    if(ISNA(real_xindex[ xp-1 ]) || ISNA(real_yindex[ yp-1 ])) {
 184Rprintf("%f, %f\n",real_xindex[xp-1],real_yindex[yp-1]);
 185      error("'NA' not allowed in 'index'");
 186    }
 187  } 
 188  } else
 189  if( TYPEOF(xindex) == INTSXP ) {
 190  int_xindex = INTEGER(xindex);
 191  int_yindex = INTEGER(yindex);
 192  while( (xp + yp) <= (len + 1) ) {
 193    if( xp > nrx ) {
 194      yp++;
 195      if(right_join) i++;
 196    } else
 197    if( yp > nry ) {
 198      xp++;
 199      if(left_join) i++;
 200    } else
 201    if( int_xindex[ xp-1 ] == int_yindex[ yp-1 ] ) {
 202      yp++;
 203      xp++;
 204      i++;
 205    } else
 206    if( int_xindex[ xp-1 ] < int_yindex[ yp-1 ] ) {
 207      xp++;
 208      if(left_join) i++;
 209    } else
 210    if( int_xindex[ xp-1 ] > int_yindex[ yp-1 ] ) {
 211      yp++;
 212      if(right_join) i++;
 213    } else
 214    if(real_xindex[ xp-1 ]==NA_INTEGER ||
 215       real_yindex[ yp-1 ]==NA_INTEGER) {
 216       error("'NA' not allowed in 'index'");
 217    }
 218  } 
 219  }
 220
 221  if(i == 0) {
 222    /* if no rows match, return an empty xts object, similar in style to zoo */
 223    PROTECT( result = allocVector(TYPEOF(x), 0) ); p++;
 224    PROTECT( index  = allocVector(TYPEOF(xindex), 0) ); p++;
 225    SET_xtsIndex(result, index);
 226    if(LOGICAL(retclass)[0])
 227      setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol));
 228    UNPROTECT(2 + p);
 229    return result;
 230  }
 231
 232  int num_rows = i;
 233  xp = 1; yp = 1;
 234
 235  PROTECT( index  = allocVector(TYPEOF(xindex), num_rows) );
 236  /* coercion/matching of TYPE for x and y needs to be checked,
 237     either here or in the calling R code.  I suspect here is
 238     more useful if other function can call the C code as well. 
 239     If objects are not the same type, convert to REALSXP. */
 240  if( coerce || TYPEOF(x) != TYPEOF(y) ) {
 241    PROTECT( x = coerceVector(x, REALSXP) ); p++;
 242    PROTECT( y = coerceVector(y, REALSXP) ); p++;
 243  }
 244  PROTECT( result = allocVector(TYPEOF(x), (ncx + ncy) * num_rows) );
 245
 246  if( TYPEOF(fill) != TYPEOF(x) ) {
 247    PROTECT( fill = coerceVector(fill, TYPEOF(x)) ); p++;
 248  } 
 249
 250  mode = TYPEOF(x);
 251
 252  /* use pointers instead of function calls */
 253  switch(TYPEOF(x)) {
 254    case INTSXP:
 255        int_x = INTEGER(x);
 256        int_y = INTEGER(y);
 257        int_fill = INTEGER(fill)[0];
 258        int_result = INTEGER(result);
 259        break;
 260    case REALSXP:
 261        real_x = REAL(x);
 262        real_y = REAL(y);
 263        /*real_fill = REAL(fill)[0];*/
 264        real_result = REAL(result);
 265        break;
 266    default:
 267        break;
 268  }
 269
 270  switch(TYPEOF(xindex)) {
 271    case INTSXP:
 272        int_index = INTEGER(index);
 273        break;
 274    case REALSXP:
 275        real_index = REAL(index);
 276        break;
 277    default:
 278        break;
 279  }
 280
 281  /* There are two type of supported index types, each branched from here */
 282  if( TYPEOF(xindex) == REALSXP ) {
 283
 284  /* REAL INDEXING */
 285  for(i = 0; i < num_rows; i++) {
 286    /* If we are past the last row in x, assign NA to merged data 
 287       and copy the y column values to the second side of result
 288    */
 289    if( xp > nrx ) {
 290      if(right_join) {
 291        real_index[ i ] = real_yindex[ yp-1 ];
 292        for(j = 0; j < ncx; j++) { /* x-values */
 293          ij_result = i + j * num_rows;
 294          switch( mode ) {
 295            case LGLSXP:
 296              LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ];
 297              break;
 298            case INTSXP:
 299              /*INTEGER(result)[ ij_result ] = INTEGER(fill)[ 0 ];*/
 300              int_result[ ij_result ] = int_fill;
 301              break;
 302            case REALSXP:
 303              REAL(result)[ ij_result ] = REAL(fill)[ 0 ];
 304              break;
 305            case CPLXSXP:
 306              COMPLEX(result)[ ij_result ].r = REAL(fill)[ 0 ];
 307              COMPLEX(result)[ ij_result ].i = REAL(fill)[ 0 ];
 308              break;
 309            case STRSXP:
 310              SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0));
 311              break;
 312            default:
 313              error("unsupported data type");
 314              break;
 315          }
 316        }
 317        for(j = 0; j < ncy; j++) { /* y-values */
 318          ij_result = i + (j+ncx) * num_rows;
 319          ij_original = (yp-1) + j * nry;
 320          switch( mode ) {
 321            case LGLSXP:
 322              LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ];
 323              break;
 324            case INTSXP:
 325              int_result[ ij_result ] = int_y[ ij_original ];
 326              break;
 327            case REALSXP:
 328              real_result[ ij_result ] = real_y[ ij_original ];
 329              break;
 330            case CPLXSXP:
 331              COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ];
 332              break;
 333            case STRSXP:
 334              SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original));
 335              break;
 336            default:
 337              error("unsupported data type");
 338              break;
 339          }
 340        }
 341      }
 342      yp++;
 343      if(!right_join) i--;  /* if all=FALSE, we must decrement i for each non-match */
 344    } else
 345
 346    /* past the last row of y */
 347    if( yp > nry ) {
 348      if(left_join) {
 349
 350        /* record new index value */
 351        real_index[ i ] = real_xindex[ xp-1 ];
 352
 353        /* copy values from x and y to result */
 354        for(j = 0; j < ncx; j++) { /* x-values */
 355          ij_result = i + j * num_rows;
 356          ij_original = (xp-1) + j * nrx; 
 357          switch( mode ) {
 358            case LGLSXP:
 359              LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ];
 360              break;
 361            case INTSXP:
 362              int_result[ ij_result ] = int_x[ ij_original ];
 363              break;
 364            case REALSXP:
 365              real_result[ ij_result ] = real_x[ ij_original ];
 366              break;
 367            case CPLXSXP:
 368              COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ];
 369              break;
 370            case STRSXP:
 371              SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original));
 372              break;
 373            default:
 374              error("unsupported data type");
 375              break;
 376          }
 377        }
 378
 379        /* we are out of y-values, so fill merged result with NAs */
 380        for(j = 0; j < ncy; j++) { /* y-values */
 381          ij_result = i + (j+ncx) * num_rows;
 382          switch( mode ) {
 383            case LGLSXP:
 384              LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ];
 385              break;
 386            case INTSXP:
 387              /*INTEGER(result)[ ij_result ] = INTEGER(fill)[ 0 ];*/
 388              int_result[ ij_result ] = int_fill;
 389              break;
 390            case REALSXP:
 391              REAL(result)[ ij_result ] = REAL(fill)[ 0 ];
 392              break;
 393            case CPLXSXP:
 394              COMPLEX(result)[ ij_result ].r = REAL(fill)[ 0 ];
 395              COMPLEX(result)[ ij_result ].i = REAL(fill)[ 0 ];
 396              break;
 397            case STRSXP:
 398              SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0));
 399              break;
 400            default:
 401              error("unsupported data type");
 402              break;
 403          }
 404        }
 405      }
 406      xp++;
 407      if(!left_join) i--;
 408    } else
 409
 410    /* matching index values copy all column values from x and y to results */
 411    if( real_xindex[ xp-1 ] == real_yindex[ yp-1 ] ) {
 412      real_index[ i ] = real_xindex[ xp-1 ];
 413      /* copy x-values to result */
 414      for(j = 0; j < ncx; j++) { /* x-values */
 415        ij_result = i + j * num_rows;
 416        ij_original = (xp-1) + j * nrx;
 417        switch( mode ) {
 418            case LGLSXP:
 419              LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ];
 420              break;
 421            case INTSXP:
 422              int_result[ ij_result ] = int_x[ ij_original ];
 423              break;
 424            case REALSXP:
 425              real_result[ ij_result ] = real_x[ ij_original ];
 426              break;
 427            case CPLXSXP:
 428              COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ];
 429              break;
 430            case STRSXP:
 431              SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original));
 432              break;
 433            default:
 434              error("unsupported data type");
 435              break;
 436          }
 437      }
 438
 439      /* copy y-values to result */
 440      for(j = 0; j < ncy; j++) { /* y-values */
 441        ij_result = i + (j+ncx) * num_rows;
 442        ij_original = (yp-1) + j * nry;
 443        switch( mode ) {
 444            case LGLSXP:
 445              LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ];
 446              break;
 447            case INTSXP:
 448              int_result[ ij_result ] = int_y[ ij_original ];
 449              break;
 450            case REALSXP:
 451              real_result[ ij_result ] = real_y[ ij_original ];
 452              break;
 453            case CPLXSXP:
 454              COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ];
 455              break;
 456            case STRSXP:
 457              SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original));
 458              break;
 459            default:
 460              error("unsupported data type");
 461              break;
 462          }
 463      }
 464      xp++;
 465      yp++;
 466    } else
 467
 468    if( real_xindex[ xp-1 ] < real_yindex[ yp-1 ] ) {
 469      if(left_join) {
 470        real_index[ i ] = real_xindex[ xp-1 ];
 471        for(j = 0; j < ncx; j++) { /* x-values */
 472          ij_result = i + j * num_rows;
 473          ij_original = (xp-1) + j * nrx;
 474          switch( mode ) {
 475            case LGLSXP:
 476              LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ];
 477              break;
 478            case INTSXP:
 479              int_result[ ij_result ] = int_x[ ij_original ];
 480              break;
 481            case REALSXP:
 482              real_result[ ij_result ] = real_x[ ij_original ];
 483              break;
 484            case CPLXSXP:
 485              COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ];
 486              break;
 487            case STRSXP:
 488              SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original));
 489              break;
 490            default:
 491              error("unsupported data type");
 492              break;
 493          }
 494        }
 495        for(j = 0; j < ncy; j++) { /* y-values */
 496          ij_result = i + (j+ncx) * num_rows;
 497          switch( mode ) {
 498            case LGLSXP:
 499              LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ]; 
 500              break;
 501            case INTSXP:
 502              /*INTEGER(result)[ ij_result ] = INTEGER(fill)[ 0 ]; */
 503              int_result[ ij_result ] = int_fill;
 504              break;
 505            case REALSXP:
 506              REAL(result)[ ij_result ] = REAL(fill)[ 0 ];
 507              break;
 508            case CPLXSXP:
 509              COMPLEX(result)[ ij_result ].r = REAL(fill)[ 0 ];
 510              COMPLEX(result)[ ij_result ].i = REAL(fill)[ 0 ];
 511              break;
 512            case STRSXP:
 513              SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0));
 514              break;
 515            default:
 516              error("unsupported data type");
 517              break;
 518          }
 519        }
 520      }
 521      xp++;
 522      if(!left_join) i--;
 523    } else
 524
 525    if( real_xindex[ xp-1 ] > real_yindex[ yp-1 ] ) {
 526      if(right_join) {
 527        real_index[ i ] = real_yindex[ yp-1 ];
 528        for(j = 0; j < ncx; j++) { /* x-values */
 529          ij_result = i + j * num_rows;
 530          switch( mode ) {
 531            case LGLSXP:
 532              LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ];
 533              break;
 534            case INTSXP:
 535              /*INTEGER(result)[ ij_result ] = INTEGER(fill)[ 0 ];*/
 536              int_result[ ij_result ] = int_fill;
 537              break;
 538            case REALSXP:
 539              REAL(result)[ ij_result ] = REAL(fill)[ 0 ];
 540              break;
 541            case CPLXSXP:
 542              COMPLEX(result)[ ij_result ].r = REAL(fill)[ 0 ];
 543              COMPLEX(result)[ ij_result ].i = REAL(fill)[ 0 ];
 544              break;
 545            case STRSXP:
 546              SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0));
 547              break;
 548            default:
 549              error("unsupported data type");
 550              break;
 551          }
 552        }
 553        for(j = 0; j < ncy; j++) { /* y-values */
 554          ij_result = i + (j+ncx) * num_rows;
 555          ij_original = (yp-1) + j * nry;
 556          switch( mode ) {
 557              case LGLSXP:
 558                LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ];
 559                break;
 560              case INTSXP:
 561                int_result[ ij_result ] = int_y[ ij_original ];
 562                break;
 563              case REALSXP:
 564                real_result[ ij_result ] = real_y[ ij_original ];
 565                break;
 566              case CPLXSXP:
 567                COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ];
 568                break;
 569              case STRSXP:
 570                SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original));
 571                break;
 572              default:
 573                error("unsupported data type");
 574                break;
 575          }
 576        }
 577      }
 578      yp++;
 579      if(!right_join) i--;
 580    }
 581  }
 582
 583  } else
 584  if( TYPEOF(xindex) == INTSXP ) {
 585  for(i = 0; i < num_rows; i++) {
 586    /* If we are past the last row in x, assign NA to merged data 
 587       and copy the y column values to the second side of result
 588    */
 589    if( xp > nrx ) {
 590      if(right_join) {
 591        int_index[ i ] = int_yindex[ yp-1 ];
 592        for(j = 0; j < ncx; j++) { /* x-values */
 593          ij_result = i + j * num_rows;
 594          switch( mode ) {
 595            case LGLSXP:
 596            case INTSXP:
 597              /*INTEGER(result)[ ij_result ] = INTEGER(fill)[ 0 ];*/
 598              int_result[ ij_result ] = int_fill;
 599              break;
 600            case REALSXP:
 601              REAL(result)[ ij_result ] = REAL(fill)[ 0 ];
 602              break;
 603            case CPLXSXP:
 604              COMPLEX(result)[ ij_result ].r = REAL(fill)[ 0 ];
 605              COMPLEX(result)[ ij_result ].i = REAL(fill)[ 0 ];
 606              break;
 607            case STRSXP:
 608              SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0));
 609              break;
 610            default:
 611              error("unsupported data type");
 612              break;
 613          }
 614        }
 615        for(j = 0; j < ncy; j++) { /* y-values */
 616          ij_result = i + (j+ncx) * num_rows;
 617          ij_original = (yp-1) + j * nry;
 618          switch( mode ) {
 619            case LGLSXP:
 620              LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ];
 621              break;
 622            case INTSXP:
 623              int_result[ ij_result ] = int_y[ ij_original ];
 624              break;
 625            case REALSXP:
 626              real_result[ ij_result ] = real_y[ ij_original ];
 627              break;
 628            case CPLXSXP:
 629              COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ];
 630              break;
 631            case STRSXP:
 632              SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original));
 633              break;
 634            default:
 635              error("unsupported data type");
 636              break;
 637          }
 638        }
 639      }
 640      yp++;
 641      if(!right_join) i--;  /* if all=FALSE, we must decrement i for each non-match */
 642    } else
 643
 644    /* past the last row of y */
 645    if( yp > nry ) {
 646      if(left_join) {
 647
 648        /* record new index value */
 649        int_index[ i ] = int_xindex[ xp-1 ];
 650
 651        /* copy values from x and y to result */
 652        for(j = 0; j < ncx; j++) { // x-values
 653          ij_result = i + j * num_rows;
 654          ij_original = (xp-1) + j * nrx; //num_rows;
 655          switch( mode ) {
 656            case LGLSXP:
 657              LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ];
 658              break;
 659            case INTSXP:
 660              int_result[ ij_result ] = int_x[ ij_original];
 661              //INTEGER(result)[ ij_result ] = INTEGER(x)[ ij_original ];
 662              break;
 663            case REALSXP:
 664              //REAL(result)[ ij_result ] = REAL(x)[ ij_original ];
 665              real_result[ ij_result ] = real_x[ ij_original ];
 666              break;
 667            case CPLXSXP:
 668              COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ];
 669              break;
 670            case STRSXP:
 671              SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original));
 672              break;
 673            default:
 674              error("unsupported data type");
 675              break;
 676          }
 677        }
 678
 679        /* we are out of y-values, so fill merged result with NAs */
 680        for(j = 0; j < ncy; j++) { // y-values
 681          ij_result = i + (j+ncx) * num_rows;
 682          //REAL(result)[ ij_result ] = NA_REAL;
 683          switch( mode ) {
 684            case LGLSXP:
 685              LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ]; //NA_INTEGER;
 686              break;
 687            case INTSXP:
 688              int_result[ ij_result ] = int_fill;
 689              break;
 690            case REALSXP:
 691              REAL(result)[ ij_result ] = REAL(fill)[ 0 ]; //NA_REAL;
 692              break;
 693            case CPLXSXP:
 694              COMPLEX(result)[ ij_result ].r = REAL(fill)[ 0 ]; //NA_REAL;
 695              COMPLEX(result)[ ij_result ].i = REAL(fill)[ 0 ]; //NA_REAL;
 696              break;
 697            case STRSXP:
 698              SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0)); //NA_STRING);
 699              break;
 700            default:
 701              error("unsupported data type");
 702              break;
 703          }
 704        }
 705      }
 706      xp++;
 707      if(!left_join) i--;
 708    } else
 709
 710    /* matching index values copy all column values from x and y to results */
 711    //if( INTEGER(xindex)[ xp-1 ] == INTEGER(yindex)[ yp-1 ] ) {
 712    if( int_xindex[ xp-1 ] == int_yindex[ yp-1 ] ) {
 713
 714      /* copy index FIXME this needs to handle INTEGER efficiently as well*/
 715      //INTEGER(index)[ i ] = INTEGER(xindex)[ xp-1 ]; 
 716      int_index[ i ] = int_xindex[ xp-1 ];
 717
 718      /* copy x-values to result */
 719      for(j = 0; j < ncx; j++) { // x-values
 720        ij_result = i + j * num_rows;
 721        ij_original = (xp-1) + j * nrx; //num_rows;
 722        //REAL(result)[ ij_result ] = REAL(x)[ ij_original ];
 723        switch( mode ) {
 724            case LGLSXP:
 725              LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ];
 726              break;
 727            case INTSXP:
 728              int_result[ ij_result ] = int_x[ ij_original ];
 729              //INTEGER(result)[ ij_result ] = INTEGER(x)[ ij_original ];
 730              break;
 731            case REALSXP:
 732              //REAL(result)[ ij_result ] = REAL(x)[ ij_original ];
 733              real_result[ ij_result ] = real_x[ ij_original ];
 734              break;
 735            case CPLXSXP:
 736              COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ];
 737              break;
 738            case STRSXP:
 739              SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original));
 740              break;
 741            default:
 742              error("unsupported data type");
 743              break;
 744          }
 745      }
 746
 747      /* copy y-values to result */
 748      for(j = 0; j < ncy; j++) { // y-values
 749        ij_result = i + (j+ncx) * num_rows;
 750        ij_original = (yp-1) + j * nry; //num_rows;
 751        //REAL(result)[ ij_result ] = REAL(y)[ ij_original ];
 752        switch( mode ) {
 753            case LGLSXP:
 754              LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ];
 755              break;
 756            case INTSXP:
 757              int_result[ ij_result ] = int_y[ ij_original ];
 758              //INTEGER(result)[ ij_result ] = INTEGER(y)[ ij_original ];
 759              break;
 760            case REALSXP:
 761              //REAL(result)[ ij_result ] = REAL(y)[ ij_original ];
 762              real_result[ ij_result ] = real_y[ ij_original ];
 763              break;
 764            case CPLXSXP:
 765              COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ];
 766              break;
 767            case STRSXP:
 768              SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original));
 769              break;
 770            default:
 771              error("unsupported data type");
 772              break;
 773          }
 774      }
 775      xp++;
 776      yp++;
 777    } else
 778
 779    //if( INTEGER(xindex)[ xp-1 ]  < INTEGER(yindex)[ yp-1 ] ) {
 780    if( int_xindex[ xp-1 ] < int_yindex[ yp-1 ] ) {
 781      if(left_join) {
 782        //copyIndex(index, xindex, i, xp-1);
 783        //INTEGER(index)[ i ] = INTEGER(xindex)[ xp-1 ]; 
 784        int_index[ i ] = int_xindex[ xp-1 ];
 785        for(j = 0; j < ncx; j++) { // x-values
 786          ij_result = i + j * num_rows;
 787          ij_original = (xp-1) + j * nrx; //num_rows;
 788          //REAL(result)[ ij_result ] = REAL(x)[ ij_original ];
 789          switch( mode ) {
 790            case LGLSXP:
 791              LOGICAL(result)[ ij_result ] = LOGICAL(x)[ ij_original ];
 792              break;
 793            case INTSXP:
 794              //INTEGER(result)[ ij_result ] = INTEGER(x)[ ij_original ];
 795              int_result[ ij_result ] = int_x[ ij_original ];
 796              break;
 797            case REALSXP:
 798              //REAL(result)[ ij_result ] = REAL(x)[ ij_original ];
 799              real_result[ ij_result ] = real_x[ ij_original ];
 800              break;
 801            case CPLXSXP:
 802              COMPLEX(result)[ ij_result ] = COMPLEX(x)[ ij_original ];
 803              break;
 804            case STRSXP:
 805              SET_STRING_ELT(result, ij_result, STRING_ELT(x, ij_original));
 806              break;
 807            default:
 808              error("unsupported data type");
 809              break;
 810          }
 811        }
 812        for(j = 0; j < ncy; j++) { /* y-values */
 813          ij_result = i + (j+ncx) * num_rows;
 814          switch( mode ) {
 815            case LGLSXP:
 816              LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ];
 817              break;
 818            case INTSXP:
 819              int_result[ ij_result ] = int_fill;
 820              break;
 821            case REALSXP:
 822              REAL(result)[ ij_result ] = REAL(fill)[ 0 ];
 823              break;
 824            case CPLXSXP:
 825              COMPLEX(result)[ ij_result ].r = REAL(fill)[ 0 ];
 826              COMPLEX(result)[ ij_result ].i = REAL(fill)[ 0 ];
 827              break;
 828            case STRSXP:
 829              SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0));
 830              break;
 831            default:
 832              error("unsupported data type");
 833              break;
 834          }
 835        }
 836      }
 837      xp++;
 838      if(!left_join) i--;
 839    } else
 840
 841    //if( INTEGER(xindex)[ xp-1 ]  > INTEGER(yindex)[ yp-1 ] ) {
 842    if( int_xindex[ xp-1 ] > int_yindex[ yp-1 ] ) {
 843      if(right_join) {
 844        //INTEGER(index)[ i ] = INTEGER(yindex)[ yp-1 ]; 
 845        int_index[ i ] = int_yindex[ yp-1 ];
 846        for(j = 0; j < ncx; j++) { // x-values
 847          ij_result = i + j * num_rows;
 848          //REAL(result)[ ij_result ] = NA_REAL;
 849          switch( mode ) {
 850            case LGLSXP:
 851              LOGICAL(result)[ ij_result ] = LOGICAL(fill)[ 0 ]; //NA_INTEGER;
 852            case INTSXP:
 853              int_result[ ij_result ] = int_fill;
 854              break;
 855            case REALSXP:
 856              REAL(result)[ ij_result ] = REAL(fill)[ 0 ]; //NA_REAL;
 857              break;
 858            case CPLXSXP:
 859              COMPLEX(result)[ ij_result ].r = REAL(fill)[ 0 ]; //NA_REAL;
 860              COMPLEX(result)[ ij_result ].i = REAL(fill)[ 0 ]; //NA_REAL;
 861              break;
 862            case STRSXP:
 863              SET_STRING_ELT(result, ij_result, STRING_ELT(fill, 0)); //NA_STRING);
 864              break;
 865            default:
 866              error("unsupported data type");
 867              break;
 868          }
 869        }
 870        for(j = 0; j < ncy; j++) { // y-values
 871          ij_result = i + (j+ncx) * num_rows;
 872          ij_original = (yp-1) + j * nry; //num_rows;
 873          //REAL(result)[ ij_result ] = REAL(y)[ ij_original ];
 874          switch( mode ) {
 875              case LGLSXP:
 876                LOGICAL(result)[ ij_result ] = LOGICAL(y)[ ij_original ];
 877                break;
 878              case INTSXP:
 879                //INTEGER(result)[ ij_result ] = INTEGER(y)[ ij_original ];
 880                int_result[ ij_result ] = int_y[ ij_original ];
 881                break;
 882              case REALSXP:
 883                //REAL(result)[ ij_result ] = REAL(y)[ ij_original ];
 884                real_result[ ij_result ] = real_y[ ij_original ];
 885                break;
 886              case CPLXSXP:
 887                COMPLEX(result)[ ij_result ] = COMPLEX(y)[ ij_original ];
 888                break;
 889              case STRSXP:
 890                SET_STRING_ELT(result, ij_result, STRING_ELT(y, ij_original));
 891                break;
 892              default:
 893                error("unsupported data type");
 894                break;
 895          }
 896        }
 897      }
 898      yp++;
 899      if(!right_join) i--;
 900    }
 901  }
 902  }
 903
 904  /* following logic to allow for 
 905     dimensionless xts objects (unsupported)
 906     to be used in Ops.xts calls
 907     This maps to how zoo behaves */
 908  if(LOGICAL(retside)[0] &&
 909     !LOGICAL(retside)[1] && 
 910     isNull(getAttrib(x,R_DimSymbol))) {
 911     /* retside=c(T,F) AND is.null(dim(x)) */ 
 912     setAttrib(result, R_DimSymbol, R_NilValue);
 913  } else 
 914  if(LOGICAL(retside)[1] &&
 915     !LOGICAL(retside)[0] && 
 916     isNull(getAttrib(y,R_DimSymbol))) {
 917     /* retside=c(F,T) AND is.null(dim(y)) */ 
 918     setAttrib(result, R_DimSymbol, R_NilValue);
 919  } else /* set Dim and DimNames */
 920  if(num_rows >= 0 && (ncx + ncy) >= 0) {
 921    /* DIM */
 922    PROTECT(attr = allocVector(INTSXP, 2));
 923    INTEGER(attr)[0] = num_rows;
 924    INTEGER(attr)[1] = ncx + ncy;
 925    setAttrib(result, R_DimSymbol, attr);
 926    UNPROTECT(1);
 927    /* DIMNAMES */
 928    if(!isNull(colnames)) { // only set DimNamesSymbol if passed colnames is not NULL
 929      SEXP dimnames, dimnames_x, dimnames_y, newcolnames;
 930      PROTECT(dimnames = allocVector(VECSXP, 2));
 931      PROTECT(dimnames_x = getAttrib(x, R_DimNamesSymbol)); p++;
 932      PROTECT(dimnames_y = getAttrib(y, R_DimNamesSymbol)); p++;
 933      PROTECT(newcolnames = allocVector(STRSXP, ncx+ncy));
 934      for(i = 0; i < (ncx + ncy); i++) {
 935        if( i < ncx ) {
 936          if(!isNull(dimnames_x) && !isNull(VECTOR_ELT(dimnames_x,1))) {
 937            SET_STRING_ELT(newcolnames, i, STRING_ELT(VECTOR_ELT(dimnames_x,1),i));
 938          } else {
 939            SET_STRING_ELT(newcolnames, i, STRING_ELT(colnames, i));
 940          }
 941        } else { // i >= ncx; 
 942          if(!isNull(dimnames_y) && !isNull(VECTOR_ELT(dimnames_y,1))) {
 943            SET_STRING_ELT(newcolnames, i, STRING_ELT(VECTOR_ELT(dimnames_y,1),i-ncx));
 944          } else {
 945            SET_STRING_ELT(newcolnames, i, STRING_ELT(colnames, i));
 946          }
 947        }
 948      }
 949      SET_VECTOR_ELT(dimnames, 0, R_NilValue);  // ROWNAMES are NULL
 950
 951      PROTECT(s = t = allocList(3)); p++;
 952      SET_TYPEOF(s, LANGSXP);
 953      SETCAR(t, install("make.names")); t = CDR(t);
 954      SETCAR(t, newcolnames); t = CDR(t);
 955      PROTECT(unique = allocVector(LGLSXP, 1)); p++;  LOGICAL(unique)[0] = 1;
 956      SETCAR(t, unique);  SET_TAG(t, install("unique"));
 957      SET_VECTOR_ELT(dimnames, 1, eval(s, env));
 958 
 959      //SET_VECTOR_ELT(dimnames, 1, newcolnames); // COLNAMES are passed in
 960      setAttrib(result, R_DimNamesSymbol, dimnames);
 961      UNPROTECT(2);
 962    }
 963  } else {
 964    // only used for zero-width results! xts always has dimension
 965    setAttrib(result, R_DimSymbol, R_NilValue);
 966  }
 967
 968  setAttrib(result, xts_IndexSymbol, index);
 969  if(LOGICAL(retclass)[0])
 970    setAttrib(result, R_ClassSymbol, getAttrib(x, R_ClassSymbol));
 971  setAttrib(result, xts_IndexClassSymbol, getAttrib(x, xts_IndexClassSymbol));
 972  setAttrib(result, xts_IndexTZSymbol, getAttrib(x, xts_IndexTZSymbol));
 973  setAttrib(result, xts_IndexFormatSymbol, getAttrib(x, xts_IndexFormatSymbol));
 974  setAttrib(result, xts_ClassSymbol, getAttrib(x, xts_ClassSymbol));
 975  copy_xtsAttributes(x, result);
 976
 977  UNPROTECT(4 + p);
 978  return result;  
 979} //}}}
 980
 981//SEXP mergeXts (SEXP all, SEXP fill, SEXP retclass, SEXP colnames, SEXP retside, SEXP env, SEXP args)
 982/* called via .External("mergeXts", ...) */
 983SEXP mergeXts (SEXP args) // mergeXts {{{
 984{
 985  SEXP _x, _y, xtmp, result, _INDEX;
 986  /* colnames should be renamed as suffixes, as colnames need to be added at the C level */
 987  SEXP all, fill, retc, retclass, symnames,
 988       suffixes, rets, retside, env, tzone;
 989  int nr, nc, ncs=0;
 990  int index_len;
 991  int i, n=0, P=0;
 992
 993  SEXP argstart;
 994
 995  args = CDR(args);
 996  PROTECT(all = CAR(args)); P++;
 997  args = CDR(args);
 998  PROTECT(fill = CAR(args)); P++;
 999  args = CDR(args);
1000  PROTECT(retclass = CAR(args)); P++;
1001  args = CDR(args);
1002  PROTECT(symnames = CAR(args)); P++;
1003  args = CDR(args);
1004  PROTECT(suffixes = CAR(args)); P++;
1005  args = CDR(args);
1006  PROTECT(retside = CAR(args)); P++;
1007  args = CDR(args);
1008  PROTECT(env = CAR(args)); P++;
1009  args = CDR(args);
1010  PROTECT(tzone = CAR(args)); P++;
1011  args = CDR(args);
1012  // args should now correspond to the ... objects we are looking to merge 
1013  argstart = args; // use this to rewind list...
1014
1015  n = 0;
1016  int type_of;
1017  int coerce_to_double=0;
1018  if(args != R_NilValue) type_of = TYPEOF(CAR(args));
1019  while(args != R_NilValue) {
1020    if( length(CAR(args)) > 0 )
1021      ncs += ncols(CAR(args));
1022    if(TYPEOF(CAR(args)) != type_of)
1023      coerce_to_double = 1;  /* need to convert all objects if one needs to be converted */
1024    args = CDR(args);
1025    n++;
1026  }
1027
1028
1029  /* build an index to be used in all subsequent calls */
1030  args = argstart;
1031
1032  PROTECT(_x = CAR(args)); P++;
1033  args = CDR(args);
1034
1035  int leading_non_xts = 0;
1036  while( !isXts(_x) ) {
1037    if( args == R_NilValue ) error("no xts object to merge");
1038    leading_non_xts = 1;
1039    /*warning("leading non-xts objects may have been dropped");*/
1040    PROTECT(_x = CAR(args)); P++;
1041    args = CDR(args);
1042  }
1043  /* test for NULLs that may be present from cbind dispatch */
1044  if(!leading_non_xts) { /* leading non-xts in 2 case scenario was igoring non-xts value */
1045    if(n < 3 && (args == R_NilValue || (isNull(CAR(args)) && length(args) == 1))) {/* no y arg or y==NULL */
1046      UNPROTECT(P);
1047      return(_x);
1048    }
1049  }
1050
1051  if( args != R_NilValue) {
1052    PROTECT(_y = CAR(args)); P++;
1053    args = CDR(args);
1054  } else {
1055    PROTECT(_y = duplicate(_x)); P++;
1056  }
1057
1058  if(n > 2 || leading_non_xts) { /*args != R_NilValue) {*/
1059    /* generalized n-case optimization
1060       currently if n>2 this is faster and more memory efficient
1061       than recursively building a merged object, object by object. */
1062
1063    PROTECT(retc = allocVector(LGLSXP, 1)); P++;
1064    LOGICAL(retc)[0] = 1; /* return class == TRUE */
1065    PROTECT(rets = allocVector(LGLSXP, 2)); P++;
1066    LOGICAL(rets)[0] = 0; /* don't return left */
1067    LOGICAL(rets)[1] = 0; /* don't return right */
1068  
1069    if( isNull(_y) ) {
1070      PROTECT(_y = duplicate(_x)); P++;
1071    }
1072
1073    PROTECT(_INDEX = do_merge_xts(_x,
1074                                  _y, 
1075                                  all,
1076                                  fill,
1077                                  retc,
1078                                  R_NilValue,
1079                                  R_NilValue, 
1080                                  rets, 
1081                                  env,
1082                                  coerce_to_double)); P++;
1083
1084    /* merge all objects into one zero-width common index */
1085    while(args != R_NilValue) { 
1086      if( !isNull(CAR(args)) ) {
1087        PROTECT(_INDEX = do_merge_xts(_INDEX,
1088                                      CAR(args),
1089                                      all,
1090                                      fill, 
1091                                      retc,
1092                                      R_NilValue,
1093                                      R_NilValue,
1094                                      rets, 
1095                                      env,
1096                                      coerce_to_double)); P++;
1097      }
1098      args = CDR(args);
1099    }
1100
1101    index_len = length(GET_xtsIndex(_INDEX));
1102  
1103    args = argstart; // reset args
1104    int ii, jj, iijj, jj_result;
1105    int *int_result=NULL, *int_xtmp=NULL;
1106    double *real_result=NULL, *real_xtmp=NULL;
1107
1108    PROTECT(result = allocVector(TYPEOF(_INDEX), index_len * ncs)); P++;
1109    switch(TYPEOF(result)) {
1110      case LGLSXP:
1111      case INTSXP:
1112        int_result = INTEGER(result);
1113        break;
1114      case REALSXP:
1115        real_result = REAL(result);
1116        break;
1117      default:
1118        error("unsupported data type");
1119    }
1120
1121    SEXP ColNames, NewColNames;
1122    PROTECT(NewColNames = allocVector(STRSXP, ncs)); P++;
1123    ncs = 0;
1124    for(i = 0, nc=0; args != R_NilValue; i = i+nc, args = CDR(args)) { // merge each object with index
1125      // i is object current being merged/copied
1126      // nc is offset in current object
1127      if( isNull(CAR(args)) ) {
1128        i = i-nc;
1129        continue;  // if NULL is passed, skip to the next object.
1130      }
1131
1132      xtmp = do_merge_xts(_INDEX,
1133                          CAR(args),
1134                          all,
1135                          fill,
1136                          retclass,
1137            /*colnames*/R_NilValue, 
1138                        R_NilValue,
1139                          retside,
1140                          env,
1141                          coerce_to_double);
1142      nc = ncols(xtmp);
1143      ncs += nc;
1144      nr = nrows(xtmp);
1145      PROTECT(ColNames = getAttrib(CAR(args),R_DimNamesSymbol));
1146      switch(TYPEOF(xtmp)) { // by type, insert merged data into result object
1147        case LGLSXP:
1148        case INTSXP:
1149          int_xtmp = INTEGER(xtmp);
1150          for(jj=0; jj < nc; jj++) {
1151            if(!isNull(ColNames) && !isNull(VECTOR_ELT(ColNames,1))) {
1152              /* if merged object has colnames, use these, otherwise use deparse names */
1153              SET_STRING_ELT(NewColNames, i+jj, STRING_ELT(VECTOR_ELT(ColNames,1),jj));
1154            } else {
1155              SET_STRING_ELT(NewColNames, i+jj, STRING_ELT(symnames,i+jj));
1156            }
1157            for(ii=0; ii < nr; ii++) {
1158              iijj = ii + jj * nr;
1159              jj_result = ii + ( (i+jj) * nr);
1160              int_result[ jj_result ] = int_xtmp[ iijj ];
1161            }
1162          }
1163          break;
1164        case REALSXP:
1165          real_xtmp = REAL(xtmp);
1166          for(jj=0; jj < nc; jj++) {
1167            if(!isNull(ColNames) && !isNull(VECTOR_ELT(ColNames,1))) {
1168              SET_STRING_ELT(NewColNames, i+jj, STRING_ELT(VECTOR_ELT(ColNames,1),jj));
1169            } else {
1170              SET_STRING_ELT(NewColNames, i+jj, STRING_ELT(symnames,i+jj));
1171            }
1172            for(ii=0; ii < nr; ii++) {
1173              iijj = ii + jj * nr;
1174              jj_result = ii + ( (i+jj) * nr);
1175              real_result[ jj_result ] = real_xtmp[ iijj ];
1176            }
1177          }
1178          break;
1179      }
1180      UNPROTECT(1); /* ColNames */
1181    }
1182
1183    SEXP dim;
1184    PROTECT(dim = allocVector(INTSXP, 2)); P++;
1185    INTEGER(dim)[0] = index_len;
1186    INTEGER(dim)[1] = ncs;
1187    setAttrib(result, R_DimSymbol, dim);
1188
1189    SEXP dimnames;
1190    PROTECT(dimnames = allocVector(VECSXP, 2)); P++;
1191    SET_VECTOR_ELT(dimnames, 0, R_NilValue); // rownames are always NULL in xts
1192
1193    /* colnames, assure they are unique before returning */
1194    SEXP s, t, unique;
1195    PROTECT(s = t = allocList(3)); P++;
1196    SET_TYPEOF(s, LANGSXP);
1197    SETCAR(t, install("make.names")); t = CDR(t);
1198    SETCAR(t, NewColNames); t = CDR(t);
1199    PROTECT(unique = allocVector(LGLSXP, 1)); P++;  LOGICAL(unique)[0] = 1;
1200    SETCAR(t, unique);  SET_TAG(t, install("unique"));
1201    SET_VECTOR_ELT(dimnames, 1, eval(s, env));
1202    setAttrib(result, R_DimNamesSymbol, dimnames);
1203
1204    SET_xtsIndex(result, GET_xtsIndex(_INDEX));
1205    SET_xtsIndexTZ(result, GET_xtsIndexTZ(_INDEX));
1206    copy_xtsCoreAttributes(_INDEX, result);
1207    copy_xtsAttributes(_INDEX, result);
1208
1209  } else { /* 2-case optimization --- simply call main routine */
1210    /* likely bug in handling of merge(1, xts) case */
1211    PROTECT(result = do_merge_xts(_x,
1212                                  _y, 
1213                                 all,
1214                                fill,
1215                            retclass,
1216                            symnames /*R_NilValue*/,
1217                            suffixes,
1218                             retside,
1219                                 env,
1220                    coerce_to_double)); P++;
1221  }
1222
1223  SEXP index_tmp = getAttrib(result, install("index"));
1224  PROTECT(index_tmp);
1225  if(isNull(tzone)) {
1226    setAttrib(index_tmp, install("tzone"), 
1227              getAttrib(getAttrib(_x,install("index")), install("tzone")));
1228  } else {
1229    setAttrib(index_tmp, install("tzone"), tzone);
1230  }
1231  copyMostAttrib(getAttrib(_x,install("index")), index_tmp);
1232  setAttrib(result, install("index"), index_tmp);
1233  setAttrib(result, install(".indexTZ"), getAttrib(index_tmp, install("tzone")));
1234  UNPROTECT(1);
1235
1236  if(P > 0) UNPROTECT(P); 
1237  return(result);
1238} //}}} end of mergeXts