64int CoCanonicalize(UBYTE *s)
66 WORD args[10], *a, num;
68 args[0] = TYPECANONICALIZE;
70 while ( *s ==
',' || *s ==
'\t' || *s ==
' ' ) s++;
71 t = s;
while ( FG.cTable[*s] == 0 ) s++;
73 if ( StrICmp(t,(UBYTE *)(
"topology")) == 0 ) {
75 while ( *s ==
',' || *s ==
'\t' || *s ==
' ' ) s++;
77 while ( *s ==
',' || *s ==
'\t' || *s ==
' ' ) s++;
78 s = GetFunction(s,a+1);
79 if ( *a == 0 || a[1] == 0 )
return(1);
82 else if ( StrICmp(t,(UBYTE *)(
"polynomial")) == 0 ) {
84 while ( *s ==
',' || *s ==
'\t' || *s ==
' ' ) s++;
89 MesPrint(
"&Canonicalize statement needs a $-variable for its input.");
92 s++; t = s;
while ( FG.cTable[*s] < 2 ) s++;
94 if ( GetName(AC.dollarnames,t,&num,NOAUTO) == CDOLLAR ) *a++ = num;
95 else { *a++ = AddDollar(t,DOLINDEX,&one,1); }
103 *a++ = DoTempSet(t,s);
106 else if ( FG.cTable[*s] == 0 || *s ==
'[' ) {
109 MesPrint(
"&Illegal name for set in Canonicalize statement: %s",t);
113 if ( GetName(AC.varnames,t,a,WITHAUTO) == CSET ) {
114 if ( Sets[*a].type != CSYMBOL ) {
115 MesPrint(
"&In Canonicalize: %s is not a set of symbols.",t);
120 MesPrint(
"&In Canonicalize: %s is not a set.",t);
125 else if ( *s ==
'$' ) {
126 s++; t = s;
while ( FG.cTable[*s] < 2 ) s++;
128 if ( GetName(AC.dollarnames,t,&num,NOAUTO) == CDOLLAR ) *a++ = -num-2;
130 MesPrint(
"&In Canonicalize: %s is undefined.",t-1);
136 MesPrint(
"&In Canonicalize: Illegal third(=set) argument.");
141 MesPrint(
"&Unrecognized option in Canonicalize statement: %s",t);
147 while ( *s ==
',' || *s ==
'\t' || *s ==
' ' ) s++;
149 MesPrint(
"&Canonicalize statement needs a $-variable for its output.");
152 s++; t = s;
while ( FG.cTable[*s] < 2 ) s++;
154 if ( GetName(AC.dollarnames,t,&num,NOAUTO) == CDOLLAR ) *a++ = num;
155 else { *a++ = AddDollar(t,DOLINDEX,&one,1); }
163 while ( *s ==
',' || *s ==
'\t' || *s ==
' ' ) s++;
166 if ( *a == -1 )
return(1);
167 while ( *s ==
',' || *s ==
'\t' || *s ==
' ' ) s++;
185int DoCanonicalize(PHEAD WORD *term, WORD *params)
192 for ( i = 0; i < params[1]; i++ ) args[i] = params[i];
193 if ( args[2] == 0 ) {
194 for ( i = 3; i < 5; i++ ) {
196 args[i] = DolToFunction(BHEAD -args[i]-2);
197 if ( args[i] == 0 ) {
198 MLOCK(ErrorMessageLock);
199 MesPrint(
"Value of $-variable in Canonicalize statement should be a function.");
200 MUNLOCK(ErrorMessageLock);
205 for ( i = 6; i < args[1]; i++ ) {
207 args[i] = DolToNumber(BHEAD -args[i]-2);
209 MLOCK(ErrorMessageLock);
210 MesPrint(
"Value of $-variable in Canonicalize statement should be a nonnegative number < %l.",(LONG)MAXPOSITIVE);
211 MUNLOCK(ErrorMessageLock);
218 WORD *tstop, *t, *tedge, *te;
219 tstop = term + *term; tstop -= ABS(tstop[-1]);
221 tedge = AT.WorkPointer; te = tedge+1;
222 while ( t < tstop ) {
223 if ( *t != args[3] && *t != args[4] ) { t += t[1];
continue; }
224 for ( i = 0; i < t[1]; i++ ) te[i] = t[i];
225 te += t[1]; t += t[1];
227 *te++ = 1; *te++ = 1; *te++ = 3;
233 AT.WorkPointer = tedge;
236 WORD *tstop, *t, *tedge, *te;
237 tstop = term + *term; tstop -= ABS(tstop[-1]);
239 tedge = AT.WorkPointer; te = tedge+1;
240 while ( t < tstop ) {
241 if ( *t != args[4] ) { t += t[1];
continue; }
242 for ( i = 0; i < t[1]; i++ ) te[i] = t[i];
243 te += t[1]; t += t[1];
245 *te++ = 1; *te++ = 1; *te++ = 3;
251 AT.WorkPointer = tedge;
254 DoTopologyCanonicalize(BHEAD term,args[3],args[4],args+5);
268 else if ( args[2] == 1 ) {
269 WORD *symlist, nsymlist;
270 for ( i = 6; i < args[1]; i++ ) {
272 args[i] = DolToNumber(BHEAD -args[i]-2);
274 MLOCK(ErrorMessageLock);
275 MesPrint(
"Value of $-variable in Canonicalize statement should be a nonnegative number < %l.",(LONG)MAXPOSITIVE);
276 MUNLOCK(ErrorMessageLock);
285 symlist = AT.WorkPointer;
286 if ( args[4] < -1 ) {
287 DOLLARS d = Dollars - args[4] - 2;
289 if ( d->type != DOLWILDARGS ) {
291 MLOCK(ErrorMessageLock);
292 MesPrint(
"Value of $-variable in Canonicalize statement should be a argument wildcard of symbol arguments.");
293 MUNLOCK(ErrorMessageLock);
296 insym = symlist; ds = d->where+1;
298 if ( *ds != -SYMBOL )
goto NoWildArg;
302 nsymlist = insym-symlist;
306 ss = (WORD *)(AC.SetElementList.lijst)+Sets[args[4]].first;
307 nsymlist = n = Sets[args[4]].last-Sets[args[4]].first;
308 sy = symlist = AT.WorkPointer;
311 AT.WorkPointer = symlist+nsymlist;
324 AT.WorkPointer = symlist;
346int DoTopologyCanonicalize(PHEAD WORD *term,WORD vert,WORD edge,WORD *args)
348 int nvert = 0, nvert2, i, ii, jj, flipnames = 0, nparts;
349 WORD *tstop, *t, *tt, *tend, *td;
350 WORD *oldworkpointer = AT.WorkPointer;
351 WORD *termcopy = TermMalloc(
"TopologyCanonize1");
352 WORD *vet= TermMalloc(
"TopologyCanonize2");
353 WORD *partition, *environ, *connect, *pparts, *p;
357 WORD momenta[150],flips[50],nmomenta = 0, nflips = 0;
363 if ( args[0] < args[1] ) { flipnames = 1; }
364 tend = term + *term; tend -= ABS(tend[-1]); t = term+1; tt = termcopy+1;
367 for ( i = FUNHEAD; i < t[1]; i += 2 ) {
368 if ( t[i] == -VECTOR || ( t[i] == -INDEX && t[i+1] < 0 ) ) {
369 momenta[nmomenta++] = -VECTOR;
370 momenta[nmomenta++] = t[i+1];
372 else if ( t[i] == -MINVECTOR ) {
373 momenta[nmomenta++] = -MINVECTOR;
374 momenta[nmomenta++] = t[i+1];
376 else goto notgoodvertex;
377 momenta[nmomenta++] = nvert;
379 ii = FUNHEAD; i = t[1]-FUNHEAD;
381 if ( flipnames ) tt[-FUNHEAD] = edge;
383 *tt++ = -CNUMBER; *tt++ = nvert++;
385 else if ( *t == edge && flipnames ) {
386 i = t[1] - 1; *tt++ = vert; t++;
394 while ( t < tend ) *tt++ = *t++;
395 termcopy[0] = tt - termcopy;
396 if ( flipnames ) EXCH(edge,vert)
397 nvert2 = nvert*nvert;
401 for ( i = 0; i < nmomenta-3; i+=3 ) {
403 while ( jj >= 0 && momenta[jj+4] > momenta[jj+1] ) {
404 EXCH(momenta[jj+5],momenta[jj+2])
405 EXCH(momenta[jj+4],momenta[jj+1])
406 EXCH(momenta[jj+3],momenta[jj])
414 for ( i = 0; i < nmomenta; i += 6 ) {
415 if ( momenta[i] == -VECTOR && momenta[i+3] == -MINVECTOR
416 && momenta[i+1] == momenta[i+4] ) {
418 else if ( momenta[i] == -MINVECTOR && momenta[i+3] == -VECTOR
419 && momenta[i+1] == momenta[i+4] ) {
420 flips[nflips++] = momenta[i+1];
421 DUMMYUSE(flips[nflips-1]);
424 MLOCK(ErrorMessageLock);
425 MesPrint(
"No momentum conservation or wrong momenta in Canonicalize statement");
426 MUNLOCK(ErrorMessageLock);
429 *t++ = EDGE; *t++ = FUNHEAD+10; FILLFUN(t)
430 *t++ = -SNUMBER; *t++ = momenta[i+2];
431 *t++ = -SNUMBER; *t++ = momenta[i+5];
432 *t++ = -VECTOR; *t++ = momenta[i+1];
433 *t++ = -SNUMBER; *t++ = 0;
434 *t++ = -SNUMBER; *t++ = 0;
437 *t++ = 1; *t++ = 1; *t++ = 3; vet[0] = t-vet; *t = 0;
441 tstop = termcopy+*termcopy; tstop -= ABS(tstop[-1]); td = termcopy+1;
442 while ( td < tstop ) {
443 if ( *td == edge && td[1] == FUNHEAD+4 ) {
444 if ( td[FUNHEAD+2] == -SNUMBER && ( td[FUNHEAD] == -VECTOR || td[FUNHEAD] == -INDEX
445 || td[FUNHEAD] == -MINVECTOR ) ) {}
447 MLOCK(ErrorMessageLock);
448 MesPrint(
"Illegal argument in edge function in Canonicalize statement");
449 MUNLOCK(ErrorMessageLock);
453 while ( tt < tend ) {
454 if ( tt[FUNHEAD+5] == td[FUNHEAD+1] ) { tt[FUNHEAD+7] = td[FUNHEAD+3];
break; }
458 else if ( *td == DOTPRODUCT )
break;
463 while ( tt < tend ) {
467 for ( i = 2; i < td[1]; i += 3 ) {
468 if ( td[i] == tt[FUNHEAD+5] && td[i+1] == tt[FUNHEAD+5] ) {
469 tt[FUNHEAD+9] = td[i+2];
476 Normalize(BHEAD vet);
489 partition = AT.WorkPointer; AT.WorkPointer += 2*nvert2;
490 for ( i = 0; i < nvert; i++ ) { partition[2*i] = i; partition[2*i+1] = 0; }
491 partition[2*i-1] = -1;
494 connect = AT.WorkPointer; AT.WorkPointer += nvert2;
495 for ( i = 0; i < nvert2; i++ ) connect[i] = 0;
496 tstop = vet+*vet; tstop -= ABS(tstop[-1]); t = vet+1;
497 while ( t < tstop ) {
499 connect[t[FUNHEAD+1]*nvert+t[FUNHEAD+3]]++;
500 connect[t[FUNHEAD+3]*nvert+t[FUNHEAD+1]]++;
504for ( i = 0; i < nvert; i++ ) {
505MesPrint(
"connectivity: %d -- %a",i,nvert,connect+i*nvert);
510 environ = AT.WorkPointer; AT.WorkPointer += nvert2;
514 WantAddPointers(nvert+1);
515 for ( i = 0; i < nvert2; i++ ) environ[i] = 0;
518 while ( nparts < nvert ) {
519 nparts = DoShattering(BHEAD connect,environ,pparts,nvert);
520 if ( nparts < nvert ) {
521 p = pparts + 2*nvert;
523 for ( i = 0; i < 2*nvert; i++ ) p[i] = pparts[i];
524 for ( ii = 0; ii < 2*nvert; ii += 2 ) {
525 if ( p[ii+1] == 0 ) {
527 while ( p[i+1] == 0 ) { i += 2; }
528 p[ii+1] = -1; pparts = p;
535MesPrint(
"partition: %d -- %a",nparts,2*nvert,pparts);
541 PutTermInDollar(vet,args[0]);
544 TermFree(vet,
"TopologyCanonize2");
545 TermFree(termcopy,
"TopologyCanonize1");
546 AT.WorkPointer = oldworkpointer;
555int DoShattering(PHEAD WORD *connect, WORD *environ, WORD *partitions, WORD nvert)
557 int nparts, i, j, ii, jj, iii, jjj, newmarker;
558 WORD **p = AT.pWorkSpace + AT.pWorkPointer, *part, *endpart;
561MesPrint(
"Entering DoShattering. partitions = %a",2*nvert,partitions);
571 nparts = 0; newmarker = 0;
572 part = partitions; endpart = part + 2*nvert;
574 while ( part < endpart ) {
575 if ( part[1] != 0 ) { p[++nparts] = part+2; }
578 for ( i = 0; i < nparts; i++ )
579 AT.WorkPointer[i] = (p[i+1]-p[i])/2;
581MesPrint(
"DoShattering: calculated the pointers");
582MesPrint(
"DoShattering: sizes: %a",nparts,AT.WorkPointer);
583MesPrint(
"DoShattering: p[0]: %a, p[1]: %a",6,p[0],6,p[1]);
585 for ( i = 0; i < nparts; i++ ) {
586 if ( AT.WorkPointer[i] > 1 ) {
587 for ( j = 0; j < nparts; j++ ) {
592 for ( ii = 0; ii < AT.WorkPointer[i]; ii++ ) {
593 for ( jj = 0; jj < AT.WorkPointer[j]; jj++ ) {
594 environ[ii*AT.WorkPointer[j]+jj] += connect[p[i][2*ii]*nvert+p[j][2*jj]];
598for ( ii = 0; ii < AT.WorkPointer[i]; ii++ ) {
599MesPrint(
"Environ(%d,%d): %a",i,j,AT.WorkPointer[j],environ+ii*AT.WorkPointer[j]);
607 for ( ii = 0; ii < nvert; ii++ ) {
608 poin1 = environ+ii*AT.WorkPointer[j];
609 for ( jj = 0; jj < AT.WorkPointer[j]-1; jj++ ) {
611 while ( jjj >= 0 && poin1[jjj+1] > poin1[jjj] ) {
612 EXCH(poin1[jjj+1],poin1[jjj])
618for ( ii = 0; ii < AT.WorkPointer[i]; ii++ ) {
619MesPrint(
"environ(%d,%d): %a",i,j,AT.WorkPointer[j],environ+ii*AT.WorkPointer[j]);
622 for ( ii = 0; ii < AT.WorkPointer[i]-1; ii++ ) {
623 poin2 = environ+ii*AT.WorkPointer[j]; poin1 = poin2+AT.WorkPointer[j];
625 while ( iii >= 0 && ( CmpArray(poin1,poin2,AT.WorkPointer[j]) < 0 ) ) {
626 EXCHN(poin2,poin1,AT.WorkPointer[j])
627 EXCH(p[i][2*iii+2],p[i][2*iii])
628 iii--; poin1 = poin2; poin2 = poin1-AT.WorkPointer[j];
632for ( ii = 0; ii < AT.WorkPointer[i]; ii++ ) {
633MesPrint(
"environ(%d,%d): %a",i,j,AT.WorkPointer[j],environ+ii*AT.WorkPointer[j]);
635MesPrint(
"partitions = %a",2*nvert,partitions);
637 for ( ii = 0; ii < AT.WorkPointer[i]-1; ii++ ) {
638 poin2 = environ+ii*AT.WorkPointer[j]; poin1 = poin2+AT.WorkPointer[j];
639 if ( CmpArray(poin1,poin2,AT.WorkPointer[j]) == 0 )
continue;
640 p[i][2*ii+1] = -1; nparts++; newmarker++;
643MesPrint(
"partitions = %a",2*nvert,partitions);
649 for ( ii = 0; ii < AT.WorkPointer[i]; ii++ ) {
650 for ( jj = 0; jj < AT.WorkPointer[j]; jj++ ) {
651 environ[ii*AT.WorkPointer[j]+jj] = 0;
654 if ( newmarker ) {
goto restart; }
UBYTE * SkipAName(UBYTE *s)