0 value m1' 0 value m2' 0 value m3'
0 value j1' 0 value j2' 0 value j3'
#10000000 VALUE #times
synonym not 0=
2 0 +field 2+ drop
: CTR0 ( -- flag )
m1' abs j1' > \ j1 >= |m1| >= 0
m2' abs j2' > or \ and j2 >= |m2| >= 0
m3' abs j3' > or \ and j3 >= |m3| >= 0
j1' j2' + j3' + 1 and or \ and j1+j2+j3 is an integer
m1' m2' + m3' + or \ and m1+m2+m3 = 0
j1' j2' - m3' - 1 and or \ and j1-j2-m3 is an integer
j1' j2' + j3' < or \ and j1+j2 >= j3
j2' j3' + j1' < or \ and j2+j3 >= j1
j3' j1' + j2' < or not \ and j3+j1 >= j2
;
: CTR1 ( -- flag )
m1' abs j1' <= \ j1 >= |m1| >= 0
m2' abs j2' <= and \ and j2 >= |m2| >= 0
m3' abs j3' <= and \ and j3 >= |m3| >= 0
j1' j2' + j3' + 1 and 0= and \ and j1+j2+j3 is an integer
m1' m2' + m3' + 0= and \ and m1+m2+m3 = 0
j1' j2' - m3' - 1 and 0= and \ and j1-j2-m3 is an integer
j1' j2' + j3' >= and \ and j1+j2 >= j3
j2' j3' + j1' >= and \ and j2+j3 >= j1
j3' j1' + j2' >= and \ and j3+j1 >= j2
;
: even? 1 and ; immediate
: && postpone 0= postpone if
postpone 0= postpone exit
postpone then ; immediate
: CTR2 ( -- flag )
true
m1' abs j1' <= && \ j1 >= |m1| >= 0
m2' abs j2' <= && \ and j2 >= |m2| >= 0
m3' abs j3' <= && \ and j3 >= |m3| >= 0
j1' j2' + j3' + 1 and 0= && \ and j1+j2+j3 is an integer
m1' m2' + m3' + 0= && \ and m1+m2+m3 = 0
j1' j2' - m3' - 1 and 0= && \ and j1-j2-m3 is an integer
j1' j2' + j3' >= && \ and j1+j2 >= j3
j2' j3' + j1' >= && \ and j2+j3 >= j1
j3' j1' + j2' >= && \ and j3+j1 >= j2
;
variable allowed
variable not_allowed
defer check-triangle-relations
: couplings ( j1' j2' -- )
to j2' to j1'
0 allowed ! 0 not_allowed !
j1' 2+ j1' negate DO \ loop over m1'
I to m1'
j2' 2+ j2' negate DO \ loop over m2'
I to m2'
j1' j2' + 2+ j1' j2' - abs DO \ loop over j3'
I to j3'
m1' abs m2' abs + dup 2+ swap negate DO \ loop over m3'
I to m3'
check-triangle-relations IF
1 allowed +!
ELSE
1 not_allowed +!
THEN
2 +loop
2 +loop
2 +loop
2 +loop ;
: bench ( xt -- )
is check-triangle-relations
10000 0 do 10 5 couplings loop ;