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

Family Day update

Browse source
This commit is contained in:
Ingy döt Net 2020-02-17 23:21:07 -08:00
parent aac6731f2c
commit 9ad63ea473
2442 changed files with 39761 additions and 8255 deletions
Download patch file Download diff file Expand all files Collapse all files

7
Task/Mutual-recursion/Lambdatalk/mutual-recursion-1.lambdatalk Normal file
View file

@ -0,0 +1,7 @@
{def F {lambda {:n} {if {= :n 0} then 1 else {- :n {M {F {- :n 1}}}} }}}
{def M {lambda {:n} {if {= :n 0} then 0 else {- :n {F {M {- :n 1}}}} }}}
{map F {serie 0 19}}
-> 1 1 2 2 3 3 4 5 5 6 6 7 8 8 9 9 10 11 11 12
{map M {serie 0 19}}
-> 0 0 1 2 2 3 4 4 5 6 6 7 7 8 9 9 10 11 11 12

35
Task/Mutual-recursion/Lambdatalk/mutual-recursion-2.lambdatalk Normal file
View file

@ -0,0 +1,35 @@
{def cache
{def cache.F {#.new}}
{def cache.M {#.new}}
{lambda {:f :n}
{let { {:f :f} {:n :n}
{:cx {if {equal? :f MF}
then {cache.F}
else {cache.M}}}
} {if {equal? {#.get :cx :n} undefined}
then {#.get {#.set! :cx :n {:f :n}} :n}
else {#.get :cx :n}}}}}
-> cache
{def MF
{lambda {:n}
{if {= :n 0}
then 1
else {- :n {MM {cache MF {- :n 1}}}}}}}
-> MF
{def MM
{lambda {:n}
{if {= :n 0}
then 0
else {- :n {MF {cache MM {- :n 1}}}}}}}
-> MM
{MF 80}
-> 50 (requires 55 ms)
{map MF {serie 0 100}} (requires75ms)
-> 1 1 2 2 3 3 4 5 5 6 6 7 8 8 9 9 10 11 11 12 13 13 14 14 15 16 16 17 17
18 19 19 20 21 21 22 22 23 24 24 25 25 26 27 27 28 29 29 30 30 31 32 32
33 34 34 35 35 36 37 37 38 38 39 40 40 41 42 42 43 43 44 45 45 46 46 47
48 48 49 50 50 51 51 52 53 53 54 55 55 56 56 57 58 58 59 59 60 61 61 62

6
Task/Mutual-recursion/REXX/mutual-recursion-1.rexx
View file

@ -1,8 +1,8 @@
/*REXX program shows mutual recursion (via the Hofstadter Male and Female sequences). */
parse arg lim .; if lim='' then lim=40; w=length(lim); pad=left('', 20)
parse arg lim .; if lim='' then lim= 40; w= length(lim); pad= left('', 20)
do j=0 to lim; jj=right(j, w); ff=right(F(j), w); mm=right(M(j), w)
say pad 'F('jj") =" ff pad 'M('jj") =" mm
do j=0 for lim+1; jj= right(j, w); ff= right(F(j), w); mm= right(M(j), w)
say pad 'F('jj") =" ff pad 'M('jj") =" mm
end /*j*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/

10
Task/Mutual-recursion/REXX/mutual-recursion-2.rexx
View file

@ -1,14 +1,14 @@
/*REXX program shows mutual recursion (via the Hofstadter Male and Female sequences). */
parse arg lim .; if lim=='' then lim=40 /*assume the default for LIM? */
w=length(lim); $m.=.; $m.0=0; $f.=.; $f.0=1; Js=; Fs=; Ms=
w= length(lim); $m.=.; $m.0= 0; $f.=.; $f.0= 1; Js=; Fs=; Ms=
do j=0 to lim
Js=Js right(j, w); Fs=Fs right(F(j), w); Ms=Ms right(M(j), w)
do j=0 for lim+1
Js= Js right(j, w); Fs= Fs right( F(j), w); Ms= Ms right( M(j), w)
end /*j*/
say 'Js=' Js /*display the list of Js to the term.*/
say 'Fs=' Fs /* " " " " Fs " " " */
say 'Ms=' Ms /* " " " " Ms " " " */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
F: procedure expose $m. $f.; parse arg n; if $f.n==. then $f.n=n-M(F(n-1)); return $f.n
M: procedure expose $m. $f.; parse arg n; if $m.n==. then $m.n=n-F(M(n-1)); return $m.n
F: procedure expose $m. $f.; parse arg n; if $f.n==. then $f.n= n-M(F(n-1)); return $f.n
M: procedure expose $m. $f.; parse arg n; if $m.n==. then $m.n= n-F(M(n-1)); return $m.n

12
Task/Mutual-recursion/REXX/mutual-recursion-3.rexx
View file

@ -1,11 +1,11 @@
/*REXX program shows mutual recursion (via the Hofstadter Male and Female sequences). */
/*───────────────── If LIM is negative, a single result is shown for the abs(lim) entry.*/
parse arg lim .; if lim=='' then lim=99; aLim=abs(lim)
w=length(aLim); $m.=.; $m.0=0; $f.=.; $f.0=1; Js=; Fs=; Ms=
parse arg lim .; if lim=='' then lim= 99; aLim= abs(lim)
w= length(aLim); $m.=.; $m.0= 0; $f.=.; $f.0= 1; Js=; Fs=; Ms=
do j=0 to Alim
Js=Js right(j, w); Fs=Fs right(F(j), w); Ms=Ms right(M(j), w)
do j=0 for Alim+1
Js= Js right(j, w); Fs= Fs right( F(j), w); Ms= Ms right( M(j), w)
end /*j*/
if lim>0 then say 'Js=' Js; else say 'J('aLim")=" word(Js, aLim+1)
@ -13,5 +13,5 @@ if lim>0 then say 'Fs=' Fs; else say 'F('aLim")=" word(Fs, aLim
if lim>0 then say 'Ms=' Ms; else say 'M('aLim")=" word(Ms, aLim+1)
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
F: procedure expose $m. $f.; parse arg n; if $f.n==. then $f.n=n-M(F(n-1)); return $f.n
M: procedure expose $m. $f.; parse arg n; if $m.n==. then $m.n=n-F(M(n-1)); return $m.n
F: procedure expose $m. $f.; parse arg n; if $f.n==. then $f.n= n-M(F(n-1)); return $f.n
M: procedure expose $m. $f.; parse arg n; if $m.n==. then $m.n= n-F(M(n-1)); return $m.n