with javascript_semantics
constant N = 6, limit = power(10,N)
-- standard sieve:
enum L,R  -- (with primes[i] as mini bit-field)
sequence primes = repeat(L+R, limit)
primes[1] = 0
for i=2 to floor(sqrt(limit)) do
    if primes[i] then
        for k=i*i to limit by i do
            primes[k] = 0
        end for
    end if
end for

-- propagate non-truncateables up the prime table:
for p=1 to N-1 do
    integer p10 = power(10,p)       -- ie 10, 100, .. 100_000
    for i=p10+1 to p10*10-1 by 2 do -- to 99, 999, .. 999_999
        if primes[i] then
            integer l = remainder(i,p10),
                    r = floor(i/10)
            integer pi = and_bits(primes[l],L)+and_bits(primes[r],R)
            if pi and find('0',sprint(i)) then pi = 0 end if
            primes[i] = pi
        end if
    end for
end for

integer maxl=0, maxr=0

for i=limit-1 to 1 by -2 do
    integer pi = primes[i]
    if pi then
        if maxl=0 and and_bits(pi,L) then maxl = i end if
        if maxr=0 and and_bits(pi,R) then maxr = i end if
        if maxl!=0 and maxr!=0 then exit end if
    end if
end for
?{maxl,maxr}


10 REM Trabb Pardo-Knuth algorithm
20 REM Used "magic numbers" because of strict specification
30 REM of the algorithm.
40 DEF FNF(N) = SQR(ABS(N))+5*N*N*N
50 DIM S(10)
60 PRINT "Enter 11 numbers."
70 FOR I = 0 TO 10
80 PRINT I+1; "- Enter number";
90 INPUT S(I)
100 NEXT I
110 PRINT
120 REM Reverse
130 FOR I = 0 TO 10/2
140 LET T = S(I)
150 LET S(I) = S(10-I)
160 LET S(10-I) = T
170 NEXT I
180 REM Results
190 PRINT "num", "f(num)"
200 FOR I = 0 TO 10
210 LET R = FNF(S(I))
220 IF R>400 THEN 250
230 PRINT S(I), R
240 GOTO 260
250 PRINT S(I), " overflow"
260 NEXT I
270 END


dim s(11)
print 'enter 11 numbers'
for i = 0 to 10
   input i + ">" , s[i]
next i

for i = 10 to 0 step -1
   print "f(" + s[i] + ")=";
   x = f(s[i])
   if x > 400 then
      print "-=< overflow >=-"
   else
      print x
   endif
next i
end

function f(n)
   return sqrt(abs(n))+5*n^3
end function


(load "@lib/rsa.l")  # Use the 'prime?' function from RSA package

(de truncatablePrime? (N Fun)
   (for (L (chop N) L (Fun L))
      (T (= "0" (car L)))
      (NIL (prime? (format L)))
      T ) )

