Data update
This commit is contained in:
Ingy döt Net
parent
8e4e15fa56
commit
72eb4943cb
1853 changed files with 35514 additions and 9441 deletions
|
|
@ -1,87 +1,62 @@
|
|||
/*REXX program implements a reasonably complete rational arithmetic (using fractions).*/
|
||||
L=length(2**19 - 1) /*saves time by checking even numbers. */
|
||||
do j=2 by 2 to 2**19 - 1; s=0 /*ignore unity (which can't be perfect)*/
|
||||
mostDivs=eDivs(j); @= /*obtain divisors>1; zero sum; null @. */
|
||||
do k=1 for words(mostDivs) /*unity isn't return from eDivs here.*/
|
||||
r='1/'word(mostDivs, k); @=@ r; s=$fun(r, , s)
|
||||
end /*k*/
|
||||
if s\==1 then iterate /*Is sum not equal to unity? Skip it.*/
|
||||
say 'perfect number:' right(j, L) " fractions:" @
|
||||
end /*j*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
$div: procedure; parse arg x; x=space(x,0); f= 'fractional division'
|
||||
parse var x n '/' d; d=p(d 1)
|
||||
if d=0 then call err 'division by zero:' x
|
||||
if \datatype(n,'N') then call err 'a non─numeric numerator:' x
|
||||
if \datatype(d,'N') then call err 'a non─numeric denominator:' x
|
||||
return n/d
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
$fun: procedure; parse arg z.1,,z.2 1 zz.2; arg ,op; op=p(op '+')
|
||||
F= 'fractionalFunction'; do j=1 for 2; z.j=translate(z.j, '/', "_"); end /*j*/
|
||||
if abbrev('ADD' , op) then op= "+"
|
||||
if abbrev('DIVIDE' , op) then op= "/"
|
||||
if abbrev('INTDIVIDE', op, 4) then op= "÷"
|
||||
if abbrev('MODULUS' , op, 3) | abbrev('MODULO', op, 3) then op= "//"
|
||||
if abbrev('MULTIPLY' , op) then op= "*"
|
||||
if abbrev('POWER' , op) then op= "^"
|
||||
if abbrev('SUBTRACT' , op) then op= "-"
|
||||
if z.1=='' then z.1= (op\=="+" & op\=='-')
|
||||
if z.2=='' then z.2= (op\=="+" & op\=='-')
|
||||
z_=z.2
|
||||
/* [↑] verification of both fractions.*/
|
||||
do j=1 for 2
|
||||
if pos('/', z.j)==0 then z.j=z.j"/1"; parse var z.j n.j '/' d.j
|
||||
if \datatype(n.j,'N') then call err 'a non─numeric numerator:' n.j
|
||||
if \datatype(d.j,'N') then call err 'a non─numeric denominator:' d.j
|
||||
if d.j=0 then call err 'a denominator of zero:' d.j
|
||||
n.j=n.j/1; d.j=d.j/1
|
||||
do while \datatype(n.j,'W'); n.j=(n.j*10)/1; d.j=(d.j*10)/1
|
||||
end /*while*/ /* [↑] {xxx/1} normalizes a number. */
|
||||
g=gcd(n.j, d.j); if g=0 then iterate; n.j=n.j/g; d.j=d.j/g
|
||||
end /*j*/
|
||||
include Settings
|
||||
|
||||
select
|
||||
when op=='+' | op=='-' then do; l=lcm(d.1,d.2); do j=1 for 2; n.j=l*n.j/d.j; d.j=l
|
||||
end /*j*/
|
||||
if op=='-' then n.2= -n.2; t=n.1 + n.2; u=l
|
||||
end
|
||||
when op=='**' | op=='↑' |,
|
||||
op=='^' then do; if \datatype(z_,'W') then call err 'a non─integer power:' z_
|
||||
t=1; u=1; do j=1 for abs(z_); t=t*n.1; u=u*d.1
|
||||
end /*j*/
|
||||
if z_<0 then parse value t u with u t /*swap U and T */
|
||||
end
|
||||
when op=='/' then do; if n.2=0 then call err 'a zero divisor:' zz.2
|
||||
t=n.1*d.2; u=n.2*d.1
|
||||
end
|
||||
when op=='÷' then do; if n.2=0 then call err 'a zero divisor:' zz.2
|
||||
t=trunc($div(n.1 '/' d.1)); u=1
|
||||
end /* [↑] this is integer division. */
|
||||
when op=='//' then do; if n.2=0 then call err 'a zero divisor:' zz.2
|
||||
_=trunc($div(n.1 '/' d.1)); t=_ - trunc(_) * d.1; u=1
|
||||
end /* [↑] modulus division. */
|
||||
when op=='ABS' then do; t=abs(n.1); u=abs(d.1); end
|
||||
when op=='*' then do; t=n.1 * n.2; u=d.1 * d.2; end
|
||||
when op=='EQ' | op=='=' then return $div(n.1 '/' d.1) = fDiv(n.2 '/' d.2)
|
||||
when op=='NE' | op=='\=' | op=='╪' | ,
|
||||
op=='¬=' then return $div(n.1 '/' d.1) \= fDiv(n.2 '/' d.2)
|
||||
when op=='GT' | op=='>' then return $div(n.1 '/' d.1) > fDiv(n.2 '/' d.2)
|
||||
when op=='LT' | op=='<' then return $div(n.1 '/' d.1) < fDiv(n.2 '/' d.2)
|
||||
when op=='GE' | op=='≥' | op=='>=' then return $div(n.1 '/' d.1) >= fDiv(n.2 '/' d.2)
|
||||
when op=='LE' | op=='≤' | op=='<=' then return $div(n.1 '/' d.1) <= fDiv(n.2 '/' d.2)
|
||||
otherwise call err 'an illegal function:' op
|
||||
end /*select*/
|
||||
say version; say 'Rational arithmetic'; say
|
||||
a = '1 2'; b = '-3 4'; c = '5 -6'; d = '-7 -8'; e = 3; f = 1.666666666
|
||||
say 'VALUES'
|
||||
say 'a =' Rlst2form(a)
|
||||
say 'b =' Rlst2form(b)
|
||||
say 'c =' Rlst2form(c)
|
||||
say 'd =' Rlst2form(d)
|
||||
say 'e =' e
|
||||
say 'f =' f
|
||||
say
|
||||
say 'BASICS'
|
||||
say 'a+b =' Rlst2form(Radd(a,b))
|
||||
say 'a+b+c+d =' Rlst2form(Radd(a,b,c,d))
|
||||
say 'a-b =' Rlst2form(Rsub(a,b))
|
||||
say 'a-b-c-d =' Rlst2form(Rsub(a,b,c,d))
|
||||
say 'a*b =' Rlst2form(Rmul(a,b))
|
||||
say 'a*b*c*d =' Rlst2form(Rmul(a,b,c,d))
|
||||
say 'a/b =' Rlst2form(Rdiv(a,b))
|
||||
say 'a/b/c/d =' Rlst2form(Rdiv(a,b,c,d))
|
||||
say '-a =' Rlst2form(Rneg(a))
|
||||
say '1/a =' Rlst2form(Rinv(a))
|
||||
say
|
||||
say 'COMPARE'
|
||||
say 'a<b =' Rlt(a,b)
|
||||
say 'a<=b =' Rle(a,b)
|
||||
say 'a=b =' Req(a,b)
|
||||
say 'a>=b =' Rge(a,b)
|
||||
say 'a>b =' Rgt(a,b)
|
||||
say 'a<>b =' Rne(a,b)
|
||||
say
|
||||
say 'BONUS'
|
||||
say 'Abs(c) =' Rlst2form(Rabs(c))
|
||||
say 'Float(b) =' Rfloat(b)
|
||||
say 'Neg(d) =' Rlst2form(Rneg(d))
|
||||
say 'Power(a,e) =' Rlst2form(Rpow(a,e))
|
||||
say 'Rational(f) =' Rlst2form(Rrat(f))
|
||||
say
|
||||
say 'FORMULA'
|
||||
say 'a^2-2ab+3c-4ad^4+5 = ',
|
||||
Rlst2form(Radd(Rpow(a,2),Rmul(-2,a,b),Rmul(3,c),Rmul(-4,a,Rpow(d,4)),5))
|
||||
say
|
||||
say 'PERFECT NUMBERS'
|
||||
call time('r')
|
||||
numeric digits 20
|
||||
do c = 6 to 2**19
|
||||
s = 1 c; m = Isqrt(c)
|
||||
do f = 2 to m
|
||||
if c//f = 0 then do
|
||||
s = Radd(s,1 f,1 c/f)
|
||||
end
|
||||
end
|
||||
if Req(s,1) then
|
||||
say c 'is a perfect number'
|
||||
end
|
||||
say time('e')/1's'
|
||||
exit
|
||||
|
||||
if t==0 then return 0; g=gcd(t, u); t=t/g; u=u/g
|
||||
if u==1 then return t
|
||||
return t'/'u
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
eDivs: procedure; parse arg x 1 b,a
|
||||
do j=2 while j*j<x; if x//j\==0 then iterate; a=a j; b=x%j b; end
|
||||
if j*j==x then return a j b; return a b
|
||||
/*───────────────────────────────────────────────────────────────────────────────────────────────────*/
|
||||
err: say; say '***error*** ' f " detected" arg(1); say; exit 13
|
||||
gcd: procedure; parse arg x,y; if x=0 then return y; do until _==0; _=x//y; x=y; y=_; end; return x
|
||||
lcm: procedure; parse arg x,y; if y=0 then return 0; x=x*y/gcd(x, y); return x
|
||||
p: return word( arg(1), 1)
|
||||
include Rational
|
||||
include Functions
|
||||
include Abend
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue