{VERSION 3 0 "APPLE_PPC_MAC" "3.0" }
{USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 0 1 255 0 0 1 0 1 0 0 
1 0 0 0 0 }{PSTYLE "Normal" -1 0 1 {CSTYLE "" -1 -1 "" 0 1 0 0 0 0 0 
0 0 0 0 0 0 0 0 }0 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "Text Output
" -1 2 1 {CSTYLE "" -1 -1 "Courier" 1 10 0 0 255 1 0 0 0 0 0 1 3 0 3 }
1 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }{PSTYLE "Warning" 2 7 1 {CSTYLE "" 
-1 -1 "" 0 1 0 0 255 1 0 0 0 0 0 0 1 0 0 }0 0 0 -1 -1 -1 0 0 0 0 0 0 
-1 0 }}
{SECT 0 {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 5881 "grovedraw:= proc(n
) local p,q,r, cord, m, i,j,k, gdata,trans;\n#draws a random grove on \+
standard initial conditions of order n\n\ngdata:=proc(n) local gpluson
e;\n#n is an integer >=2 gdata encodes standard groves of order n in a
n upper triangular (2k-1) by (2k-1) matrix.\n\ngplusone:= proc(l,n) lo
cal m,j,i,ii,jj,kk,x,y,flip,r;\n#takes an array encoding of triangles \+
of type s,t and generates a bigger array of #triangles of type s,t.  T
he array l has k^2 nonempty terms where k is the order of #the grove.
\n\nflip:=proc(t) local r;\n#changes downward triangle t into upward t
riangle s of the proper type\nr:=rand(1..3);\nif t = 1 then 14+r(); \n
elif member(t, \{5,6,7\}) then 11;\nelif member(t, \{2,3,4\}) then t+1
0;\nelse 0\nfi;\nend;\n\nif n = 1 then\nr:=rand(1..3);\n\nfirstrand:=p
roc(k) local l;\nif k = 1 then l:=array(1..3,1..3,[[4,0,1],[0,16,0],[0
,0,2]])\nelif k =2 then l:=array(1..3,1..3,[[1,0,3],[0,15,0],[0,0,2]])
\nelse l:=array(1..3,1..3,[[4,0,3],[0,17,0],[0,0,1]])\nfi;\nend;\n\nm:
=firstrand(r());\n\nfi;\n\nif n > 2 then\n\nm:= array(1..(n+2),1..(n+2
));\n\nfor i from 1 to n+2 do\nfor j from 1 to n+2 do\nm[i,j] := 0;\no
d;\nod;\n\nfor i from 1 to (n+1)/2 do\nfor j from i to (n+1)/2 do\nm[2
*i,2*j]:=flip(l[2*i-1,2*j-1]);\nod;\nod;\n\nif member(m[2,2], \{14,16,
17\}) then m[1,1]:=4\n else m[1,1] := 1 fi;\n\nif member( m[2,n+1], \{
13,15,17\}) then m[1,n+2] := 3\n else m[1,n+2] := 1 fi;\n\nif member( \+
m[n+1,n+1], \{12,15,16\}) then m[n+2,n+2] := 2 \nelse m[n+2,n+2] := 1 \+
fi;\n\n#this loop does the top row minus ends\nfor ii from 1 to (n-1)/
2 do\nif member( m[2,2*ii], \{11,12,14,16\}) and \n member( m[2,2*ii+2
], \{14,16,17\}) then m[1,2*ii+1] := 4\nelif member( m[2,2*ii], \{11,1
2,14,16\}) and member( m[2,2*ii+2], \{11,13,12,15\}) then m[1,2*ii +1]
 := 1\nelif member( m[2,2*ii], \{13,15,17\}) and member( m[2,2*ii + 2]
, \{14,16,17\}) then m[1,2*ii+1] := 7\nelse m[1,2*ii +1] := 3\nfi; \no
d;\n\n#this does the diagonal minus ends\nfor jj from 1 to (n-1)/2 do
\nif member( m[2*jj,2*jj], \{11,13,14,17\}) and\nmember( m[2*jj +2, 2*
jj+2], \{14,16,17\}) then m[2*jj+1,2*jj+1] := 4\nelif member( m[2*jj,2
*jj], \{11,13,14,17\}) and member( m[2*jj+2,2*jj+2], \{11,13,12,15\}) \+
then m[2*jj+1, 2*jj+1] := 1\nelif member( m[2*jj,2*jj], \{12,15,16\}) \+
and member( m[2*jj+2,2*jj+2], \{14,16,17\}) then m[2*jj+1,2*jj+1] := 6
\nelse m[2*jj+1,2*jj+1] := 2\nfi;\nod;\n\n#this does the right side mi
nus ends\nfor kk from 1 to (n-1)/2 do\nif member( m[2*kk,n+1], \{11,13
,14,17\}) and\nmember( m[2*kk +2, n+1], \{13,15,17\}) then m[2*kk+1,n+
2] := 3\nelif member( m[2*kk,n+1], \{11,13,14,17\}) and member( m[2*kk
+2,n+1], \{11,12,14,16\}) then m[2*kk+1, n+2] := 1\nelif member( m[2*k
k,n+1], \{12,15,16\}) and member( m[2*kk+2,n+1], \{15,13,17\}) then m[
2*kk+1,n+2] := 5\nelse m[2*kk+1,n+2] := 2\nfi;\nod;\n\nfi;\n\n#this do
es the interior\nif n > 3 then\nfor x from 1 to (n-3)/2 do\n for y fro
m x+1 to (n-1)/2 do\nif member( m[2*x,2*y], \{11,13,14,17\}) and\n mem
ber( m[2*x+2, 2*y], \{11,14,12,16\}) and \n member( m[2*x+2,2*y+2], \{
11,12,13,15\}) then m[2*x+1,2*y+1] := 1\nelif member( m[2*x,2*y], \{11
,13,14,17\}) and\n member( m[2*x+2, 2*y], \{11,14,12,16\}) and \n memb
er( m[2*x+2,2*y+2], \{14,16,17\}) then m[2*x+1,2*y+1] := 4\nelif membe
r( m[2*x,2*y], \{11,13,14,17\}) and\n member( m[2*x+2, 2*y], \{17,15,1
3\}) and \n member( m[2*x+2,2*y+2], \{16,17,14\}) then m[2*x+1,2*y+1] \+
:= 7\nelif member( m[2*x,2*y], \{11,13,14,17\}) and\n member( m[2*x+2,
 2*y], \{13,15,17\}) and \n member( m[2*x+2,2*y+2], \{11,12,13,15\}) t
hen m[2*x+1,2*y+1] := 3\nelif member( m[2*x,2*y], \{12,15,16\}) and\n \+
member( m[2*x+2, 2*y], \{13,15,17\}) and \n member( m[2*x+2,2*y+2], \{
11,12,13,15\}) then m[2*x+1,2*y+1] := 5\nelif member( m[2*x,2*y], \{12
,15,16\}) and\n member( m[2*x+2, 2*y], \{11,14,12,16\}) and \n member(
 m[2*x+2,2*y+2], \{14,16,17\}) then m[2*x+1, 2*y+1] := 6\nelse m[2*x+1
,2*y+1] := 2\nfi;\nod;\nod;\nfi;\n\nm;\nend;\n\nif n = 2 then gplusone
([1],1)\nelse gplusone(gdata(n-1),2*n-3)\nfi;\nend;\n\ncord:=proc(x,y,
st);\n#cord gets coordinates for the corners of a triangle centered at
 x,y of type s or t \nif st = t then\n[[x-1/2,y+1/(2*sqrt(3))],[x+1/2,
y+1/(2*sqrt(3))],[x,y-1/sqrt(3)]];\nelse [[x-1/2,y-1/(2*sqrt(3))],[x+1
/2,y-1/(2*sqrt(3))],[x,y+1/sqrt(3)]];\nfi;\nend;\n\nm:=gdata(n);\n\ntr
ans:=proc(i,j);\n#transforms the ij th entry into x,y coordinates (for
 t type only)\n(j-.5*i, 1-1/(2*sqrt(3))-(sqrt(3)/2)*(i-1) )\nend;\n\nt