(let (Left 1000000  Right 1000000)
   (until (truncatablePrime? (dec 'Left) cdr))
   (until (truncatablePrime? (dec 'Right) '((L) (cdr (rot L)))))
   (cons Left Right) )


bool is_trunc_prime(int p, string direction)
{
    while(p) {
	if( !p->probably_prime_p() )
	    return false;
	if(direction == "l")
	    p = (int)p->digits()[1..];
	else
	    p = (int)p->digits()[..<1];
    }
    return true;
}

void main()
{
    bool ltp_found, rtp_found;
    for(int prime = 10->pow(6); prime--; prime > 0) {
	if( !ltp_found && is_trunc_prime(prime, "l") ) {
	    ltp_found = true;
	    write("Largest LTP: %d\n", prime);
	}
	if( !rtp_found && is_trunc_prime(prime, "r") ) {
	    rtp_found = true;
	    write("Largest RTP: %d\n", prime);
	}
	if(ltp_found && rtp_found)
	    break;
    }
}


#include<math.h>
#include<stdio.h>

int
main ()
{
  double inputs[11], check = 400, result;
  int i;

  printf ("\nPlease enter 11 numbers :");

  for (i = 0; i < 11; i++)
    {
      scanf ("%lf", &inputs[i]);
    }

  printf ("\n\n\nEvaluating f(x) = |x|^0.5 + 5x^3 for the given inputs :");

  for (i = 10; i >= 0; i--)
    {
      result = sqrt (fabs (inputs[i])) + 5 * pow (inputs[i], 3);

      printf ("\nf(%lf) = ");

      if (result > check)
        {
          printf ("Overflow!");
        }

      else
        {
          printf ("%lf", result);
        }
    }

  return 0;
}


#include <iostream>
#include <cmath>
#include <vector>
#include <algorithm>
#include <iomanip>

int main( ) {
   std::vector<double> input( 11 ) , results( 11 ) ;
   std::cout << "Please enter 11 numbers!\n" ;
   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-- ) {
      std::cout << "f( " << std::setw( 3 ) << input[ i ] << " ) : " ;
      if ( results[ i ] > 400 )
	 std::cout << "too large!" ;
      else
	 std::cout << results[ i ] << " !" ;
      std::cout << std::endl ;
   }
   return 0 ;
}


tp: procedure options (main);
    declare primes(1000000) bit (1);
    declare max_primes fixed binary (31);
    declare (i, k) fixed binary (31);

    max_primes = hbound(primes, 1);
    call sieve;

   /* Now search for primes that are right-truncatable. */
   call right_truncatable;

   /* Now search for primes that are left-truncatable. */
   call left_truncatable;

right_truncatable: procedure;
   declare direction bit (1);
   declare (i, k) fixed binary (31);

test_truncatable:
   do i = max_primes to 2 by -1;
      if primes(i) then /* it's a prime */
         do;
            k = i/10;
            do while (k > 0);
               if ^primes(k) then iterate test_truncatable;
               k = k/10;
            end;
            put skip list (i || ' is right-truncatable');
            return;
         end;
   end;
end right_truncatable;

left_truncatable: procedure;
   declare direction bit (1);
   declare (i, k, d, e) fixed binary (31);

test_truncatable:
   do i = max_primes to 2 by -1;
      if primes(i) then /* it's a prime */
         do;
            k = i;
            do d = 100000 repeat d/10 until (d = 10);
               e = k/d;
               k = k - e*d;
               if e = 0 then iterate test_truncatable;
               if ^primes(k) then iterate test_truncatable;
            end;
            put skip list (i || ' is left-truncatable');
            return;
         end;
   end;
end left_truncatable;

sieve: procedure;
   declare (i, j) fixed binary (31);

   primes = '1'b; primes(1) = '0'b;

   do i = 2 to sqrt(max_primes);
      do j = i+i to max_primes by i;
         primes(j) = '0'b;
      end;
   end;
end sieve;

end tp;


function IsPrime ( [int] $num )
{
    $isprime = @{}
    2..[math]::sqrt($num) | Where-Object {
        $isprime[$_] -eq $null } | ForEach-Object {
        $_
        $isprime[$_] = $true
        for ( $i=$_*$_ ; $i -le $num; $i += $_ )
        { $isprime[$i] = $false }
    }
    2..$num | Where-Object { $isprime[$_] -eq $null }
}

function Truncatable ( [int] $num )
{
    $declen = [math]::abs($num).ToString().Length
    $primes = @()
    $ltprimes = @{}
    $rtprimes = @{}
    1..$declen | ForEach-Object { $ltprimes[$_][email protected]{}; $rtprimes[$_][email protected]{} }
    IsPrime $num | ForEach-Object {
        $lastltprime = 2
        $lastrtprime = 2
    } {
        $curprim = $_
        $curdeclen = $curprim.ToString().Length
        $primes += $curprim
        if( $curdeclen -eq 1 ) {
            $ltprimes[1][$curprim] = $true
            $rtprimes[1][$curprim] = $true
            $lastltprime = $curprim
            $lastrtprime = $curprim
        } else {
            $curmod = $curprim % [math]::pow(10,$curdeclen - 1)
            $curdiv = [math]::floor($curprim / 10)
            if( $ltprimes[$curdeclen - 1][[int]$curmod] ) {
                $ltprimes[$curdeclen][$curprim] = $true
                $lastltprime = $curprim
            }
            if( $rtprimes[$curdeclen - 1][[int]$curdiv] ) {
                $rtprimes[$curdeclen][$curprim] = $true
                $lastrtprime = $curprim
            }
        }
        if( ( $ltprimes[$curdeclen - 2].Keys.count -gt 0 ) -and ( $ltprimes[$curdeclen - 1].Keys.count -gt 0 ) ) { $ltprimes[$curdeclen -2] = @{} }
        if( ( $rtprimes[$curdeclen - 2].Keys.count -gt 0 ) -and ( $rtprimes[$curdeclen - 1].Keys.count -gt 0 ) ) { $rtprimes[$curdeclen -2] = @{} }
    } {
        "Largest Left Truncatable Prime: $lastltprime"
        "Largest Right Truncatable Prime: $lastrtprime"
    }
}


10 REM TRABB PARDO-KNUTH ALGORITHM
20 REM USED "MAGIC NUMBERS" BECAUSE OF STRICT SPECIFICATION OF THE ALGORITHM.
30 DEF FNF(N)=SQR(ABS(N))+5*N*N*N
40 DIM S(10)
50 PRINT "ENTER 11 NUMBERS."
60 FOR I=0 TO 10
70 PRINT STR$(I+1);
80 INPUT S(I)
90 NEXT I
100 PRINT
110 REM REVERSE
120 FOR I=0 TO 10/2
130 TMP=S(I)
140 S(I)=S(10-I)
150 S(10-I)=TMP
160 NEXT I
170 REM RESULTS
180 FOR I=0 TO 10
190 PRINT "F(";STR$(S(I));") =";
200 R=FNF(S(I))
210 IF R>400 THEN PRINT " OVERFLOW":ELSE PRINT R
220 NEXT I
230 END


(defun read-numbers ()
  (princ "Enter 11 numbers (space-separated): ")
  (let ((numbers '()))
    (dotimes (i 11 numbers)
      (push (read) numbers))))

(defun trabb-pardo-knuth (func overflowp)
  (let ((S (read-numbers)))
    (format T "~{~a~%~}"
            (substitute-if "Overflow!" overflowp (mapcar func S)))))

(trabb-pardo-knuth (lambda (x) (+ (expt (abs x) 0.5) (* 5 (expt x 3))))
                   (lambda (x) (> x 400)))


largest_left_truncatable_prime(N, N):-
    is_left_truncatable_prime(N),
    !.
largest_left_truncatable_prime(N, P):-
    N > 1,
    N1 is N - 1,
    largest_left_truncatable_prime(N1, P).

is_left_truncatable_prime(P):-
    is_prime(P),
    is_left_truncatable_prime(P, P, 10).

is_left_truncatable_prime(P, _, N):-
    P =< N,
    !.
is_left_truncatable_prime(P, Q, N):-
    Q1 is P mod N,
    is_prime(Q1),
    Q \= Q1,
    N1 is N * 10,
    is_left_truncatable_prime(P, Q1, N1).

largest_right_truncatable_prime(N, N):-
    is_right_truncatable_prime(N),
    !.
largest_right_truncatable_prime(N, P):-
    N > 1,
    N1 is N - 1,
    largest_right_truncatable_prime(N1, P).

is_right_truncatable_prime(P):-
    is_prime(P),
    Q is P // 10,
    (Q == 0, ! ; is_right_truncatable_prime(Q)).

main(N):-
    find_prime_numbers(N),
    largest_left_truncatable_prime(N, L),
    writef('Largest left-truncatable prime less than %t: %t\n', [N, L]),
    largest_right_truncatable_prime(N, R),
    writef('Largest right-truncatable prime less than %t: %t\n', [N, R]).

main:-
    main(1000000).


#MaxLim = 999999

Procedure is_Prime(n)
  If     n<=1 : ProcedureReturn #False
  ElseIf n<4  : ProcedureReturn #True
  ElseIf n%2=0: ProcedureReturn #False
  ElseIf n<9  : ProcedureReturn #True
  ElseIf n%3=0: ProcedureReturn #False
  Else
    Protected r=Round(Sqr(n),#PB_Round_Down)
    Protected f=5
    While f<=r
      If n%f=0 Or n%(f+2)=0
        ProcedureReturn #False
      EndIf
      f+6
    Wend
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure TruncateLeft(n)
  Protected s.s=Str(n), l=Len(s)-1
  If Not FindString(s,"0",1)
    While l>0
      s=Right(s,l)
      If Not is_Prime(Val(s))
        ProcedureReturn #False
      EndIf
      l-1
    Wend
    ProcedureReturn #True
  EndIf
EndProcedure

Procedure TruncateRight(a)
  Repeat
    a/10
    If Not a
      Break
    ElseIf Not is_Prime(a) Or a%10=0
      ProcedureReturn #False
    EndIf
  ForEver
  ProcedureReturn #True
EndProcedure

i=#MaxLim
Repeat
  If is_Prime(i)
    If Not truncateleft And TruncateLeft(i)
      truncateleft=i
    EndIf
    If Not truncateright And TruncateRight(i)
      truncateright=i
    EndIf
  EndIf
  If truncateleft And truncateright
    Break
  Else
    i-2
  EndIf
Until i<=0

x.s="Largest TruncateLeft= "+Str(truncateleft)
y.s="Largest TruncateRight= "+Str(truncateright)

MessageRequester("Truncatable primes",x+#CRLF$+y)


import std.stdio, std.math, std.conv, std.algorithm, std.array;

double f(in double x) pure nothrow {
    return x.abs.sqrt + 5 * x ^^ 3;
}

void main() {
    double[] data;

    while (true) {
        "Please enter eleven numbers on a line: ".write;
        data = readln.split.map!(to!double).array;
        if (data.length == 11)
            break;
        writeln("Those aren't eleven numbers.");
    }
    foreach_reverse (immutable x; data) {
        immutable y = x.f;
        writefln("f(%0.3f) = %s", x, y > 400 ? "Too large" : y.text);
    }
}


(define (trabb-fun n)
		(+  (* 5 n n n) (sqrt(abs n))))

(define (check-trabb n)
	(if (number? n)
	(if (<=  (trabb-fun n) 400)
		(printf "🌱 f(%d) = %d" n (trabb-fun n))
		(printf "❌  f(%d) = %d" n (trabb-fun n)))
	(error "not a number" n)))

(define (trabb (numlist null))
	(while (< (length numlist) 11)
	(set! numlist (append numlist
		(or
		(read default: (shuffle (iota 11))
		      prompt: (format "Please enter %d more numbers" (- 11 (length numlist))))
		(error 'incomplete-list numlist))))) ;; users cancel
	(for-each check-trabb (reverse (take numlist 11))))


maxprime = 1000000

def primes(n):
    multiples = set()
    prime = []
    for i in range(2, n+1):
        if i not in multiples:
            prime.append(i)
            multiples.update(set(range(i*i, n+1, i)))
    return prime

def truncatableprime(n):
    'Return a longest left and right truncatable primes below n'
    primelist = [str(x) for x in primes(n)[::-1]]
    primeset = set(primelist)
    for n in primelist:
        # n = 'abc'; [n[i:] for i in range(len(n))] -> ['abc', 'bc', 'c']
        alltruncs = set(n[i:] for i in range(len(n)))
        if alltruncs.issubset(primeset):
            truncateleft = int(n)
            break
    for n in primelist:
        # n = 'abc'; [n[:i+1] for i in range(len(n))] -> ['a', 'ab', 'abc']
        alltruncs = set([n[:i+1] for i in range(len(n))])
        if alltruncs.issubset(primeset):
            truncateright = int(n)
            break
    return truncateleft, truncateright

print(truncatableprime(maxprime))


open monad io number string

:::IO

take_numbers 0 xs = do
  return $ iter xs
  where f x = sqrt (toSingle x) + 5.0 * (x ** 3.0)
        p x = x < 400.0
        iter [] = return ()
        iter (x::xs)
          | p res = do
              putStrLn (format "f({0}) = {1}" x res)
              iter xs
          | else = do
              putStrLn (format "f({0}) :: Overflow" x)
              iter xs
          where res = f x
take_numbers n xs = do
  x <- readAny
  take_numbers (n - 1) (x::xs)

do
  putStrLn "Please enter 11 numbers:"
  take_numbers 11 []


import extensions;
import extensions'math;

public program()
{
    real[] inputs := new real[](11);
    console.printLine("Please enter 11 numbers :");
    for(int i := 0, i < 11, i += 1)
    {
        inputs[i] := console.readLine().toReal()
    };

    console.printLine("Evaluating f(x) = |x|^0.5 + 5x^3 for the given inputs :");
    for(int i := 10, i >= 0, i -= 1)
    {
        real result := sqrt(abs(inputs[i])) + 5 * power(inputs[i], 3);

        console.print("f(", inputs[i], ")=");

        if (result > 400)
        {
            console.printLine("Overflow!")
        }
        else
        {
            console.printLine(result)
        }
    }
}


defmodule Trabb_Pardo_Knuth do
  def task do
    Enum.reverse( get_11_numbers )
    |> Enum.each( fn x -> perform_operation( &function(&1), 400, x ) end )
  end

  defp alert( n ), do: IO.puts "Operation on #{n} overflowed"

  defp get_11_numbers do
    ns = IO.gets( "Input 11 integers.  Space delimited, please: " )
         |> String.split
         |> Enum.map( &String.to_integer &1 )
    if 11 == length( ns ), do: ns, else: get_11_numbers
  end

  defp function( x ), do: :math.sqrt( abs(x) ) + 5 * :math.pow( x, 3 )

  defp perform_operation( fun, overflow, n ), do: perform_operation_check_overflow( n, fun.(n), overflow )

  defp perform_operation_check_overflow( n, result, overflow ) when result > overflow, do: alert( n )
  defp perform_operation_check_overflow( n, result, _overflow ), do: IO.puts "f(#{n}) => #{result}"
end

Trabb_Pardo_Knuth.task


-module( trabb_pardo_knuth ).

-export( [task/0] ).

task() ->
	Sequence = get_11_numbers(),
	S = lists:reverse( Sequence ),
	[perform_operation( fun  function/1, 400, X) || X <- S].

alert( N ) -> io:fwrite( "Operation on ~p overflowed~n", [N] ).

get_11_numbers() ->
	{ok, Ns} = io:fread( "Input 11 integers.  Space delimited, please:  ", "~d ~d ~d ~d ~d ~d ~d  ~d ~d ~d ~d" ),
	11 = erlang:length( Ns ),
	Ns.

function( X ) -> math:sqrt( erlang:abs(X) ) + 5 * math:pow( X, 3 ).

perform_operation( Fun, Overflow, N ) -> perform_operation_check_overflow( N, Fun(N), Overflow ).

perform_operation_check_overflow( N, Result, Overflow ) when Result > Overflow -> alert( N );
perform_operation_check_overflow( N, Result, _Overflow ) -> io:fwrite( "f(~p) => ~p~n", [N, Result] ).


  1000000 eratosthenes

  [ false swap
    number$ witheach
      [ char 0 =
        if [ conclude not ] ] ] is haszero      ( n --> b )

  [ 10 / ]                      is truncright   ( n --> n )

  [ number$
    behead drop $->n drop ]     is truncleft    ( n --> n )

  [ dup isprime not iff
      [ drop false ] done
    dup haszero iff
      [ drop false ] done
    true swap
    [ truncleft
      dup 0 > while
      dup isprime not iff
        [ dip not ] done
      again ] drop ]           is ltruncatable ( n --> b )

  [ dup isprime not iff
      [ drop false ] done
    dup haszero iff
      [ drop false ] done
    true swap
    [ truncright
      dup 0 > while
      dup isprime not iff
        [ dip not ] done
      again ] drop ]           is rtruncatable ( n --> b )

  say "Left:  "
  1000000 times [ i ltruncatable if [ i echo conclude ] ]
  cr
  say "Right: "
  1000000 times [ i rtruncatable if [ i echo conclude ] ]
  cr


#lang racket
(require math/number-theory)

(define (truncate-right n)
  (quotient n 10))

(define (truncate-left n)
  (define s (number->string n))
  (string->number (substring s 1 (string-length s))))

(define (contains-zero? n)
  (member #\0 (string->list (number->string n))))

(define (truncatable? truncate n)
  (and (prime? n)
       (not (contains-zero? n))
       (or (< n 10)
           (truncatable? truncate (truncate n)))))

; largest left truncatable prime
(for/first ([n (in-range 1000000 1 -1)]
            #:when (truncatable? truncate-left n))
  n)

; largest right truncatable prime
(for/first ([n (in-range 1000000 1 -1)]
            #:when (truncatable? truncate-right n))
  n)

; Output:
998443
739399


!Trabb Pardo-Knuth algorithm
PROGRAM TPK
!VAR I%,Y
DIM A[10]

FUNCTION F(T)
    F=SQR(ABS(T))+5*T^3
END FUNCTION

BEGIN
  DATA(10,-1,1,2,3,4,4.3,4.305,4.303,4.302,4.301)
  FOR I%=0 TO 10 DO
      READ(A[I%])
  END FOR
  FOR I%=10 TO 0 STEP -1 DO
       Y=F(A[I%])
       PRINT("F(";A[I%];")=";)
       IF Y>400 THEN PRINT("--->too large<---")
                ELSE PRINT(Y)
       END IF
  END FOR
END PROGRAM


module ``Trabb Pardo - Knuth``
open System
let f (x: float) = sqrt(abs x) + (5.0 * (x ** 3.0))

Console.WriteLine "Enter 11 numbers:"
[for _ in 1..11 -> Convert.ToDouble(Console.ReadLine())]
|> List.rev |> List.map f |> List.iter (function
| n when n <= 400.0 -> Console.WriteLine(n)
| _                 -> Console.WriteLine("Overflow"))


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


/*REXX program finds largest  left─ and right─truncatable  primes ≤ 1m  (or argument 1).*/
parse arg hi .;      if hi==''  then hi= 1000000 /*Not specified? Then use default of 1m*/
call genP                                        /*generate some primes,  about  hi ÷ 2 */
                                                 /* [↓]  find largest left truncatable P*/
  do L=#  by -1  for #                           /*search from top end;  get the length.*/
       do k=1  for length(@.L); _= right(@.L, k) /*validate all left truncatable primes.*/
       if \!._  then iterate L                   /*Truncated number not prime?  Skip it.*/
       end   /*k*/
  leave                                          /*egress, found left truncatable prime.*/
  end        /*L*/
                                                 /* [↓]  find largest right truncated P.*/
  do R=#  by -1  for #                           /*search from top end;  get the length.*/
       do k=1  for length(@.R);  _= left(@.R, k) /*validate all right truncatable primes*/
       if \!._  then iterate R                   /*Truncated number not prime?  Skip it.*/
       end   /*k*/
  leave                                          /*egress, found right truncatable prime*/
  end        /*R*/

say 'The largest  left─truncatable prime ≤'        hi        " is "       right(@.L, w)
say 'The largest right─truncatable prime ≤'        hi        " is "       right(@.R, w)
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
genP: !.= 0;                     w= length(hi)   /*placeholders for primes;  max width. */
      @.1=2;  @.2=3;  @.3=5;  @.4=7;  @.5=11     /*define some low primes.              */
      !.2=1;  !.3=1;  !.5=1;  !.7=1;  !.11=1     /*   "     "   "    "     flags.       */
                        #=5;     s.#= @.# **2    /*number of primes so far;     prime². */
                                                 /* [↓]  generate more  primes  ≤  high.*/
        do [email protected].#+2  by 2  for max(0, hi%[email protected].#%2-1)      /*find odd primes from here on. */
        parse var j '' -1 _; if     _==5  then iterate  /*J divisible by 5?  (right dig)*/
                             if j// 3==0  then iterate  /*"     "      " 3?             */
                             if j// 7==0  then iterate  /*"     "      " 7?             */
                                                 /* [↑]  the above five lines saves time*/
               do k=5  while s.k<=j              /* [↓]  divide by the known odd primes.*/
               if j // @.k == 0  then iterate j  /*Is  J ÷ X?  Then not prime.     ___  */
               end   /*k*/                       /* [↑]  only process numbers  ≤  √ J   */
        #= #+1;    @.#= j;    s.#= j*j;   !.j= 1 /*bump # of Ps; assign next P;  P²; P# */
        end          /*j*/
     return


: f(x)  fdup fsqrt fswap 3e f** 5e f* f+ ;

4e2 fconstant f-too-big

11 Constant #Elements

: float-array ( compile: n -- / run: n -- addr )
    create
        floats allot
    does>
        swap floats + ;

#Elements float-array vec

: get-it  ( -- )
    ." Enter " #Elements . ." numbers:" cr
    #Elements 0 DO
        ." > " pad 25 accept cr
        pad swap >float 0= abort" Invalid Number"
        i vec F!
    LOOP ;

: reverse-it ( -- )
    #Elements 2/  0 DO
        i vec [email protected]  #Elements i - 1- vec [email protected]
        i vec F!  #Elements i - 1- vec F!
    LOOP ;

: do-it ( -- )
    #Elements 0 DO
        i vec [email protected] fdup f. [char] : emit space
	f(x) fdup f-too-big f> IF
            fdrop ." too large"
        ELSE
            f.
        THEN cr
    LOOP ;

: tpk  ( -- )
    get-it reverse-it do-it ;


program tpk
  implicit none

  real, parameter :: overflow = 400.0
  real :: a(11), res
  integer :: i

  write(*,*) "Input eleven numbers:"
  read(*,*) a

  a = a(11:1:-1)
  do i = 1, 11
    res = f(a(i))
    write(*, "(a, f0.3, a)", advance = "no") "f(", a(i), ") = "
    if(res > overflow) then
      write(*, "(a)") "overflow!"
    else
       write(*, "(f0.3)") res
    end if
  end do

contains

real function f(x)
  real, intent(in) :: x

  f = sqrt(abs(x)) + 5.0*x**3

end function
end program


# Project : Truncatable primes

for n = 1000000 to 1 step -1
    flag = 1
    flag2 = 1
    strn = string(n)
    for nr = 1 to len(strn)
        if strn[nr] = "0"
           flag2 = 0
        ok
    next
    if flag2 = 1
       for m = 1 to len(strn)
           strp = right(strn, m)
           if isprime(number(strp))
           else
              flag = 0
              exit
           ok
       next
       if flag = 1
          nend = n
          exit
       ok
    ok
next
see "Largest left truncatable prime : " + nend + nl

for n = 1000000 to 1 step -1
    flag = 1
    strn = string(n)
    for m = 1 to len(strn)
        strp = left(strn, len(strn) - m + 1)
        if isprime(number(strp))
        else
           flag = 0
           exit
        ok
    next
    if flag = 1
       nend = n
       exit
    ok
next
see "Largest right truncatable prime : " + nend + nl

func isprime num
     if (num <= 1) return 0 ok
     if (num % 2 = 0 and num != 2) return 0 ok
     for i = 3 to floor(num / 2) -1 step 2
         if (num % i = 0) return 0 ok
     next
     return 1


def left_truncatable?(n)
  truncatable?(n) {|i| i.to_s[1..-1].to_i}
end

def right_truncatable?(n)
  truncatable?(n) {|i| i/10}
end

def truncatable?(n, &trunc_func)
  return false if n.to_s.include? "0"
  loop do
    n = trunc_func.call(n)
    return true if n.zero?
    return false unless Prime.prime?(n)
  end
end

require 'prime'
primes = Prime.each(1_000_000).to_a.reverse

p primes.detect {|p| left_truncatable? p}
p primes.detect {|p| right_truncatable? p}


' version 22-07-2017
' compile with: fbc -s console

Function f(n As Double) As Double
    return Sqr(Abs(n)) + 5 * n ^ 3
End Function

' ------=< MAIN >=------

Dim As Double x, s(1 To 11)
Dim As Long i

For i = 1 To 11
    Print Str(i);
    Input " => ", s(i)
Next

Print
Print String(20,"-")

i -= 1
Do
    Print "f(" + Str(s(i)) + ") = ";
   x = f(s(i))
   If x > 400 Then
       Print "-=< overflow >=-"
   Else
       Print x
   End If
   i -= 1
Loop Until i < 1

' empty keyboard buffer
While InKey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End


package main

import (
    "fmt"
    "log"
    "math"
)

func main() {
    // prompt
    fmt.Print("Enter 11 numbers: ")
    // accept sequence
    var s [11]float64
    for i := 0; i < 11; {
        if n, _ := fmt.Scan(&s[i]); n > 0 {
            i++
        }
    }
    // reverse sequence
    for i, item := range s[:5] {
        s[i], s[10-i] = s[10-i], item
    }
    // iterate
    for _, item := range s {
        if result, overflow := f(item); overflow {
            // send alerts to stderr
            log.Printf("f(%g) overflow", item)
        } else {
            // send normal results to stdout
            fmt.Printf("f(%g) = %g\n", item, result)
        }
    }
}

func f(x float64) (float64, bool) {
    result := math.Sqrt(math.Abs(x)) + 5*x*x*x
    return result, result > 400
}


fn is_prime(n: u32) -> bool {
    if n < 2 {
        return false;
    }
    if n % 2 == 0 {
        return n == 2;
    }
    if n % 3 == 0 {
        return n == 3;
    }
    let mut p = 5;
    while p * p <= n {
        if n % p == 0 {
            return false;
        }
        p += 2;
        if n % p == 0 {
            return false;
        }
        p += 4;
    }
    true
}

fn is_left_truncatable(p: u32) -> bool {
    let mut n = 10;
    let mut q = p;
    while p > n {
        if !is_prime(p % n) || q == p % n {
            return false;
        }
        q = p % n;
        n *= 10;
    }
    true
}

fn is_right_truncatable(p: u32) -> bool {
    let mut q = p / 10;
    while q > 0 {
        if !is_prime(q) {
            return false;
        }
        q /= 10;
    }
    true
}

fn main() {
    let limit = 1000000;
    let mut largest_left = 0;
    let mut largest_right = 0;
    let mut p = limit;
    while p >= 2 {
        if is_prime(p) && is_left_truncatable(p) {
            largest_left = p;
            break;
        }
        p -= 1;
    }
    println!("Largest left truncatable prime is {}", largest_left);
    p = limit;
    while p >= 2 {
        if is_prime(p) && is_right_truncatable(p) {
            largest_right = p;
            break;
        }
        p -= 1;
    }
    println!("Largest right truncatable prime is {}", largest_right);
}


object TruncatablePrimes {
  def main(args: Array[String]): Unit = {
    val max = 1000000

    println(
      s"""|ltPrime: ${ltPrimes.takeWhile(_ <= max).last}
          |rtPrime: ${rtPrimes.takeWhile(_ <= max).last}
          |""".stripMargin)
  }

  def ltPrimes: LazyList[Int] = 2 #:: LazyList.from(3, 2).filter(isLeftTruncPrime)
  def rtPrimes: LazyList[Int] = 2 #:: LazyList.from(3, 2).filter(isRightTruncPrime)

  def isPrime(num: Int): Boolean = (num > 1) && !LazyList.range(3, math.sqrt(num).toInt + 1, 2).exists(num%_ == 0)
  def isLeftTruncPrime(num: Int): Boolean = !num.toString.contains('0') && Iterator.unfold(num.toString){str => if(str.nonEmpty) Some((str.toInt, str.tail)) else None}.forall(isPrime)
  def isRightTruncPrime(num: Int): Boolean = !num.toString.exists(_.asDigit%2 == 0) && Iterator.unfold(num.toString){str => if(str.nonEmpty) Some((str.toInt, str.init)) else None}.forall(isPrime)
}


import Control.Monad (replicateM, mapM_)

f :: Floating a => a -> a
f x = sqrt (abs x) + 5 * x ** 3

main :: IO ()
main = do
  putStrLn "Enter 11 numbers for evaluation"
  x <- replicateM 11 readLn
  mapM_
    ((\x ->
         if x > 400
           then putStrLn "OVERFLOW"
           else print x) .
     f) $
    reverse x


procedure main()
    S := []
    writes("Enter 11 numbers: ")
    read() ? every !11 do (tab(many(' \t'))|0,put(S, tab(upto(' \t')|0)))
    every item := !reverse(S) do
        write(item, " -> ", (400 >= f(item)) | "overflows")
end

procedure f(x)
   return abs(x)^0.5 + 5*x^3
end


func t_prime(n, left=true) {
    var p = %w(2 3 5 7);
    var f = (
        left ? { '1'..'9' ~X+ p }
             : { p ~X+ '1'..'9' }
    )
    n.times {
        p = f().grep{ .to_i.is_prime }
    }
    p.map{.to_i}.max
}

say t_prime(5, left: true)
say t_prime(5, left: false)


func isPrime(_ n: Int) -> Bool {
    if n < 2 {
        return false
    }
    if n % 2 == 0 {
        return n == 2
    }
    if n % 3 == 0 {
        return n == 3
    }
    var p = 5
    while p * p <= n {
        if n % p == 0 {
            return false
        }
        p += 2
        if n % p == 0 {
            return false
        }
        p += 4
    }
    return true
}

func isLeftTruncatable(_ p: Int) -> Bool {
    var n = 10
    var q = p
    while p > n {
        if !isPrime(p % n) || q == p % n {
            return false
        }
        q = p % n
        n *= 10
    }
    return true
}

func isRightTruncatable(_ p: Int) -> Bool {
    var q = p / 10
    while q > 0 {
        if !isPrime(q) {
            return false
        }
        q /= 10
    }
    return true
}

let limit = 1000000
var largestLeft = 0
var largestRight = 0
var p = limit
while p >= 2 {
    if isPrime(p) && isLeftTruncatable(p) {
        largestLeft = p
        break
    }
    p -= 1
}
print("Largest left truncatable prime is \(largestLeft)")
p = limit
while p >= 2 {
    if isPrime(p) && isRightTruncatable(p) {
        largestRight = p
        break
    }
    p -= 1
}
print("Largest right truncatable prime is \(largestRight)")


// Initialize objects to be used
in_num := File standardInput()
nums := List clone
result := Number

// Prompt the user and get numbers from standard input
"Please enter 11 numbers:" println
11 repeat(nums append(in_num readLine() asNumber()))

// Reverse the numbers received
nums reverseInPlace

// Apply the function and tell the user if the result is above
// our limit. Otherwise, tell them the result.
nums foreach(v,
  // v needs parentheses around it for abs to properly convert v to its absolute value
  result = (v) abs ** 0.5 + 5 * v ** 3
  if (result > 400,
    "Overflow!" println
  ,
     result println
  )
)


/**
 * Alexander Alvonellos
 */
import java.util.*;
import java.io.*;

public class TPKA {
	public static void main(String... args) {
		double[] input = new double[11];
		double userInput = 0.0;
		Scanner in = new Scanner(System.in);
		for(int i = 0; i < 11; i++) {
			System.out.print("Please enter a number: ");
			String s = in.nextLine();
			try {
				userInput = Double.parseDouble(s);
			} catch (NumberFormatException e) {
				System.out.println("You entered invalid input, exiting");
				System.exit(1);
			}
			input[i] = userInput;
		}
		for(int j = 10; j >= 0; j--) {
			double x = input[j]; double y = f(x);
			if( y < 400.0) {
				System.out.printf("f( %.2f ) = %.2f\n", x, y);
			} else {
				System.out.printf("f( %.2f ) = %s\n", x, "TOO LARGE");
			}
		}
	}

	private static double f(double x) {
		return Math.pow(Math.abs(x), 0.5) + (5*(Math.pow(x, 3)));
	}
}


package require Tcl 8.5

# Optimized version of the Sieve-of-Eratosthenes task solution
proc sieve n {
    set primes [list]
    if {$n < 2} {return $primes}
    set nums [dict create]
    for {set i 2} {$i <= $n} {incr i} {
        dict set nums $i ""
    }
    set next 2
    set limit [expr {sqrt($n)}]
    while {$next <= $limit} {
        for {set i $next} {$i <= $n} {incr i $next} {dict unset nums $i}
        lappend primes $next
	dict for {next -} $nums break
    }
    return [concat $primes [dict keys $nums]]
}

proc isLeftTruncatable n {
    global isPrime
    while {[string length $n] > 0} {
	if {![info exist isPrime($n)]} {
	    return false
	}
	set n [string range $n 1 end]
    }
    return true
}
proc isRightTruncatable n {
    global isPrime
    while {[string length $n] > 0} {
	if {![info exist isPrime($n)]} {
	    return false
	}
	set n [string range $n 0 end-1]
    }
    return true
}

# Demo code
set limit 1000000
puts "calculating primes up to $limit"
set primes [sieve $limit]
puts "search space contains [llength $primes] members"
foreach p $primes {
    set isPrime($p) "yes"
}
set primes [lreverse $primes]

puts "searching for largest left-truncatable prime"
foreach p $primes {
    if {[isLeftTruncatable $p]} {
	puts FOUND:$p
	break
    }
}

puts "searching for largest right-truncatable prime"
foreach p $primes {
    if {[isRightTruncatable $p]} {
	puts FOUND:$p
	break
    }
}


#!/usr/bin/env js

function main() {
    var nums = getNumbers(11);
    nums.reverse();
    for (var i in  nums) {
        pardoKnuth(nums[i], fn, 400);
    }
}

function pardoKnuth(n, f, max) {
    var res = f(n);
    putstr('f(' + String(n) + ')');
    if (res > max) {
        print(' is too large');
    } else {
        print(' = ' + String(res));
    }
}

function fn(x) {
    return Math.pow(Math.abs(x), 0.5) + 5 * Math.pow(x, 3);
}

function getNumbers(n) {
    var nums = [];
    print('Enter', n, 'numbers.');
    for (var i = 1; i <= n; i++) {
        putstr('   ' + i + ': ');
        var num = readline();
        nums.push(Number(num));
    }
    return nums;
}

main();


def f:
  def abs: if . < 0 then -. else . end;
  def power(x): (x * log) | exp;
  . as $x | abs | power(0.5) + (5 * (.*.*. ));

. as $in | split(" ") | map(tonumber)
| if length == 11 then
    reverse | map(f | if . > 400 then "TOO LARGE" else . end)
  else error("The number of numbers was not 11.")
  end
| .[]  # print one result per line


start_time = Now

lt = 0
rt = 0

For h = 1 To 1000000
	If IsLeftTruncatable(h) And h > lt Then
		lt = h
	End If
	If IsRightTruncatable(h) And h > rt Then
		rt = h
	End If
Next

end_time = now

WScript.StdOut.WriteLine "Largest LTP from 1..1000000: " & lt
WScript.StdOut.WriteLine "Largest RTP from 1..1000000: " & rt
WScript.StdOut.WriteLine "Elapse Time(seconds)       : " & DateDiff("s",start_time,end_time)

'------------
Function IsLeftTruncatable(n)
	IsLeftTruncatable = False
	c = 0
	For i = Len(n) To 1 Step -1
		If InStr(1,n,"0") > 0 Then
			Exit For
		End If
		If IsPrime(Right(n,i)) Then
			c = c + 1
		End If
	Next
	If c = Len(n) Then
		IsLeftTruncatable = True
	End If
End Function

Function IsRightTruncatable(n)
	IsRightTruncatable = False
	c = 0
	For i = Len(n) To 1 Step -1
		If InStr(1,n,"0") > 0 Then
			Exit For
		End If
		If IsPrime(Left(n,i)) Then
			c = c + 1
		End If
	Next
	If c = Len(n) Then
		IsRightTruncatable = True
	End If
End Function

Function IsPrime(n)
	If n = 2 Then
		IsPrime = True
	ElseIf n <= 1 Or n Mod 2 = 0 Then
		IsPrime = False
	Else
		IsPrime = True
		For i = 3 To Int(Sqr(n)) Step 2
			If n Mod i = 0 Then
				IsPrime = False
				Exit For
			End If
		Next
	End If
End Function


import "/fmt" for Fmt
import "/math" for Int

var limit = 999999
var c = Int.primeSieve(limit, false)
var leftFound = false
var rightFound = false
System.print("Largest truncatable primes less than a million:")
var i = limit
while (i > 2) {
    if (!c[i]) {
        if (!rightFound) {
            var p = (i/10).floor
            while (p > 0) {
                if (p%2 == 0 || c[p]) break
                p = (p/10).floor
            }
            if (p == 0) {
                System.print("  Right truncatable prime = %(Fmt.dc(0, i))")
                rightFound = true
                if (leftFound) return
            }
        }
        if (!leftFound) {
            var q = i.toString[1..-1]
            if (!q.contains("0")) {
                var p = Num.fromString(q)
                while (q.count > 0) {
                    if (p%2 == 0 || c[p]) break
                    q = q[1..-1]
                    p = Num.fromString(q)
                }
                if (q == "") {
                    System.print("  Left truncatable prime  = %(Fmt.dc(0, i))")
                    leftFound = true
                    if (rightFound) return
                }
            }
        }
    }
    i = i - 2
}


f(x) = √abs(x) + 5x^3
for i in reverse(split(readline()))
    v = f(parse(Int, i))
    println("$(i): ", v > 400 ? "TOO LARGE" : v)
end


// version 1.1.2

fun f(x: Double) = Math.sqrt(Math.abs(x)) + 5.0 * x * x * x

fun main(args: Array<String>) {
    val da = DoubleArray(11)
    println("Please enter 11 numbers:")
    var i = 0
    while (i < 11) {
        print("  ${"%2d".format(i + 1)}: ")
        val d = readLine()!!.toDoubleOrNull()
        if (d == null)
            println("Not a valid number, try again")
        else
            da[i++] = d
    }
    println("\nThe sequence you just entered in reverse is:")
    da.reverse()
    println(da.contentToString())
    println("\nProcessing this sequence...")
    for (j in 0..10) {
        val v = f(da[j])
        print("  ${"%2d".format(j + 1)}: ")
        if (v > 400.0)
            println("Overflow!")
        else
            println(v)
    }
}


code CrLf=9, IntOut=11;

func Prime(P);          \Return true if P is a prime number
int  P;                 \(1 is not prime, but 2 is, etc.)
int  I;
[if P<=1 then return false;     \negative numbers are not prime
for I:= 2 to sqrt(P) do
        if rem(P/I) = 0 then return false;
return true;
];

func RightTrunc(N);     \Return largest right-truncatable prime < one million
int N;
int M;
[for N:= 1_000_000-1 downto 2 do
        [M:= N;
        loop    [if not Prime(M) then quit;
                M:= M/10;
                if rem(0) = 0 then quit;        \no zeros allowed
                if M=0 then return N;
                ];
        ];
];

func LeftTrunc(N);      \Return largest left-truncatable prime < one million
int N;
int M, P;
[for N:= 1_000_000-1 downto 2 do
        [M:= N;
        P:=100_000;
        loop    [if not Prime(M) then quit;
                M:= rem(M/P);
                P:= P/10;
                if M<P then quit;               \no zeros allowed
                if M=0 then return N;
                ];
        ];
];

[IntOut(0, LeftTrunc);  CrLf(0);
 IntOut(0, RightTrunc); CrLf(0);
]


const million=0d1_000_000;

var pTable=Data(million+1,Int).fill(0);	// actually bytes, all zero
primes:=Utils.Generator(Import("sieve").postponed_sieve);
while((p:=primes.next())<million){ pTable[p]=1; }

fcn rightTrunc(n){
   while(n){ if(not pTable[n]) return(False); n/=10; }
   True
}
fcn leftTrunc(n){  // 999,907 is not allowed
   ns:=n.toString(); if (ns.holds("0")) return(False);
   while(ns){ if(not pTable[ns]) return(False); ns=ns[1,*]; }
   True
}


#!/bin/ksh

# Trabb Pardo–Knuth algorithm

#	# Variables:
#
integer NUM_ELE=11
typeset -F FUNC_LIMIT=400

#	# Functions:
#
#	# Function _input(_arr) - Ask for user input, build array
#
function _input {
	typeset _arr ; nameref _arr="$1"
	typeset _i ; integer _i

	clear ; print "Please input 11 numbers..."
	for ((_i=1 ; _i<=NUM_ELE ; _i++)); do
		read REPLY?"${_i}: "
		[[ $REPLY != {,1}(-)+(\d){,1}(.)*(\d) ]] && ((_i--)) && continue
		_arr+=( $REPLY )
	done
}

#	# Function _function() - Apply |x|^0.5 + 5x^3
#	#	note: >400 creates an overflow situation
#
function _function {
	typeset _x ; _x=$1

	(( _result = sqrt(abs(${_x})) + 5 * _x * _x * _x ))
	(( _result <= $FUNC_LIMIT )) && echo ${_result} && return 0
	return 1
}

 ######
# main #
 ######

typeset -a inputarr
_input inputarr
integer i
printf "%s\n\n" "Evaluating f(x) = |x|^0.5 + 5x^3 for the given inputs :"
for (( i=NUM_ELE-1; i>=0; i-- )); do
	result=$(_function ${inputarr[i]})
	if (( $? )); then
		printf "%s\n" "Overflow"
	else
		printf "%s\n" "${result}"
	fi
done


' Trabb Pardo-Knuth algorithm
' Used "magic numbers" because of strict specification of the algorithm.
dim s(10)
print "Enter 11 numbers."
for i = 0 to 10
  print i + 1;
  input " => "; s(i)
next i
print
' Reverse
for i = 0 to 10 / 2
  tmp = s(i)
  s(i) = s(10 - i)
  s(10 - i) = tmp
next i
'Results
for i = 0 to 10
  print "f("; s(i); ") = ";
  r = f(s(i))
  if r > 400 then
    print "overflow"
  else
    print r
  end if
next i
end

function f(n)
  f = sqr(abs(n)) + 5 * n * n * n
end function


function f (x) return math.abs(x)^0.5 + 5*x^3 end

function reverse (t)
    local rev = {}
    for i, v in ipairs(t) do rev[#t - (i-1)] = v end
    return rev
end

local sequence, result = {}
print("Enter 11 numbers...")
for n = 1, 11 do
    io.write(n .. ": ")
    sequence[n] = io.read()
end
for _, x in ipairs(reverse(sequence)) do
    result = f(x)
    if result > 400 then print("Overflow!") else print(result) end
end


Module Input11 {
      Flush ' empty stack
      For I=1 to 11 {
            Input "Give me a number ", a
            Data a   ' add to bottom of stack, use: Push a to add to top, to get reverse order here
      }
}
Module Run {
      Print "Trabb Pardo–Knuth algorithm"
      Print "f(x)=Sqrt(Abs(x))+5*x^3"
      if not match("NNNNNNNNN") then Error "Need 11 numbers"
      Shiftback 1, -11 ' reverse  order 11 elements of stack of values
      Def f(x)=Sqrt(Abs(x))+5*x^3
      For i=1 to 11 {
            Read pop
            y=f(pop)
            if y>400 Then {
                  Print format$("f({0}) = Overflow!", pop)
            }  Else {
                  Print format$("f({0}) = {1}", pop, y)
            }
      }
}
Run 10, -1, 1, 2, 3, 4, 4.3, 4.305, 4.303, 4.302, 4.301
Run 1, 2, 3, -4.55,5.1111, 6, -7, 8, 9, 10, 11
Input11
Run


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:


numbers=RandomReal[{-2,6},11]
tpk[numbers_,overflowVal_]:=Module[{revNumbers},
 revNumbers=Reverse[numbers];
 f[x_]:=Abs[x]^0.5+5 x^3;
 Do[
  If[f[i]>overflowVal,
   Print["f[",i,"]= Overflow"]
  ,
   Print["f[",i,"]= ",f[i]]
  ]
  ,
  {i,revNumbers}
 ]
]
tpk[numbers,400]


((0 <) (-1 *) when) :abs
(((abs 0.5 pow) (3 pow 5 * +)) cleave) :fn
"Enter 11 numbers:" puts!
(gets float) 11 times
(fn (400 <=) (pop "Overflow") unless puts!) 11 times


10 REM Trabb Pardo-Knuth algorithm
20 REM Used "magic numbers" because of strict
30 REM specification of the algorithm.
40 DEF FNF(N)=SQR(ABS(N))+5*N*N*N
50 DIM S(10)
60 PRINT "Enter 11 numbers."
70 FOR I=0 TO 10
80 PRINT STR$(I+1);
90 INPUT S(I)
100 NEXT I
110 PRINT
120 REM ** Reverse
130 FOR I=0 TO 10/2
140 TMP=S(I)
150 S(I)=S(10-I)
160 S(10-I)=TMP
170 NEXT I
180 REM ** Results
190 FOR I=0 TO 10
200 PRINT "f(";STR$(S(I));") =";
210 R=FNF(S(I))
220 IF R>400 THEN PRINT " overflow":GOTO 240
230 PRINT R
240 NEXT I
250 END


import math, rdstdin, strutils, algorithm, sequtils

proc f(x: float): float = x.abs.pow(0.5) + 5 * x.pow(3)

proc ask: seq[float] =
  readLineFromStdin("11 numbers: ").strip.split[0..10].map(parseFloat)

var s = ask()
reverse s
for x in s:
  let result = f(x)
  echo x, ": ", if result > 400: "TOO LARGE!" else: $result


//
//  TPKA.m
//  RosettaCode
//
//  Created by Alexander Alvonellos on 5/26/12.
//  Trabb Pardo-Knuth algorithm
//

#import <Foundation/Foundation.h>
double f(double x);

double f(double x) {
    return pow(abs(x), 0.5) + 5*(pow(x, 3));
}

int main (int argc, const char * argv[])
{
    @autoreleasepool {
        NSMutableArray *input = [[NSMutableArray alloc] initWithCapacity:0];

        printf("%s", "Instructions: please enter 11 numbers.\n");
        for(int i = 0; i < 11; i++) {
            double userInput = 0.0;
            printf("%s", "Please enter a number: ");
            scanf("%lf", &userInput);
            [input addObject: @(userInput)];
        }

        for(int i = 10; i >= 0; i--) {
            double x = [input[i] doubleValue];
            double y = f(x);
            printf("f(%.2f) \t=\t", x);
            if(y < 400.0) {
                printf("%.2f\n", y);
            } else {
                printf("%s\n", "TOO LARGE");
            }
        }
    }
    return 0;
}


let f x = sqrt x +. 5.0 *. (x ** 3.0)
let p x = x < 400.0

let () =
  print_endline "Please enter 11 Numbers:";
  let lst = Array.to_list (Array.init 11 (fun _ -> read_float ())) in
  List.iter (fun x ->
    let res = f x in
    if p res
    then Printf.printf "f(%g) = %g\n%!" x res
    else Printf.eprintf "f(%g) :: Overflow\n%!" x
  ) (List.rev lst)


{
  print("11 numbers: ");
  v=vector(11, n, eval(input()));
  v=apply(x->x=sqrt(abs(x))+5*x^3;if(x>400,"overflow",x), v);
  vector(11, i, v[12-i])
}


print "Enter 11 numbers:\n";
for ( 1..11 ) {
   $number = <STDIN>;
   chomp $number;
   push @sequence, $number;
}

for $n (reverse @sequence) {
   my $result = sqrt( abs($n) ) + 5 * $n**3;
   printf "f( %6.2f ) %s\n", $n, $result > 400 ? "  too large!" : sprintf "= %6.2f", $result
}


function f(atom x)
    return sqrt(abs(x))+5*power(x,3)
end function

procedure test(string s, bool fake_prompt=true)
    if fake_prompt then printf(1,"Enter 11 numbers:%s\n",{s}) end if
    s = substitute(s,","," ")
    sequence S = scanf(s,"%f %f %f %f %f %f %f %f %f %f %f")
    if length(S)!=1 then puts(1,"not 11 numbers") abort(0) end if
    S = reverse(S[1])
    for i=1 to length(S) do
        atom result = f(S[i])
        if result>400 then
            printf(1,"f(%g):overflow\n",{S[i]})
        else
            printf(1,"f(%g):%g\n",{S[i],result})
        end if
    end for
    puts(1,"\n")
end procedure

--test(prompt_string("Enter 11 numbers:"),false)
constant tests = {"10 -1 1 2 3 4 4.3 4.305 4.303 4.302 4.301","1,2,3,4,5,6,7,8,9,10,11",
"0.470145,1.18367,2.36984,4.86759,2.40274,5.48793,3.30256,5.34393,4.21944,2.23501,-0.0200707"}
papply(tests,test)


import util.

go =>
  L = [I.parse_term() : I in split(read_line())],
  S = [[I,cond(F<=400,F,'TOO LARGE')] : I in L.len..-1..1, F=f(L[I])],
  println(S),
  nl.

f(T) = sqrt(abs(T)) + 5*T**3.


(de f (X)
   (+ (sqrt (abs X)) (* 5 X X X)) )

(trace 'f)

(in NIL
   (prin "Input 11 numbers: ")
   (for X (reverse (make (do 11 (link (read)))))
      (when (> (f X) 400)
         (prinl "TOO LARGE") ) ) )


Trabb: Procedure options (main); /* 11 November 2013 */

   declare (i, n) fixed binary;
   declare s fixed (5,1) controlled;
   declare g fixed (15,5);

   put ('Please type 11 values:');
   do i = 1 to 11;
      allocate s;
      get (s);
      put (s);
   end;
   put skip(2) ('Results:');
   do i = 1 to 11;
      g = f(s); put skip list (s);
      if g > 400 then put ('Too large'); else put (g);
      free s;
   end;

f: procedure (x) returns (fixed(15,5));
   declare x fixed (5,1);
   return (sqrt(abs(x)) + 5*x**3);
end f;

end Trabb;


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;


function Get-Tpk
{
    [CmdletBinding()]
    [OutputType([PSCustomObject])]
    Param
    (
        [Parameter(Mandatory=$true,
                   ValueFromPipeline=$true,
                   ValueFromPipelineByPropertyName=$true,
                   Position=0)]
        [double]
        $Number
    )

    Begin
    {
        function Get-TpkFunction ([double]$Number)
        {
            [Math]::Pow([Math]::Abs($Number),(0.5)) + 5 * [Math]::Pow($Number,3)
        }

        [object[]]$output = @()
    }
    Process
    {
        $Number | ForEach-Object {
            $n = Get-TpkFunction $_

            if ($n -le 400)
            {
                $result = $n
            }
            else
            {
                $result = "Overflow"
            }
        }

        $output += [PSCustomObject]@{
            Number = $Number
            Result = $result
        }
    }
    End
    {
        [Array]::Reverse($output)
        $output
    }
}


Procedure.d f(x.d)
  ProcedureReturn Pow(Abs(x), 0.5) + 5 * x * x * x
EndProcedure

Procedure split(i.s, delimeter.s, List o.d())
  Protected index = CountString(i, delimeter) + 1 ;add 1 because last entry will not have a delimeter

  While index > 0
    AddElement(o())
    o() = ValD(Trim(StringField(i, index, delimeter)))
    index - 1
  Wend

  ProcedureReturn ListSize(o())
EndProcedure

Define i$, entriesAreValid = 0, result.d, output$
NewList numbers.d()

If OpenConsole()
  Repeat
    PrintN(#crlf$ + "Enter eleven numbers that are each separated by spaces or commas:")

    i$ = Input(
    i$ = Trim(i$)
    If split(i$, ",", numbers.d()) < 11
      ClearList(numbers())
      If split(i$, " ", numbers.d()) < 11
        PrintN("Not enough numbers were supplied.")
        ClearList(numbers())
      Else
        entriesAreValid = 1
      EndIf
    Else
      entriesAreValid = 1
    EndIf
  Until entriesAreValid = 1

  ForEach numbers()
    output$  = "f(" + RTrim(RTrim(StrD(numbers(), 3), "0"), ".") + ") = "
    result.d = f(numbers())
    If result > 400
      output$ + "Too Large"
    Else
      output$ + RTrim(RTrim(StrD(result, 3), "0"), ".")
    EndIf
    PrintN(output$)
  Next

  Print(#crlf$ + #crlf$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


Python 3.2.2 (default, Sep  4 2011, 09:51:08) [MSC v.1500 32 bit (Intel)] on win32
Type "copyright", "credits" or "license()" for more information.
>>> def f(x): return abs(x) ** 0.5 + 5 * x**3

>>> print(', '.join('%s:%s' % (x, v if v<=400 else "TOO LARGE!")
	           for x,v in ((y, f(float(y))) for y in input('\nnumbers: ').strip().split()[:11][::-1])))

11 numbers: 1 2 3 4 5 6 7 8 9 10 11
11:TOO LARGE!, 10:TOO LARGE!, 9:TOO LARGE!, 8:TOO LARGE!, 7:TOO LARGE!, 6:TOO LARGE!, 5:TOO LARGE!, 4:322.0, 3:136.73205080756887, 2:41.41421356237309, 1:6.0
>>>


S <- scan(n=11)

f <- function(x) sqrt(abs(x)) + 5*x^3

for (i in rev(S)) {
  res <- f(i)
  if (res > 400)
    print("Too large!")
  else
    print(res)
}


#lang racket

(define input
  (for/list ([i 11])
    (printf "Enter a number (~a of 11): " (+ 1 i))
    (read)))

(for ([x (reverse input)])
  (define res (+ (sqrt (abs x)) (* 5 (expt x 3))))
  (if (> res 400)
      (displayln "Overflow!")
      (printf "f(~a) = ~a\n" x res)))


my @nums = prompt("Please type 11 space-separated numbers: ").words
    until @nums == 11;
for @nums.reverse -> $n {
    my $r = $n.abs.sqrt + 5 * $n ** 3;
    say "$n\t{ $r > 400 ?? 'Urk!' !! $r }";
}


/*REXX program implements the Trabb─Pardo-Knuth algorithm for N numbers (default is 11).*/
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 '                           _____'           /* ◄─── this  SAY  displays 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                                    /* [↓]  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
        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.*/
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*/
      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*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
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


# Project : Trabb Pardo–Knuth algorithm

decimals(3)
x = list(11)
for n=1 to 11
    x[n] = n
next

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)


def f(x) x.abs ** 0.5 + 5 * x ** 3 end

puts "Please enter 11 numbers:"
nums = 11.times.map{ gets.to_f }

nums.reverse_each do |n|
  print "f(#{n}) = "
  res = f(n)
  puts res > 400 ? "Overflow!" : res
end


use std::io::{self, BufRead};

fn op(x: f32) -> Option<f32> {
    let y = x.abs().sqrt() + 5.0 * x * x * x;
    if y < 400.0 {
        Some(y)
    } else {
        None
    }
}

fn main() {
    println!("Please enter 11 numbers (one number per line)");
    let stdin = io::stdin();

    let xs = stdin
        .lock()
        .lines()
        .map(|ox| ox.unwrap().trim().to_string())
        .flat_map(|s| str::parse::<f32>(&s))
        .take(11)
        .collect::<Vec<_>>();

    for x in xs.into_iter().rev() {
        match op(x) {
            Some(y) => println!("{}", y),
            None => println!("overflow"),
        };
    }
}


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
}


var nums; do {
    nums = Sys.readln("Please type 11 space-separated numbers: ").nums
} while(nums.len != 11)

nums.reverse.each { |n|
    var r = (n.abs.sqrt + (5 * n**3));
    say "#{n}\t#{ r > 400 ? 'Urk!' : r }";
}


 10 DIM A(11)
 20 PRINT "ENTER ELEVEN NUMBERS:"
 30 FOR I=1 TO 11
 40 INPUT A(I)
 50 NEXT I
 60 FOR I=11 TO 1 STEP -1
 70 LET Y=SQR ABS A(I)+5*A(I)**3
 80 IF Y<=400 THEN GOTO 110
 90 PRINT A(I),"TOO LARGE"
100 GOTO 120
110 PRINT A(I),Y
120 NEXT I


import Foundation

print("Enter 11 numbers for the Trabb─Pardo─Knuth algorithm:")

let f: (Double) -> Double = { sqrt(fabs($0)) + 5 * pow($0, 3) }

(1...11)
    .generate()
    .map { i -> Double in
        print("\(i): ", terminator: "")
        guard let s = readLine(), let n = Double(s) else { return 0 }
        return n
    }
    .reverse()
    .forEach {
        let result = f($0)
        print("f(\($0))", result > 400.0 ? "OVERFLOW" : result, separator: "\t")
    }


|Trabb Pardo–Knuth algorithm

a : 11 0

 i
 if i LE 10
    [] $s
    ~ $s w
    w a.i
   + i
    goif
 endif
 10 i
 if i GE 0
    call f
    if x GT 400
       'too large' $s
    else
       ~ x $s
    endif
    ~ i $r
    + ' ' $r
    + $r $s.1
    $s []
    - i
    goif
 endif
 stop

f a.i t
  * t t x
  * x t x
  * 5 x
  abs t
  sqrt t y
  + y x
  return


# Helper procedures
proc f {x} {expr {abs($x)**0.5 + 5*$x**3}}
proc overflow {y} {expr {$y > 400}}

# Read in 11 numbers, with nice prompting
fconfigure stdout -buffering none
for {set n 1} {$n <= 11} {incr n} {
    puts -nonewline "number ${n}: "
    lappend S [scan [gets stdin] "%f"]
}

# Process and print results in reverse order
foreach x [lreverse $S] {
    set result [f $x]
    if {[overflow $result]} {
	puts "${x}: TOO LARGE!"
    } else {
	puts "${x}: $result"
    }
}


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)


import "io" for Stdin, Stdout
import "/fmt" for Fmt

var f = Fn.new { |x| x.abs.sqrt + 5*x*x*x }

var s = List.filled(11, 0)
System.print("Please enter 11 numbers:")
var count = 0
while (count < 11) {
    Fmt.write("  Number $-2d : ", count + 1)
    Stdout.flush()
    var number = Num.fromString(Stdin.readLine())
    if (!number) {
        System.print("Not a valid number, try again.")
    } else {
        s[count] = number
        count = count + 1
    }
}
s = s[-1..0]
System.print("\nResults:")
for (item in s) {
    var fi = f.call(item)
    if (fi <= 400) {
        Fmt.print("  f($6.3f) = $7.3f", item, fi)
    } else {
        Fmt.print("  f($6.3f) = overflow", item)
    }
}


' Trabb Pardo-Knuth algorithm
PROGRAM "tpkalgorithm"
VERSION "0.0001"

IMPORT "xma"

DECLARE FUNCTION Entry ()
INTERNAL FUNCTION SINGLE F(SINGLE n)

FUNCTION Entry ()
  ' Used "magic numbers" because of strict specification of the algorithm.
  SINGLE s[10]
  SINGLE tmp, r
  UBYTE i
  PRINT "Enter 11 numbers."
  FOR i = 0 TO 10
    PRINT i + 1;
    s[i] = SINGLE(INLINE$(" => "))
  NEXT i
  PRINT
  ' Reverse
  FOR i = 0 TO 10 / 2
    tmp = s[i]
    s[i] = s[10 - i]
    s[10 - i] = tmp
  NEXT i
  'Results
  FOR i = 0 TO 10
    PRINT "f("; LTRIM$(STR$(s[i])); ") =";
    r = F(s[i])
    IF r > 400 THEN
      PRINT " overflow"
    ELSE
      PRINT r
    END IF
  NEXT i
END FUNCTION

FUNCTION SINGLE F(SINGLE n)
  RETURN SQRT(ABS(n)) + 5 * n * n *n
END FUNCTION
END PROGRAM


include c:\cxpl\codes;

func real F(X);
real X;
return sqrt(abs(X)) + 5.0*X*X*X;

real Result, S(11);  int I;
[Text(0, "Please enter 11 numbers: ");
for I:= 0 to 11-1 do S(I):= RlIn(0);

for I:= 11-1 downto 0 do
        [RlOut(0, S(I));
        Result:= F(S(I));
        if Result > 400.0 then
                Text(0, "  overflows")
        else    RlOut(0, Result);
        CrLf(0)];
]


fcn f(x) { x.abs().pow(0.5) + x.pow(3)*5 }
reg ns; do{
   ns=ask("11 numbers seperated by spaces: ");
   try{ ns=ns.split(" ").filter().apply("toFloat") } catch{}
}while(not ns.isType(List) or ns.len()!=11);
ns.reverse().apply(fcn(x){
   fx:=f(x); "f(%7.3f)-->%s".fmt(x, if(fx>400)"Overflow" else fx) })
.pump(Console.println);


V rad = math:pi / 4
V deg = 45.0
print(‘Sine: ’sin(rad)‘ ’sin(radians(deg)))
print(‘Cosine: ’cos(rad)‘ ’cos(radians(deg)))
print(‘Tangent: ’tan(rad)‘ ’tan(radians(deg)))
V arcsine = asin(sin(rad))
print(‘Arcsine: ’arcsine‘ ’degrees(arcsine))
V arccosine = acos(cos(rad))
print(‘Arccosine: ’arccosine‘ ’degrees(arccosine))
V arctangent = atan(tan(rad))
print(‘Arctangent: ’arctangent‘ ’degrees(arctangent))


(defun fac (n)
   (if (zp n)
       1
       (* n (fac (1- n)))))

(defconst *pi-approx*
   (/ 3141592653589793238462643383279
      (expt 10 30)))

(include-book "arithmetic-3/floor-mod/floor-mod" :dir :system)

(defun dgt-to-str (d)
   (case d
         (1 "1") (2 "2") (3 "3") (4 "4") (5 "5")
         (6 "6") (7 "7") (8 "8") (9 "9") (0 "0")))

(defmacro cat (&rest args)
   `(concatenate 'string ,@args))

(defun num-to-str-r (n)
   (if (zp n)
       ""
       (cat (num-to-str-r (floor n 10))
            (dgt-to-str (mod n 10)))))

(defun num-to-str (n)
   (cond ((= n 0) "0")
         ((< n 0) (cat "-" (num-to-str-r (- n))))
         (t (num-to-str-r n))))

(defun pad-with-zeros (places str lngth)
   (declare (xargs :measure (nfix (- places lngth))))
   (if (zp (- places lngth))
       str
       (pad-with-zeros places (cat "0" str) (1+ lngth))))

(defun as-decimal-str (r places)
   (let ((before (floor r 1))
         (after (floor (* (expt 10 places) (mod r 1)) 1)))
        (cat (num-to-str before)
             "."
             (let ((afterstr (num-to-str after)))
                  (pad-with-zeros places afterstr
                             (length afterstr))))))

(defun taylor-sine (theta terms term)
   (declare (xargs :measure (nfix (- terms term))))
   (if (zp (- terms term))
       0
       (+ (/ (*(expt -1 term) (expt theta (1+ (* 2 term))))
             (fac (1+ (* 2 term))))
          (taylor-sine theta terms (1+ term)))))

(defun sine (theta)
   (taylor-sine (mod theta (* 2 *pi-approx*))
                 20 0)) ; About 30 places of accuracy

(defun cosine (theta)
   (sine (+ theta (/ *pi-approx* 2))))

(defun tangent (theta)
   (/ (sine theta) (cosine theta)))

(defun rad->deg (rad)
   (* 180 (/ rad *pi-approx*)))

(defun deg->rad (deg)
   (* *pi-approx* (/ deg 180)))

(defun trig-demo ()
   (progn$ (cw "sine of pi / 4 radians:    ")
           (cw (as-decimal-str (sine (/ *pi-approx* 4)) 20))
           (cw "~%sine of 45 degrees:        ")
           (cw (as-decimal-str (sine (deg->rad 45)) 20))
           (cw "~%cosine of pi / 4 radians:  ")
           (cw (as-decimal-str (cosine (/ *pi-approx* 4)) 20))
           (cw "~%tangent of pi / 4 radians: ")
           (cw (as-decimal-str (tangent (/ *pi-approx* 4)) 20))
           (cw "~%")))


V best = [0] * 16

F try_swaps(&deck, f, =s, d, n)
   I d > :best[n]
      :best[n] = d

   V i = 0
   V k = 1 << s
   L s != 0
      k >>= 1
      s--
      I deck[s] == -1 | deck[s] == s
         L.break
      i [|]= k
      I (i [&] f) == i & d + :best[s] <= :best[n]
         R d
   s++

   V deck2 = copy(deck)
   k = 1
   L(i2) 1 .< s
      k <<= 1
      I deck2[i2] == -1
         I (f [&] k) != 0
            L.continue
      E I deck2[i2] != i2
         L.continue

      deck[i2] = i2
      L(j) 0 .. i2
         deck2[j] = deck[i2 - j]
      try_swaps(&deck2, f [|] k, s, 1 + d, n)

F topswops(n)
   :best[n] = 0
   V deck0 = [-1] * 16
   deck0[0] = 0
   try_swaps(&deck0, 1, n, 0, n)
   R :best[n]

L(i) 1..12
   print(‘#2: #.’.format(i, topswops(i)))


trace("Radians:");
trace("sin(Pi/4) = ", Math.sin(Math.PI/4));
trace("cos(Pi/4) = ", Math.cos(Math.PI/4));
trace("tan(Pi/4) = ", Math.tan(Math.PI/4));
trace("arcsin(0.5) = ", Math.asin(0.5));
trace("arccos(0.5) = ", Math.acos(0.5));
trace("arctan(0.5) = ", Math.atan(0.5));
trace("arctan2(-1,-2) = ", Math.atan2(-1,-2));
trace("\nDegrees")
trace("sin(45) = ", Math.sin(45 * Math.PI/180));
trace("cos(45) = ", Math.cos(45 * Math.PI/180));
trace("tan(45) = ", Math.tan(45 * Math.PI/180));
trace("arcsin(0.5) = ", Math.asin(0.5)*180/Math.PI);
trace("arccos(0.5) = ", Math.acos(0.5)*180/Math.PI);
trace("arctan(0.5) = ", Math.atan(0.5)*180/Math.PI);
trace("arctan2(-1,-2) = ", Math.atan2(-1,-2)*180/Math.PI);


*        Topswops optimized        12/07/2016
TOPSWOPS CSECT
         USING  TOPSWOPS,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         " <-
         ST     R15,8(R13)         " ->
         LR     R13,R15            " addressability
         MVC    N,=F'1'            n=1
LOOPN    L      R4,N               n; do n=1 to 10  ===-------------==*
         C      R4,=F'10'          "                                  *
         BH     ELOOPN             .                                  *
         MVC    P(40),PINIT        p=pinit
         MVC    COUNTM,=F'0'       countm=0
REPEAT   MVC    CARDS(40),P        cards=p  -------------------------+
         SR     R11,R11            count=0                           |
WHILE    CLC    CARDS,=F'1'        do while cards(1)^=1  ---------+
         BE     EWHILE             .                              |
         MVC    M,CARDS            m=cards(1)
         L      R2,M               m
         SRA    R2,1               m/2
         ST     R2,MD2             md2=m/2
         L      R3,M               @card(mm)=m
         SLA    R3,2               *4
         LA     R3,CARDS-4(R3)     @card(mm)
         LA     R2,CARDS           @card(i)=0
         LA     R6,1               i=1
LOOPI    C      R6,MD2             do i=1 to m/2  -------------+
         BH     ELOOPI             .                           |
         L      R0,0(R2)           swap r0=cards(i)
         MVC    0(4,R2),0(R3)      swap cards(i)=cards(mm)
         ST     R0,0(R3)           swap cards(mm)=r0
         AH     R2,=H'4'           @card(i)[email protected](i)+4
         SH     R3,=H'4'           @card(mm)[email protected](mm)-4
         LA     R6,1(R6)           i=i+1                       |
         B      LOOPI              ----------------------------+
ELOOPI   LA     R11,1(R11)         count=count+1                  |
         B      WHILE              -------------------------------+
EWHILE   C      R11,COUNTM         if count>countm
         BNH    NOTGT              then
         ST     R11,COUNTM           countm=count
NOTGT    BAL    R14,NEXTPERM       call nextperm
         LTR    R0,R0              until nextperm=0                 |
         BNZ    REPEAT             ---------------------------------+
         L      R1,N               n
         XDECO  R1,XDEC            edit n
         MVC    PG(2),XDEC+10      output n
         MVI    PG+2,C':'          output ':'
         L      R1,COUNTM          countm
         XDECO  R1,XDEC            edit countm
         MVC    PG+3(4),XDEC+8     output countm
         XPRNT  PG,L'PG            print buffer
         L      R1,N               n                                  *
         LA     R1,1(R1)           +1                                 *
         ST     R1,N               n=n+1                              *
         B      LOOPN              ===------------------------------==*
ELOOPN   L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    " restore
         XR     R15,R15            " rc=0
         BR     R14                exit
PINIT    DC     F'1',F'2',F'3',F'4',F'5',F'6',F'7',F'8',F'9',F'10'
CARDS    DS     10F                cards
P        DS     10F                p
COUNTM   DS     F                  countm
M        DS     F                  m
N        DS     F                  n
MD2      DS     F                  m/2
PG       DC     CL20' '            buffer
XDEC     DS     CL12               temp
*------- ----   nextperm ----------{-----------------------------------
NEXTPERM L      R9,N               nn=n
         SR     R8,R8              jj=0
         LR     R7,R9              nn
         BCTR   R7,0               j=nn-1
         LTR    R7,R7              if j=0
         BZ     ELOOPJ1            then skip do loop
LOOPJ1   LR     R1,R7              do j=nn-1 to 1 by -1; j ----+
         SLA    R1,2               .                           |
         L      R2,P-4(R1)         p(j)
         C      R2,P(R1)           if p(j)<p(j+1)
         BNL    PJGEPJP            then
         LR     R8,R7                jj=j
         B      ELOOPJ1              leave j                   |
PJGEPJP  BCT    R7,LOOPJ1          j=j-1  ---------------------+
ELOOPJ1  LA     R7,1(R8)           j=jj+1
LOOPJ2   CR     R7,R9              do j=jj+1 while j<nn  ------+
         BNL    ELOOPJ2            .                           |
         LR     R2,R7              j
         SLA    R2,2               .
         LR     R3,R9              nn
         SLA    R3,2               .
         L      R0,P-4(R2)         swap p(j),p(nn)
         L      R1,P-4(R3)         "
         ST     R0,P-4(R3)         "
         ST     R1,P-4(R2)         "
         BCTR   R9,0               nn=nn-1
         LA     R7,1(R7)           j=j+1                       |
         B      LOOPJ2             ----------------------------+
ELOOPJ2  LTR    R8,R8              if jj=0
         BNZ    JJNE0              then
         LA     R0,0                 return(0)
         BR     R14                  "
JJNE0    LA     R7,1(R8)           j=jj+1
         LR     R2,R7              j
         SLA    R2,2               [email protected](j)
         LR     R3,R8              jj
         SLA    R3,2               [email protected](jj)
LOOPJ3   L      R0,P-4(R2)         p(j)  ----------------------+
         C      R0,P-4(R3)         do j=jj+1 while p(j)<p(jj)  |
         BNL    ELOOPJ3
         LA     R2,4(R2)           [email protected](j)[email protected](j)+4
         LA     R7,1(R7)           j=j+1                       |
         B      LOOPJ3             ----------------------------+
ELOOPJ3  L      R1,P-4(R3)         swap p(j),p(jj)
         ST     R0,P-4(R3)         "
         ST     R1,P-4(R2)         "
         LA     R0,1               return(1)
         BR     R14 ---------------}-----------------------------------
         YREGS
         END    TOPSWOPS


with Ada.Integer_Text_IO, Generic_Perm;

procedure Topswaps is

   function Topswaps(Size: Positive) return Natural is
      package Perms is new Generic_Perm(Size);
      P: Perms.Permutation;
      Done: Boolean;
      Max: Natural;

      function Swapper_Calls(P: Perms.Permutation) return Natural is
	 Q: Perms.Permutation := P;
	 I: Perms.Element := P(1);
      begin
	 if I = 1 then
	    return 0;
	 else
	    for Idx in 1 .. I loop
	       Q(Idx) := P(I-Idx+1);
	    end loop;
	    return 1 + Swapper_Calls(Q);
	 end if;
      end Swapper_Calls;

   begin
      Perms.Set_To_First(P, Done);
      Max:= Swapper_Calls(P);
      while not Done loop
	 Perms.Go_To_Next(P, Done);
	 Max := natural'Max(Max, Swapper_Calls(P));
      end loop;
      return Max;
   end Topswaps;

begin
   for I in 1 .. 10 loop
      Ada.Integer_Text_IO.Put(Item => Topswaps(I), Width => 3);
   end loop;
end Topswaps;


Topswops(Obj, n){
	R := []
	for i, val in obj{
		if (i <=n)
			res := val (A_Index=1?"":",") res
		else
			res .= "," val
	}
	Loop, Parse, res, `,
		R[A_Index]:= A_LoopField
	return R
}


with Ada.Numerics.Elementary_Functions;
use Ada.Numerics.Elementary_Functions;
with Ada.Float_Text_Io; use Ada.Float_Text_Io;
with Ada.Text_IO; use Ada.Text_IO;

procedure Trig is
   Degrees_Cycle : constant Float := 360.0;
   Radians_Cycle : constant Float := 2.0 * Ada.Numerics.Pi;
   Angle_Degrees : constant Float := 45.0;
   Angle_Radians : constant Float := Ada.Numerics.Pi / 4.0;
   procedure Put (V1, V2 : Float) is
   begin
      Put (V1, Aft => 5, Exp => 0);
      Put (" ");
      Put (V2, Aft => 5, Exp => 0);
      New_Line;
   end Put;
begin
   Put (Sin (Angle_Degrees, Degrees_Cycle),
        Sin (Angle_Radians, Radians_Cycle));
   Put (Cos (Angle_Degrees, Degrees_Cycle),
        Cos (Angle_Radians, Radians_Cycle));
   Put (Tan (Angle_Degrees, Degrees_Cycle),
        Tan (Angle_Radians, Radians_Cycle));
   Put (Cot (Angle_Degrees, Degrees_Cycle),
        Cot (Angle_Radians, Radians_Cycle));
   Put (ArcSin (Sin (Angle_Degrees, Degrees_Cycle), Degrees_Cycle),
        ArcSin (Sin (Angle_Radians, Radians_Cycle), Radians_Cycle));
   Put (Arccos (Cos (Angle_Degrees, Degrees_Cycle), Degrees_Cycle),
        Arccos (Cos (Angle_Radians, Radians_Cycle), Radians_Cycle));
   Put (Arctan (Y => Tan (Angle_Degrees, Degrees_Cycle)),
        Arctan (Y => Tan (Angle_Radians, Radians_Cycle)));
   Put (Arccot (X => Cot (Angle_Degrees, Degrees_Cycle)),
        Arccot (X => Cot (Angle_Degrees, Degrees_Cycle)));
end Trig;


#include <stdio.h>
#include <string.h>

typedef struct { char v[16]; } deck;
typedef unsigned int uint;

uint n, d, best[16];

void tryswaps(deck *a, uint f, uint s) {
#	define A a->v
#	define B b.v
	if (d > best[n]) best[n] = d;
	while (1) {
		if ((A[s] == s || (A[s] == -1 && !(f & 1U << s)))
			&& (d + best[s] >= best[n] || A[s] == -1))
			break;

		if (d + best[s] <= best[n]) return;
		if (!--s) return;
	}

	d++;
	deck b = *a;
	for (uint i = 1, k = 2; i <= s; k <<= 1, i++) {
		if (A[i] != i && (A[i] != -1 || (f & k)))
			continue;

		for (uint j = B[0] = i; j--;) B[i - j] = A[j];
		tryswaps(&b, f | k, s);
	}
	d--;
}

int main(void) {
	deck x;
	memset(&x, -1, sizeof(x));
	x.v[0] = 0;

	for (n = 1; n < 13; n++) {
		tryswaps(&x, 1, n - 1);
		printf("%2d: %d\n", n, best[n]);
	}

	return 0;
}


main:(
  REAL pi = 4 * arc tan(1);
  # Pi / 4 is 45 degrees. All answers should be the same. #
  REAL radians = pi / 4;
  REAL degrees = 45.0;
  REAL temp;
  # sine #
  print((sin(radians), " ", sin(degrees * pi / 180), new line));
  # cosine #
  print((cos(radians), " ", cos(degrees * pi / 180), new line));
  # tangent #
  print((tan(radians), " ", tan(degrees * pi / 180), new line));
  # arcsine #
  temp := arc sin(sin(radians));
  print((temp, " ", temp * 180 / pi, new line));
  # arccosine #
  temp := arc cos(cos(radians));
  print((temp, " ", temp * 180 / pi, new line));
  # arctangent #
  temp := arc tan(tan(radians));
  print((temp, " ", temp * 180 / pi, new line))
)


#include <iostream>
#include <vector>
#include <numeric>
#include <algorithm>

int topswops(int n) {
  std::vector<int> list(n);
  std::iota(std::begin(list), std::end(list), 1);
  int max_steps = 0;
  do {
    auto temp_list = list;
    for (int steps = 1; temp_list[0] != 1; ++steps) {
      std::reverse(std::begin(temp_list), std::begin(temp_list) + temp_list[0]);
      if (steps > max_steps) max_steps = steps;
    }
  } while (std::next_permutation(std::begin(list), std::end(list)));
  return max_steps;
}

int main() {
  for (int i = 1; i <= 10; ++i) {
    std::cout << i << ": " << topswops(i) << std::endl;
  }
  return 0;
}


import std.stdio, std.algorithm, std.range, permutations2;

int topswops(in int n) pure @safe {
    static int flip(int[] xa) pure nothrow @safe @nogc {
        if (!xa[0]) return 0;
        xa[0 .. xa[0] + 1].reverse();
        return 1 + flip(xa);
    }
    return n.iota.array.permutations.map!flip.reduce!max;
}

void main() {
    foreach (immutable i; 1 .. 11)
        writeln(i, ": ", i.topswops);
}


begin
    % Algol W only supplies sin, cos and arctan as standard. We can define    %
    % arcsin, arccos and tan functions using these. The standard functions    %
    % use radians so we also provide versions that use degrees                %

    % convert degrees to radians   %
    real procedure toRadians( real value x ) ; pi * ( x / 180 );
    % convert radians to degrees   %
    real procedure toDegrees( real value x ) ; 180 * ( x / pi );
    % tan of an angle in radians   %
    real procedure tan( real value x ) ; sin( x ) / cos( x );
    % arcsin in radians            %
    real procedure arcsin( real value x ) ; arctan( x / sqrt( 1 - ( x * x ) ) );
    % arccos in radians            %
    real procedure arccos( real value x ) ; arctan( sqrt( 1 - ( x * x ) ) / x );
    % sin of an angle in degrees   %
    real procedure sinD( real value x ) ; sin( toRadians( x ) );
    % cos of an angle in degrees   %
    real procedure cosD( real value x ) ; cos( toRadians( x ) );
    % tan of an angle in degrees   %
    real procedure tanD( real value x ) ; tan( toRadians( x ) );
    % arctan in degrees            %
    real procedure arctanD( real value x ) ; toDegrees( arctan( x ) );
    % arcsin in degrees            %
    real procedure arcsinD( real value x ) ; toDegrees( arcsin( x ) );
    % arccos in degrees            %
    real procedure arccosD( real value x ) ; toDegrees( arccos( x ) );

    % test the procedures %
    begin

        real piOver4, piOver3, oneOverRoot2, root3Over2;
        piOver3 := pi / 3; piOver4  := pi / 4;
        oneOverRoot2 := 1.0 / sqrt( 2 ); root3Over2 := sqrt( 3 ) / 2;

        r_w := 12; r_d := 5; r_format := "A"; s_w := 0; % set output format   %

        write( "PI/4: ", piOver4, " 1/root(2): ", oneOverRoot2 );
        write();
        write( "sin 45 degrees: ", sinD( 45 ), " sin pi/4 radians: ", sin( piOver4 ) );
        write( "cos 45 degrees: ", cosD( 45 ), " cos pi/4 radians: ", cos( piOver4 ) );
        write( "tan 45 degrees: ", tanD( 45 ), " tan pi/4 radians: ", tan( piOver4 ) );
        write();
        write( "arcsin( sin( pi/4 radians ) ): ", arcsin( sin( piOver4 ) ) );
        write( "arccos( cos( pi/4 radians ) ): ", arccos( cos( piOver4 ) ) );
        write( "arctan( tan( pi/4 radians ) ): ", arctan( tan( piOver4 ) ) );
        write();
        write( "PI/3: ", piOver4, " root(3)/2: ", root3Over2 );
        write();
        write( "sin 60 degrees: ", sinD( 60 ), " sin pi/3 radians: ", sin( piOver3 ) );
        write( "cos 60 degrees: ", cosD( 60 ), " cos pi/3 radians: ", cos( piOver3 ) );
        write( "tan 60 degrees: ", tanD( 60 ), " tan pi/3 radians: ", tan( piOver3 ) );
        write();
        write( "arcsin( sin( 60 degrees ) ): ", arcsinD( sinD( 60 ) ) );
        write( "arccos( cos( 60 degrees ) ): ", arccosD( cosD( 60 ) ) );
        write( "arctan( tan( 60 degrees ) ): ", arctanD( tanD( 60 ) ) );

    end

end.


pi: 4*atan 1.0

radians: pi/4
degrees: 45.0

print "sine"
print [sin radians, sin degrees*pi/180]

print "cosine"
print [cos radians, cos degrees*pi/180]

print "tangent"
print [tan radians, tan degrees*pi/180]

print "arcsine"
print [asin sin radians, (asin sin radians)*180/pi]

print "arccosine"
print [acos cos radians, (acos cos radians)*180/pi]

print "arctangent"
print [atan tan radians, (atan tan radians)*180/pi]


class
	TOPSWOPS

create
	make

feature

	make (n: INTEGER)
			-- Topswop game.
		local
			perm, ar: ARRAY [INTEGER]
			tcount, count: INTEGER
		do
			create perm_sol.make_empty
			create solution.make_empty
			across
				1 |..| n as c
			loop
				create ar.make_filled (0, 1, c.item)
				across
					1 |..| c.item as d
				loop
					ar [d.item] := d.item
				end
				permute (ar, 1)
				across
					1 |..| perm_sol.count as e
				loop
					tcount := 0
					from
					until
						perm_sol.at (e.item).at (1) = 1
					loop
						perm_sol.at (e.item) := reverse_array (perm_sol.at (e.item))
						tcount := tcount + 1
					end
					if tcount > count then
						count := tcount
					end
				end
				solution.force (count, c.item)
			end
		end

	solution: ARRAY [INTEGER]

feature {NONE}

	perm_sol: ARRAY [ARRAY [INTEGER]]

	reverse_array (ar: ARRAY [INTEGER]): ARRAY [INTEGER]
			-- Array with 'ar[1]' elements reversed.
		require
			ar_not_void: ar /= Void
		local
			i, j: INTEGER
		do
			create Result.make_empty
			Result.deep_copy (ar)
			from
				i := 1
				j := ar [1]
			until
				i > j
			loop
				Result [i] := ar [j]
				Result [j] := ar [i]
				i := i + 1
				j := j - 1
			end
		ensure
			same_elements: across ar as a all Result.has (a.item) end
		end

	permute (a: ARRAY [INTEGER]; k: INTEGER)
			-- All permutations of array 'a' stored in perm_sol.
		require
			ar_not_void: a.count >= 1
			k_valid_index: k > 0
		local
			i, t: INTEGER
			temp: ARRAY [INTEGER]
		do
			create temp.make_empty
			if k = a.count then
				across
					a as ar
				loop
					temp.force (ar.item, temp.count + 1)
				end
				perm_sol.force (temp, perm_sol.count + 1)
			else
				from
					i := k
				until
					i > a.count
				loop
					t := a [k]
					a [k] := a [i]
					a [i] := t
					permute (a, k + 1)
					t := a [k]
					a [k] := a [i]
					a [i] := t
					i := i + 1
				end
			end
		end

end


real pi = 4 * atan(1);
real radian = pi / 4.0;
real angulo = 45.0 * pi / 180;

write("Radians     : ", radian);
write("Degrees     : ", angulo / pi * 180);
write();
write("Sine        : ", sin(radian), sin(angulo));
write("Cosine      : ", cos(radian), cos(angulo));
write("Tangent     : ", tan(radian), tan(angulo));
write();
real temp = asin(sin(radian));
write("Arc Sine    : ", temp, temp * 180 / pi);
temp = acos(cos(radian));
write("Arc Cosine  : ", temp, temp * 180 / pi);
temp = atan(tan(radian));
write("Arc Tangent : ", temp, temp * 180 / pi);


defmodule Topswops do
  def get_1_first( [1 | _t] ), do: 0
  def get_1_first( list ), do: 1 + get_1_first( swap(list) )

  defp swap( [n | _t]=list ) do
    {swaps, remains} = Enum.split( list, n )
    Enum.reverse( swaps, remains )
  end

  def task do
    IO.puts "N\ttopswaps"
    Enum.map(1..10, fn n -> {n, permute(Enum.to_list(1..n))} end)
    |> Enum.map(fn {n, n_permutations} -> {n, get_1_first_many(n_permutations)} end)
    |> Enum.map(fn {n, n_swops} -> {n, Enum.max(n_swops)} end)
    |> Enum.each(fn {n, max} -> IO.puts "#{n}\t#{max}" end)
  end

  def get_1_first_many( n_permutations ), do: (for x <- n_permutations, do: get_1_first(x))

  defp permute([]), do: [[]]
  defp permute(list), do: for x <- list, y <- permute(list -- [x]), do: [x|y]
end

Topswops.task


-module( topswops ).

-export( [get_1_first/1, swap/1, task/0] ).

get_1_first( [1 | _T] ) -> 0;
get_1_first( List ) -> 1 + get_1_first( swap(List) ).

swap( [N | _T]=List ) ->
	{Swaps, Remains} = lists:split( N, List ),
	lists:reverse( Swaps ) ++ Remains.

task() ->
	Permutations = [{X, permute:permute(lists:seq(1, X))} || X <- lists:seq(1, 10)],
	Swops = [{N, get_1_first_many(N_permutations)} || {N, N_permutations} <- Permutations],
	Topswops = [{N, lists:max(N_swops)} || {N, N_swops} <- Swops],
	io:fwrite( "N	topswaps~n" ),
	[io:fwrite("~p	~p~n", [N, Max]) || {N, Max} <- Topswops].

get_1_first_many( N_permutations ) -> [get_1_first(X) ||  X <- N_permutations].


T Symbol
   String id
   Int lbp
   Int nud_bp
   Int led_bp
   (ASTNode -> ASTNode) nud
   ((ASTNode, ASTNode) -> ASTNode) led

   F set_nud_bp(nud_bp, nud)
      .nud_bp = nud_bp
      .nud = nud

   F set_led_bp(led_bp, led)
      .led_bp = led_bp
      .led = led

T Var
   String name
   Int value
   F (name)
      .name = name
[Var] vars

T ASTNode
   Symbol& symbol
   Int var_index
   ASTNode? first_child
   ASTNode? second_child

   F eval()
      S .symbol.id
         ‘(var)’
            R :vars[.var_index].value
         ‘|’
            R .first_child.eval() [|] .second_child.eval()
         ‘^’
            R .first_child.eval() (+) .second_child.eval()
         ‘&’
            R .first_child.eval() [&] .second_child.eval()
         ‘!’
            R (-).first_child.eval() [&] 1
         ‘(’
            R .first_child.eval()
         E
            assert(0B)
            R 0

[String = Symbol] symbol_table
[String] tokens
V tokeni = -1
ASTNode token_node

F advance(sid = ‘’)
   I sid != ‘’
      assert(:token_node.symbol.id == sid)
   :tokeni++
   :token_node = ASTNode()
   I :tokeni == :tokens.len
      :token_node.symbol = :symbol_table[‘(end)’]
      R
   V token = :tokens[:tokeni]
   I token[0].is_alpha()
      :token_node.symbol = :symbol_table[‘(var)’]
      L(v) :vars
         I v.name == token
            :token_node.var_index = L.index
            L.break
      L.was_no_break
         :token_node.var_index = :vars.len
         :vars.append(Var(token))
   E
      :token_node.symbol = :symbol_table[token]

F expression(rbp = 0)
   ASTNode t = move(:token_node)
   advance()
   V left = t.symbol.nud(move(t))
   L rbp < :token_node.symbol.lbp
      t = move(:token_node)
      advance()
      left = t.symbol.led(t, move(left))
   R left

F parse(expr_str) -> ASTNode
   :tokens = re:‘\s*(\w+|.)’.find_strings(expr_str)
   :tokeni = -1
   :vars.clear()
   advance()
   R expression()

F symbol(id, bp = 0) -> &
   I id !C :symbol_table
      V s = Symbol()
      s.id = id
      s.lbp = bp
      :symbol_table[id] = s
   R :symbol_table[id]

F infix(id, bp)
   F led(ASTNode self, ASTNode left)
      self.first_child = left
      self.second_child = expression(self.symbol.led_bp)
      R self
   symbol(id, bp).set_led_bp(bp, led)

F prefix(id, bp)
   F nud(ASTNode self)
      self.first_child = expression(self.symbol.nud_bp)
      R self
   symbol(id).set_nud_bp(bp, nud)

infix(‘|’, 1)
infix(‘^’, 2)
infix(‘&’, 3)
prefix(‘!’, 4)

F nud(ASTNode self)
   R self
symbol(‘(var)’).nud = nud
symbol(‘(end)’)

F nud_parens(ASTNode self)
   V expr = expression()
   advance(‘)’)
   R expr
symbol(‘(’).nud = nud_parens
symbol(‘)’)

L(expr_str) [‘!A | B’, ‘A ^ B’, ‘S | ( T ^ U )’, ‘A ^ (B ^ (C ^ D))’]
   print(‘Boolean expression: ’expr_str)
   print()
   ASTNode p = parse(expr_str)
   print(vars.map(v -> v.name).join(‘ ’)‘ : ’expr_str)
   L(i) 0 .< (1 << vars.len)
      L(v) vars
         v.value = (i >> (vars.len - 1 - L.index)) [&] 1
         print(v.value, end' ‘ ’)
      print(‘: ’p.eval())
   print()


USING: formatting kernel math math.combinatorics math.order
math.ranges sequences ;
FROM: sequences.private => exchange-unsafe ;
IN: rosetta-code.topswops

! Reverse a subsequence in-place from 0 to n.
: head-reverse! ( seq n -- seq' )
    dupd [ 2/ ] [ ] bi rot
    [ [ over - 1 - ] dip exchange-unsafe ] 2curry each-integer ;

! Reverse the elements in seq according to the first element.
: swop ( seq -- seq' ) dup first head-reverse! ;

! Determine the number of swops until 1 is the head.
: #swops ( seq -- n )
    0 swap [ dup first 1 = ] [ [ 1 + ] [ swop ] bi* ] until
    drop ;

! Determine the maximum number of swops for a given length.
: topswops ( n -- max )
    [1,b] <permutations> [ #swops ] [ max ] map-reduce ;

: main ( -- )
    10 [1,b] [ dup topswops "%2d: %2d\n" printf ] each ;

MAIN: main


module top
implicit none
contains
recursive function f(x) result(m)
  integer :: n, m, x(:),y(size(x)), fst
  fst = x(1)
  if (fst == 1) then
    m = 0
  else
    y(1:fst) = x(fst:1:-1)
    y(fst+1:) = x(fst+1:)
    m = 1 + f(y)
  end if
end function

recursive function perms(x) result(p)
integer, pointer     :: p(:,:), q(:,:)
integer              :: x(:), n, k, i
n = size(x)
if (n == 1) then
  allocate(p(1,1))
  p(1,:) = x
else
  q => perms(x(2:n))
  k = ubound(q,1)
  allocate(p(k*n,n))
  p = 0
  do i = 1,n
    p(1+k*(i-1):k*i,1:i-1) = q(:,1:i-1)
    p(1+k*(i-1):k*i,i) = x(1)
    p(1+k*(i-1):k*i,i+1:) = q(:,i:)
  end do
end if
end function
end module

program topswort
use top
implicit none
integer :: x(10)
integer, pointer  :: p(:,:)
integer :: i, j, m

forall(i=1:10)
  x(i) = i
end forall

do i = 1,10
  p=>perms(x(1:i))
  m = 0
  do j = 1, ubound(p,1)
    m = max(m, f(p(j,:)))
  end do
  print "(i3,a,i3)", i,": ",m
end do
end program


	;;;	CP/M truth table generator
	;;;	Supported operators:
	;;;	~ (not), & (and), | (or), ^ (xor) and => (implies)
	;;;	Variables are A-Z, constants are 0 and 1.
putch:	equ	2
puts:	equ	9
TVAR:	equ	32
TCONST:	equ	64
TOP:	equ	96
TPAR:	equ	128
TMASK:	equ	31
TTYPE:	equ	224
	org	100h
	lxi	h,80h	; Have we got a command line argument?
	mov	a,m
	ana	a
	lxi	d,noarg	; If not, print error message and stop.
	mvi	c,puts
	jz	5
	add 	l	; Otherwise, 0-terminate the argument string
	inr	a
	mov	l,a
	mvi	m,0
	inx	h
	mvi	m,'$'	; And $-terminate it also for error messages
	lxi	h,opstk	; Pointer to operator stack on the system stack
	push	h
	lxi	h,80h	; Start of command line
	lxi	b,expr	; Start of expression (output queue for shunting yard)
parse:	inx	h
	mvi	a,' '	; Ignore all whitespace
	cmp	m
	jz	parse
	mov	a,m 	; Load current character
	ana	a	; Done?
	jz	pdone
	mov	d,a	; Store copy in D
	ori	32	; Check for variable
	sui	'a'
	cpi	26
	jnc	pconst	; If not variable, go check constants
	ori	TVAR	; It _is_ a variable
	stax	b	; Store token
	inx	b
	jmp	parse	; Next token
pconst:	mov	a,d	; Restore character
	sui	'0'	; 0 or 1 are constants
	cpi	2
	jnc	pparen	; If not constant, go check parenthesis
	ori	TCONST	; It _is_ a constant
	stax	b	; Store token
	inx	b
	jmp	parse
pparen:	mov	a,d	; Restore character
	sui	'('	; ( and ) are parentheses
	jz	ppopen	; Open parenthesis
	dcr	a
	jnz	poper	; If not ( or ), check operators
	xthl		; Closing parenthesis - get operator stack
closep:	mov 	a,l	; If at beginning, missing ( - give error
	ana	a
	jz	emiss
	dcx	h	; Back up pointer
	mov	a,m	; Found it?
	cpi	TPAR
	jnz	closes	; If not, keep scanning
	xthl		; Get input string back
	jmp	parse	; Keep parsing
closes:	stax	b	; Not parenthesis - put token in output queue
	inx	b
	jmp	closep	; And keep going
ppopen:	xthl		; Get operator stack
	mvi	m,TPAR	; Store open parenthesis
	inx	h
	xthl		; Get input string
	jmp	parse
poper:	push	h	; Check tokens - keep input string
	mvi	e,0	; Counter
	lxi	h,opers	; Operator pointer
opscan:	mov	a,m	; Check against character
	cmp	d	; Found it?
	jz	opfind
	inr	e	; Increment counter
	ana	a	; Otherwise, is it zero?
	inx	h
	jnz	opscan	; If not, keep scanning
eparse:	lxi 	d,pserr	; It is zero - print a parse error
	mvi	c,puts
	call	5
	pop	d
	mvi	c,puts
	call 	5
	rst	0
opfind: cpi 	'='	; Special case - is it '='?
	jnz	opfin2	; If so it should be followed by '>'
	xthl
	inx	h
	mov	a,m
	xthl
	cpi	'>'
	jnz	eparse	; '=' not part of '=>' is parse error
opfin2:	mvi	d,0	; Look up the precedence for this operator
	lxi	h,prec
	dad	d
	mov	d,m	; Store it in D (D=prec E=operator number)
	pop	h	; Restore input string
	xthl		; Get operator stack pointer
oppop:	mov	a,l	; At beginning of operator stack?
	ana	a
	jz 	oppush	; Then done - push current operator
	dcx	h	; Check what's on top
	mov	a,m
	inx	h
	cpi	TPAR	; Parenthesis?
	jz 	oppush	; Then done - push current operator
	push	b	; Store output pointer for a while
	push	h	; As well as operator stack pointer
	mvi	b,0	; Get index of operator from stack
	ani	TMASK
	mov	c,a
	lxi	h,prec	; Find precedence
	dad	b
	mov	a,m 	; Load precedence into A
	pop	h	; Restore operator stack pointer
	pop	b	; As well as output pointer
	cmp	d	; Compare to operator from input
	jc	oppush	; If input precedence higher, then push operator
	dcx	h	; Otherwise, pop from operator stack,
	mov	a,m
	stax	b	; And store in output queue
	inx	b
	jmp	oppop	; Keep popping from operator stack
oppush:	mov	a,e	; Get input operator
	ori	TOP
	mov	m,a	; Store on operator stack
	inx	h
	xthl		; Switch to input string
	jmp	parse
emiss:	lxi	d,missp	; Error message for missing parentheses
	mvi	c,puts
	call	5
	rst	0
pdone:	pop	h	; Get operator stack pointer
ppop:	mov	a,l	; Pop whatever is left off
	ana	a
	jz	cntvar
	dcx	h
	mov	a,m	; Get value
	cpi	TPAR	; If we find a paranthesis then the parentheses
	jz	emiss 	; don't match
	stax	b	; Store in output queue
	inx	b
	jmp 	ppop
cntvar:	stax	b	; Zero-terminate the expression
	lxi	h,vused+25	; See which variables are used in the expr
	xra	a
vzero:	mov	m,a
	dcr	l
	jp	vzero
	lxi	d,expr
vscan:	ldax	d	; Load expression element
	inx	d	; Next one next time
	ana	a	; Was it zero?
	jz	vdone	; Then we're done
	mov	b,a	; Store copy
	ani	TTYPE	; Is it a variable?
	cpi	TVAR
	jnz	vscan	; If not, ignore it
	mov	a,b
	ani	TMASK
	mov	l,a	; If so, mark it
	inr	m
	jmp	vscan
vdone:	call	eval	; Run the evaluation once to catch errors
	lxi	h,vused ; Print header
	mvi	b,0	; Character counter
varhdr:	mov	a,m	; Current variable used?
	ana	a
	jz	varnxt	; If not, skip it
	inr	b	; Two characters
	inr	b
	push	h	; Keep registers
	push	b
	mvi	c,putch	; Print letter
	mov	a,l
	adi	'A'
	mov	e,a
	call	5
	mvi	c,putch	; Print space
	mvi	e,' '
	call 	5
	pop	b	; Restore registers
	pop	h
varnxt: inr	l
	mov	a,l
	cpi	26
	jnz	varhdr
	inr	b	; Two characters for "| "
	inr	b
	push 	b
	lxi	d,dvdr
	mvi	c,puts
	call	5
	pop 	b
	lxi	h,81h	; Print expression
exhdr:	inr	b	; One character
	push	b
	push	h
	mov	e,m
	mvi	c,putch
	call 	5
	pop	h
	pop 	b
	mov	a,m	; Until zero reached
	ana	a
	inx	h
	jnz	exhdr
	push	b	; Keep count
	lxi	d,nwln	; Print newline
	mvi	c,puts
	call	5
	pop	b
linhdr:	push 	b	; Print dashes
	mvi	c,putch
	mvi	e,'-'
	call	5
	pop 	b
	dcr 	b
	jnz	linhdr
	lxi	h,vars	; Set all variables to 0
	xra	a
zero:	mov	m,a
	inr	l
	jnz	zero
mloop:	lxi	d,nwln	; Print newline
	mvi	c,puts
	call	5
	lxi	h,vars	; Print current state
	lxi	d,vused
	lxi	b,1A00h
pstate:	ldax	d	; Is variable in use?
	ana	a
	jz	pnext	; If not, try next one
	mov	c,e	; Keep highest used variable
	mov	a,m	; Otherwise, get value
	ani	1	; 0 or 1
	ori	'0'
	push	b	; Keep state
	push 	d
	push	h
	mvi	c,putch	; Print variable
	mov	e,a
	call	5
	mvi	c,putch	; And space
	mvi	e,' '
	call 	5
	pop	h	; Restore state
	pop	d
	pop 	b
pnext:	inx	h	; Print next one
	inx	d
	dcr	b
	jnz	pstate
	push	b	; Keep last variable
	lxi	d,dvdr	; Print "| "
	mvi	c,puts
	call	5
	call 	eval	; Evaluate expr using current state
	ani	1	; Print result
	ori	'0'
	mvi	c,putch
	mov	e,a
	call	5
	pop	b	; Restore last used variable
	inr	c
	lxi	h,vars	; Find next state
	lxi	d,vused
istate:	ldax	d	; Is variable in use?
	ana	a
	jz	inext	; If not, try next one
	mov	a,m	; Otherwise, get value
	ana	a	; Is it zero?
	jnz	iinc	; If not, keep going,
	inr	m 	; But if so, set it to one
	jmp 	mloop	; And print next state
iinc:	dcr	m	; If one, set it to zero
inext:	inx	d	; And try next variable
	inx	h
	dcr	c	; Test if we have variables left
	jnz	istate	; If not, try next one
	rst	0	; But if so, we're done
eval:	lxi	b,expr	; Evaluate the expression
	lxi	h,opstk	; Evaluation stack
eloop:	ldax	b	; Load expression element
	inx	b
	ana	a	; Done?
	jz	edone
	mov	d,a	; Keep copy
	ani 	TTYPE
	cpi	TCONST	; Constant?
	jz	econst
	cpi	TVAR	; Variable?
	jz	evar
	mov	a,d	; Otherwise it's an operator
	ani	TMASK
	mov 	d,a
	ana	a	; Not?
	jnz	e2
	dcr	l	; Error if stack empty
	jm	errop
	mov	a,m	; Not
	cma
	mov	m,a
	inr	l
	jmp 	eloop
e2: 	dcr	l	; 2 values needed - error if stack empty
	mov	e,m	; Right hand value
	dcr	l
	mov	a,m	; Left hand value
	jm 	errop
	dcr	d 	; And?
	jz 	eand
	dcr 	d	; Or?
	jz 	eor
	dcr	d	; Xor?
	jz	exor
eimpl:	ana 	a	; Implies - if A=1 then E else 1
	jnz	e_lde
	mvi	m,-1
	inr	l
	jmp	eloop
e_lde:	mov	m,e
	inr	l
	jmp	eloop
exor:	xra	e
	jmp	estore
eor:	ora	e
	jmp	estore
eand:	ana 	e
estore:	mov	m,a
	inr	l
	jmp 	eloop
econst:	mov	a,d	; Constant
	ani	TMASK
	mov	m,a
	inr	l
	jmp	eloop
evar:	mov	a,d	; Variable
	ani	TMASK
	push	h
	mvi	h,vars/256
	mov	l,a
	mov	a,m
	pop	h
	mov	m,a
	inr	l
	jmp	eloop
edone:	dcr	l	; Should be at 0
	mov	a,m
	rz
	lxi	d,mop	; Missing operator (not all values used)
	jmp	errop+3
errop:	lxi	d,mval	; Missing operand (stack underflow)
	mvi	c,puts
	call	5
	rst	0
nwln:	db	13,10,'$'
dvdr:	db	'| $'
noarg:	db	'Please enter a boolean expression on the command line.$'
missp:	db	'Missing parenthesis.$'
pserr:	db	'Parse error at: $'
mval:	db	'Missing operand.$'
mop:	db	'Missing operator.$'
opers:	db	'~&|^=',0	; Operators - note that impl is actually =>
prec:	db	4,3,2,2,1	; Precedence
opstk:	equ	($/256)*256+256	; Operator stack (for shunting yard)
vars:	equ	opstk+256	; Space for variables
vused:	equ	vars+256	; Marks which variables are used
expr:	equ	vused+26	; Parsed expression is stored here