The R Project SVN R

Rev

Rev 70543 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 70543 Rev 70665
Line 1707... Line 1707...
1707 
#ifndef LONG_VECTOR_SUPPORT
 1707 
#ifndef LONG_VECTOR_SUPPORT
1708 
   if ((double)nr * (double)nc > INT_MAX)
 1708 
   if ((double)nr * (double)nc > INT_MAX)
1709 
	error(_("too many elements specified"));
 1709 
	error(_("too many elements specified"));
1710 
#endif
 1710 
#endif
1711 
 
 1711 
 
- 
 
 1712 
   int nx = LENGTH(x);
- 
 
 1713 
   R_xlen_t NR = nr;
- 
 
 1714 
 
- 
 
 1715 
#define mk_DIAG(_zero_)					\
- 
 
 1716 
   for (R_xlen_t i = 0; i < NR*nc; i++) ra[i] = _zero_;	\
- 
 
 1717 
   R_xlen_t i, i1;					\
- 
 
 1718 
   MOD_ITERATE1(mn, nx, i, i1, {			\
- 
 
 1719 
	   ra[i * (NR+1)] = rx[i1];			\
- 
 
 1720 
   });
- 
 
 1721 
 
1712 
   if (TYPEOF(x) == CPLXSXP) {
 1722 
   switch(TYPEOF(x)) {
- 
 
 1723 
 
- 
 
 1724 
   case REALSXP:
- 
 
 1725 
   {
- 
 
 1726 
#define mk_REAL_DIAG					\
- 
 
 1727 
       PROTECT(ans = allocMatrix(REALSXP, nr, nc));	\
- 
 
 1728 
       double *rx = REAL(x), *ra = REAL(ans);		\
- 
 
 1729 
       mk_DIAG(0.0)
- 
 
 1730 
 
- 
 
 1731 
       mk_REAL_DIAG;
- 
 
 1732 
       break;
- 
 
 1733 
   }
- 
 
 1734 
   case CPLXSXP:
- 
 
 1735 
   {
1713 
       PROTECT(ans = allocMatrix(CPLXSXP, nr, nc));
 1736 
       PROTECT(ans = allocMatrix(CPLXSXP, nr, nc));
1714 
       int nx = LENGTH(x);
 1737 
       int nx = LENGTH(x);
1715 
       R_xlen_t NR = nr;
 1738 
       R_xlen_t NR = nr;
1716 
       Rcomplex *rx = COMPLEX(x), *ra = COMPLEX(ans), zero;
 1739 
       Rcomplex *rx = COMPLEX(x), *ra = COMPLEX(ans), zero;
1717 
       zero.r = zero.i = 0.0;
 1740 
       zero.r = zero.i = 0.0;
1718 
       for (R_xlen_t i = 0; i < NR*nc; i++) ra[i] = zero;
 1741 
       mk_DIAG(zero);
1719 
       R_xlen_t i, i1;
 1742 
       break;
- 
 
 1743 
   }
- 
 
 1744 
   case INTSXP:
- 
 
 1745 
   {
1720 
       MOD_ITERATE1(mn, nx, i, i1, {
 1746 
       PROTECT(ans = allocMatrix(INTSXP, nr, nc));
1721 
	   ra[i * (NR+1)] = rx[i1];
 1747 
       int *rx = INTEGER(x), *ra = INTEGER(ans);
- 
 
 1748 
       mk_DIAG(0);
1722 
       });
 1749 
       break;
- 
 
 1750 
   }
- 
 
 1751 
   case LGLSXP:
1723 
  } else {
 1752 
   {
1724 
       if(TYPEOF(x) != REALSXP) {
 1753 
       PROTECT(ans = allocMatrix(LGLSXP, nr, nc));
1725 
	   PROTECT(x = coerceVector(x, REALSXP));
 1754 
       int *rx = LOGICAL(x), *ra = LOGICAL(ans);
- 
 
 1755 
       mk_DIAG(0);
1726 
	   nprotect++;
 1756 
       break;
1727 
       }
 1757 
   }
- 
 
 1758 
   case RAWSXP:
- 
 
 1759 
   {
1728 
       PROTECT(ans = allocMatrix(REALSXP, nr, nc));
 1760 
       PROTECT(ans = allocMatrix(RAWSXP, nr, nc));
1729 
       int nx = LENGTH(x);
 1761 
       Rbyte *rx = RAW(x), *ra = RAW(ans);
1730 
       R_xlen_t NR = nr;
 1762 
       mk_DIAG((Rbyte) 0);
1731 
       double *rx = REAL(x), *ra = REAL(ans);
 1763 
       break;
- 
 
 1764 
   }
- 
 
 1765 
   default: {
1732 
       for (R_xlen_t i = 0; i < NR*nc; i++) ra[i] = 0.0;
 1766 
       PROTECT(x = coerceVector(x, REALSXP));
1733 
       R_xlen_t i, i1;
 1767 
       nprotect++;
1734 
       MOD_ITERATE1(mn, nx, i, i1, {
 - 
 
1735 
	   ra[i * (NR+1)] = rx[i1];
 1768 
       mk_REAL_DIAG;
1736 
       });
 1769 
     }
1737 
   }
 1770 
   }
- 
 
 1771 
#undef mk_REAL_DIAG
- 
 
 1772 
#undef mk_DIAG
1738 
   UNPROTECT(nprotect);
 1773 
   UNPROTECT(nprotect);
1739 
   return ans;
 1774 
   return ans;
1740 
}
 1775 
}
1741 
 
 1776 
 
1742 
 
 1777