aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

tasks a-s

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 23:57:08 -07:00
parent 47bf37c096
commit b83f433714
12433 changed files with 156208 additions and 123 deletions
Download patch file Download diff file Expand all files Collapse all files

176
Task/Same-Fringe/REXX/same-fringe-1.rexx Normal file
View file

@ -0,0 +1,176 @@
/* REXX ***************************************************************
* Same Fringe
* 1 A A
* / \ / \ / \
* / \ / \ / \
* / \ / \ / \
* 2 3 B C B C
* / \ / / \ / / \ /
* 4 5 6 D E F D E F
* / / \ / / \ / / \
* 7 8 9 G H I G * I
*
* 23.08.2012 Walter Pachl derived from
* http://rosettacode.org/wiki/Tree_traversal
* Tree A: A B D G E C F H I
* Tree B: A B D G E C F * I
**********************************************************************/
debug=0
node.=0
lvl=0
Call mktree 'A'
Call mktree 'B'
done.=0
za=root.a; leafa=node.a.za.0name
zb=root.a; leafb=node.b.zb.0name
done.a.za=1
done.b.zb=1
Do i=1 To 12
if leafa=leafb Then Do
If leafa=0 Then Do
Say 'Fringes are equal'
Leave
End
Say leafa '=' leafb
Do j=1 To 12 Until done.a.za=0
za=go_next(za,'A'); leafa=node.a.za.0name
End
done.a.za=1
Do j=1 To 12 Until done.b.zb=0
zb=go_next(zb,'B'); leafb=node.b.zb.0name
End
done.b.zb=1
End
Else Do
Select
When leafa=0 Then
Say leafb 'exceeds leaves in tree A'
When leafb=0 Then
Say leafa 'exceeds leaves in tree B'
Otherwise
Say 'First difference' leafa '<>' leafb
End
Leave
End
End
Exit
note:
/**********************************************************************
* add the node to the preorder list unless it's already there
* add the node to the level list
**********************************************************************/
Parse Arg z,t
If z<>0 &, /* it's a node */
done.z=0 Then Do /* not yet done */
wl.t=wl.t z /* add it to the preorder list*/
ll.lvl=ll.lvl z /* add it to the level list */
done.z=1 /* remember it's done */
leafl=leafl node.t.z.0name
End
Return
go_next: Procedure Expose node. lvl
/**********************************************************************
* find the next node to visit in the treewalk
**********************************************************************/
next=0
Parse arg z,t
If node.t.z.0left<>0 Then Do /* there is a left son */
If node.t.z.0left.done=0 Then Do /* we have not visited it */
next=node.t.z.0left /* so we go there */
node.t.z.0left.done=1 /* note we were here */
lvl=lvl+1 /* increase the level */
End
End
If next=0 Then Do /* not moved yet */
If node.t.z.0rite<>0 Then Do /* there is a right son */
If node.t.z.0rite.done=0 Then Do /* we have not visited it */
next=node.t.z.0rite /* so we go there */
node.t.z.0rite.done=1 /* note we were here */
lvl=lvl+1 /* increase the level */
End
End
End
If next=0 Then Do /* not moved yet */
next=node.t.z.0father /* go to the father */
lvl=lvl-1 /* decrease the level */
End
Return next /* that's the next node */
/* or zero if we are done */
mknode: Procedure Expose node.
/**********************************************************************
* create a new node
**********************************************************************/
Parse Arg name,t
z=node.t.0+1
node.t.z.0name=name
node.t.z.0father=0
node.t.z.0left =0
node.t.z.0rite =0
node.t.0=z
Return z /* number of the node just created */
attleft: Procedure Expose node.
/**********************************************************************
* make son the left son of father
**********************************************************************/
Parse Arg son,father,t
node.t.son.0father=father
z=node.t.father.0left
If z<>0 Then Do
node.t.z.0father=son
node.t.son.0left=z
End
node.t.father.0left=son
Return
attrite: Procedure Expose node.
/**********************************************************************
* make son the right son of father
**********************************************************************/
Parse Arg son,father,t
node.t.son.0father=father
z=node.t.father.0rite
If z<>0 Then Do
node.t.z.0father=son
node.t.son.0rite=z
End
node.t.father.0rite=son
le=node.t.father.0left
If le>0 Then
node.t.le.0brother=node.t.father.0rite
Return
mktree: Procedure Expose node. root.
/**********************************************************************
* build the tree according to the task
**********************************************************************/
Parse Arg t
If t='A' Then Do
a=mknode('A',t); root.t=a
b=mknode('B',t); Call attleft b,a,t
c=mknode('C',t); Call attrite c,a,t
d=mknode('D',t); Call attleft d,b,t
e=mknode('E',t); Call attrite e,b,t
f=mknode('F',t); Call attleft f,c,t
g=mknode('G',t); Call attleft g,d,t
h=mknode('H',t); Call attleft h,f,t
i=mknode('I',t); Call attrite i,f,t
End
Else Do
a=mknode('A',t); root.t=a
b=mknode('B',t); Call attleft b,a,t
c=mknode('C',t); Call attrite c,a,t
d=mknode('D',t); Call attleft d,b,t
e=mknode('E',t); Call attrite e,b,t
f=mknode('F',t); Call attleft f,c,t
g=mknode('G',t); Call attleft g,d,t
h=mknode('*',t); Call attleft h,f,t
i=mknode('I',t); Call attrite i,f,t
End
Return

