matrix* Closure(matrix* m, boolean close, group* lie_type)
{ matrix* result; lie_Index i,j;
group* tp=(s=Ssrank(grp), lie_type==NULL ? mkgroup(s) : lie_type);
tp->toraldim=Lierank(grp); tp->ncomp=0; /* start with maximal torus */
m=copymatrix(m);
if (close)
if (type_of(grp)==SIMPGRP) close = two_lengths(grp->s.lietype);
else
{ for (i=0; i<grp->g.ncomp; i++)
if (two_lengths(Liecomp(grp,i)->lietype)) break;
close= i<grp->g.ncomp;
}
{ entry* t;
for (i=0; i<m->nrows; i++)
if (!isroot(t=m->elm[i]))
error("Set of root vectors contains a non-root\n");
else if (!isposroot(t=m->elm[i]))
for (j=0; j<m->ncols; j++) t[j]= -t[j]; /* make positive root */
Unique(m,cmpfn);
}
{ lie_Index next;
for (i=0; i<m->nrows; i=next)
{ lie_Index d,n=0; simpgrp* c;
next=isolcomp(m,i);
fundam(m,i,&next);
if (close) long_close(m,i,next),fundam(m,i,&next);
c=simp_type(&m->elm[i],d=next-i);
{ j=tp->ncomp++;
while(--j>=0 && grp_less(tp->liecomp[j],c))
n += (tp->liecomp[j+1]=tp->liecomp[j])->lierank;
tp->liecomp[++j]=c; tp->toraldim -= d;
/* insert component and remove rank from torus */
cycle_block(m,i-n,next,n);
/* move the |d| rows down across |n| previous rows */
}
}
}
if (lie_type==NULL)
return result=copymatrix(m),freemem(m),freemem(tp),result;
else return freemem(m),(matrix*)NULL; /* |Cartan_type| doesn't need |m| */
}
int main()
{
Group *gtmp = NULL;
List *ltmp = NULL;
List *ltmp2 = NULL;
int i = 0;
int num = 0;
int testno = 0;
char *output[14];
output[i++] = "<NULL>";
output[i++] = "<EMPTY>";
output[i++] = "1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 7 -> 0 -> NULL";
output[i++] = "1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 7 -> 0 -> NULL";
output[i++] = "8 -> 9 -> 10 -> 11 -> 12 -> 13 -> 14 -> 15 -> NULL";
output[i++] = "1 -> 2 -> 3 -> 4 -> 5 -> 6 -> 7 -> 0 -> NULL";
output[i++] = "8 -> 9 -> 10 -> 11 -> 12 -> 13 -> 14 -> 15 -> NULL";
output[i++] = "17 -> 18 -> 19 -> 20 -> 21 -> 22 -> 23 -> 16 -> NULL";
output[i++] = "24 -> 25 -> 26 -> 27 -> 28 -> 29 -> 30 -> 31 -> NULL";
output[i++] = "33 -> 34 -> 35 -> 36 -> 37 -> 38 -> 39 -> 32 -> NULL";
output[i++] = "40 -> 41 -> 42 -> 43 -> 44 -> 45 -> 46 -> 47 -> NULL";
output[i++] = "49 -> 50 -> 51 -> 52 -> 53 -> 54 -> 55 -> 48 -> NULL";
output[i++] = "NULL";
fprintf(stdout, "UNIT TEST: group library lobtain() function\n");
fprintf(stdout, "===========================================\n");
// NULL list test
fprintf(stdout, "Test %d: Obtaining on NULL group ...\n", testno++);
fprintf(stdout, " you have: ");
gtmp = lobtain(gtmp, <mp);
ldisplay(gtmp, 0);
fprintf(stdout, "should be: %s\n\n", output[num++]);
fflush (stdout);
gtmp = mkgroup();
// EMPTY list test
fprintf(stdout, "Test %d: Obtaining on empty group ...\n", testno++);
fprintf(stdout, " you have: ");
gtmp = lobtain(gtmp, <mp);
ldisplay(gtmp, 0);
fprintf(stdout, "should be: %s\n\n", output[num++]);
fflush (stdout);
// Building list
for (i = 0; i < 64; i++)
{
if ((i % 8) == 0)
{
if (i > 0)
{
gtmp = lappend(gtmp, gtmp -> last, ltmp);
if ((i / 8) == 1)
{
fprintf(stdout, "Test %d: Obtaining from one-list group ...\n", testno++);
fprintf(stdout, " you have: ");
ltmp = gtmp -> first;
gtmp = lobtain(gtmp, <mp);
displayf(ltmp, 0);
fprintf(stdout, "should be: %s\n\n", output[num++]);
fflush (stdout);
gtmp = lappend(gtmp, gtmp -> last, ltmp);
}
else if ((i / 8) == 2)
{
fprintf(stdout, "Test %d: Obtaining from two-list group (1/2) ...\n", testno++);
fprintf(stdout, " you have: ");
ltmp = gtmp -> first;
gtmp = lobtain(gtmp, <mp);
displayf(ltmp, 0);
fprintf(stdout, "should be: %s\n\n", output[num++]);
fflush (stdout);
// Verify list integrity
fprintf(stdout, "Test %d: Is last now first? ...\n", testno++);
fprintf(stdout, " you have: %p\n", gtmp -> last);
fprintf(stdout, "should be: %p\n\n", gtmp -> first);
fflush (stdout);
// Put list back into group
gtmp = linsert(gtmp, gtmp -> first, ltmp);
fprintf(stdout, "Test %d: Obtaining from two-list group (2/2) ...\n", testno++);
fprintf(stdout, " you have: ");
ltmp = gtmp -> last;
gtmp = lobtain(gtmp, <mp);
displayf(ltmp, 0);
fprintf(stdout, "should be: %s\n\n", output[num++]);
fflush (stdout);
// Verify list integrity
fprintf(stdout, "Test %d: Is first now last? ...\n", testno++);
fprintf(stdout, " you have: %p\n", gtmp -> first);
fprintf(stdout, "should be: %p\n\n", gtmp -> last);
fflush (stdout);
gtmp = lappend(gtmp, gtmp -> last, ltmp);
}
}
ltmp = mklist();
}
if ((i % 16) > 7)
ltmp = append(ltmp, ltmp -> last, mknode(i));
else
ltmp = insert(ltmp, ltmp -> last, mknode(i));
}
fprintf(stdout, "Displaying entire list group:\n");
ldisplay(gtmp, -1);
fprintf(stdout, "\n");
for (i = 0; i < 8; i++)
{
// Tag the list
ltmp = lsetpos(gtmp, i);
// Grab it from the group
gtmp = lobtain(gtmp, <mp);
// Tag the new list in its place
ltmp2 = lsetpos(gtmp, i);
fprintf(stdout, "Displaying entire list group:\n");
ldisplay(gtmp, -1);
fprintf(stdout, "\n");
fprintf(stdout, "Test %d: Checking group integrity (pos %d/7) ...\n", testno++, i);
fprintf(stdout, " you have: ");
displayf(ltmp, 0);
fprintf(stdout, "should be: %s\n\n", output[num++]);
fflush (stdout);
// Return list to group
gtmp = linsert(gtmp, ltmp2, ltmp);
}
return(0);
}
int main()
{
Group *myListGroup = NULL;
List *tmp = NULL;
List *tmp2 = NULL;
long int i = 0;
long int j = 0;
long int data[] = { 2, 3, 0, 1, 4, 0, 6, 1 };
long int order[] = { 2, 3, 0, 1, 4, 7, 6, 5, -3, 9 };
long int result = 0;
int testno = 0;
char *output[10];
output[i++] = "<2>: -> NULL";
output[i++] = "<3>: 7 -> NULL";
output[i++] = "<0>: 4 -> 6 -> NULL";
output[i++] = "<1>: 5 -> 7 -> 1 -> NULL";
output[i++] = "<4>: 8 -> 10 -> 4 -> 6 -> NULL";
output[i++] = "<7>: 11 -> NULL";
output[i++] = "<6>: 10 -> 12 -> 6 -> 8 -> 14 -> 6 -> NULL";
output[i++] = "<5>: -> NULL";
output[i++] = "<ERROR>";
output[i++] = "<ERROR>";
fprintf (stdout, "UNIT TEST: group library lsetpos() function\n");
fprintf (stdout, "===========================================\n");
fprintf (stdout, "Test %d: Processing on NULL group, NULL list ...\n", testno++);
result = lgetpos(myListGroup, tmp);
tmp2 = lsetpos(myListGroup, result);
fprintf (stdout, " you have: ");
displayf(tmp2, 0);
fprintf (stdout, "should be: NULL\n\n");
fflush (stdout);
tmp = mklist();
fprintf (stdout, "Test %d: Processing on NULL group, EMPTY list ...\n", testno++);
result = lgetpos(myListGroup, tmp);
tmp2 = lsetpos(myListGroup, result);
fprintf (stdout, " you have: ");
displayf(tmp2, 0);
fprintf (stdout, "should be: NULL\n\n");
fflush (stdout);
myListGroup = mkgroup();
fprintf (stdout, "Test %d: Processing on EMPTY group, NULL list ...\n", testno++);
result = lgetpos(myListGroup, NULL);
tmp2 = lsetpos(myListGroup, result);
fprintf (stdout, " you have: ");
displayf(tmp2, 0);
fprintf (stdout, "should be: NULL\n\n");
fflush (stdout);
fprintf (stdout, "Test %d: Processing on EMPTY group, EMPTY list ...\n", testno++);
result = lgetpos(myListGroup, tmp);
tmp2 = lsetpos(myListGroup, result);
fprintf (stdout, " you have: ");
displayf(tmp2, 0);
fprintf (stdout, "should be: NULL\n\n");
fflush (stdout);
if (myListGroup -> first == NULL)
{
myListGroup -> first = mklist();
myListGroup -> last = myListGroup -> first;
}
tmp = myListGroup -> first;
for (i = 0; i < 8; i++)
{
for (j = 0; j < data[i]; j++)
tmp = append(tmp, tmp -> last, mknode(data[j]*2+i));
if (i != 7)
{
myListGroup -> last -> after = mklist();
myListGroup -> last = myListGroup -> last -> after;
}
tmp = myListGroup -> last;
myListGroup -> last -> after = NULL;
}
result = ldisplay(myListGroup, -1);
tmp = myListGroup -> first;
for (i = 0; i < 10; i++)
{
fprintf (stdout, "Test %d: Testing lsetpos() [%ld/7] ...\n", testno++, i);
tmp2 = lsetpos(myListGroup, order[i]);
fprintf (stdout, " you have: ");
result = ldisplay(myListGroup, order[i]);
j = order[i];
fprintf (stdout, "should be: %s\n\n", output[i]);
fflush (stdout);
if (tmp != NULL)
tmp = tmp -> after;
}
return(0);
}
group* Carttype(matrix* m)
{ group* type=mkgroup(s=Ssrank(grp)); /* rank bounds number of components */
Closure(m,false,type); return type;
}
