Same fringe: Difference between revisions

Content added Content deleted
m (→‎version 1.1: removed OVERFLOW from the PRE html tagm, indented and changed section header comments.)
(→‎version 1.1: comgined two subroutines into one, changed/added comments, used cardinal numbers instead of ordinal numbers for internal tree identifiers.)
Line 1,699: Line 1,699:
<br><br>This version has:
<br><br>This version has:
:::* elided a subroutine
:::* elided a subroutine
:::* elided superfluous '''do ── end''' groups
:::* elided superfluous &nbsp; '''do ── end''' &nbsp; groups
:::* elided some stemmed array tails
:::* elided some stemmed array tails
:::* elided some REXX variables (lvl, debug, ···)
:::* elided some REXX variables &nbsp; (lvl, debug, ···)
:::* simplified some stem names
:::* simplified some stem names
:::* displays the tree (as an ASCII display)
:::* displays the tree &nbsp; (as an ASCII display)
:::* changed ''tree'' names so as to not conflict with ''leaf'' names
:::* changed ''tree'' names so as to not conflict with ''leaf'' names
:::* uses non-case sensitive tree names
:::* uses non-case sensitive tree names
:::* used boolean based variables as ''logicals''
:::* used boolean based variables as ''logicals''
:::* expanded message texts
:::* expanded message texts
:::* streamlined the &nbsp; ''make_tree'' &nbsp; subroutine
:::* combined subroutines &nbsp; '''attleft''' &nbsp; and &nbsp; '''attright''' &nbsp; into one
:::* streamlined the &nbsp; '''make_tree''' &nbsp; subroutine
<lang rexx>/*REXX pgm examines leaves of two binary trees. Tree used is as above.*/
<lang rexx>/*REXX program examines the leaves of two binary trees (shown below). */
_=left('',28); say _ ' A A '
_=left('',28); say _ ' A A '
say _ ' / \ ◄────1st tree / \ '
say _ ' / \ ◄────1st tree / \ '
Line 1,721: Line 1,722:
say; #=0 /*#: # of leaves. */
say; #=0 /*#: # of leaves. */
parse var # done. 1 node. /*set all these variables to zero*/
parse var # done. 1 node. /*set all these variables to zero*/
call make_tree '1st'
call make_tree 1 /*define tree number 1 (1st tree)*/
call make_tree '2nd'
call make_tree 2 /* " " " 2 (2nd " )*/
z1=root.1st; L1=node.1st.z1; done.1st.z1=1 /*L1 is a leaf on 1st tree*/
z1=root.1; L1=node.1.z1; done.1.z1=1 /*L1 is a leaf on tree #1. */
z2=z1; L2=node.2nd.z2; done.2nd.z2=1 /*L2 " " " " 2nd " */
z2=z1; L2=node.2.z2; done.2.z2=1 /*L2 " " " " " #2. */


