Le code qui suit est écrit en Maple V.4. Il n'est aucunement garanti.
height:=proc(expr) local i; option remember; if type(expr,{table,procedure}) then 1+max(seq(height(i),i=convert(eval(expr),set))) elif type(expr,{name,integer}) then 0 else 1+max(seq(height(i),i=convert(expr,set))) fi end: # Renvoie la largeur de l'expression. # L'id\'ee est que l'on ins\`ere un espace d'une unit\'e entre les # op\'erandes et sur les bords. width:=proc(expr) local i; option remember; if type(expr,{name,integer}) then length(expr) else max(length(op(0,expr)) ,nops(expr)+1+add(width(i),i=convert(expr,set))) fi end: draw_expr:=proc() local i; if nargs<1 then ERROR(`expected some arguments, but received nothing`) elif nargs=1 then draw_expr_aux1(args,'origin'=[0,0]) else if convert([seq(type(i,string=anything),i=args[2..-1])],`and`) then draw_expr_aux1(args) else ERROR(`bad specification of options, received `,args) fi fi end: draw_expr_aux1:=proc() local expr,useroptions,nber,text, localfont,localfontcolor,locallinecolor,localscale,localaxes, localtree,localtextset,locallineset,localrootpoint, rootpoint,picture; # global LS,RP,eps; expr:=args[1]; # traitement des options useroptions:=[args[2..-1]]; if hasoption(useroptions,font,'localfont','useroptions') then nber:=select(xx->type(xx,posint),localfont); text:=select(xx->type(xx,string),localfont); if nber=[] then nber:=15; if text=[] then localfont:=[HELVETICA,BOLD,nber] elif member(text,[[TIMES,ROMAN], [TIMES,BOLD], [TIMES,ITALIC], [TIMES,BOLDITALIC], [HELVETICA], [HELVETICA,BOLD], [HELVETICA,OBLIQUE], [HELVETICA,BOLDOBLIQUE], [COURIER], [COURIER,BOLD], [COURIER,OBLIQUE], [COURIER,BOLDOBLIQUE]]) then localfont:=[op(text),nber] else ERROR(`bad specification of font `,localfont) fi; else nber:=op(1,nber); if text=[] then localfont:=[HELVETICA,BOLD,nber] elif member(text,[[TIMES,ROMAN], [TIMES,BOLD], [TIMES,ITALIC], [TIMES,BOLDITALIC], [HELVETICA], [HELVETICA,BOLD], [HELVETICA,OBLIQUE], [HELVETICA,BOLDOBLIQUE], [COURIER], [COURIER,BOLD], [COURIER,OBLIQUE], [COURIER,BOLDOBLIQUE]]) then localfont:=[op(text),nber] else ERROR(`bad specification of font `,localfont) fi; fi; else nber:=15; localfont:=[HELVETICA,BOLD,nber] fi; if hasoption(useroptions,color,'localcolor','useroptions') then localfontcolor:=localcolor; locallinecolor:=localcolor; else if not hasoption(useroptions,fontcolor,'localfontcolor','useroptions') then localfontcolor:=BLACK fi; if not hasoption(useroptions,linecolor,'locallinecolor','useroptions') then locallinecolor:=BLACK fi; fi; if not hasoption(useroptions,`scale`,'localscale','useroptions') then localscale:=[height(expr),width(expr)]; fi; if not hasoption(useroptions,axes,'localaxes','useroptions') then localaxes:='NONE' fi; if hasoption(useroptions,origin,localrootpoint,'useroptions') then rootpoint:=localrootpoint else rootpoint:=[0,0] fi; if hasoption(useroptions,coords,localcoords,'useroptions') and localcoords<>cartesian then lprint(`Warning, option coords = `,localcoords,` not implemented`); lprint(`default used, coords = cartesian`); fi; useroptions:=op(useroptions); # fin du traitement des options # construction de l'arbre associe a l'expression if type(expr,procedure) then lprint(`procedure`) fi; localtree:=draw_expr_aux2(rootpoint,expr); # dessin pour les etiquettes des noeuds localtextset:={draw_expr_aux3(localtree)}; localtextset:=map(subs(LS=localscale,RP=rootpoint, L->[(1-LS[1])*RP[1]+LS[1]*L[1], (1-LS[2])*RP[2]+LS[2]*L[2], L[3]]),localtextset); picture[text]:=plots[textplot](localtextset, font=localfont,color=localfontcolor, axes=localaxes, useroptions); # dessin des aretes de l'arbre locallineset:={draw_expr_aux4(localtree)}; # on enleve 10% a chaque bout d'arete locallineset:=map(subs(eps=0.9, L->[[(1-eps)*L[1][1]+eps*L[2][1], (1-eps)*L[1][2]+eps*L[2][2]], [eps*L[1][1]+(1-eps)*L[2][1], eps*L[1][2]+(1-eps)*L[2][2]]]), locallineset); # on tient compte de l'origine choisie et des # echelles horizontale et verticale. locallineset:=map(subs(LS=localscale,RP=rootpoint, L->[[(1-LS[1])*RP[1]+LS[1]*L[1][1], (1-LS[2])*RP[2]+LS[2]*L[1][2]], [(1-LS[1])*RP[1]+LS[1]*L[2][1], (1-LS[2])*RP[2]+LS[2]*L[2][2]]]), locallineset); picture[line]:=plot(locallineset, color=locallinecolor, axes=localaxes, useroptions); # assemblage des deux dessins plots[display]({picture[text],picture[line]}) end: # pour les procedures et les tables appeler des procedures particulieres # draw_expr_aux2 prend en entr\'ee un point, c'est-\`a-dire un couple # de numeric [x,y], et une expression expr. Il renvoie une liste L dont # le premier \'el\'ement est [x,y,e0] o\`u e0 est l'\'etiquette de la # racine de expr et \'eventuellement des listes de m\^eme type que L # associ\'ees aux op\'erandes de expr. draw_expr_aux2:=proc(point,expr) local w,s,sw,n,i; if nargs<2 then RETURN([[op(1,point),op(2,point),convert('NULL',string)]]) fi; if type(expr,{name,integer}) then if type(expr,procedure) then RETURN([[op(1,point),op(2,point),convert('expr',string)], op(draw_expr_aux2(eval(expr)))]) else RETURN([[op(1,point),op(2,point),convert(expr,string)]]) fi; fi; n:=nops(expr); if n=0 then RETURN([[op(1,point),op(2,point),convert(op(0,expr),string)], [op(1,point),op(2,point)-1,convert('NULL',string)]]) else w[0]:=0; for i to n do w[i]:=width(op(i,expr)); od; sw:=add(w[i],i=1..n)+n+1; # if sw>length(op(0,expr)) then # # s[0]:=-width(expr)/2 # # else # s[0]:=-sw/2; # # fi; # for i to n do s[i]:=s[i-1]+1+(w[i-1]+w[i])/2 od; [[op(1,point),op(2,point),convert(op(0,expr),string)], seq(draw_expr_aux2([op(1,point)+s[i],op(2,point)-1],op(i,expr)),i=1..n)] fi end: # draw_expr_aux3 prend en entree un arbre representant une expression. # L'arbre est vu comme une liste [racine, sequence des sous-arbres]. # draw_expr_aux3 renvoie la sequence des triplets [x,y,e] ou [x,y] # est un point et e l'etiquette a ecrire en ce point. Autrement dit # cette procedure met simplement a plat l'arbre associe a une expression. draw_expr_aux3:=proc(L) local i; if type(L,[constant,constant,string]) then L else [L[1][1],L[1][2],L[1][3]], seq(op(map(draw_expr_aux3,L[i])),i=2..nops(L)) fi end: # draw_expr_aux4 prend en entree un arbre representant une expression. # L'arbre est vu comme une liste [racine, sequence des sous-arbres]. # draw_expr_aux4 renvoie la sequence des aretes de l'arbre. Une arete # est une liste de deux points [[x1,y1],[x2,y2]]. draw_expr_aux4:=proc(L) local i; if type(L,[constant,constant,string]) then NULL else seq([[L[1][1],L[1][2]], [L[i][1][1],L[i][1][2]]],i=2..nops(L)) ,seq(draw_expr_aux4(L[i]),i=2..nops(L)) fi end: