05-28-2015, 09:56 AM
If you wish to calculate G/H in base B, G, H, B positive integers this is the programme.
eg For input
107
103
4567
the programme calculates 107/103 base 4567 & returns
:4567: { 1 "." "°" 177 1640 2616 221 3192 2128 1418 3990 2660 1773 2704 3325 2216 4522 3015 487 3369 3768 4034 4212 1285 3901 4123 2749 310 1729 1152 3813 1019 3724 2483 133 88 3103 3591 2394 1596 1064 709 1995 1330 886 3635 3946 1108 2261 1507 2527 1684 4167 4300 4389 2926 1950 4345 1374 2438 3148 576 1906 2793 1862 1241 2350 44 1551 4079 1197 798 532 354 3281 665 443 1817 4256 2837 3414 753 3547 842 2083 4433 4478 1463 975 2172 2970 3502 3857 2571 3236 3680 931 620 3458 2305 3059 2039 2882 399 266 }
where everything after the "°" recurs.
Programme name: XdYB
eg For input
107
103
4567
the programme calculates 107/103 base 4567 & returns
:4567: { 1 "." "°" 177 1640 2616 221 3192 2128 1418 3990 2660 1773 2704 3325 2216 4522 3015 487 3369 3768 4034 4212 1285 3901 4123 2749 310 1729 1152 3813 1019 3724 2483 133 88 3103 3591 2394 1596 1064 709 1995 1330 886 3635 3946 1108 2261 1507 2527 1684 4167 4300 4389 2926 1950 4345 1374 2438 3148 576 1906 2793 1862 1241 2350 44 1551 4079 1197 798 532 354 3281 665 443 1817 4256 2837 3414 753 3547 842 2083 4433 4478 1463 975 2172 2970 3502 3857 2571 3236 3680 931 620 3458 2305 3059 2039 2882 399 266 }
where everything after the "°" recurs.
Programme name: XdYB
Code:
::
CK3&Dispatch
# AAA
::
FPTR2 ^CK3Z
BINT3
NDUP
FPTR2 ^QMul
FPTR2 ^QMul
FPTR2 ^QIsZero?
case2drop
::
FPTR2 ^DupQIsZero?
?SEMI
SETIVLERR
;
ZINT 0
FPTR2 ^2LAMBIND
2DUP
FPTR2 ^ZDIVext
SWAP
2GETLAM
NULL{}
3UNROLL
::
BEGIN
OVER
FPTR2 ^QIsZero?
case
AGAIN
DUPUNROT
FPTR2 ^ZDIVext
4ROLLSWAP
>HCOMP
SWAPROT
AGAIN
;
RDROP
2DROP
"."
>TCOMP
4UNROLL
FPTR2 ^QIsZero?
::
case2DROP
NULL{}
DUP4UNROLL
3UNROLL
BEGIN
DUPUNROT
FPTR2 ^ZDIVext
5ROLL
ROT
>TCOMP
4UNROLL
2GETLAM
FPTR2 ^QMul
SWAPROT
1GETLAM
>TCOMP
UNROTOVER
1PUTLAM
OVER
4PICK
FPTR2 ^ListPos
DUP#0=
WHILE
DROP
REPEAT
4UNROLL3DROP
1GETLAM
FPTR2 ^QIsZero?
::
caseDROP
"°"
SWAP
FPTR2 ^INSERT{}N
;
CDRCOMP
&COMP
;
2GETLAM
ABND
DO>STR
>TAG
;
;