139
Task/Same-Fringe/REXX/same-fringe-2.rexx Normal file
View file

@ -0,0 +1,139 @@
/* REXX ***************************************************************
* Same Fringe
= 1 A A
= / \ / \ / \
= / \ / \ / \
= / \ / \ / \
= 2 3 B C B C
= / \ / / \ / / \ /
= 4 5 6 D E F D E F
= / / \ / / \ / / \
= 7 8 9 G H I G * I
=
* 23.08.2012 Walter Pachl derived from
* http://rosettacode.org/wiki/Tree_traversal
* Tree A: A B D G E C F H I
* Tree B: A B D G E C F * I
**********************************************************************/
node.=0
Call mktree 'A'
Call mktree 'B'
sideboard.=0
za=root.a; leafa=node.a.za.0name
zb=root.b; leafb=node.b.zb.0name
Do i=1 To 20 Until za=0 & zb=0
If leafa=leafb Then Do
Say leafa '=' leafb
Parse Value get_next(za,'A') with za leafa
Parse Value get_next(zb,'B') with zb leafb
End
Else Do
Select
When za=0 Then Say leafb 'exceeds tree A'
When zb=0 Then Say leafa 'exceeds tree B'
Otherwise Say 'First difference' leafa '<>' leafb
End
Leave
Exit
End
End
exit
get_next: Procedure Expose node. sideboard.
Parse Arg za,t
Select
When node.t.za.0left<>0 Then Do
If node.t.za.0rite<>0 Then Do
z=sideboard.t.0+1
sideboard.t.z=node.t.za.0rite
sideboard.t.0=z
End
za=node.t.za.0left
End
When node.t.za.0rite<>0 Then Do
za=node.t.za.0rite
End
Otherwise Do
z=sideboard.t.0
za=sideboard.t.z
z=z-1
sideboard.t.0=z
End
End
Return za node.t.za.0name
mknode: Procedure Expose node.
/**********************************************************************
* create a new node
**********************************************************************/
Parse Arg name,t
z=node.t.0+1
node.t.z.0name=name
node.t.z.0father=0
node.t.z.0left =0
node.t.z.0rite =0
node.t.0=z
Return z /* number of the node just created */
attleft: Procedure Expose node.
/**********************************************************************
* make son the left son of father
**********************************************************************/
Parse Arg son,father,t
node.t.son.0father=father
z=node.t.father.0left
If z<>0 Then Do
node.t.z.0father=son
node.t.son.0left=z
End
node.t.father.0left=son
Return
attrite: Procedure Expose node.
/**********************************************************************
* make son the right son of father
**********************************************************************/
Parse Arg son,father,t
node.t.son.0father=father
z=node.t.father.0rite
If z<>0 Then Do
node.t.z.0father=son
node.t.son.0rite=z
End
node.t.father.0rite=son
le=node.t.father.0left
If le>0 Then
node.t.le.0brother=node.t.father.0rite
Return
mktree: Procedure Expose node. root.
/**********************************************************************
* build the tree according to the task
**********************************************************************/
Parse Arg t
If t='A' Then Do
a=mknode('A',t); root.t=a
b=mknode('B',t); Call attleft b,a,t
c=mknode('C',t); Call attrite c,a,t
d=mknode('D',t); Call attleft d,b,t
e=mknode('E',t); Call attrite e,b,t
f=mknode('F',t); Call attleft f,c,t
g=mknode('G',t); Call attleft g,d,t
h=mknode('H',t); Call attleft h,f,t
i=mknode('I',t); Call attrite i,f,t
End
Else Do
a=mknode('A',t); root.t=a
b=mknode('B',t); Call attleft b,a,t
c=mknode('C',t); Call attrite c,a,t
d=mknode('D',t); Call attleft d,b,t
e=mknode('E',t); Call attrite e,b,t
f=mknode('F',t); Call attleft f,c,t
g=mknode('G',t); Call attleft g,d,t
h=mknode('*',t); Call attleft h,f,t
i=mknode('I',t); Call attrite i,f,t
End
Return

