June 2018 Update
This commit is contained in:
Ingy döt Net
parent
ba8067c3b7
commit
22f33d4004
5278 changed files with 84726 additions and 14379 deletions
|
|
@ -0,0 +1,32 @@
|
|||
import system'math
|
||||
import extensions.
|
||||
|
||||
program =
|
||||
[
|
||||
array<real> inputs := real<>(11).
|
||||
console printLine("Please enter 11 numbers :").
|
||||
0 till:11 do(:i)
|
||||
[
|
||||
inputs[i] := console readLine; toReal.
|
||||
].
|
||||
|
||||
console printLine("Evaluating f(x) = |x|^0.5 + 5x^3 for the given inputs :").
|
||||
10 to:0 do(:i)
|
||||
[
|
||||
var r1 := inputs[i] absolute; sqrt.
|
||||
var r2 := inputs[i] power(3).
|
||||
var r :=inputs[i] /*absolute;*/ sqrt + 5*r2.
|
||||
|
||||
real result := (inputs[i] absolute; sqrt) + 5 * (inputs[i] power(3)).
|
||||
|
||||
console print("f(", inputs[i], ")=").
|
||||
|
||||
if (result > 400)
|
||||
[
|
||||
console printLine("Overflow!")
|
||||
];
|
||||
[
|
||||
console printLine(result).
|
||||
]
|
||||
]
|
||||
].
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
USING: formatting io kernel math math.functions math.parser
|
||||
prettyprint sequences splitting ;
|
||||
IN: rosetta-code.trabb-pardo-knuth
|
||||
|
||||
CONSTANT: threshold 400
|
||||
CONSTANT: prompt "Please enter 11 numbers: "
|
||||
|
||||
: fn ( x -- y ) [ abs 0.5 ^ ] [ 3 ^ 5 * ] bi + ;
|
||||
|
||||
: overflow? ( x -- ? ) threshold > ;
|
||||
|
||||
: get-input ( -- seq )
|
||||
prompt write flush readln " " split dup length 11 =
|
||||
[ drop get-input ] unless ;
|
||||
|
||||
: ?result ( ..a quot: ( ..a -- ..b ) -- ..b )
|
||||
[ "f(%u) = " sprintf ] swap bi dup overflow?
|
||||
[ drop "overflow" ] [ "%.3f" sprintf ] if append ; inline
|
||||
|
||||
: main ( -- )
|
||||
get-input reverse
|
||||
[ string>number [ fn ] ?result print ] each ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
seqn := ListTools:-Reverse([parse(Maplets[Display](Maplets:-Elements:-Maplet(Maplets:-Elements:-InputDialog['ID1']("Enter a sequence of numbers separated by comma", 'onapprove' = Maplets:-Elements:-Shutdown(['ID1']), 'oncancel' = Maplets:-Elements:-Shutdown())))[1])]):
|
||||
f:= x -> abs(x)^0.5 + 5*x^3:
|
||||
for item in seqn do
|
||||
result := f(item):
|
||||
if (result > 400) then
|
||||
print("Alert: Overflow."):
|
||||
else
|
||||
print(result):
|
||||
end if:
|
||||
end do:
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
TPK: DO;
|
||||
/* external I/O and real mathematical routines */
|
||||
WRITE$STRING: PROCEDURE( S ) EXTERNAL; DECLARE S POINTER; END;
|
||||
WRITE$REAL: PROCEDURE( R ) EXTERNAL; DECLARE R REAL; END;
|
||||
WRITE$NL: PROCEDURE EXTERNAL; END;
|
||||
READ$REAL: PROCEDURE( R ) REAL EXTERNAL; DECLARE R POINTER; END;
|
||||
REAL$ABS: PROCEDURE( R ) REAL EXTERNAL; DECLARE R REAL; END;
|
||||
REAL$SQRT: PROCEDURE( R ) REAL EXTERNAL; DECLARE R REAL; END;
|
||||
/* end external routines */
|
||||
|
||||
F: PROCEDURE( T ) REAL;
|
||||
DECLARE T REAL;
|
||||
RETURN REAL$SQRT(REAL$ABS(T))+5*T*T*T;
|
||||
END F;
|
||||
MAIN: PROCEDURE;
|
||||
DECLARE Y REAL, A( 11 ) REAL, I INTEGER;
|
||||
DO I = 0 TO 10;
|
||||
CALL READ$REAL( @A( I ) );
|
||||
END;
|
||||
DO I = 10 TO 0 BY -1;
|
||||
Y = F( A( I ) );
|
||||
IF Y > 400.0 THEN CALL WRITE$STRING( @( 'TOO LARGE', 0 ) );
|
||||
ELSE CALL WRITE$REAL( Y );
|
||||
CALL WRITE$NL();
|
||||
END;
|
||||
END MAIN;
|
||||
|
||||
END TPK;
|
||||
|
|
@ -1,50 +1,48 @@
|
|||
/*REXX program implements the Trabb─Pardo-Knuth algorithm for N numbers (default is 11).*/
|
||||
parse arg N .; if N=='' | N=="," then N=11 /*Not specified? Then use the default.*/
|
||||
maxValue=400 /*the maximum value f(x) can have. */
|
||||
wid= 20 /* ··· but only show this many digits.*/
|
||||
frac= 5 /* ··· show this # of fractional digs.*/
|
||||
numeric digits 200 /*the number of digits precision to use*/
|
||||
parse arg N .; if N=='' | N=="," then N=11 /*Not specified? Then use the default.*/
|
||||
maxValue= 400 /*the maximum value f(x) can have. */
|
||||
wid= 20 /* ··· but only show this many digits.*/
|
||||
frac= 5 /* ··· show this # of fractional digs.*/
|
||||
say ' _____ ' /* ◄───── display a vinculum.*/
|
||||
say 'function: ƒ(x) ≡ √ │x│ + (5 * x^3)'
|
||||
prompt= 'enter ' N " numbers for the Trabb─Pardo─Knuth algorithm: (or Quit)"
|
||||
|
||||
/*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ */
|
||||
do ask=0; say; say prompt; say; pull $; say /* ▒ */
|
||||
if abbrev('QUIT',$,1) then do; say 'quitting.'; exit 1; end /* ▒ */
|
||||
ok=0 /* ▒ */
|
||||
select /*validate there're N numbers.*/ /* ▒ */
|
||||
when $='' then say "no numbers entered" /* ▒ */
|
||||
when words($)<N then say "not enough numbers entered" /* ▒ */
|
||||
when words($)>N then say "too many numbers entered" /* ▒ */
|
||||
otherwise ok=1 /* ▒ */
|
||||
end /*select*/ /* ▒ */
|
||||
if \ok then iterate /* [↓] is max width.*/ /* ▒ */
|
||||
w=0; do v=1 for N; _=word($,v); w=max(w,length(_)) /* ▒ */
|
||||
if datatype(_,'N') then iterate /*numeric ? */ /* ▒ */
|
||||
say _ "isn't numeric"; iterate ask /* ▒ */
|
||||
end /*v*/ /* ▒ */
|
||||
leave /* ▒ */
|
||||
end /*ask*/ /* ▒ */
|
||||
/*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ */
|
||||
do ask=0; say; /*░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░*/
|
||||
say prompt; say; pull $; say /*░*/
|
||||
if abbrev('QUIT',$,1) then do; say 'quitting.'; exit 1; end /*░*/
|
||||
ok=0 /*░*/
|
||||
select /*validate there're N numbers.*/ /*░*/
|
||||
when $='' then say "no numbers entered" /*░*/
|
||||
when words($)<N then say "not enough numbers entered" /*░*/
|
||||
when words($)>N then say "too many numbers entered" /*░*/
|
||||
otherwise ok=1 /*░*/
|
||||
end /*select*/ /*░*/
|
||||
if \ok then iterate /* [↓] W=max width. */ /*░*/
|
||||
w=0; do v=1 for N; _=word($, v); w=max(w, length(_) ) /*░*/
|
||||
if datatype(_, 'N') then iterate /*numeric ?*/ /*░*/
|
||||
say _ "isn't numeric"; iterate ask /*░*/
|
||||
end /*v*/ /*░*/
|
||||
leave /*░*/
|
||||
end /*ask*/ /*░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░*/
|
||||
|
||||
say 'numbers entered: ' $
|
||||
say 'numbers entered: ' $
|
||||
say
|
||||
do i=N by -1 to 1; #=word($,i)/1 /*process the numbers in reverse. */
|
||||
do i=N by -1 for N; #=word($, i) / 1 /*process the numbers in reverse. */
|
||||
g = fmt( f( # ) ) /*invoke function ƒ with arg number.*/
|
||||
gw=right( 'ƒ('#") ", w+7) /*nicely formatted ƒ(number). */
|
||||
if g>maxValue then say gw "is > " maxValue ' ['space(g)"]"
|
||||
else say gw " = " g
|
||||
end /*i*/ /* [+] display the result to terminal.*/
|
||||
if g>maxValue then say gw "is > " maxValue ' ['space(g)"]"
|
||||
else say gw " = " g
|
||||
end /*i*/ /* [↑] display the result to terminal.*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
f: procedure; parse arg x; return sqrt( abs(x) ) + 5 * x**3
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
fmt: z=right(translate(format(arg(1),wid,frac),'e',"E"),wid) /*right adjust; use e*/
|
||||
fmt: z=right(translate(format(arg(1), wid, frac), 'e', "E"), wid) /*right adjust; use e*/
|
||||
if pos(.,z)\==0 then z=left(strip(strip(z,'T',0),"T",.),wid) /*strip trailing 0 &.*/
|
||||
return right(z,wid-4*(pos('e',z)==0)) /*adjust: no exponent*/
|
||||
return right(z, wid - 4*(pos('e', z)==0) ) /*adjust: no exponent*/
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6
|
||||
numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g *.5'e'_ % 2
|
||||
do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
|
||||
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
|
||||
return g
|
||||
do j=0 while h>9; m.j=h; h=h % 2 + 1; end /*j*/
|
||||
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/; return g
|
||||
|
|
|
|||
|
|
@ -1,12 +1,31 @@
|
|||
decimals(7)
|
||||
s = [4,3,4,2,1,1,2,3,4,5]
|
||||
# Project : Trabb Pardo–Knuth algorithm
|
||||
# Date : 2017/10/06
|
||||
# Author : Gal Zsolt (~ CalmoSoft ~)
|
||||
# Email : <calmosoft@gmail.com>
|
||||
|
||||
for i = 10 to 1 step -1
|
||||
see "f(" + s[i] + ")=";
|
||||
x = f(s[i])
|
||||
if x > 400 see "--- too large ---" + nl
|
||||
else see x + nl ok
|
||||
decimals(3)
|
||||
x = list(11)
|
||||
for n=1 to 11
|
||||
x[n] = n
|
||||
next
|
||||
|
||||
func f n
|
||||
return sqrt(fabs(n))+5*pow(n,3)
|
||||
s = [-5, -3, -2, -1, 0, 1, 2, 3, 4, 5, 6]
|
||||
for i = 1 to 11
|
||||
see string(i) + " => " + s[i] + nl
|
||||
next
|
||||
see copy("-", 20) + nl
|
||||
i = i - 1
|
||||
|
||||
while i > 0
|
||||
see "f(" + string(s[i]) + ") = "
|
||||
x = f(s[i])
|
||||
if x > 400
|
||||
see "-=< overflow >=-" + nl
|
||||
else
|
||||
see x + nl
|
||||
ok
|
||||
i = i - 1
|
||||
end
|
||||
|
||||
func f(n)
|
||||
return sqrt(fabs(n)) + 5 * pow(n, 3)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue