Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
|
|
@ -1,4 +1,6 @@
|
|||
The TPK algorithm is an early example of programming chrestomathy. It was used in Donald Knuth and Luis Trabb Pardo's Stanford tech report [http://bitsavers.org/pdf/stanford/cs_techReports/STAN-CS-76-562_EarlyDevelPgmgLang_Aug76.pdf The Early Development of Programming Languages]. The report traces the early history of work in developing computer languages in the 1940s and 1950s, giving several translations of the algorithm.
|
||||
The TPK algorithm is an early example of a programming chrestomathy.
|
||||
It was used in Donald Knuth and Luis Trabb Pardo's Stanford tech report [http://bitsavers.org/pdf/stanford/cs_techReports/STAN-CS-76-562_EarlyDevelPgmgLang_Aug76.pdf The Early Development of Programming Languages].
|
||||
The report traces the early history of work in developing computer languages in the 1940s and 1950s, giving several translations of the algorithm.
|
||||
|
||||
From the [[wp:Trabb Pardo–Knuth algorithm|wikipedia entry]]:
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,13 @@
|
|||
begin
|
||||
real y; real array a( 0 :: 10 );
|
||||
real procedure f( real value t );
|
||||
sqrt(abs(t))+5*t*t*t;
|
||||
for i:=0 until 10 do read( a(i) );
|
||||
r_format := "A"; r_w := 9; r_d := 4;
|
||||
for i:=10 step -1 until 0 do
|
||||
begin
|
||||
y:=f(a(i));
|
||||
if y > 400 then write( "TOO LARGE" )
|
||||
else write( y );
|
||||
end
|
||||
end.
|
||||
|
|
@ -6,12 +6,10 @@
|
|||
|
||||
int main( ) {
|
||||
std::vector<double> input( 11 ) , results( 11 ) ;
|
||||
double number = 0.0 ;
|
||||
std::cout << "Please enter 11 numbers!\n" ;
|
||||
for ( int i = 0 ; i < input.size( ) ; i++ ) {
|
||||
std::cin >> number ;
|
||||
input[ i ] = number ;
|
||||
}
|
||||
for ( int i = 0 ; i < input.size( ) ; i++ )
|
||||
std::cin >> input[i];
|
||||
|
||||
std::transform( input.begin( ) , input.end( ) , results.begin( ) ,
|
||||
[ ]( double n )-> double { return sqrt( abs( n ) ) + 5 * pow( n , 3 ) ; } ) ;
|
||||
for ( int i = 10 ; i > -1 ; i-- ) {
|
||||
|
|
|
|||
|
|
@ -0,0 +1,16 @@
|
|||
C THE TPK ALGORITH - FORTRAN I - 1957 TPK00010
|
||||
FTPKF(X)=SQRTF(ABSF(X))+5.0*X**3 TPK00020
|
||||
DIMENSION A(11) TPK00030
|
||||
READ 100,A TPK00040
|
||||
100 FORMAT(6F12.4/) TPK00050
|
||||
DO 3 I=1,11 TPK00060
|
||||
J=12-I TPK00070
|
||||
Y=FTPKF(A(J)) TPK00080
|
||||
IF (Y-400.0)2,2,1 TPK00090
|
||||
1 PRINT 301,I,A(J) TPK00100
|
||||
301 FORMAT(I10,F12.7,18H *** TOO LARGE ***) TPK00110
|
||||
GO TO 10 TPK00120
|
||||
2 PRINT 302,I,A(J),Y TPK00130
|
||||
302 FORMAT(I10,2F12.7) TPK00140
|
||||
3 CONTINUE TPK00150
|
||||
STOP 0 TPK00160
|
||||
|
|
@ -37,7 +37,7 @@ If OpenConsole()
|
|||
Until entriesAreValid = 1
|
||||
|
||||
ForEach numbers()
|
||||
output$ = "f(" + RTrim(RTrim(StrD(numbers(), 3), "0"), ".") + ") = "
|
||||
output$ = "f(" + RTrim(RTrim(StrD(numbers(), 3), "0"), ".") + ") = "
|
||||
result.d = f(numbers())
|
||||
If result > 400
|
||||
output$ + "Too Large"
|
||||
|
|
|
|||
|
|
@ -1,49 +1,45 @@
|
|||
/*REXX program to implement the Trabb-Pardo-Knuth algorithm for N nums.*/
|
||||
N=11 /*N is the number of numbers. */
|
||||
maxValue=400 /*the maximum value f(x) can have*/
|
||||
precDigs=200 /*compute with this many digits. */
|
||||
showDigs=20 /*...but only show this many digs*/
|
||||
numeric digits precDigs /*the number of digits precision.*/
|
||||
prompt='enter' N "numbers for the Trabb-Pardo-Knuth algorithm: (or Quit)"
|
||||
say ' _____ ' /*vinculum.*/
|
||||
/*REXX program to implement the Trabb─Pardo-Knuth algorithm for N numbers.*/
|
||||
N=11 /*N is the number of numbers to be used*/
|
||||
maxValue=400 /*the maximum value f(x) can have. */
|
||||
compDigs=200 /*compute with this many decimal digits*/
|
||||
showDigs=20 /* ··· but only show this many digits.*/
|
||||
numeric digits compDigs /*the number of digits precision to use*/
|
||||
say ' _____ ' /*vinculum.*/
|
||||
say 'function: ƒ(x) ≡ √ │x│ + (5 * x^3)'
|
||||
/*██████████████████████████████████████████████████████████████████████*/
|
||||
do ask=0; say; say prompt; say; parse pull yyyU . 1 yyy; say
|
||||
upper yyyU; if abbrev('QUIT',yyyU,1) then exit
|
||||
|
||||
do validate=0
|
||||
select
|
||||
when yyy='' then say 'no numbers entered'
|
||||
when words(yyy)<N then say 'not enough numbers entered'
|
||||
when words(yyy)>N then say 'too many numbers entered'
|
||||
otherwise leave validate
|
||||
end /*select*/
|
||||
iterate ask
|
||||
end /*validate*/
|
||||
do j=1 for N; _=word(yyy,j)
|
||||
if \datatype(_,'N') then do
|
||||
say _ "isn't numeric"
|
||||
iterate ask
|
||||
end
|
||||
end /*j*/
|
||||
leave ask
|
||||
end /*ask*/
|
||||
say 'numbers entered:' yyy; say
|
||||
/*██████████████████████████████████████████████████████████████████████*/
|
||||
do i=N by -1 to 1; p=word(yyy,i)/1 /*process #s in reverse.*/
|
||||
g=f(p)
|
||||
numeric digits showdigs; g=g/1 /*scale down the result.*/
|
||||
if g>maxValue then say 'f('p") is > " maxValue ' ['g"]"
|
||||
else say 'f('p") = " g /*show the (good) result*/
|
||||
numeric digits precDigs /*re-instate big digits.*/
|
||||
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 exit /*does the user want to QUIT this pgm? */ /* ▒ */
|
||||
ok=0 /* ▒ */
|
||||
select /*validate that there are 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*/ /* ▒ */
|
||||
say 'numbers entered: ' $; say /* ▒ */
|
||||
/*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ */
|
||||
do i=N by -1 to 1; #=word($,i)/1 /*process nums in reverse. */
|
||||
numeric digits compDigs; g=f(#) /*for func. ƒ, use big digs*/
|
||||
numeric digits showdigs; g=g/1 /*scale down output digits.*/
|
||||
gw=right('ƒ('#") ",w+7) /*nice formatted ƒ(number)*/
|
||||
if g>maxValue then say gw "is > " maxValue ' ['g"]"
|
||||
else say gw " = " g /*display the (good) result*/
|
||||
end /*i*/
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────F function──────────────────────────*/
|
||||
f: procedure; arg x; return sqrt(abs(x)) + 5 * x**3
|
||||
/*──────────────────────────────────SQRT function───────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits();numeric digits 11
|
||||
g=.sqrtGuess(); do j=0 while p>9; m.j=p; p=p%2+1; end
|
||||
do k=j+5 to 0 by -1; if m.k>11 then numeric digits m.k; g=.5*(g+x/g); end
|
||||
numeric digits d; return g/1
|
||||
.sqrtGuess: numeric form; m.=11; p=d+d%4+2
|
||||
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; return g*.5'E'_%2
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
f: procedure; parse arg x; return sqrt(abs(x)) + 5 * x**3
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
|
||||
numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
|
||||
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*/
|
||||
numeric digits d; return (g/1)i /*make complex if X < 0.*/
|
||||
|
|
|
|||
|
|
@ -0,0 +1,26 @@
|
|||
object TPKa extends App {
|
||||
final val numbers = scala.collection.mutable.MutableList[Double]()
|
||||
final val in = new java.util.Scanner(System.in)
|
||||
while (numbers.length < CAPACITY) {
|
||||
print("enter a number: ")
|
||||
try {
|
||||
numbers += in.nextDouble()
|
||||
}
|
||||
catch {
|
||||
case _: Exception =>
|
||||
in.next()
|
||||
println("invalid input, try again")
|
||||
}
|
||||
}
|
||||
|
||||
numbers reverseMap { x =>
|
||||
val fx = Math.pow(Math.abs(x), .5D) + 5D * (Math.pow(x, 3))
|
||||
if (fx < THRESHOLD)
|
||||
print("%8.3f -> %8.3f\n".format(x, fx))
|
||||
else
|
||||
print("%8.3f -> %s\n".format(x, Double.PositiveInfinity.toString))
|
||||
}
|
||||
|
||||
private final val THRESHOLD = 400D
|
||||
private final val CAPACITY = 11
|
||||
}
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
Function tpk(s)
|
||||
arr = Split(s," ")
|
||||
For i = UBound(arr) To 0 Step -1
|
||||
n = fx(CDbl(arr(i)))
|
||||
If n > 400 Then
|
||||
WScript.StdOut.WriteLine arr(i) & " = OVERFLOW"
|
||||
Else
|
||||
WScript.StdOut.WriteLine arr(i) & " = " & n
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
Function fx(x)
|
||||
fx = Sqr(Abs(x))+5*x^3
|
||||
End Function
|
||||
|
||||
'testing the function
|
||||
WScript.StdOut.Write "Please enter a series of numbers:"
|
||||
list = WScript.StdIn.ReadLine
|
||||
tpk(list)
|
||||
Loading…
Add table
Add a link
Reference in a new issue