rans1:=proc(i,j);\n#transforms the ij th entry into x,y coordinates (f
or s type only)\n(j-.5*i+.5, 1-1/sqrt(3)-(sqrt(3)/2)*(i-1) )\nend;\n\n
#need to send all the 4,14 entries to p.i, all the 3,13 entries to q.i
, and all the 2,12 entries to r.i\n\nk:=0:\nl:=0:\nll:=0:\nkk:=0:\nlll
:=0:\nllll:=0:\n\nfor i from 1 to n do\nfor j from i to n do\nif m[2*i
-1,2*j-1] = 4 then k:=k+1: p.k := evalf(cord(trans(i,j),t));\nelif m[2
*i-1,2*j-1] = 3 then l:=l+1: q.l := evalf(cord(trans(i,j),t));\nelif m
[2*i-1,2*j-1] = 2 then ll:= ll+1: r.ll := evalf(cord(trans(i,j),t));\n
elif m[2*i-1,2*j-1] = 7 then kk:= kk+1: pq.kk := evalf(cord(trans(i,j)
,t));\nelif m[2*i-1,2*j-1] = 6 then lll:= lll+1: pr.lll := evalf(cord(
trans(i,j),t));\nelif m[2*i-1,2*j-1] = 5 then llll:= llll+1: qr.llll :
= evalf(cord(trans(i,j),t));\nfi;\nod;\nod; \n\nfor i from 1 to n-1 do
\nfor j from i to n-1 do\n\nif m[2*i,2*j] = 14 then k:=k+1: p.k:=evalf
(cord(trans1(i,j),s));\nelif m[2*i,2*j] = 13 then l:=l+1: q.l := evalf
(cord(trans1(i,j),s));\nelif m[2*i,2*j] = 12 then ll:=ll+1: r.ll := ev
alf(cord(trans1(i,j),s));\nelif m[2*i,2*j] = 17 then kk:=kk+1: pq.kk :
= evalf(cord(trans1(i,j),s));\nelif m[2*i,2*j] = 16 then lll:=lll+1: p
r.lll := evalf(cord(trans1(i,j),s));\nelif m[2*i,2*j] = 15 then llll:=
llll+1: qr.llll := evalf(cord(trans1(i,j),s));\nfi;\nod;\nod;\n\n#seq(
p.i, i=1..k);\n\nPLOT( POLYGONS( seq(p.i, i=1..k), COLOR(RGB,1,0,0) ),
 POLYGONS( seq(q.i, i=1..l),COLOR(RGB,0,1,0) ), POLYGONS( seq(r.i, i=1
..ll),COLOR(RGB,0,0,1)  ), POLYGONS( seq(pq.i, i=1..kk),COLOR(RGB,.5,.
5,0)  ),POLYGONS( seq(pr.i, i=1..lll),COLOR(RGB,.5,0,.5)  ),POLYGONS( \+
seq(qr.i, i=1..llll),COLOR(RGB,0,.5,.5)  ), STYLE(PATCHNOGRID), AXESST
YLE(NONE), SCALING(CONSTRAINED) );\nend:" }}{PARA 7 "" 1 "" {TEXT -1 
46 "Warning, `trans1` is implicitly declared local" }}{PARA 7 "" 1 "" 
{TEXT -1 41 "Warning, `l` is implicitly declared local" }}{PARA 7 "" 
1 "" {TEXT -1 42 "Warning, `ll` is implicitly declared local" }}{PARA 
7 "" 1 "" {TEXT -1 42 "Warning, `kk` is implicitly declared local" }}
{PARA 7 "" 1 "" {TEXT -1 43 "Warning, `lll` is implicitly declared loc
al" }}{PARA 7 "" 1 "" {TEXT -1 44 "Warning, `llll` is implicitly decla
red local" }}{PARA 7 "" 1 "" {TEXT -1 49 "Warning, `firstrand` is impl
icitly declared local" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 14 "gr
ovedraw(30);" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}}{MARK 
"2 0 0" 0 }{VIEWOPTS 1 1 0 1 1 1803 }