do #%2 /*loop for the number of leaves. */
do # % 2 /*loop for the number of leaves. */
if L1==L2 then do
if L1==L2 then do
if L1==0 then call sayX 'The trees are equal.'
if L1==0 then call sayX 'The trees are equal.'
say ' The ' L1 " leaf is identical in both trees."
say ' The ' L1 " leaf is identical in both trees."
do until \done.1st.z1
do until \done.1.z1
z1=go_next(z1,'1st'); L1=node.1st.z1
z1=go_next(z1,1); L1=node.1.z1
end
end
done.1st.z1=1
done.1.z1=1
do until \done.2nd.z2
do until \done.2.z2
z2=go_next(z2,'2nd'); L2=node.2nd.z2
z2=go_next(z2,2); L2=node.2.z2
end
end
done.2nd.z2=1
done.2.z2=1
end
end
else select
else select
when L1==0 then call sayX L2 'exceeds leaves in 1st tree'
when L1==0 then call sayX L2 'exceeds leaves in 1st tree'
when L2==0 then call sayX L1 'exceeds leaves in 2nd tree'
when L2==0 then call sayX L1 'exceeds leaves in 2nd tree'
otherwise call sayX 'A difference is: ' L1 '¬=' L2
otherwise call sayX 'A difference is: ' L1 '¬=' L2
end /*select*/
end /*select*/
end /*#%2*/
end /*# % 2*/
exit
exit
/*──────────────────────────────────GO_NEXT subroutine──────────────────*/
/*──────────────────────────────────GO_NEXT subroutine──────────────────*/
Line 1,763: Line 1,764:
return next /*the next node (or 0, if done).*/
return next /*the next node (or 0, if done).*/
/*──────────────────────────────────MAKE_NODE subroutine────────────────*/
/*──────────────────────────────────MAKE_NODE subroutine────────────────*/
make_node: parse arg name,t; # = #+1 /*make a new node/branch on tree.*/
make_node: parse arg name,t; # = #+1 /*make a new node/branch on tree.*/
q = node.t.0 + 1; node.t.q = name; node.t.q._dad = 0
q = node.t.0 + 1 ; node.t.q = name ; node.t.q._dad = 0
node.t.q._Lson = 0; node.t.q._Rson = 0; node.t.0 = q
node.t.q._Lson = 0 ; node.t.q._Rson = 0 ; node.t.0 = q
return q /*number of the node just created*/
return q /*number of the node just created*/
/*──────────────────────────────────MAKE_TREE subroutine────────────────*/
/*──────────────────────────────────MAKE_TREE subroutine────────────────*/
make_tree: procedure expose node. root. #; arg tree /*build a tree.*/
make_tree: procedure expose node. root. #; arg tree /*build a tree.*/
⚫
if tree==1 then hhh='H'
hhh='δ' /*the odd duck in the whole tree.*/
else hhh='δ' /*the odd duck in the whole tree.*/
⚫
if tree=='1ST' then hhh='H'
a=make_node('A',tree); root.tree=a
a=make_node('A',tree); root.tree=a
b=make_node('B',tree); call sonL b,a,tree
b=make_node('B',tree); call son 'L',b,a,tree
c=make_node('C',tree); call sonR c,a,tree
c=make_node('C',tree); call son 'R',c,a,tree
d=make_node('D',tree); call sonL d,b,tree
d=make_node('D',tree); call son 'L',d,b,tree
e=make_node('E',tree); call sonR e,b,tree
e=make_node('E',tree); call son 'R',e,b,tree
f=make_node('F',tree); call sonL f,c,tree
f=make_node('F',tree); call son 'L',f,c,tree
g=make_node('G',tree); call sonL g,d,tree
g=make_node('G',tree); call son 'L',g,d,tree
/*quack?*/ h=make_node(hhh,tree); call sonL h,f,tree
/*quacks like a duck?*/ h=make_node(hhh,tree); call son 'L',h,f,tree
i=make_node('I',tree); call sonR i,f,tree
i=make_node('I',tree); call son 'R',i,f,tree
return
return
/*──────────────────────────────────SAYX subroutine─────────────────────*/
/*──────────────────────────────────SAYX subroutine─────────────────────*/
sayX: say; say arg(1); say; exit /*tell msg & exit.*/
sayX: say; say arg(1); say; exit /*tell msg and exit.*/
/*──────────────────────────────────SON subroutine──────────────────────*/
/*──────────────────────────────────SONL subroutine─────────────────────*/
sonL: procedure expose node.; parse arg son,dad,t /*build left son. */
son: procedure expose node.; parse arg ?,son,dad,t; LR = '_'?"SON"
node.t.son._dad=dad; q=node.t.dad._Lson
node.t.son._dad=dad; q=node.t.dad.LR /*define which son [↑] */
if q\==0 then do; node.t.q._dad=son; node.t.son._Lson=q; end
if q\==0 then do; node.t.q._dad=son; node.t.son.LR=q; end
node.t.dad._Lson=son
node.t.dad.LR=son
⚫
if ?=='R' then if node.t.dad.LR>0 then node.t.le._brother=node.t.dad.LR
return
/*──────────────────────────────────SONR subroutine─────────────────────*/
sonR: procedure expose node.; parse arg son,dad,t /*build right son.*/
node.t.son._dad=dad; q=node.t.dad._Rson
if q\==0 then do; node.t.q._dad=son; node.t.son._Rson=q; end
node.t.dad._Rson=son
⚫
if node.t.dad._Lson>0 then node.t.le._brother=node.t.dad._Rson
return</lang>
return</lang>
'''output'''
'''output'''
Retrieved from "https://rosettacode.org/wiki/Same_fringe"