(49G) Egyptian Fraction (Random) Programme
05-25-2015, 02:24 PM (This post was last modified: 06-15-2017 01:46 PM by Gene.)
Post: #1
 Gerald H Senior Member Posts: 1,522 Joined: May 2014
(49G) Egyptian Fraction (Random) Programme
The programme EGYRAND takes a fraction expressed as the division of two integers from the stack & returns a random decomposition into Egyptian fractions.

eg For entry

'77/73'

the programme returns

:6: { 1 '1/19' '1/464' '1/128715' '1/11833836446' '1/490138897595538851760' }

or

:5: { 1 '1/19' '1/463' '1/321091' '1/206198539471' }

or

:5: { 1 '1/19' '1/464' '1/128714' '1/41418105776' }

or

:5: { 1 '1/20' '1/209' '1/101715' '1/6207463020' }

or a different list.

Here the programme in a box:

Code:
::   CK1&Dispatch   BINT10   ::     BINT1     Z0_     FPTR2 ^2LAMBIND     FPTR2 ^SIMP1ext     FPTR2 ^FLAGPROPFRAC     FPTR2 ^DUPTYPEZ?     ?SKIP     ::       EXPR>_       SWAPDROP       '       x/       EQUAL       IT       ::         Z0_         3UNROLL         FPTR2 ^QDiv       ;       BEGIN       2GETLAM       #1+       2PUTLAM       DUP       FPTR2 ^FXNDext       SWAP       FPTR2 ^DupZIsOne?       NOT_WHILE       ::         FPTR2 ^ZQUOText         %RAN         %.5         %>         ITE         Z1_         Z2_         FPTR2 ^RADDext         DUP         1GETLAM         Z<=         IT         ::           DROP           1GETLAM           Z2_           FPTR2 ^RADDext         ;         DUP1PUTLAM_         Z1_         FPTR2 ^SWAPRDIV         DUPUNROT         FPTR2 ^QSub       ;       REPEAT       2DROP     ;     2GETLAM     {}N     2GETLAM     ABND     #>$>TAG ; ; & again the programme (which depiction do you prefer?) :: CK1&Dispatch BINT10 :: BINT1 Z0_ FPTR2 ^2LAMBIND FPTR2 ^SIMP1ext FPTR2 ^FLAGPROPFRAC FPTR2 ^DUPTYPEZ? ?SKIP :: EXPR>_ SWAPDROP ' x/ EQUAL IT :: Z0_ 3UNROLL FPTR2 ^QDiv ; BEGIN 2GETLAM #1+ 2PUTLAM DUP FPTR2 ^FXNDext SWAP FPTR2 ^DupZIsOne? NOT_WHILE :: FPTR2 ^ZQUOText %RAN %.5 %> ITE Z1_ Z2_ FPTR2 ^RADDext DUP 1GETLAM Z<= IT :: DROP 1GETLAM Z2_ FPTR2 ^RADDext ; DUP1PUTLAM_ Z1_ FPTR2 ^SWAPRDIV DUPUNROT FPTR2 ^QSub ; REPEAT 2DROP ; 2GETLAM {}N 2GETLAM ABND #>$
>TAG
;
;
 « Next Oldest | Next Newest »

User(s) browsing this thread: 1 Guest(s)