Post Reply 
(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
(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
;
;
Find all posts by this user
Quote this message in a reply
Post Reply 




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