src/main/printvector.c - R - Git at Google

 /*
  *  R : A Computer Language for Statistical Data Analysis
  *  Copyright (C) 1998-2022  The R Core Team.
  *  Copyright (C) 1995-1998  Robert Gentleman and Ross Ihaka
  *
  *  This program 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.
  *
  *  This program 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 this program; if not, a copy is available at
  *  https://www.R-project.org/Licenses/
  *
  *  EXPORTS	printVector()
  *		printNamedVector()
  *		printRealVector()
  *		printRealVectorS()
  *		printIntegerVector()
  *		printIntegerVectorS()
  *		printComplexVector()
  *		printComplexVectorS()
  *
  *  See ./printutils.c	 for remarks on Printing and the Encoding utils.
  *  See ./format.c	 for the formatXXXX functions used below.
  */

 #ifdef HAVE_CONFIG_H
 #include <config.h>
 #endif

 #include "Defn.h"
 #include "Print.h"
 #include <R_ext/Itermacros.h> /* for ITERATE_BY_REGION */

 #ifdef Win32
 #include <trioremap.h> /* for %lld */
 #endif

 #define DO_first_lab			\
     if (indx) {				\
 	labwidth = IndexWidth(n) + 2;	\
 	/* labwidth may well be		\
 	   one more than desired ..*/	\
 	VectorIndex(1, labwidth);	\
 	width = labwidth;		\
     }					\
     else width = 0

 #define DO_newline			\
     Rprintf("\n");			\
     if (indx) {				\
 	VectorIndex(i + 1, labwidth);	\
 	width = labwidth;		\
     }					\
     else				\
 	width = 0

 /* print*Vector (* in {Real, Integer, Complex}) are exported, but no
    longer directly called by internal R sources (which now call
    print*VectorS for ALTREP support). Macros are used to prevent drift
    between print*Vector and print*VectorS.

    printIntegerVector(INTEGER(x)) and printIntegerVector(x) must
    always give identical output, unless INTEGER(x) fails, en.g. during
    allocation. */

 /* i must be defined and contain the overall position in the vector
    because DO_newline uses it
    ENCCALL is the full invocation of Encode*() which
    is passed to Rprintf
 */

 /* used for logical, integer, numeric and complex vectors */
 #define NUMVECTOR_TIGHTLOOP(ENCCALL) do {	\
 	if (i > 0 && width + w > R_print.width) {	\
 	    DO_newline;					\
 	}						\
 	Rprintf("%s", ENCCALL);				\
 	width += w;					\
     } while(0)

 /* used when printing character vectors */
 #define CHARVECTOR_TIGHTLOOP(ENCCALL) do {			\
 	if (i > 0 && width + w + R_print.gap > R_print.width) {	\
 	    DO_newline;						\
 	}							\
 	Rprintf("%*s%s", R_print.gap, "",			\
 		ENCCALL);					\
 	width += w + R_print.gap;				\
     } while (0)

 /* used for raw vectors. Could be combined with character vectors
    above but NB the different second conditions for the if
    (width + w vs width + w + R_print.gap) and the different increment
    on width.
 */
 #define RAWVECTOR_TIGHTLOOP(ptr, pos) do {				\
 	if (i > 0 && width + w > R_print.width) {			\
 	    DO_newline;							\
 	}								\
 	Rprintf("%*s%s", R_print.gap, "", EncodeRaw(ptr[pos], ""));	\
 	width += w;							\
     } while (0)

 static
 void printLogicalVectorS(SEXP x, R_xlen_t n, int indx) {
     int w, labwidth=0, width;
     R_xlen_t i;
     DO_first_lab;
     formatLogicalS(x, n, &w);
     w += R_print.gap;

     ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, int, LOGICAL, 0, n,
 		      for(R_xlen_t j = 0; j < nb; j++) {
 			  i = idx + j; /* for Do_newline */
 			  NUMVECTOR_TIGHTLOOP( EncodeLogical(px[j], w) );
 		      });
     Rprintf("\n");
 }

 attribute_hidden
 void printIntegerVector(const int *x, R_xlen_t n, int indx)
 {
     int w, labwidth=0, width;

     DO_first_lab;
     formatInteger(x, n, &w);
     w += R_print.gap;

     for (R_xlen_t i = 0; i < n; i++) {
 	NUMVECTOR_TIGHTLOOP(EncodeInteger(x[i], w));
     }
     Rprintf("\n");
 }

 attribute_hidden
 void printIntegerVectorS(SEXP x, R_xlen_t n, int indx)
 {
     int w, labwidth=0, width;
     R_xlen_t i;
     DO_first_lab;
     formatIntegerS(x, n, &w);
     w += R_print.gap;

     ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, int, INTEGER, 0, n,
 		      for (R_xlen_t j = 0; j < nb; j++) {
 			  i = idx + j; /* for macros */
 			  NUMVECTOR_TIGHTLOOP(EncodeInteger(px[j], w));
 		      });

     Rprintf("\n");
 }

 // used in uncmin.c
 // Not easily converted to printRealVectorS calls
 attribute_hidden
 void printRealVector(const double *x, R_xlen_t n, int indx)
 {
     int w, d, e, labwidth=0, width;

     DO_first_lab;
     formatReal(x, n, &w, &d, &e, 0);
     w += R_print.gap;

     for (R_xlen_t i = 0; i < n; i++) {
 	NUMVECTOR_TIGHTLOOP( EncodeReal0(x[i], w, d, e, OutDec) );
     }
     Rprintf("\n");
 }

 attribute_hidden
 void printRealVectorS(SEXP x, R_xlen_t n, int indx)
 {
     int w, d, e, labwidth=0, width;
     R_xlen_t i;
     DO_first_lab;
     formatRealS(x, n, &w, &d, &e, 0);
     w += R_print.gap;

     ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, double, REAL, 0, n,
 		      for(R_xlen_t j = 0; j < nb; j++) {
 			  i = idx + j; /* for macros */
 			  NUMVECTOR_TIGHTLOOP(EncodeReal0(px[j], w, d, e, OutDec));
 		      });

     Rprintf("\n");
 }

 #define CMPLX_ISNA(cplx) (ISNA(cplx.r) || ISNA(cplx.i))
 attribute_hidden
 void printComplexVector(const Rcomplex *x, R_xlen_t n, int indx)
 {
     int w, wr, dr, er, wi, di, ei, labwidth=0, width;

     DO_first_lab;
     formatComplex(x, n, &wr, &dr, &er, &wi, &di, &ei, 0);

     w = wr + wi + 2;	/* +2 for "+" and "i" */
     w += R_print.gap;

     for (R_xlen_t i = 0; i < n; i++) {
 	NUMVECTOR_TIGHTLOOP(CMPLX_ISNA(x[i]) ?
 			EncodeReal0(NA_REAL, w, 0, 0, OutDec) :
 			EncodeComplex(x[i], wr + R_print.gap,
 				      dr, er, wi, di, ei, OutDec));
     }
     Rprintf("\n");
 }

 attribute_hidden
 void printComplexVectorS(SEXP x, R_xlen_t n, int indx)
 {
     int w, wr, dr, er, wi, di, ei, labwidth=0, width;
     R_xlen_t i;
     DO_first_lab;
     formatComplexS(x, n, &wr, &dr, &er, &wi, &di, &ei, 0);

     w = wr + wi + 2;	/* +2 for "+" and "i" */
     w += R_print.gap;

     ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, Rcomplex, COMPLEX, 0, n,
 		      for(R_xlen_t j = 0; j < nb; j++) {
 			  i = idx + j; /* for macros */
 			  NUMVECTOR_TIGHTLOOP(CMPLX_ISNA(px[j]) ?
 					  EncodeReal0(NA_REAL, w, 0, 0, OutDec) :
 					  EncodeComplex(px[j], wr + R_print.gap , dr, er, wi, di, ei, OutDec));
 		      });
     Rprintf("\n");
 }


 static void printStringVector(const SEXP *x, R_xlen_t n, int quote, int indx)
 {
     int w, labwidth=0, width;

     DO_first_lab;
     formatString(x, n, &w, quote);

     for (R_xlen_t i = 0; i < n; i++) {
 	if (i > 0 && width + w + R_print.gap > R_print.width) {
 	    DO_newline;
 	}
 	Rprintf("%*s%s", R_print.gap, "",
 		EncodeString(x[i], w, quote, R_print.right));
 	width += w + R_print.gap;
     }
     Rprintf("\n");
 }

 static void printStringVectorS(SEXP x, R_xlen_t n, int quote, int indx)
 {
     /* because there's no get_region method for ALTSTRINGs
        we hit the old version if we can to avoid the
        STRING_ELT in the tight loop.

        This will work for all nonALTREP STRSXPs as well as whenever
        the ALTSTRING class is willing to give us a full dataptr from
        Dataptr_or_null method. */

     const SEXP *xptr = (const SEXP *) DATAPTR_OR_NULL(x);
     if(xptr != NULL) {
 	printStringVector(xptr, n, quote, indx);
 	return;
     }

     int w, labwidth=0, width;

     DO_first_lab;
     formatStringS(x, n, &w, quote);

     for (R_xlen_t i = 0; i < n; i++) {
 	CHARVECTOR_TIGHTLOOP(
 	    EncodeString(STRING_ELT(x, i), w, quote, R_print.right)
 	    );
     }
     Rprintf("\n");
 }


 attribute_hidden
 void printRawVector(const Rbyte *x, R_xlen_t n, int indx)
 {
     int w, labwidth=0, width;

     DO_first_lab;
     formatRaw(x, n, &w);
     w += R_print.gap;

     for (R_xlen_t i = 0; i < n; i++) {
 	RAWVECTOR_TIGHTLOOP(x, i);
     }
     Rprintf("\n");
 }


 static
 void printRawVectorS(SEXP x, R_xlen_t n, int indx)
 {
     int w, labwidth=0, width;
     R_xlen_t i;
     DO_first_lab;
     formatRawS(x, n, &w);
     w += R_print.gap;

     ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, Rbyte, RAW, 0, n,
 		      for(R_xlen_t j = 0; j < nb; j++) {
 			  i = idx + j; /* for macros */
 			  RAWVECTOR_TIGHTLOOP(px, j);
 		      });
     Rprintf("\n");
 }


 void printVector(SEXP x, int indx, int quote)
 {
 /* print R vector x[];	if(indx) print indices; if(quote) quote strings */
     R_xlen_t n;

     if ((n = XLENGTH(x)) != 0) {
 	R_xlen_t n_pr = (n <= R_print.max +1) ? n : R_print.max;
 	/* '...max +1'  ==> will omit at least 2 ==> plural in msg below */
 	switch (TYPEOF(x)) {
 	case LGLSXP:
 	    printLogicalVectorS(x, n_pr, indx);
 	    break;
 	case INTSXP:
 	    printIntegerVectorS(x, n_pr, indx);
 	    break;
 	case REALSXP:
 	    printRealVectorS(x, n_pr, indx);
 	    break;
 	case STRSXP:
 	    if (quote)
 		printStringVectorS(x, n_pr, '"', indx);
 	    else
 		printStringVectorS(x, n_pr, 0, indx);
 	    break;
 	case CPLXSXP:
 	    printComplexVectorS(x, n_pr, indx);
 	    break;
 	case RAWSXP:
 	    printRawVectorS(x, n_pr, indx);
 	    break;
 	}
 	if(n_pr < n)
 	    Rprintf(" [ reached getOption(\"max.print\") -- omitted %lld entries ]\n",
 		    (long long)n - n_pr);
     }
     else
 #define PRINT_V_0						\
 	switch (TYPEOF(x)) {					\
 	case LGLSXP:	Rprintf("logical(0)\n");	break;	\
 	case INTSXP:	Rprintf("integer(0)\n");	break;	\
 	case REALSXP:	Rprintf("numeric(0)\n");	break;	\
 	case CPLXSXP:	Rprintf("complex(0)\n");	break;	\
 	case STRSXP:	Rprintf("character(0)\n");	break;	\
 	case RAWSXP:	Rprintf("raw(0)\n");		break;	\
 	}
 	PRINT_V_0;
 }

 #undef DO_first_lab
 #undef DO_newline


 /* The following code prints vectors which have every element named.

  * Primitives for each type of vector are presented first, followed
  * by the main (dispatching) function.
  * 1) These primitives are almost identical... ==> use PRINT_N_VECTOR_SEXP macro
  * 2) S prints a _space_ in the first column for named vectors; we dont.
  */

 #define PRINT_N_VECTOR_SEXP(INI_FORMAT, PRINT_1)			\
     {									\
 	int nperline, w, wn;						\
 	R_xlen_t i, j, k, nlines;					\
 	INI_FORMAT;							\
 									\
 	formatStringS(names, n, &wn, 0);				\
 	if (w < wn) w = wn;						\
 	nperline = R_print.width / (w + R_print.gap);			\
 	if (nperline <= 0) nperline = 1;				\
 	nlines = n / nperline;						\
 	if (n % nperline) nlines += 1;					\
 									\
 	for (i = 0; i < nlines; i++) {					\
 	    if (i) Rprintf("\n");					\
 	    for (j = 0; j < nperline && (k = i * nperline + j) < n; j++) \
 		Rprintf("%s%*s",					\
 			EncodeString(STRING_ELT(names, k), w, 0,	\
 				     Rprt_adj_right),			\
 			R_print.gap, "");				\
 	    Rprintf("\n");						\
 	    for (j = 0; j < nperline && (k = i * nperline + j) < n; j++) \
 		PRINT_1;						\
 	}								\
 	Rprintf("\n");							\
     }

 static void printNamedLogicalVectorS(SEXP x, R_xlen_t n, SEXP names)
     PRINT_N_VECTOR_SEXP(formatLogicalS(x, n, &w),
 			Rprintf("%s%*s", EncodeLogical(LOGICAL_ELT(x, k), w),
 				R_print.gap,""))

 static void printNamedIntegerVectorS(SEXP x, R_xlen_t n, SEXP names)
     PRINT_N_VECTOR_SEXP(formatIntegerS(x, n, &w),
 			Rprintf("%s%*s", EncodeInteger(INTEGER_ELT(x, k), w),
 				R_print.gap,""))

 #undef INI_F_REAL_S
 #define INI_F_REAL_S	int d, e; formatRealS(x, n, &w, &d, &e, 0)

 static void printNamedRealVectorS(SEXP x, R_xlen_t n, SEXP names)
     PRINT_N_VECTOR_SEXP(INI_F_REAL_S,
 			Rprintf("%s%*s",
 				EncodeReal0(REAL_ELT(x, k), w, d, e, OutDec),
 				R_print.gap,""))

 #undef INI_F_CPLX_S
 #define INI_F_CPLX_S						\
     int wr, dr, er, wi, di, ei;					\
     formatComplexS(x, n, &wr, &dr, &er, &wi, &di, &ei, 0);	\
     w = wr + wi + 2;						\
     Rcomplex tmp

 #undef P_IMAG_NA
 #define P_IMAG_NA(VALUE)			\
 	    if(ISNAN(VALUE.i))			\
 		Rprintf("+%si", "NaN");		\
 	    else

 static void printNamedComplexVectorS(SEXP x, R_xlen_t n, SEXP names)
     PRINT_N_VECTOR_SEXP(INI_F_CPLX_S,
 	{ /* PRINT_1 */
 	    tmp = COMPLEX_ELT(x, k);
 	    if(j) Rprintf("%*s", R_print.gap, "");
 	    if (ISNA(tmp.r) || ISNA(tmp.i)) {
 		Rprintf("%s", EncodeReal0(NA_REAL, w, 0, 0, OutDec));
 	    }
 	    else {
 		Rprintf("%s", EncodeReal0(tmp.r, wr, dr, er, OutDec));
 		P_IMAG_NA(tmp)
 		if (tmp.i >= 0)
 		    Rprintf("+%si", EncodeReal0(tmp.i, wi, di, ei, OutDec));
 		else
 		    Rprintf("-%si", EncodeReal0(-tmp.i, wi, di, ei, OutDec));
 	    }
 	})

 static void printNamedStringVectorS(SEXP x, R_xlen_t n, int quote, SEXP names)
     PRINT_N_VECTOR_SEXP(formatStringS(x, n, &w, quote),
 		   Rprintf("%s%*s",
 			   EncodeString(STRING_ELT(x, k), w, quote,
 					Rprt_adj_right),
 			   R_print.gap, ""))

 static void printNamedRawVectorS(SEXP x, R_xlen_t n, SEXP names)
     PRINT_N_VECTOR_SEXP(formatRawS(x, n, &w),
 		   Rprintf("%*s%s%*s", w - 2, "",
 			   EncodeRaw(RAW_ELT(x, k), ""), R_print.gap,""))

 attribute_hidden
 void printNamedVector(SEXP x, SEXP names, int quote, const char *title)
 {

     if (title != NULL)
 	 Rprintf("%s\n", title);

     R_xlen_t n = XLENGTH(x);
     if (n != 0) {
 	R_xlen_t n_pr = (n <= R_print.max +1) ? n : R_print.max;
 	/* '...max +1'  ==> will omit at least 2 ==> plural in msg below */
 	switch (TYPEOF(x)) {
 	case LGLSXP:
 	    printNamedLogicalVectorS(x, n_pr, names);
 	    break;
 	case INTSXP:
 	    printNamedIntegerVectorS(x, n_pr, names);
 	    break;
 	case REALSXP:
 	    printNamedRealVectorS(x, n_pr, names);
 	    break;
 	case CPLXSXP:
 	    printNamedComplexVectorS(x, n_pr, names);
 	    break;
 	case STRSXP:
 	    if(quote) quote = '"';
 	    printNamedStringVectorS(x, n_pr, quote, names);
 	    break;
 	case RAWSXP:
 	    printNamedRawVectorS(x, n_pr, names);
 	    break;
 	}
 	if(n_pr < n)
 	    Rprintf(" [ reached getOption(\"max.print\") -- omitted %lld entries ]\n",
 		    (long long)n - n_pr);
     }
     else {
 	Rprintf("named ");
 	PRINT_V_0;
     }
 }
	/*
	* R : A Computer Language for Statistical Data Analysis
	* Copyright (C) 1998-2022 The R Core Team.
	* Copyright (C) 1995-1998 Robert Gentleman and Ross Ihaka
	*
	* This program 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.
	*
	* This program 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 this program; if not, a copy is available at
	* https://www.R-project.org/Licenses/
	*
	* EXPORTS printVector()
	* printNamedVector()
	* printRealVector()
	* printRealVectorS()
	* printIntegerVector()
	* printIntegerVectorS()
	* printComplexVector()
	* printComplexVectorS()
	*
	* See ./printutils.c for remarks on Printing and the Encoding utils.
	* See ./format.c for the formatXXXX functions used below.
	*/

	#ifdef HAVE_CONFIG_H
	#include <config.h>
	#endif

	#include "Defn.h"
	#include "Print.h"
	#include <R_ext/Itermacros.h> /* for ITERATE_BY_REGION */

	#ifdef Win32
	#include <trioremap.h> /* for %lld */
	#endif

	#define DO_first_lab \
	if (indx) { \
	labwidth = IndexWidth(n) + 2; \
	/* labwidth may well be \
	one more than desired ..*/ \
	VectorIndex(1, labwidth); \
	width = labwidth; \
	} \
	else width = 0

	#define DO_newline \
	Rprintf("\n"); \
	if (indx) { \
	VectorIndex(i + 1, labwidth); \
	width = labwidth; \
	} \
	else \
	width = 0

	/* printVector ( in {Real, Integer, Complex}) are exported, but no
	longer directly called by internal R sources (which now call
	print*VectorS for ALTREP support). Macros are used to prevent drift
	between printVector and printVectorS.

	printIntegerVector(INTEGER(x)) and printIntegerVector(x) must
	always give identical output, unless INTEGER(x) fails, en.g. during
	allocation. */

	/* i must be defined and contain the overall position in the vector
	because DO_newline uses it
	ENCCALL is the full invocation of Encode*() which
	is passed to Rprintf
	*/

	/* used for logical, integer, numeric and complex vectors */
	#define NUMVECTOR_TIGHTLOOP(ENCCALL) do { \
	if (i > 0 && width + w > R_print.width) { \
	DO_newline; \
	} \
	Rprintf("%s", ENCCALL); \
	width += w; \
	} while(0)

	/* used when printing character vectors */
	#define CHARVECTOR_TIGHTLOOP(ENCCALL) do { \
	if (i > 0 && width + w + R_print.gap > R_print.width) { \
	DO_newline; \
	} \
	Rprintf("%*s%s", R_print.gap, "", \
	ENCCALL); \
	width += w + R_print.gap; \
	} while (0)

	/* used for raw vectors. Could be combined with character vectors
	above but NB the different second conditions for the if
	(width + w vs width + w + R_print.gap) and the different increment
	on width.
	*/
	#define RAWVECTOR_TIGHTLOOP(ptr, pos) do { \
	if (i > 0 && width + w > R_print.width) { \
	DO_newline; \
	} \
	Rprintf("%*s%s", R_print.gap, "", EncodeRaw(ptr[pos], "")); \
	width += w; \
	} while (0)

	static
	void printLogicalVectorS(SEXP x, R_xlen_t n, int indx) {
	int w, labwidth=0, width;
	R_xlen_t i;
	DO_first_lab;
	formatLogicalS(x, n, &w);
	w += R_print.gap;

	ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, int, LOGICAL, 0, n,
	for(R_xlen_t j = 0; j < nb; j++) {
	i = idx + j; /* for Do_newline */
	NUMVECTOR_TIGHTLOOP( EncodeLogical(px[j], w) );
	});
	Rprintf("\n");
	}

	attribute_hidden
	void printIntegerVector(const int *x, R_xlen_t n, int indx)
	{
	int w, labwidth=0, width;

	DO_first_lab;
	formatInteger(x, n, &w);
	w += R_print.gap;

	for (R_xlen_t i = 0; i < n; i++) {
	NUMVECTOR_TIGHTLOOP(EncodeInteger(x[i], w));
	}
	Rprintf("\n");
	}

	attribute_hidden
	void printIntegerVectorS(SEXP x, R_xlen_t n, int indx)
	{
	int w, labwidth=0, width;
	R_xlen_t i;
	DO_first_lab;
	formatIntegerS(x, n, &w);
	w += R_print.gap;

	ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, int, INTEGER, 0, n,
	for (R_xlen_t j = 0; j < nb; j++) {
	i = idx + j; /* for macros */
	NUMVECTOR_TIGHTLOOP(EncodeInteger(px[j], w));
	});

	Rprintf("\n");
	}

	// used in uncmin.c
	// Not easily converted to printRealVectorS calls
	attribute_hidden
	void printRealVector(const double *x, R_xlen_t n, int indx)
	{
	int w, d, e, labwidth=0, width;

	DO_first_lab;
	formatReal(x, n, &w, &d, &e, 0);
	w += R_print.gap;

	for (R_xlen_t i = 0; i < n; i++) {
	NUMVECTOR_TIGHTLOOP( EncodeReal0(x[i], w, d, e, OutDec) );
	}
	Rprintf("\n");
	}

	attribute_hidden
	void printRealVectorS(SEXP x, R_xlen_t n, int indx)
	{
	int w, d, e, labwidth=0, width;
	R_xlen_t i;
	DO_first_lab;
	formatRealS(x, n, &w, &d, &e, 0);
	w += R_print.gap;

	ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, double, REAL, 0, n,
	for(R_xlen_t j = 0; j < nb; j++) {
	i = idx + j; /* for macros */
	NUMVECTOR_TIGHTLOOP(EncodeReal0(px[j], w, d, e, OutDec));
	});

	Rprintf("\n");
	}

	#define CMPLX_ISNA(cplx) (ISNA(cplx.r) \|\| ISNA(cplx.i))
	attribute_hidden
	void printComplexVector(const Rcomplex *x, R_xlen_t n, int indx)
	{
	int w, wr, dr, er, wi, di, ei, labwidth=0, width;

	DO_first_lab;
	formatComplex(x, n, &wr, &dr, &er, &wi, &di, &ei, 0);

	w = wr + wi + 2; /* +2 for "+" and "i" */
	w += R_print.gap;

	for (R_xlen_t i = 0; i < n; i++) {
	NUMVECTOR_TIGHTLOOP(CMPLX_ISNA(x[i]) ?
	EncodeReal0(NA_REAL, w, 0, 0, OutDec) :
	EncodeComplex(x[i], wr + R_print.gap,
	dr, er, wi, di, ei, OutDec));
	}
	Rprintf("\n");
	}

	attribute_hidden
	void printComplexVectorS(SEXP x, R_xlen_t n, int indx)
	{
	int w, wr, dr, er, wi, di, ei, labwidth=0, width;
	R_xlen_t i;
	DO_first_lab;
	formatComplexS(x, n, &wr, &dr, &er, &wi, &di, &ei, 0);

	w = wr + wi + 2; /* +2 for "+" and "i" */
	w += R_print.gap;

	ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, Rcomplex, COMPLEX, 0, n,
	for(R_xlen_t j = 0; j < nb; j++) {
	i = idx + j; /* for macros */
	NUMVECTOR_TIGHTLOOP(CMPLX_ISNA(px[j]) ?
	EncodeReal0(NA_REAL, w, 0, 0, OutDec) :
	EncodeComplex(px[j], wr + R_print.gap , dr, er, wi, di, ei, OutDec));
	});
	Rprintf("\n");
	}


	static void printStringVector(const SEXP *x, R_xlen_t n, int quote, int indx)
	{
	int w, labwidth=0, width;

	DO_first_lab;
	formatString(x, n, &w, quote);

	for (R_xlen_t i = 0; i < n; i++) {
	if (i > 0 && width + w + R_print.gap > R_print.width) {
	DO_newline;
	}
	Rprintf("%*s%s", R_print.gap, "",
	EncodeString(x[i], w, quote, R_print.right));
	width += w + R_print.gap;
	}
	Rprintf("\n");
	}

	static void printStringVectorS(SEXP x, R_xlen_t n, int quote, int indx)
	{
	/* because there's no get_region method for ALTSTRINGs
	we hit the old version if we can to avoid the
	STRING_ELT in the tight loop.

	This will work for all nonALTREP STRSXPs as well as whenever
	the ALTSTRING class is willing to give us a full dataptr from
	Dataptr_or_null method. */

	const SEXP xptr = (const SEXP ) DATAPTR_OR_NULL(x);
	if(xptr != NULL) {
	printStringVector(xptr, n, quote, indx);
	return;
	}

	int w, labwidth=0, width;

	DO_first_lab;
	formatStringS(x, n, &w, quote);

	for (R_xlen_t i = 0; i < n; i++) {
	CHARVECTOR_TIGHTLOOP(
	EncodeString(STRING_ELT(x, i), w, quote, R_print.right)
	);
	}
	Rprintf("\n");
	}




	attribute_hidden
	void printRawVector(const Rbyte *x, R_xlen_t n, int indx)
	{
	int w, labwidth=0, width;

	DO_first_lab;
	formatRaw(x, n, &w);
	w += R_print.gap;

	for (R_xlen_t i = 0; i < n; i++) {
	RAWVECTOR_TIGHTLOOP(x, i);
	}
	Rprintf("\n");
	}


	static
	void printRawVectorS(SEXP x, R_xlen_t n, int indx)
	{
	int w, labwidth=0, width;
	R_xlen_t i;
	DO_first_lab;
	formatRawS(x, n, &w);
	w += R_print.gap;

	ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, Rbyte, RAW, 0, n,
	for(R_xlen_t j = 0; j < nb; j++) {
	i = idx + j; /* for macros */
	RAWVECTOR_TIGHTLOOP(px, j);
	});
	Rprintf("\n");
	}


	void printVector(SEXP x, int indx, int quote)
	{
	/* print R vector x[]; if(indx) print indices; if(quote) quote strings */
	R_xlen_t n;

	if ((n = XLENGTH(x)) != 0) {
	R_xlen_t n_pr = (n <= R_print.max +1) ? n : R_print.max;
	/* '...max +1' ==> will omit at least 2 ==> plural in msg below */
	switch (TYPEOF(x)) {
	case LGLSXP:
	printLogicalVectorS(x, n_pr, indx);
	break;
	case INTSXP:
	printIntegerVectorS(x, n_pr, indx);
	break;
	case REALSXP:
	printRealVectorS(x, n_pr, indx);
	break;
	case STRSXP:
	if (quote)
	printStringVectorS(x, n_pr, '"', indx);
	else
	printStringVectorS(x, n_pr, 0, indx);
	break;
	case CPLXSXP:
	printComplexVectorS(x, n_pr, indx);
	break;
	case RAWSXP:
	printRawVectorS(x, n_pr, indx);
	break;
	}
	if(n_pr < n)
	Rprintf(" [ reached getOption(\"max.print\") -- omitted %lld entries ]\n",
	(long long)n - n_pr);
	}
	else
	#define PRINT_V_0 \
	switch (TYPEOF(x)) { \
	case LGLSXP: Rprintf("logical(0)\n"); break; \
	case INTSXP: Rprintf("integer(0)\n"); break; \
	case REALSXP: Rprintf("numeric(0)\n"); break; \
	case CPLXSXP: Rprintf("complex(0)\n"); break; \
	case STRSXP: Rprintf("character(0)\n"); break; \
	case RAWSXP: Rprintf("raw(0)\n"); break; \
	}
	PRINT_V_0;
	}

	#undef DO_first_lab
	#undef DO_newline


	/* The following code prints vectors which have every element named.

	* Primitives for each type of vector are presented first, followed
	* by the main (dispatching) function.
	* 1) These primitives are almost identical... ==> use PRINT_N_VECTOR_SEXP macro
	* 2) S prints a _space_ in the first column for named vectors; we dont.
	*/

	#define PRINT_N_VECTOR_SEXP(INI_FORMAT, PRINT_1) \
	{ \
	int nperline, w, wn; \
	R_xlen_t i, j, k, nlines; \
	INI_FORMAT; \
	\
	formatStringS(names, n, &wn, 0); \
	if (w < wn) w = wn; \
	nperline = R_print.width / (w + R_print.gap); \
	if (nperline <= 0) nperline = 1; \
	nlines = n / nperline; \
	if (n % nperline) nlines += 1; \
	\
	for (i = 0; i < nlines; i++) { \
	if (i) Rprintf("\n"); \
	for (j = 0; j < nperline && (k = i * nperline + j) < n; j++) \
	Rprintf("%s%*s", \
	EncodeString(STRING_ELT(names, k), w, 0, \
	Rprt_adj_right), \
	R_print.gap, ""); \
	Rprintf("\n"); \
	for (j = 0; j < nperline && (k = i * nperline + j) < n; j++) \
	PRINT_1; \
	} \
	Rprintf("\n"); \
	}

	static void printNamedLogicalVectorS(SEXP x, R_xlen_t n, SEXP names)
	PRINT_N_VECTOR_SEXP(formatLogicalS(x, n, &w),
	Rprintf("%s%*s", EncodeLogical(LOGICAL_ELT(x, k), w),
	R_print.gap,""))

	static void printNamedIntegerVectorS(SEXP x, R_xlen_t n, SEXP names)
	PRINT_N_VECTOR_SEXP(formatIntegerS(x, n, &w),
	Rprintf("%s%*s", EncodeInteger(INTEGER_ELT(x, k), w),
	R_print.gap,""))

	#undef INI_F_REAL_S
	#define INI_F_REAL_S int d, e; formatRealS(x, n, &w, &d, &e, 0)

	static void printNamedRealVectorS(SEXP x, R_xlen_t n, SEXP names)
	PRINT_N_VECTOR_SEXP(INI_F_REAL_S,
	Rprintf("%s%*s",
	EncodeReal0(REAL_ELT(x, k), w, d, e, OutDec),
	R_print.gap,""))

	#undef INI_F_CPLX_S
	#define INI_F_CPLX_S \
	int wr, dr, er, wi, di, ei; \
	formatComplexS(x, n, &wr, &dr, &er, &wi, &di, &ei, 0); \
	w = wr + wi + 2; \
	Rcomplex tmp

	#undef P_IMAG_NA
	#define P_IMAG_NA(VALUE) \
	if(ISNAN(VALUE.i)) \
	Rprintf("+%si", "NaN"); \
	else

	static void printNamedComplexVectorS(SEXP x, R_xlen_t n, SEXP names)
	PRINT_N_VECTOR_SEXP(INI_F_CPLX_S,
	{ /* PRINT_1 */
	tmp = COMPLEX_ELT(x, k);
	if(j) Rprintf("%*s", R_print.gap, "");
	if (ISNA(tmp.r) \|\| ISNA(tmp.i)) {
	Rprintf("%s", EncodeReal0(NA_REAL, w, 0, 0, OutDec));
	}
	else {
	Rprintf("%s", EncodeReal0(tmp.r, wr, dr, er, OutDec));
	P_IMAG_NA(tmp)
	if (tmp.i >= 0)
	Rprintf("+%si", EncodeReal0(tmp.i, wi, di, ei, OutDec));
	else
	Rprintf("-%si", EncodeReal0(-tmp.i, wi, di, ei, OutDec));
	}
	})

	static void printNamedStringVectorS(SEXP x, R_xlen_t n, int quote, SEXP names)
	PRINT_N_VECTOR_SEXP(formatStringS(x, n, &w, quote),
	Rprintf("%s%*s",
	EncodeString(STRING_ELT(x, k), w, quote,
	Rprt_adj_right),
	R_print.gap, ""))

	static void printNamedRawVectorS(SEXP x, R_xlen_t n, SEXP names)
	PRINT_N_VECTOR_SEXP(formatRawS(x, n, &w),
	Rprintf("%s%s%s", w - 2, "",
	EncodeRaw(RAW_ELT(x, k), ""), R_print.gap,""))

	attribute_hidden
	void printNamedVector(SEXP x, SEXP names, int quote, const char *title)
	{

	if (title != NULL)
	Rprintf("%s\n", title);

	R_xlen_t n = XLENGTH(x);
	if (n != 0) {
	R_xlen_t n_pr = (n <= R_print.max +1) ? n : R_print.max;
	/* '...max +1' ==> will omit at least 2 ==> plural in msg below */
	switch (TYPEOF(x)) {
	case LGLSXP:
	printNamedLogicalVectorS(x, n_pr, names);
	break;
	case INTSXP:
	printNamedIntegerVectorS(x, n_pr, names);
	break;
	case REALSXP:
	printNamedRealVectorS(x, n_pr, names);
	break;
	case CPLXSXP:
	printNamedComplexVectorS(x, n_pr, names);
	break;
	case STRSXP:
	if(quote) quote = '"';
	printNamedStringVectorS(x, n_pr, quote, names);
	break;
	case RAWSXP:
	printNamedRawVectorS(x, n_pr, names);
	break;
	}
	if(n_pr < n)
	Rprintf(" [ reached getOption(\"max.print\") -- omitted %lld entries ]\n",
	(long long)n - n_pr);
	}
	else {
	Rprintf("named ");
	PRINT_V_0;
	}
	}