64 int 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 ==
'[' ) {
108 if ( ( s = SkipAName(s) ) == 0 ) {
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++;
185 int 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;
348 WORD GenTopologies(PHEAD WORD *term,WORD level)
350 WORD *t1, *tt1, *tstop, *t, *tt;
351 WORD *oldworkpointer = AT.WorkPointer;
352 WORD option1 = 0, option2 = 0, setoption = -1;
359 tstop = term+*term; tstop -= ABS(tstop[-1]);
361 while ( tt < tstop ) {
363 if ( *t != TOPOLOGIES )
continue;
364 tt = t + t[1]; t1 = t + FUNHEAD;
365 if ( t1+10 > tt || *t1 != -SNUMBER || t1[1] < 0 ||
366 t1[2] != -SNUMBER || ( t1[3] < 0 && t1[3] != -2 ) ||
367 t1[4] != -SETSET || Sets[t1[5]].type != CNUMBER ||
368 t1[6] != -SETSET || Sets[t1[7]].type != CVECTOR ||
369 t1[8] != -SETSET || Sets[t1[9]].type != CVECTOR )
continue;
371 if ( tt1+2 <= tt && tt1[0] == -SETSET ) {
372 if ( Sets[t1[5]].last-Sets[t1[5]].first !=
373 Sets[tt1[1]].last-Sets[tt1[1]].first )
continue;
374 setoption = tt1[1]; tt1 += 2;
376 if ( tt1+2 <= tt && tt1[0] == -SNUMBER ) { option1 = tt1[1]; tt1 += 2; }
377 if ( tt1+2 <= tt && tt1[0] == -SNUMBER ) { option2 = tt1[1]; tt1 += 2; }
378 AT.setinterntopo = t1[9];
379 AT.setexterntopo = t1[7];
380 AT.TopologiesTerm = term;
381 AT.TopologiesStart = t;
382 AT.TopologiesLevel = level;
383 AT.TopologiesOptions[0] = option1;
384 AT.TopologiesOptions[1] = option2;
385 retval = GenerateTopologies(BHEAD t1[1],t1[3],t1[5],setoption);
386 AT.WorkPointer = oldworkpointer;
389 MLOCK(ErrorMessageLock);
390 MesPrint(
"Internal error: topologies_ function not encountered.");
391 MUNLOCK(ErrorMessageLock);
401 WORD GenDiagrams(PHEAD WORD *term,WORD level)
428 int DoTopologyCanonicalize(PHEAD WORD *term,WORD vert,WORD edge,WORD *args)
430 int nvert = 0, nvert2, i, ii, jj, flipnames = 0, nparts, level, num;
431 WORD *tstop, *t, *tt, *tend, *td;
432 WORD *oldworkpointer = AT.WorkPointer;
433 WORD *termcopy = TermMalloc(
"TopologyCanonize1");
434 WORD *vet= TermMalloc(
"TopologyCanonize2");
435 WORD *partition, *environ, *connect, *pparts, *p;
439 WORD momenta[150],flips[50],nmomenta = 0, nflips = 0;
445 if ( args[0] < args[1] ) { flipnames = 1; }
446 tend = term + *term; tend -= ABS(tend[-1]); t = term+1; tt = termcopy+1;
449 for ( i = FUNHEAD; i < t[1]; i += 2 ) {
450 if ( t[i] == -VECTOR || ( t[i] == -INDEX && t[i+1] < 0 ) ) {
451 momenta[nmomenta++] = -VECTOR;
452 momenta[nmomenta++] = t[i+1];
454 else if ( t[i] == -MINVECTOR ) {
455 momenta[nmomenta++] = -MINVECTOR;
456 momenta[nmomenta++] = t[i+1];
458 else goto notgoodvertex;
459 momenta[nmomenta++] = nvert;
461 ii = FUNHEAD; i = t[1]-FUNHEAD;
463 if ( flipnames ) tt[-FUNHEAD] = edge;
465 *tt++ = -CNUMBER; *tt++ = nvert++;
467 else if ( *t == edge && flipnames ) {
468 i = t[1] - 1; *tt++ = vert; t++;
476 while ( t < tend ) *tt++ = *t++;
477 termcopy[0] = tt - termcopy;
478 if ( flipnames ) EXCH(edge,vert)
479 nvert2 = nvert*nvert;
483 for ( i = 0; i < nmomenta-3; i+=3 ) {
485 while ( jj >= 0 && momenta[jj+4] > momenta[jj+1] ) {
486 EXCH(momenta[jj+5],momenta[jj+2])
487 EXCH(momenta[jj+4],momenta[jj+1])
488 EXCH(momenta[jj+3],momenta[jj])
496 for ( i = 0; i < nmomenta; i += 6 ) {
497 if ( momenta[i] == -VECTOR && momenta[i+3] == -MINVECTOR
498 && momenta[i+1] == momenta[i+4] ) {
500 else if ( momenta[i] == -MINVECTOR && momenta[i+3] == -VECTOR
501 && momenta[i+1] == momenta[i+4] ) {
502 flips[nflips++] = momenta[i+1];
503 DUMMYUSE(flips[nflips-1]);
506 MLOCK(ErrorMessageLock);
507 MesPrint(
"No momentum conservation or wrong momenta in Canonicalize statement");
508 MUNLOCK(ErrorMessageLock);
511 *t++ = EDGE; *t++ = FUNHEAD+10; FILLFUN(t)
512 *t++ = -SNUMBER; *t++ = momenta[i+2];
513 *t++ = -SNUMBER; *t++ = momenta[i+5];
514 *t++ = -VECTOR; *t++ = momenta[i+1];
515 *t++ = -SNUMBER; *t++ = 0;
516 *t++ = -SNUMBER; *t++ = 0;
519 *t++ = 1; *t++ = 1; *t++ = 3; vet[0] = t-vet; *t = 0;
523 tstop = termcopy+*termcopy; tstop -= ABS(tstop[-1]); td = termcopy+1;
524 while ( td < tstop ) {
525 if ( *td == edge && td[1] == FUNHEAD+4 ) {
526 if ( td[FUNHEAD+2] == -SNUMBER && ( td[FUNHEAD] == -VECTOR || td[FUNHEAD] == -INDEX
527 || td[FUNHEAD] == -MINVECTOR ) ) {}
529 MLOCK(ErrorMessageLock);
530 MesPrint(
"Illegal argument in edge function in Canonicalize statement");
531 MUNLOCK(ErrorMessageLock);
535 while ( tt < tend ) {
536 if ( tt[FUNHEAD+5] == td[FUNHEAD+1] ) { tt[FUNHEAD+7] = td[FUNHEAD+3];
break; }
540 else if ( *td == DOTPRODUCT )
break;
545 while ( tt < tend ) {
549 for ( i = 2; i < td[1]; i += 3 ) {
550 if ( td[i] == tt[FUNHEAD+5] && td[i+1] == tt[FUNHEAD+5] ) {
551 tt[FUNHEAD+9] = td[i+2];
558 Normalize(BHEAD vet);
571 partition = AT.WorkPointer; AT.WorkPointer += 2*nvert2;
572 for ( i = 0; i < nvert; i++ ) { partition[2*i] = i; partition[2*i+1] = 0; }
573 partition[2*i-1] = -1;
576 connect = AT.WorkPointer; AT.WorkPointer += nvert2;
577 for ( i = 0; i < nvert2; i++ ) connect[i] = 0;
578 tstop = vet+*vet; tstop -= ABS(tstop[-1]); t = vet+1;
579 while ( t < tstop ) {
581 connect[t[FUNHEAD+1]*nvert+t[FUNHEAD+3]]++;
582 connect[t[FUNHEAD+3]*nvert+t[FUNHEAD+1]]++;
586 for ( i = 0; i < nvert; i++ ) {
587 MesPrint(
"connectivity: %d -- %a",i,nvert,connect+i*nvert);
592 environ = AT.WorkPointer; AT.WorkPointer += nvert2;
596 WantAddPointers(nvert+1);
597 for ( i = 0; i < nvert2; i++ ) environ[i] = 0;
600 while ( nparts < nvert ) {
601 nparts = DoShattering(BHEAD connect,environ,pparts,nvert);
602 if ( nparts < nvert ) {
603 p = pparts + 2*nvert;
605 for ( i = 0; i < 2*nvert; i++ ) p[i] = pparts[i];
606 for ( ii = 0; ii < 2*nvert; ii += 2 ) {
607 if ( p[ii+1] == 0 ) {
609 while ( p[i+1] == 0 ) { num++; i += 2; }
612 p[ii+1] = -1; pparts = p;
619 MesPrint(
"partition: %d -- %a",nparts,2*nvert,pparts);
625 PutTermInDollar(vet,args[0]);
628 TermFree(vet,
"TopologyCanonize2");
629 TermFree(termcopy,
"TopologyCanonize1");
630 AT.WorkPointer = oldworkpointer;
639 int DoShattering(PHEAD WORD *connect, WORD *environ, WORD *partitions, WORD nvert)
641 int nparts, i, j, ii, jj, iii, jjj, newmarker;
642 WORD **p = AT.pWorkSpace + AT.pWorkPointer, *part, *endpart;
645 MesPrint(
"Entering DoShattering. partitions = %a",2*nvert,partitions);
655 nparts = 0; newmarker = 0;
656 part = partitions; endpart = part + 2*nvert;
658 while ( part < endpart ) {
659 if ( part[1] != 0 ) { p[++nparts] = part+2; }
662 for ( i = 0; i < nparts; i++ )
663 AT.WorkPointer[i] = (p[i+1]-p[i])/2;
665 MesPrint(
"DoShattering: calculated the pointers");
666 MesPrint(
"DoShattering: sizes: %a",nparts,AT.WorkPointer);
667 MesPrint(
"DoShattering: p[0]: %a, p[1]: %a",6,p[0],6,p[1]);
669 for ( i = 0; i < nparts; i++ ) {
670 if ( AT.WorkPointer[i] > 1 ) {
671 for ( j = 0; j < nparts; j++ ) {
676 for ( ii = 0; ii < AT.WorkPointer[i]; ii++ ) {
677 for ( jj = 0; jj < AT.WorkPointer[j]; jj++ ) {
678 environ[ii*AT.WorkPointer[j]+jj] += connect[p[i][2*ii]*nvert+p[j][2*jj]];
682 for ( ii = 0; ii < AT.WorkPointer[i]; ii++ ) {
683 MesPrint(
"Environ(%d,%d): %a",i,j,AT.WorkPointer[j],environ+ii*AT.WorkPointer[j]);
691 for ( ii = 0; ii < nvert; ii++ ) {
692 poin1 = environ+ii*AT.WorkPointer[j];
693 for ( jj = 0; jj < AT.WorkPointer[j]-1; jj++ ) {
695 while ( jjj >= 0 && poin1[jjj+1] > poin1[jjj] ) {
696 EXCH(poin1[jjj+1],poin1[jjj])
702 for ( ii = 0; ii < AT.WorkPointer[i]; ii++ ) {
703 MesPrint(
"environ(%d,%d): %a",i,j,AT.WorkPointer[j],environ+ii*AT.WorkPointer[j]);
706 for ( ii = 0; ii < AT.WorkPointer[i]-1; ii++ ) {
707 poin2 = environ+ii*AT.WorkPointer[j]; poin1 = poin2+AT.WorkPointer[j];
709 while ( iii >= 0 && ( CmpArray(poin1,poin2,AT.WorkPointer[j]) < 0 ) ) {
710 EXCHN(poin2,poin1,AT.WorkPointer[j])
711 EXCH(p[i][2*iii+2],p[i][2*iii])
712 iii--; poin1 = poin2; poin2 = poin1-AT.WorkPointer[j];
716 for ( ii = 0; ii < AT.WorkPointer[i]; ii++ ) {
717 MesPrint(
"environ(%d,%d): %a",i,j,AT.WorkPointer[j],environ+ii*AT.WorkPointer[j]);
719 MesPrint(
"partitions = %a",2*nvert,partitions);
721 for ( ii = 0; ii < AT.WorkPointer[i]-1; ii++ ) {
722 poin2 = environ+ii*AT.WorkPointer[j]; poin1 = poin2+AT.WorkPointer[j];
723 if ( CmpArray(poin1,poin2,AT.WorkPointer[j]) == 0 )
continue;
724 p[i][2*ii+1] = -1; nparts++; newmarker++;
727 MesPrint(
"partitions = %a",2*nvert,partitions);
733 for ( ii = 0; ii < AT.WorkPointer[i]; ii++ ) {
734 for ( jj = 0; jj < AT.WorkPointer[j]; jj++ ) {
735 environ[ii*AT.WorkPointer[j]+jj] = 0;
738 if ( newmarker ) {
goto restart; }