2005-08-07 16:42:42 +02:00
|
|
|
// Transpose tensor indices
|
|
|
|
|
2004-08-15 21:30:02 +02:00
|
|
|
#include "stdafx.h"
|
|
|
|
#include "defs.h"
|
2005-08-07 16:42:42 +02:00
|
|
|
static void ytranspose(void);
|
2004-08-15 21:30:02 +02:00
|
|
|
|
|
|
|
void
|
|
|
|
eval_transpose(void)
|
|
|
|
{
|
|
|
|
push(cadr(p1));
|
|
|
|
eval();
|
|
|
|
if (cddr(p1) == nil) {
|
|
|
|
push_integer(1);
|
|
|
|
push_integer(2);
|
|
|
|
} else {
|
|
|
|
push(caddr(p1));
|
|
|
|
eval();
|
|
|
|
push(cadddr(p1));
|
|
|
|
eval();
|
|
|
|
}
|
|
|
|
transpose();
|
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
transpose(void)
|
|
|
|
{
|
|
|
|
save();
|
2005-08-07 16:42:42 +02:00
|
|
|
ytranspose();
|
2004-08-15 21:30:02 +02:00
|
|
|
restore();
|
|
|
|
}
|
|
|
|
|
|
|
|
static void
|
2005-08-07 16:42:42 +02:00
|
|
|
ytranspose(void)
|
2004-08-15 21:30:02 +02:00
|
|
|
{
|
|
|
|
int i, j, k, l, m, ndim, nelem, t;
|
|
|
|
int ai[MAXDIM], an[MAXDIM];
|
|
|
|
U **a, **b;
|
|
|
|
|
|
|
|
p3 = pop();
|
|
|
|
p2 = pop();
|
|
|
|
p1 = pop();
|
|
|
|
|
2005-08-06 22:57:37 +02:00
|
|
|
if (!istensor(p1)) {
|
2004-08-15 21:30:02 +02:00
|
|
|
if (!iszero(p1))
|
|
|
|
stop("transpose: tensor expected, 1st arg is not a tensor");
|
|
|
|
push(zero);
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
ndim = p1->u.tensor->ndim;
|
|
|
|
nelem = p1->u.tensor->nelem;
|
|
|
|
|
|
|
|
push(p2);
|
|
|
|
l = pop_integer();
|
|
|
|
|
|
|
|
push(p3);
|
|
|
|
m = pop_integer();
|
|
|
|
|
|
|
|
if (l < 1 || l > ndim || m < 1 || m > ndim)
|
|
|
|
stop("transpose: index out of range");
|
|
|
|
|
|
|
|
l--;
|
|
|
|
m--;
|
|
|
|
|
|
|
|
p2 = alloc_tensor(nelem);
|
|
|
|
|
|
|
|
p2->u.tensor->ndim = ndim;
|
|
|
|
|
|
|
|
for (i = 0; i < ndim; i++)
|
|
|
|
p2->u.tensor->dim[i] = p1->u.tensor->dim[i];
|
|
|
|
|
|
|
|
p2->u.tensor->dim[l] = p1->u.tensor->dim[m];
|
|
|
|
p2->u.tensor->dim[m] = p1->u.tensor->dim[l];
|
|
|
|
|
|
|
|
a = p1->u.tensor->elem;
|
|
|
|
b = p2->u.tensor->elem;
|
|
|
|
|
|
|
|
for (i = 0; i < ndim; i++) {
|
|
|
|
ai[i] = 0;
|
|
|
|
an[i] = p1->u.tensor->dim[i];
|
|
|
|
}
|
|
|
|
|
|
|
|
// copy components from a to b
|
|
|
|
|
|
|
|
for (i = 0; i < nelem; i++) {
|
|
|
|
|
|
|
|
t = ai[l]; ai[l] = ai[m]; ai[m] = t;
|
|
|
|
t = an[l]; an[l] = an[m]; an[m] = t;
|
|
|
|
|
|
|
|
k = 0;
|
|
|
|
for (j = 0; j < ndim; j++)
|
|
|
|
k = (k * an[j]) + ai[j];
|
|
|
|
|
|
|
|
t = ai[l]; ai[l] = ai[m]; ai[m] = t;
|
|
|
|
t = an[l]; an[l] = an[m]; an[m] = t;
|
|
|
|
|
|
|
|
b[k] = a[i];
|
|
|
|
|
|
|
|
for (j = ndim - 1; j >= 0; j--) {
|
|
|
|
if (++ai[j] < an[j])
|
|
|
|
break;
|
|
|
|
ai[j] = 0;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
push(p2);
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
|
|
static char *s[] = {
|
|
|
|
|
|
|
|
"transpose(0)",
|
|
|
|
"0",
|
|
|
|
|
2005-08-07 16:42:42 +02:00
|
|
|
"transpose(0.0)",
|
|
|
|
"0",
|
|
|
|
|
2004-08-15 21:30:02 +02:00
|
|
|
"transpose(((a,b),(c,d)))",
|
|
|
|
"((a,c),(b,d))",
|
|
|
|
|
|
|
|
"transpose(((a,b),(c,d)),1,2)",
|
|
|
|
"((a,c),(b,d))",
|
|
|
|
|
|
|
|
"transpose(((a,b,c),(d,e,f)),1,2)",
|
|
|
|
"((a,d),(b,e),(c,f))",
|
|
|
|
|
|
|
|
"transpose(((a,d),(b,e),(c,f)),1,2)",
|
|
|
|
"((a,b,c),(d,e,f))",
|
|
|
|
};
|
|
|
|
|
|
|
|
void
|
|
|
|
test_transpose(void)
|
|
|
|
{
|
|
|
|
test(__FILE__, s, sizeof s / sizeof (char *));
|
|
|
|
}
|