87
Task/Same-Fringe/REXX/same-fringe-3.rexx Normal file
View file

@ -0,0 +1,87 @@
/*REXX pgm examines leaves of two binary trees. Tree used is as above.*/
_=left('',28); say _ ' A A '
say _ ' / \ ◄────1st tree / \ '
say _ ' / \ / \ '
say _ ' / \ / \ '
say _ ' B C B C '
say _ ' / \ / 2nd tree────► / \ / '
say _ ' D E F D E F '
say _ ' / / \ / / \ '
say _ 'G H I G δ I '
say; #=0 /*#: # of leaves. */
parse var # done. 1 node. /*set all these variables to zero*/
call make_tree '1st'
call make_tree '2nd'
z1=root.1st; L1=node.1st.z1; done.1st.z1=1 /*L1 is a leaf on 1st tree*/
z2=z1; L2=node.2nd.z2; done.2nd.z2=1 /*L2 " " " " 2nd " */
do #%2 /*loop for the number of leaves. */
if L1==L2 then do
if L1==0 then call sayX 'The trees are equal.'
say ' The ' L1 " leaf is identical in both trees."
do until \done.1st.z1
z1=go_next(z1,'1st'); L1=node.1st.z1
end
done.1st.z1=1
do until \done.2nd.z2
z2=go_next(z2,'2nd'); L2=node.2nd.z2
end
done.2nd.z2=1
end
else select
when L1==0 then call sayX L2 'exceeds leaves in 1st tree'
when L2==0 then call sayX L1 'exceeds leaves in 2nd tree'
otherwise call sayX 'A difference is: ' L1 '¬=' L2
end /*select*/
end /*#%2*/
exit
/*──────────────────────────────────GO_NEXT subroutine──────────────────*/
go_next: procedure expose node.; arg q,t /*find next node.*/
next=0
if node.t.q._Lson\==0 then /*is there a left branch in tree?*/
if node.t.q._Lson.done==0 then do /*has this node been visited yet?*/
next=node.t.q._Lson /*──► next node. */
node.t.q._Lson.done=1 /*mark Lson done.*/
end
if next==0 then
if node.t.q._Rson\==0 then /*is there a right tree branch ? */
if node.t.q._Rson.done==0 then do /*has this node been visited yet?*/
next=node.t.q._Rson /*──► next node*/
node.t.q._Rson.done=1 /*mark Rson don*/
end
if next==0 then next=node.t.q._dad /*process the father node. */
return next /*the next node (or 0, if done).*/
/*──────────────────────────────────MAKE_NODE subroutine────────────────*/
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
node.t.q._Lson = 0; node.t.q._Rson = 0; node.t.0 = q
return q /*number of the node just created*/
/*──────────────────────────────────MAKE_TREE subroutine────────────────*/
make_tree: procedure expose node. root. #; arg tree /*build a tree.*/
hhh='δ' /*the odd duck in the whole tree.*/
if tree=='1ST' then hhh='H'
a=make_node('A',tree); root.tree=a
b=make_node('B',tree); call sonL b,a,tree
c=make_node('C',tree); call sonR c,a,tree
d=make_node('D',tree); call sonL d,b,tree
e=make_node('E',tree); call sonR e,b,tree
f=make_node('F',tree); call sonL f,c,tree
g=make_node('G',tree); call sonL g,d,tree
/*quack?*/ h=make_node(hhh,tree); call sonL h,f,tree
i=make_node('I',tree); call sonR i,f,tree
return
/*──────────────────────────────────SAYX subroutine─────────────────────*/
sayX: say; say arg(1); say; exit /*tell msg & exit.*/
/*──────────────────────────────────SONL subroutine─────────────────────*/
sonL: procedure expose node.; parse arg son,dad,t /*build left son. */
node.t.son._dad=dad; q=node.t.dad._Lson
if q\==0 then do; node.t.q._dad=son; node.t.son._Lson=q; end
node.t.dad._Lson=son
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