The R Project SVN R

Rev

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

Rev 23236 Rev 24735
Line 782... Line 782...
782 
 not_matrix:
 782 
 not_matrix:
783 
    errorcall(call, "argument is not a matrix");
 783 
    errorcall(call, "argument is not a matrix");
784 
    return call;/* never used; just for -Wall */
 784 
    return call;/* never used; just for -Wall */
785 
}
 785 
}
786 
 
 786 
 
787 
 
 - 
 
788 
#ifdef OLD
 - 
 
789 
/* swap works by finding for a index i, the position */
 - 
 
790 
/* in the array with dimensions dims1 in terms of */
 - 
 
791 
/* (i, j, k, l, m, ...); i.e. component-wise position, */
 - 
 
792 
/* then permute these to the order of the array with */
 - 
 
793 
/* dimensions dims2 and work backwards to an integer */
 - 
 
794 
/* offset in this array */
 - 
 
795 
 
 - 
 
796 
static int swap(int ival, SEXP dims1, SEXP dims2, SEXP perm,
 - 
 
797 
		SEXP ind1, SEXP ind2)
 - 
 
798 
{
 - 
 
799 
    int len, t1, i;
 - 
 
800 
    len = length(dims1);
 - 
 
801 
    t1 = ival;
 - 
 
802 
    for (i = 0; i < len; i++) {
 - 
 
803 
	INTEGER(ind1)[i] = t1 % INTEGER(dims1)[i];
 - 
 
804 
	t1 = t1 / INTEGER(dims1)[i];
 - 
 
805 
    }
 - 
 
806 
 
 - 
 
807 
    for (i = 0; i < len; i++)
 - 
 
808 
	INTEGER(ind2)[i] = INTEGER(ind1)[(INTEGER(perm)[i] - 1)];
 - 
 
809 
 
 - 
 
810 
    t1 = INTEGER(ind2)[(len - 1)];
 - 
 
811 
    for (i = (len - 2); i >= 0; i--) {
 - 
 
812 
	t1 *= INTEGER(dims2)[i];
 - 
 
813 
	t1 += INTEGER(ind2)[i];
 - 
 
814 
    }
 - 
 
815 
    return t1;
 - 
 
816 
}
 - 
 
817 
#endif
 - 
 
818 
 
 - 
 
819 
/*
 787 
/*
820 
 New version of aperm, using strides for speed.
 788 
 New version of aperm, using strides for speed.
821 
 Jonathan Rougier <J.C.Rougier@durham.ac.uk>
 789 
 Jonathan Rougier <J.C.Rougier@durham.ac.uk>
822 
 
 790 
 
823 
 v1.0 30.01.01
 791 
 v1.0 30.01.01
Line 856... Line 824...
856 
    n = LENGTH(dimsa);
 824 
    n = LENGTH(dimsa);
857 
 
 825 
 
858 
    /* check the permutation */
 826 
    /* check the permutation */
859 
 
 827 
 
860 
    PROTECT(perm = coerceVector(CADR(args), INTSXP));
 828 
    PROTECT(perm = coerceVector(CADR(args), INTSXP));
861 
#ifdef OLD
 - 
 
862 
    if (!isVector(perm) || (length(perm) != length(dimsa)))
 - 
 
863 
	errorcall(call,
 - 
 
864 
	 "invalid second argument, must be a vector of the appropriate length");
 - 
 
865 
#else
 - 
 
866 
    vmax = vmaxget();
 829 
    vmax = vmaxget();
867 
    pp = (int *) R_alloc(n, sizeof(int));
 830 
    pp = (int *) R_alloc(n, sizeof(int));
868 
    if (length(perm) == 0) {
 831 
    if (length(perm) == 0) {
869 
	for (i=0; i<n; i++)
 832 
	for (i=0; i<n; i++)
870 
	    pp[i] = n-1-i;
 833 
	    pp[i] = n-1-i;
Line 882... Line 845...
882 
	else
 845 
	else
883 
	    errorcall(call, "value of out range in `perm'");
 846 
	    errorcall(call, "value of out range in `perm'");
884 
    for (i=0; i<n; i++)
 847 
    for (i=0; i<n; i++)
885 
	if (iip[i]==0)
 848 
	if (iip[i]==0)
886 
	    errorcall(call, "invalid permutation (`perm')");
 849 
	    errorcall(call, "invalid permutation (`perm')");
887 
#endif
 - 
 
888 
 
 850 
 
889 
    /* create the stride object and permute */
 851 
    /* create the stride object and permute */
890 
 
 852 
 
891 
    stride = (int *) R_alloc(n, sizeof(int));
 853 
    stride = (int *) R_alloc(n, sizeof(int));
892 
 
 854