import "/dynamic" for Enum, Tuple, Struct
import "/fmt" for Fmt

var Dir = Enum.create("Dir", ["LEFT", "RIGHT", "STAY"])

var Rule = Tuple.create("Rule", ["state1", "symbol1", "symbol2", "dir", "state2"])

var Tape = Struct.create("Tape", ["symbol", "left", "right"])

class Turing {
    construct new(states, finalStates, symbols, blank, state, tapeInput, rules) {
        _states = states
        _finalStates = finalStates
        _symbols = symbols
        _blank = blank
        _state = state
        _tape = null
        _transitions = List.filled(_states.count, null)
        for (i in 0..._states.count) _transitions[i] = List.filled(_symbols.count, null)
        for (i in 0...tapeInput.count) {
            move_(Dir.RIGHT)
            _tape.symbol = tapeInput[i]
        }
        if (tapeInput.count == 0) move_(Dir.RIGHT)
        while (_tape.left) _tape = _tape.left
        for (i in 0...rules.count) {
            var rule = rules[i]
            _transitions[stateIndex_(rule.state1)][symbolIndex_(rule.symbol1)] = rule
        }
    }

    stateIndex_(state) {
        var i = _states.indexOf(state)
        return (i >= 0) ? i : 0
    }

    symbolIndex_(symbol) {
        var i = _symbols.indexOf(symbol)
        return (i >= 0) ? i : 0
    }

    move_(dir) {
        var orig = _tape
        if (dir == Dir.RIGHT) {
            if (orig && orig.right) {
                _tape = orig.right
            } else {
                _tape = Tape.new(_blank, null, null)
                if (orig) {
                    _tape.left = orig
                    orig.right = _tape
                }
            }
        } else if (dir == Dir.LEFT) {
            if (orig && orig.left) {
                _tape = orig.left
            } else {
                _tape = Tape.new(_blank, null, null)
                if (orig) {
                    _tape.right = orig
                    orig.left = _tape
                }
            }
        } else if (dir == Dir.STAY) {}
    }

    printState() {
        Fmt.write("$-10s ", _state)
        var t = _tape
        while (t.left) t = t.left
        while (t) {
            if (t == _tape) {
                System.write("[%(t.symbol)]")
            } else {
                System.write(" %(t.symbol) ")
            }
            t = t.right
        }
        System.print()
    }

    run(maxLines) {
        var lines = 0
        while (true) {
            printState()
            for (finalState in _finalStates) {
                if (finalState == _state) return
            }
            lines = lines + 1
            if (lines == maxLines) {
                System.print("(Only the first %(maxLines) lines displayed)")
                return
            }
            var rule = _transitions[stateIndex_(_state)][symbolIndex_(_tape.symbol)]
            _tape.symbol = rule.symbol2
            move_(rule.dir)
            _state = rule.state2
        }
    }
}

System.print("Simple incrementer")
Turing.new(
    ["q0", "qf"],    // states
    ["qf"],          // finalStates
    ["B", "1"],      // symbols
    "B",             // blank
    "q0",            // state
    ["1", "1", "1"], // tapeInput
    [                // rules
        Rule.new("q0", "1", "1", Dir.RIGHT, "q0"),
        Rule.new("q0", "B", "1", Dir.STAY,  "qf")
    ]
).run(20)

System.print("\nThree-state busy beaver")
Turing.new(
    ["a", "b", "c", "halt"], // states
    ["halt"],                // finalStates
    ["0", "1"],              // symbols
    "0",                     // blank
    "a",                     // state
    [],                      // tapeInput
    [                        // rules
        Rule.new("a", "0", "1", Dir.RIGHT, "b"),
        Rule.new("a", "1", "1", Dir.LEFT,  "c"),
        Rule.new("b", "0", "1", Dir.LEFT,  "a"),
        Rule.new("b", "1", "1", Dir.RIGHT, "b"),
        Rule.new("c", "0", "1", Dir.LEFT,  "b"),
        Rule.new("c", "1", "1", Dir.STAY,  "halt")
    ]
).run(20)

System.print("\nFive-state two-symbol probable busy beaver")
Turing.new(
    ["A", "B", "C", "D", "E", "H"], // states
    ["H"],                          // finalStates
    ["0", "1"],                     // symbols
    "0",                            // blank
    "A",                            // state
    [],                             // tapeInput
    [                               // rules
        Rule.new("A", "0", "1", Dir.RIGHT, "B"),
        Rule.new("A", "1", "1", Dir.LEFT,  "C"),
        Rule.new("B", "0", "1", Dir.RIGHT, "C"),
        Rule.new("B", "1", "1", Dir.RIGHT, "B"),
        Rule.new("C", "0", "1", Dir.RIGHT, "D"),
        Rule.new("C", "1", "0", Dir.LEFT,  "E"),
        Rule.new("D", "0", "1", Dir.LEFT,  "A"),
        Rule.new("D", "1", "1", Dir.LEFT,  "D"),
        Rule.new("E", "0", "1", Dir.STAY,  "H"),
        Rule.new("E", "1", "0", Dir.LEFT,  "A")
    ]
).run(20)


// Machine definitions

name = 1 : initState = 2 : endState = 3 : blank = 4 : countOnly = true

incrementer$ = "Simple incrementer,q0,qf,B"
incrementer$ = incrementer$ + ",q0,1,1,right,q0,q0,B,1,stay,qf"

threeStateBB$ = "Three-state busy beaver,a,halt,0"
data "a,0,1,right,b"
data "a,1,1,left,c"
data "b,0,1,left,a"
data "b,1,1,right,b"
data "c,0,1,left,b"
data "c,1,1,stay,halt"
data ""

do
    read a$
    if a$ = "" break
    threeStateBB$ = threeStateBB$ + "," + a$
loop

fiveStateBB$ = "Five-state busy beaver,A,H,0"
data "A,0,1,right,B"
data "A,1,1,left,C"
data "B,0,1,right,C"
data "B,1,1,right,B"
data "C,0,1,right,D"
data "C,1,0,left,E"
data "D,0,1,left,A"
data "D,1,1,left,D"
data "E,0,1,stay,H"
data "E,1,0,left,A"
data ""

do
    read a$
    if a$ = "" break
    fiveStateBB$ = fiveStateBB$ + "," + a$
loop

clear screen

// Display a representation of the tape and machine state on the screen
sub show(state$, headPos, tape$)
    local pos

    print " ", state$, "\t| ";
    for pos = 1 to len(tape$)
        if pos = headPos then print "[", mid$(tape$, pos, 1), "] "; else print " ", mid$(tape$, pos, 1), "  "; end if
    next
    print
end sub

sub string.rep$(s$, n)
    local i, r$

    for i = 1 to n
        r$ = r$ + s$
    next

    return r$
end sub

// Simulate a turing machine
sub UTM(mach$, tape$, countOnly)
    local state$, headPos, counter, machine$(1), n, m, rule

    m = len(tape$)
    n = token(mach$, machine$(), ",")
    state$ = machine$(initState)
    n = n - blank
    headPos = 1

    print "\n\n", machine$(name)
    print string.rep$("=", len(machine$(name))), "\n"
    if not countOnly print " State", "\t| Tape [head]\n----------------------"

    repeat
        if mid$(tape$, headPos, 1) = " " mid$(tape$, headPos, 1) = machine$(blank)
        if not countOnly show(state$, headPos, tape$)
        for rule = blank + 1 to n step 5
            if machine$(rule) = state$ and machine$(rule + 1) = mid$(tape$, headPos, 1) then
                mid$(tape$, headPos, 1) = machine$(rule + 2)
                if machine$(rule + 3) = "left" then
                    headPos = headPos - 1
                    if headPos < 1  then
                        headPos = 1
                        tape$ = " " + tape$
                    end if
                end if
                if machine$(rule + 3) = "right" then
                    headPos = headPos + 1
                    if headPos > m then
                        m = m + 1
                        tape$ = tape$ + " "
                    end if
                end if
                state$ = machine$(rule + 4)
                break
            end if
        next
        counter = counter + 1
    until(state$ = machine$(endState))
    if countOnly then print "Steps taken: ", counter else show(state$, headPos, tape$) end if
end sub

// Main procedure
UTM(incrementer$, "111")
UTM(threeStateBB$, " ")
UTM(fiveStateBB$, " ", countOnly)


var [const] D=Dictionary;	// short cut
// blank symbol and terminating state(s) are Void
var Lt=-1, Sy=0, Rt=1;  // Left, Stay, Right

fcn printTape(tape,pos){
   tape.keys.apply("toInt").sort()
      .pump(String,'wrap(i){ ((pos==i) and "(%s)" or " %s ").fmt(tape[i]) })
      .println();
}
fcn turing(state,[D]tape,[Int]pos,[D]rules,verbose=True,n=0){
   if(not state){
      print("%d steps. Length %d. Tape: ".fmt(n,tape.len()));
      printTape(tape,Void);
      return(tape);
   }
   r:=rules[state][tape[pos] = tape.find(pos)];
   if(verbose) printTape(tape,pos);
   tape[pos]=r[0];
   return(self.fcn(r[2],tape,pos+r[1],rules,verbose,n+1));
}


T NNode
   String value
   [NNode] children

   F (value)
      .value = value

   F add(node)
      .children.append(node)

   F.const to_str(depth) -> String
      V result = (‘  ’ * depth)‘’(.value)"\n"
      L(child) .children
         result ‘’= child.to_str(depth + 1)
      R result

   F String()
      R .to_str(0)

T INode
   String value
   Int level
   F (value, level)
      .value = value
      .level = level

F to_indented(node)
   [INode] result
   F add_node(NNode node, Int level) -> N
      @result.append(INode(node.value, level))
      L(child) node.children
         @add_node(child, level + 1)
   add_node(node, 0)
   R result

F to_nested(tree)
   [NNode] stack
   V nnode = NNode(tree[0].value)
   L(i) 1 .< tree.len
      V inode = tree[i]
      I inode.level > stack.len
         stack.append(nnode)
      E I inode.level == stack.len
         stack.last.children.append(nnode)
      E
         L inode.level < stack.len
            stack.last.children.append(nnode)
            nnode = stack.pop()
         stack.last.children.append(nnode)
      nnode = NNode(inode.value)

   L stack.len > 0
      stack.last.children.append(nnode)
      nnode = stack.pop()

   R nnode

print(‘Displaying tree built using nested structure:’)
V nestedTree = NNode(‘RosettaCode’)
V rocks = NNode(‘rocks’)
rocks.add(NNode(‘code’))
rocks.add(NNode(‘comparison’))
rocks.add(NNode(‘wiki’))
V mocks = NNode(‘mocks’)
mocks.add(NNode(‘trolling’))
nestedTree.add(rocks)
nestedTree.add(mocks)
print(nestedTree)

print(‘Displaying tree converted to indented structure:’)
V indentedTree = to_indented(nestedTree)
L(node) indentedTree
   print((node.level)‘ ’(node.value))
print()

print(‘Displaying tree converted back to nested structure:’)
print(to_nested(indentedTree))

print(‘Are they equal? ’(I String(nestedTree) == String(to_nested(indentedTree)) {‘yes’} E ‘no’))


#include <iomanip>
#include <iostream>
#include <list>
#include <string>
#include <vector>
#include <utility>
#include <vector>

class nest_tree;

bool operator==(const nest_tree&, const nest_tree&);

class nest_tree {
public:
    explicit nest_tree(const std::string& name) : name_(name) {}
    nest_tree& add_child(const std::string& name) {
        children_.emplace_back(name);
        return children_.back();
    }
    void print(std::ostream& out) const {
        print(out, 0);
    }
    const std::string& name() const {
        return name_;
    }
    const std::list<nest_tree>& children() const {
        return children_;
    }
    bool equals(const nest_tree& n) const {
        return name_ == n.name_ && children_ == n.children_;
    }
private:
    void print(std::ostream& out, int level) const {
        std::string indent(level * 4, ' ');
        out << indent << name_ << '\n';
        for (const nest_tree& child : children_)
            child.print(out, level + 1);
    }
    std::string name_;
    std::list<nest_tree> children_;
};

bool operator==(const nest_tree& a, const nest_tree& b) {
    return a.equals(b);
}

class indent_tree {
public:
    explicit indent_tree(const nest_tree& n) {
        items_.emplace_back(0, n.name());
        from_nest(n, 0);
    }
    void print(std::ostream& out) const {
        for (const auto& item : items_)
            std::cout << item.first << ' ' << item.second << '\n';
    }
    nest_tree to_nest() const {
        nest_tree n(items_[0].second);
        to_nest_(n, 1, 0);
        return n;
    }
private:
    void from_nest(const nest_tree& n, int level) {
        for (const nest_tree& child : n.children()) {
            items_.emplace_back(level + 1, child.name());
            from_nest(child, level + 1);
        }
    }
    size_t to_nest_(nest_tree& n, size_t pos, int level) const {
        while (pos < items_.size() && items_[pos].first == level + 1) {
            nest_tree& child = n.add_child(items_[pos].second);
            pos = to_nest_(child, pos + 1, level + 1);
        }
        return pos;
    }
    std::vector<std::pair<int, std::string>> items_;
};

int main() {
    nest_tree n("RosettaCode");
    auto& child1 = n.add_child("rocks");
    auto& child2 = n.add_child("mocks");
    child1.add_child("code");
    child1.add_child("comparison");
    child1.add_child("wiki");
    child2.add_child("trolling");

    std::cout << "Initial nest format:\n";
    n.print(std::cout);

    indent_tree i(n);
    std::cout << "\nIndent format:\n";
    i.print(std::cout);

    nest_tree n2(i.to_nest());
    std::cout << "\nFinal nest format:\n";
    n2.print(std::cout);

    std::cout << "\nAre initial and final nest formats equal? "
        << std::boolalpha << n.equals(n2) << '\n';

    return 0;
}


package main

import (
    "fmt"
    "io"
    "os"
    "strings"
)

type nNode struct {
    name     string
    children []nNode
}

type iNode struct {
    level int
    name  string
}

func printNest(n nNode, level int, w io.Writer) {
    if level == 0 {
        fmt.Fprintln(w, "\n==Nest form==\n")
    }
    fmt.Fprintf(w, "%s%s\n", strings.Repeat("  ", level), n.name)
    for _, c := range n.children {
        fmt.Fprintf(w, "%s", strings.Repeat("  ", level+1))
        printNest(c, level+1, w)
    }
}

func toNest(iNodes []iNode, start, level int, n *nNode) {
    if level == 0 {
        n.name = iNodes[0].name
    }
    for i := start + 1; i < len(iNodes); i++ {
        if iNodes[i].level == level+1 {
            c := nNode{iNodes[i].name, nil}
            toNest(iNodes, i, level+1, &c)
            n.children = append(n.children, c)
        } else if iNodes[i].level <= level {
            return
        }
    }
}

func printIndent(iNodes []iNode, w io.Writer) {
    fmt.Fprintln(w, "\n==Indent form==\n")
    for _, n := range iNodes {
        fmt.Fprintf(w, "%d %s\n", n.level, n.name)
    }
}

func toIndent(n nNode, level int, iNodes *[]iNode) {
    *iNodes = append(*iNodes, iNode{level, n.name})
    for _, c := range n.children {
        toIndent(c, level+1, iNodes)
    }
}

func main() {
    n1 := nNode{"RosettaCode", nil}
    n2 := nNode{"rocks", []nNode{{"code", nil}, {"comparison", nil}, {"wiki", nil}}}
    n3 := nNode{"mocks", []nNode{{"trolling", nil}}}
    n1.children = append(n1.children, n2, n3)

    var sb strings.Builder
    printNest(n1, 0, &sb)
    s1 := sb.String()
    fmt.Print(s1)

    var iNodes []iNode
    toIndent(n1, 0, &iNodes)
    printIndent(iNodes, os.Stdout)

    var n nNode
    toNest(iNodes, 0, 0, &n)
    sb.Reset()
    printNest(n, 0, &sb)
    s2 := sb.String()
    fmt.Print(s2)

    fmt.Println("\nRound trip test satisfied? ", s1 == s2)
}


{-# LANGUAGE FlexibleInstances       #-}
{-# LANGUAGE MultiParamTypeClasses   #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE TypeApplications        #-}

import Data.List (span)

-- A nested tree structure.
-- Using `Maybe` allows encoding several zero-level items
-- or irregular lists (see test example)
data Nest a = Nest (Maybe a) [Nest a]
  deriving Eq

instance Show a => Show (Nest a) where
  show (Nest (Just a) []) = show a
  show (Nest (Just a) s) = show a ++ show s
  show (Nest Nothing []) = "\"\""
  show (Nest Nothing s) = "\"\"" ++ show s

-- An indented tree structure.
type Indent a = [(Int, a)]

-- class for isomorphic types
class Iso b a => Iso a b where
  from :: a -> b

-- A bijection from nested form to indent form
instance Iso (Nest a) (Indent a) where
  from = go (-1)
    where
      go n (Nest a t) =
        case a of
          Just a -> (n, a) : foldMap (go (n + 1)) t
          Nothing -> foldMap (go (n + 1)) t

-- A bijection from indent form to nested form
instance Iso (Indent a) (Nest a) where
  from = revNest . foldl add (Nest Nothing [])
    where
      add t (d,x) = go 0 t
        where
          go n (Nest a s) =
            case compare n d of
              EQ -> Nest a $ Nest (Just x) [] : s
              LT -> case s of
                      h:t -> Nest a $ go (n+1) h : t
                      [] -> go n $ Nest a [Nest Nothing []]
              GT -> go (n-1) $ Nest Nothing [Nest a s]

      revNest (Nest a s) = Nest a (reverse $ revNest <$> s)

-- A bijection from indent form to a string
instance Iso (Indent String) String where
  from = unlines . map process
    where
      process (d, s) = replicate (4*d) ' ' ++ s

-- A bijection from a string to indent form
instance Iso String (Indent String) where
  from = map process . lines
    where
      process s = let (i, a) = span (== ' ') s
                  in (length i `div` 4, a)

-- A bijection from nest form to a string via indent form
instance Iso (Nest String) String where
  from = from @(Indent String) . from

-- A bijection from a string to nest form via indent form
instance Iso String (Nest String) where
  from = from @(Indent String) . from


const nesttext = """
RosettaCode
    rocks
        code
        comparison
        wiki
    mocks
        trolling
"""

function nesttoindent(txt)
    ret = ""
    windent = gcd(length.([x.match for x in eachmatch(r"\s+", txt)]) .- 1)
    for lin in split(txt, "\n")
        ret *= isempty(lin) ? "\n" : isspace(lin[1]) ?
            replace(lin, r"\s+" => (s) -> "$(length(s)÷windent)    ") * "\n" :
            "0    " * lin * "\n"
    end
    return ret, " "^windent
end

function indenttonest(txt, indenttext)
    ret = ""
    for lin in filter(x -> length(x) > 1, split(txt, "\n"))
        (num, name) = split(lin, r"\s+", limit=2)
        indentnum = parse(Int, num)
        ret *= indentnum == 0 ? name * "\n" : indenttext^indentnum * name * "\n"
    end
    return ret
end

indenttext, itext = nesttoindent(nesttext)
restorednesttext = indenttonest(indenttext, itext)

println("Original:\n", nesttext, "\n")
println("Indent form:\n", indenttext, "\n")
println("Back to nest form:\n", restorednesttext, "\n")
println("original == restored: ", strip(nesttext) == strip(restorednesttext))


import strformat, strutils

####################################################################################################
# Nested representation of trees.
# The tree is simply the first node.

type

  NNode*[T] = ref object
    value*: T
    children*: seq[NNode[T]]

proc newNNode*[T](value: T; children: varargs[NNode[T]]): NNode[T] =
  ## Create a node.
  NNode[T](value: value, children: @children)

proc add*[T](node: NNode[T]; children: varargs[NNode[T]]) =
  ## Add a list of chlidren to a node.
  node.children.add children

proc `$`*[T](node: NNode[T]; depth = 0): string =
  ## Return a string representation of a tree/node.
  result = repeat(' ', 2 * depth) & $node.value & '\n'
  for child in node.children:
    result.add `$`(child, depth + 1)

####################################################################################################
# Indented representation of trees.
# The tree is described as the list of the nodes.

type

  INode*[T] = object
    value*: T
    level*: Natural

  ITree*[T] = seq[INode[T]]

proc initINode*[T](value: T; level: Natural): INode[T] =
  ## Return a new node.
  INode[T](value: value, level: level)

proc initItree*[T](value: T): ITree[T] =
  ## Return a new tree initialized with the first node (root node).
  result = @[initINode(value, 0)]

proc add*[T](tree: var ITree[T]; nodes: varargs[INode[T]]) =
  ## Add a list of nodes to the tree.
  for node in nodes:
    if node.level - tree[^1].level > 1:
      raise newException(ValueError, &"wrong level {node.level} in node {node.value}.")
    tree.add node

proc `$`*[T](tree: ITree[T]): string =
  ## Return a string representation of a tree.
  for node in tree:
    result.add $node.level & ' ' & $node.value & '\n'

####################################################################################################
# Conversion between nested form and indented form.

proc toIndented*[T](node: NNode[T]): Itree[T] =
  ## Convert a tree in nested form to a tree in indented form.

  proc addNode[T](tree: var Itree[T]; node: NNode[T]; level: Natural) =
    ## Add a node to the tree at the given level.
    tree.add initINode(node.value, level)
    for child in node.children:
      tree.addNode(child, level + 1)

  result.addNode(node, 0)

proc toNested*[T](tree: Itree[T]): NNode[T] =
  ## Convert a tree in indented form to a tree in nested form.

  var stack: seq[NNode[T]]            # Note that stack.len is equal to the current level.
  var nnode = newNNode(tree[0].value) # Root.
  for i in 1..tree.high:
    let inode = tree[i]
    if inode.level > stack.len:
      # Child.
      stack.add nnode
    elif inode.level == stack.len:
      # Sibling.
      stack[^1].children.add nnode
    else:
      # Branch terminated.
      while inode.level < stack.len:
        stack[^1].children.add nnode
        nnode = stack.pop()
      stack[^1].children.add nnode

    nnode = newNNode(inode.value)

  # Empty the stack.
  while stack.len > 0:
    stack[^1].children.add nnode
    nnode = stack.pop()

  result = nnode

#———————————————————————————————————————————————————————————————————————————————————————————————————

when isMainModule:

  echo "Displaying tree built using nested structure:"
  let nestedTree = newNNode("RosettaCode")
  let rocks = newNNode("rocks")
  rocks.add newNNode("code"), newNNode("comparison"), newNNode("wiki")
  let mocks = newNNode("mocks", newNNode("trolling"))
  nestedTree.add rocks, mocks
  echo nestedTree

  echo "Displaying tree converted to indented structure:"
  let indentedTree = nestedTree.toIndented
  echo indentedTree

  echo "Displaying tree converted back to nested structure:"
  echo indentedTree.toNested

  echo "Are they equal? ", if $nestedTree == $indentedTree.toNested: "yes" else: "no"


use strict;
use warnings;
use feature 'say';
use JSON;
use Data::Printer;

my $trees = <<~END;
    RosettaCode
      encourages
        code
          diversity
          comparison
      discourages
        golfing
        trolling
        emphasising execution speed
    code-golf.io
      encourages
        golfing
      discourages
        comparison
    END

my $level = '  ';
sub nested_to_indent { shift =~ s#^($level*)# ($1 ? length($1)/length $level : 0) . ' ' #egmr }
sub indent_to_nested { shift =~ s#^(\d+)\s*# $level x $1 #egmr }

say my $indent = nested_to_indent $trees;
    my $nest   = indent_to_nested $indent;

use Test::More;
is($trees, $nest, 'Round-trip');
done_testing();

# Import outline paragraph into native data structure
sub import {
    my($trees) = @_;
    my $level = '  ';
    my $forest;
    my $last = -999;

    for my $branch (split /\n/, $trees) {
        $branch =~ m/(($level*))*/;
        my $this = $1 ? length($1)/length($level) : 0;
        $forest .= do {
            if    ($this gt $last) { '['                   . trim_and_quote($branch) }
            elsif ($this lt $last) { ']'x($last-$this).',' . trim_and_quote($branch) }
            else                   {                         trim_and_quote($branch) }
        };
        $last = $this;
    }
    sub trim_and_quote { shift =~ s/^\s*(.*\S)\s*$/"$1",/r }

    eval $forest . ']' x (1+$last);
}

my $forest = import $trees;
say "Native data structure:\n" . np $forest;
say "\nJSON:\n" . encode_json($forest);


function text_to_indent(string plain_text)
    sequence lines = split(plain_text,"\n",no_empty:=true),
             parents = {}
    for i=1 to length(lines) do
        string line = trim_tail(lines[i]),
               text = trim_head(line)
        integer indent = length(line)-length(text)
        -- remove any completed parents
        while length(parents) and indent<=parents[$] do
            parents = parents[1..$-1]
        end while
        -- append potential new parent
        parents &= indent
        integer depth = length(parents)
        lines[i] = {depth,text}
    end for
    return lines
end function

function indent_to_nested(sequence indent, integer idx=1, level=1)
    sequence res = {}
    while idx<=length(indent) do
        {integer lvl, string text} = indent[idx]
        if lvl<level then exit end if
        {sequence children,idx} = indent_to_nested(indent,idx+1,level+1)
        res = append(res,{text,children})
    end while
    return {res,idx}
end function

function nested_to_indent(sequence nested, integer level=1)
    sequence res = {}
    for i=1 to length(nested) do
        {string text, sequence children} = nested[i]
        res = append(res,{level,text})
        res &= nested_to_indent(children,level+1)
    end for
    return res
end function

constant text = """
    RosettaCode
      encourages
        code
          diversity
          comparison
      discourages
        emphasising execution speed
    code-golf.io
      encourages
        golfing
      discourages
        comparison"""

sequence indent = text_to_indent(text),
         nested = indent_to_nested(indent)[1],
         n2ichk = nested_to_indent(nested)

puts(1,"Indent form:\n")
pp(indent,{pp_Nest,1})
puts(1,"\nNested form:\n")
pp(nested,{pp_Nest,8})
printf(1,"\nNested to indent:%s\n",{iff(n2ichk==indent?"same":"***ERROR***")})


from pprint import pprint as pp

def to_indent(node, depth=0, flat=None):
    if flat is None:
        flat = []
    if node:
        flat.append((depth, node[0]))
    for child in node[1]:
        to_indent(child, depth + 1, flat)
    return flat

def to_nest(lst, depth=0, level=None):
    if level is None:
        level = []
    while lst:
        d, name = lst[0]
        if d == depth:
            children = []
            level.append((name, children))
            lst.pop(0)
        elif d > depth:  # down
            to_nest(lst, d, children)
        elif d < depth:  # up
            return
    return level[0] if level else None

if __name__ == '__main__':
    print('Start Nest format:')
    nest = ('RosettaCode', [('rocks', [('code', []), ('comparison', []), ('wiki', [])]),
                            ('mocks', [('trolling', [])])])
    pp(nest, width=25)

    print('\n... To Indent format:')
    as_ind = to_indent(nest)
    pp(as_ind, width=25)

    print('\n... To Nest format:')
    as_nest = to_nest(as_ind)
    pp(as_nest, width=25)

    if nest != as_nest:
        print("Whoops round-trip issues")


#`(
Sort of vague as to what we are trying to accomplish here. If we are just
trying to transform from one format to another, probably easiest to just
perform string manipulations.
)

my $level = '  ';

my $trees = q:to/END/;
    RosettaCode
      encourages
        code
          diversity
          comparison
      discourages
        golfing
        trolling
        emphasising execution speed
    code-golf.io
      encourages
        golfing
      discourages
        comparison
    END

sub nested-to-indent { $^str.subst: / ^^ ($($level))* /, -> $/ { "{+$0} " }, :g }
sub indent-to-nested { $^str.subst: / ^^ (\d+) \s* /, -> $/ { "{$level x +$0}" }, :g }

say $trees;
say my $indent = $trees.&nested-to-indent;
say my $nest = $indent.&indent-to-nested;

use Test;
is($trees, $nest, 'Round-trip equals original');

#`(
If, on the other hand, we want perform more complex transformations; better to
load it into a native data structure which will then allow us to manipulate it
however we like.
)

# Import outline paragraph into native data structure
sub import (Str $trees, $level = '  ') {
    my $forest;
    my $last = -Inf;

    for $trees.lines -> $branch {
        $branch ~~ / ($($level))* /;
        my $this = +$0;
        $forest ~= do {
            given $this cmp $last {
                when More { "\['{esc $branch.trim}', " }
                when Same { "'{esc $branch.trim}', " }
                when Less { "{']' x $last - $this}, '{esc $branch.trim}', " }
            }
        }
        $last = $this;
    }

    sub esc { $^s.subst( /(<['\\]>)/, -> $/ { "\\$0" }, :g) }

    $forest ~= ']' x 1 + $last;
    $forest.EVAL;
}

my $forest = import $trees;

say "\nNative data structure:\n", $forest.raku;

{
    use JSON::Fast;
    say "\nJSON:\n", $forest.&to-json;
}

{
    use YAML;
    say "\nYAML:\n", $forest.&dump;
}


import "/dynamic" for Struct
import "/fmt" for Fmt

var NNode = Struct.create("NNode", ["name", "children"])
var INode = Struct.create("INode", ["level", "name"])

var sw = ""

var printNest // recursive
printNest = Fn.new { |n, level|
    if (level == 0) sw = sw + "\n==Nest form==\n\n"
    sw = sw + Fmt.swrite("$0s$s\n", "  " * level, n.name)
    for (c in n.children) {
        sw = sw + ("  " * (level + 1))
        printNest.call(c, level+1)
    }
}

var toNest // recursive
toNest = Fn.new { |iNodes, start, level, n|
    if (level == 0) n.name = iNodes[0].name
    var i = start + 1
    while (i < iNodes.count) {
        if (iNodes[i].level == level + 1) {
            var c = NNode.new(iNodes[i].name, [])
            toNest.call(iNodes, i, level+1, c)
            n.children.add(c)
        } else if (iNodes[i].level <= level) return
        i = i + 1
    }
}

var printIndent = Fn.new { |iNodes|
    sw = sw + "\n==Indent form==\n\n"
    for (n in iNodes) sw = sw + Fmt.swrite("$d $s\n", n.level, n.name)
}

var toIndent // recursive
toIndent = Fn.new { |n, level, iNodes|
    iNodes.add(INode.new(level, n.name))
    for (c in n.children) toIndent.call(c, level+1, iNodes)
}

var n1 = NNode.new("RosettaCode", [])
var n2 = NNode.new("rocks", [NNode.new("code", []), NNode.new("comparison", []), NNode.new("wiki", [])])
var n3 = NNode.new("mocks", [NNode.new("trolling", [])])
n1.children.add(n2)
n1.children.add(n3)

printNest.call(n1, 0)
var s1 = sw
System.print(s1)

var iNodes = []
toIndent.call(n1, 0, iNodes)
sw = ""
printIndent.call(iNodes)
System.print(sw)

var n = NNode.new("", [])
toNest.call(iNodes, 0, 0, n)
sw = ""
printNest.call(n, 0)
var s2 = sw
System.print(s2)

System.print("\nRound trip test satisfied? %(s1 == s2)")


fcn nestToIndent(nestTree){
   fcn(out,node,level){
      out.append(List(level,node[0]));	// (n,name) or ("..",name)
      if(node.len()>1){		// (name children), (name, (tree))
	 level+=1;
	 foreach child in (node[1,*]){
	    if(String.isType(child)) out.append(List(level,child));
	    else self.fcn(out,child,level)
	 }
      }
      out
   }(List(),nestTree,0)
}
fcn nestToString(nestTree,dot="."){
   fcn(out,dot,node,level){
      out.writeln(dot*level,node[0]);	// (name)
      if(node.len()>1){			// (name children), (name, (tree))
	 level+=1;
	 foreach child in (node[1,*]){
	    if(String.isType(child)) out.writeln(dot*level,child);
	    else self.fcn(out,dot,child,level)
	 }
      }
      out
   }(Data(),dot,nestTree,0).text
}

fcn indentToNest(iTree,depth=0,nTree=List()){
   while(iTree){	// (n,name)
      d, name := iTree[0];
      if(d==depth){
         nTree.append(name);
	 iTree.pop(0);
      }
      else if(d>depth){		// assume can't skip levels down
	 if(nTree.len()>1 and not List.isType((nm:=nTree[-1]))){
	    nTree[-1]=(children:=List(nm));
	    indentToNest(iTree,d,children);
	 }else{
	    nTree.append(children:=List(name));
	    iTree.pop(0);
	    indentToNest(iTree,d+1,children);
	 }
      }
      else break;  // d<depth
   }
   return(nTree)
}
fcn indentToString(indentTree){ indentTree.apply("concat"," ").concat("\n") }


V MAX_PRIME = 1000000
V primes = [1B] * MAX_PRIME
primes[0] = primes[1] = 0B

V i = 2
L i * i < MAX_PRIME
   L(j) (i * i .< MAX_PRIME).step(i)
      primes[j] = 0B
   i++
   L i < MAX_PRIME & !primes[i]
      i++

F left_trunc(=n)
   V tens = 1
   L tens < n
      tens *= 10

   L n != 0
      I !:primes[n]
         R 0B
      tens I/= 10
      I n < tens
         R 0B
      n %= tens

   R 1B

F right_trunc(=n)
   L n != 0
      I !:primes[n]
         R 0B
      n I/= 10
   R 1B

L(n) (MAX_PRIME - 1 .< 0).step(-2)
   I left_trunc(n)
      print(‘Left: ’n)
      L.break

L(n) (MAX_PRIME - 1 .< 0).step(-2)
   I right_trunc(n)
      print(‘Right: ’n)
      L.break


with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Containers.Ordered_Sets;

procedure Truncatable_Primes is
   package Natural_Set is new Ada.Containers.Ordered_Sets (Natural);
   use Natural_Set;

   Primes : Set;

   function Is_Prime (N : Natural) return Boolean is
      Position : Cursor := First (Primes);
   begin
      while Has_Element (Position) loop
         if N mod Element (Position) = 0 then
            return False;
         end if;
         Position := Next (Position);
      end loop;
      return True;
   end Is_Prime;

   function Is_Left_Trucatable_Prime (N : Positive) return Boolean is
      M : Natural := 1;
   begin
      while Contains (Primes, N mod (M * 10)) and (N / M) mod 10 > 0 loop
         M := M * 10;
         if N <= M then
            return True;
         end if;
      end loop;
      return False;
   end Is_Left_Trucatable_Prime;

   function Is_Right_Trucatable_Prime (N : Positive) return Boolean is
      M : Natural := N;
   begin
      while Contains (Primes, M) and M mod 10 > 0 loop
         M := M / 10;
         if M <= 1 then
            return True;
         end if;
      end loop;
      return False;
   end Is_Right_Trucatable_Prime;

   Position : Cursor;
begin
   for N in 2..1_000_000 loop
      if Is_Prime (N) then
         Insert (Primes, N);
      end if;
   end loop;
   Position := Last (Primes);
   while Has_Element (Position) loop
      if Is_Left_Trucatable_Prime (Element (Position)) then
         Put_Line ("Largest LTP from 1..1000000:" & Integer'Image (Element (Position)));
         exit;
      end if;
      Previous (Position);
   end loop;
   Position := Last (Primes);
   while Has_Element (Position) loop
      if Is_Right_Trucatable_Prime (Element (Position)) then
         Put_Line ("Largest RTP from 1..1000000:" & Integer'Image (Element (Position)));
         exit;
      end if;
      Previous (Position);
   end loop;
end Truncatable_Primes;


#!/usr/local/bin/a68g --script #

PROC is prime = (INT n)BOOL:(
  []BOOL is short prime=(FALSE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE);
  IF n<=UPB is short prime THEN is short prime[n] # EXIT # ELSE
    IF ( NOT ODD n | TRUE | n MOD 3 = 0 ) THEN FALSE # EXIT # ELSE
      INT h := ENTIER sqrt(n)+3;
      FOR a FROM 7 BY 6 WHILE a<h DO
        IF ( n MOD a = 0 | TRUE |  n MOD (a-2) = 0 ) THEN false exit FI
      OD;
      TRUE # EXIT #
    FI
  FI EXIT
  false exit: FALSE
);

PROC string to int = (STRING in a)INT:(
  FILE f; STRING a := in a; associate(f, a);
  INT i; get(f, i); close(f);
  i
);

PROC is trunc prime = (INT in n, PROC(REF STRING)VOID trunc)BOOL: (
  INT n := in n;
  STRING s := whole(n, 0);
  IF char in string("0", NIL, s) THEN FALSE # EXIT #
  ELSE
    WHILE is prime(n) DO
      s := whole(n, 0);
      trunc(s);
      IF UPB s = 0 THEN true exit FI;
      n := string to int(s)
    OD;
    FALSE EXIT
    true exit: TRUE
  FI
);

PROC get trunc prime = (INT in n, PROC(REF STRING)VOID trunc)VOID:(
  FOR n FROM in n BY -1 TO 1 DO
    IF is trunc prime(n, trunc) THEN
      printf(($g(0)l$, n));
      break
    FI
  OD;
  break: ~
);

main:(
  INT limit = 1000000;
  printf(($g g(0) gl$,"Highest left- and right-truncatable primes under ",limit,":"));
  get trunc prime(limit, (REF STRING s)VOID: s := s[LWB s+1:]);
  get trunc prime(limit, (REF STRING s)VOID: s := s[:UPB s-1]);
  write("Press Enter");
  read(newline)
)


leftTruncatable?: function [n][
    every? map 0..(size s)-1 'z -> to :integer slice s z (size s)-1
                                => prime?
]

rightTruncatable?: function [n][
    every? map 0..(size s)-1 'z -> to :integer slice s 0 z
                                => prime?
]

upperLimit: 999999

loop range upperLimit .step:2 0 'x [
    s: to :string x
    if and? not? contains? s "0"
            leftTruncatable? x [
        print ["highest left-truncatable:" x]
        break
    ]
]

loop range upperLimit .step:2 0 'x [
    s: to :string x
    if and? not? contains? s "0"
            rightTruncatable? x [
        print ["highest right-truncatable:" x]
        break
    ]
]


SetBatchLines, -1
MsgBox, % "Largest left-truncatable and right-truncatable primes less than one million:`n"
	. "Left:`t" LTP(10 ** 6) "`nRight:`t" RTP(10 ** 6)

LTP(n) {
	while n {
		n--
		if (!Instr(n, "0") && IsPrime(n)) {
			Loop, % StrLen(n)
				if (!IsPrime(SubStr(n, A_Index)))
					continue, 2
			break
		}
	}
	return, n
}

RTP(n) {
	while n {
		n--
		if (!IsPrime(SubStr(n, 1, 1)))
			n -= 10 ** (StrLen(n) - 1)
		if (!Instr(n, "0") && IsPrime(n)) {
			Loop, % StrLen(n)
				if (!IsPrime(SubStr(n, 1, A_Index)))
					continue, 2
			break
		}
	}
	return, n
}

IsPrime(n) {
	if (n < 2)
		return, 0
	else if (n < 4)
		return, 1
	else if (!Mod(n, 2))
		return, 0
	else if (n < 9)
		return 1
	else if (!Mod(n, 3))
		return, 0
	else {
		r := Floor(Sqrt(n))
		f := 5
		while (f <= r) {
			if (!Mod(n, f))
				return, 0
			if (!Mod(n, (f + 2)))
				return, 0
			f += 6
		}
		return, 1
	}
}


# syntax: GAWK -f TRUNCATABLE_PRIMES.AWK
BEGIN {
    limit = 1000000
    for (i=1; i<=limit; i++) {
      if (is_prime(i)) {
        prime_count++
        arr[i] = ""
        if (truncate_left(i) == 1) {
          max_left = max(max_left,i)
        }
        if (truncate_right(i) == 1) {
          max_right = max(max_right,i)
        }
      }
    }
    printf("1-%d: %d primes\n",limit,prime_count)
    printf("largest L truncatable: %d\n",max_left)
    printf("largest R truncatable: %d\n",max_right)
    exit(0)
}
function is_prime(x,  i) {
    if (x <= 1) {
      return(0)
    }
    for (i=2; i<=int(sqrt(x)); i++) {
      if (x % i == 0) {
        return(0)
      }
    }
    return(1)
}
function truncate_left(n) {
    while (n != "") {
      if (!(n in arr)) {
        return(0)
      }
      n = substr(n,2)
    }
    return(1)
}
function truncate_right(n) {
    while (n != "") {
      if (!(n in arr)) {
        return(0)
      }
      n = substr(n,1,length(n)-1)
    }
    return(1)
}
function max(x,y) { return((x > y) ? x : y) }


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

#define MAX_PRIME 1000000
char *primes;
int n_primes;

/*  Sieve. If we were to handle 10^9 range, use bit field. Regardless,
 *  if a large amount of prime numbers need to be tested, sieve is fast.
 */
void init_primes()
{
	int j;
	primes = malloc(sizeof(char) * MAX_PRIME);
	memset(primes, 1, MAX_PRIME);
	primes[0] = primes[1] = 0;
	int i = 2;
	while (i * i < MAX_PRIME) {
		for (j = i * 2; j < MAX_PRIME; j += i)
			primes[j] = 0;
		while (++i < MAX_PRIME && !primes[i]);
	}
}

int left_trunc(int n)
{
	int tens = 1;
	while (tens < n) tens *= 10;

	while (n) {
		if (!primes[n]) return 0;
		tens /= 10;
		if (n < tens) return 0;
		n %= tens;
	}
	return 1;
}

int right_trunc(int n)
{
	while (n) {
		if (!primes[n]) return 0;
		n /= 10;
	}
	return 1;
}

int main()
{
	int n;
	int max_left = 0, max_right = 0;
	init_primes();

	for (n = MAX_PRIME - 1; !max_left;  n -= 2)
		if (left_trunc(n)) max_left = n;

	for (n = MAX_PRIME - 1; !max_right; n -= 2)
		if (right_trunc(n)) max_right = n;

	printf("Left: %d; right: %d\n", max_left, max_right);
	return 0;
}


using System;  // [email protected]
using System.Collections.Generic;
class truncatable_primes
{
    static void Main()
    {
        uint m = 1000000;
        Console.Write("L " + L(m) + " R " + R(m) + "  ");
        var sw = System.Diagnostics.Stopwatch.StartNew();
        for (int i = 1000; i > 0; i--) { L(m); R(m); }
        Console.Write(sw.Elapsed); Console.Read();
    }

    static uint L(uint n)
    {
        n -= n & 1; n--;
        for (uint d, d1 = 100; ; n -= 2)
        {
            while (n % 3 == 0 || n % 5 == 0 || n % 7 == 0) n -= 2;
            if ((d = n % 10) == 3 || d == 7)
            {
                while (d1 < n && d < (d = n % d1) && isP(d)) d1 *= 10;
                if (d1 > n && isP(n)) return n; d1 = 100;
            }
        }
    }

    static uint R(uint m)
    {
        var p = new List<uint>() { 2, 3, 5, 7 }; uint n = 20, np;
        for (int i = 1; i < p.Count; n = 10 * p[i++])
        {
            if ((np = n + 1) >= m) break; if (isP(np)) p.Add(np);
            if ((np = n + 3) >= m) break; if (isP(np)) p.Add(np);
            if ((np = n + 7) >= m) break; if (isP(np)) p.Add(np);
            if ((np = n + 9) >= m) break; if (isP(np)) p.Add(np);
        }
        return p[p.Count - 1];
    }

    static bool isP(uint n)
    {
        if (n < 7) return n == 2 || n == 3 || n == 5;
        if ((n & 1) == 0 || n % 3 == 0 || n % 5 == 0) return false;
        for (uint r = (uint)Math.Sqrt(n), d = 7; d <= r; d += 30)
            if (n % (d + 00) == 0 || n % (d + 04) == 0 ||
                n % (d + 06) == 0 || n % (d + 10) == 0 ||
                n % (d + 12) == 0 || n % (d + 16) == 0 ||
                n % (d + 22) == 0 || n % (d + 24) == 0) return false;
        return true;
    }
}


on treeFromNestingLevels(input)
    set maxLevel to 0
    repeat with thisLevel in input
        if (thisLevel > maxLevel) then set maxLevel to thisLevel
    end repeat
    if (maxLevel < 2) then return input

    set emptyList to {}
    repeat with testLevel from maxLevel to 2 by -1
        set output to {}
        set subnest to {}
        repeat with thisLevel in input
            set thisLevel to thisLevel's contents
            if ((thisLevel's class is integer) and (thisLevel < testLevel)) then
                if (subnest ≠ emptyList) then set subnest to {}
                set end of output to thisLevel
            else
                if (subnest = emptyList) then set end of output to subnest
                set end of subnest to thisLevel
            end if
        end repeat
        set input to output
    end repeat

    return output
end treeFromNestingLevels

-- Task code:
local output, astid, input, part1, errMsg
set output to {}
set astid to AppleScript's text item delimiters
repeat with input in {{}, {1, 2, 4}, {3, 1, 3, 1}, {1, 2, 3, 1}, {3, 2, 1, 3}, {3, 3, 3, 1, 1, 3, 3, 3}}
    set input to input's contents
    set AppleScript's text item delimiters to ", "
    set part1 to "{" & input & "} nests to:  {"
    -- It's a pain having to parse nested lists to text, so throw a deliberate error and parse the error message instead.
    try
        || of treeFromNestingLevels(input)
    on error errMsg
        set AppleScript's text item delimiters to {"{", "}"}
        set end of output to part1 & ((text from text item 2 to text item -2 of errMsg) & "}")
    end try
end repeat
set AppleScript's text item delimiters to linefeed
set output to output as text
set AppleScript's text item delimiters to astid
return output


#include <iostream>
#include "prime_sieve.hpp"

bool is_left_truncatable(const prime_sieve& sieve, int p) {
    for (int n = 10, q = p; p > n; n *= 10) {
        if (!sieve.is_prime(p % n) || q == p % n)
            return false;
        q = p % n;
    }
    return true;
}

bool is_right_truncatable(const prime_sieve& sieve, int p) {
    for (int q = p/10; q > 0; q /= 10) {
        if (!sieve.is_prime(q))
            return false;
    }
    return true;
}

int main() {
    const int limit = 1000000;

    // find the prime numbers up to the limit
    prime_sieve sieve(limit + 1);

    int largest_left = 0;
    int largest_right = 0;
    // find largest left truncatable prime
    for (int p = limit; p >= 2; --p) {
        if (sieve.is_prime(p) && is_left_truncatable(sieve, p)) {
            largest_left = p;
            break;
        }
    }
    // find largest right truncatable prime
    for (int p = limit; p >= 2; --p) {
        if (sieve.is_prime(p) && is_right_truncatable(sieve, p)) {
            largest_right = p;
            break;
        }
    }
    // write results to standard output
    std::cout << "Largest left truncatable prime is " << largest_left << '\n';
    std::cout << "Largest right truncatable prime is " << largest_right << '\n';
    return 0;
}


#include <any>
#include <iostream>
#include <iterator>
#include <vector>

using namespace std;

// Make a tree that is a vector of either values or other trees
vector<any> MakeTree(input_iterator auto first, input_iterator auto last, int depth = 1)
{
    vector<any> tree;
    while (first < last && depth <= *first)
    {
        if(*first == depth)
        {
            // add a single value
            tree.push_back(*first);
            ++first;
        }
        else // (depth < *b)
        {
            // add a subtree
            tree.push_back(MakeTree(first, last, depth + 1));
            first = find(first + 1, last, depth);
        }
    }

    return tree;
}

// Print an input vector or tree
void PrintTree(input_iterator auto first, input_iterator auto last)
{
    cout << "[";
    for(auto it = first; it != last; ++it)
    {
        if(it != first) cout << ", ";
        if constexpr (is_integral_v<remove_reference_t<decltype(*first)>>)
        {
            // for printing the input vector
            cout << *it;
        }
        else
        {
            // for printing the tree
            if(it->type() == typeid(unsigned int))
            {
                // a single value
                cout << any_cast<unsigned int>(*it);
            }
            else
            {
                // a subtree
                const auto& subTree = any_cast<vector<any>>(*it);
                PrintTree(subTree.begin(), subTree.end());
            }
        }
    }
    cout << "]";
}

int main(void)
{
    auto execises = vector<vector<unsigned int>> {
        {},
        {1, 2, 4},
        {3, 1, 3, 1},
        {1, 2, 3, 1},
        {3, 2, 1, 3},
        {3, 3, 3, 1, 1, 3, 3, 3}
        };

    for(const auto& e : execises)
    {
        auto tree = MakeTree(e.begin(), e.end());
        PrintTree(e.begin(), e.end());
        cout << " Nests to:\n";
        PrintTree(tree.begin(), tree.end());
        cout << "\n\n";
    }
}


(use '[clojure.contrib.lazy-seqs :only [primes]])

(def prime?
  (let [mem (ref #{})
	primes (ref primes)]
    (fn [n]
      (dosync
       (if (< n (first @primes))
	 (@mem n)
	 (let [[mems ss] (split-with #(<= % n) @primes)]
	   (ref-set primes ss)
	   ((commute mem into mems) n)))))))

(defn drop-lefts [n]
  (let [dropl #(if (< % 10) 0 (Integer. (subs (str %) 1)))]
    (->> (iterate dropl n)
	 (take-while pos? ,)
	 next)))

(defn drop-rights [n]
  (->> (iterate #(quot % 10) n)
       next
       (take-while pos? ,)))

(defn truncatable-left? [n]
  (every? prime? (drop-lefts n)))

(defn truncatable-right? [n]
  (every? prime? (drop-rights n)))

user> (->> (for [p primes
	   :while (< p 1000000)
	   :when (not-any? #{\0} (str p))
	   :let [l? (if (truncatable-left? p) p 0)
		 r? (if (truncatable-right? p) p 0)]
	    :when (or l? r?)]
       [l? r?])
     ((juxt #(apply max-key first %) #(apply max-key second %)) ,)
     ((juxt ffirst (comp second second)) ,)
     (map vector ["left truncatable: " "right truncatable: "] ,))
(["left truncatable: " 998443] ["right truncatable: " 739399])


package main

import "fmt"

type any = interface{}

func toTree(list []int) any {
    s := []any{[]any{}}
    for _, n := range list {
        for n != len(s) {
            if n > len(s) {
                inner := []any{}
                s[len(s)-1] = append(s[len(s)-1].([]any), inner)
                s = append(s, inner)
            } else {
                s = s[0 : len(s)-1]
            }
        }
        s[len(s)-1] = append(s[len(s)-1].([]any), n)
        for i := len(s) - 2; i >= 0; i-- {
            le := len(s[i].([]any))
            s[i].([]any)[le-1] = s[i+1]
        }
    }
    return s[0]
}

func main() {
    tests := [][]int{
        {},
        {1, 2, 4},
        {3, 1, 3, 1},
        {1, 2, 3, 1},
        {3, 2, 1, 3},
        {3, 3, 3, 1, 1, 3, 3, 3},
    }
    for _, test := range tests {
        nest := toTree(test)
        fmt.Printf("%17s => %v\n", fmt.Sprintf("%v", test), nest)
    }
}


# You could have symmetric algorithms for max right and left
# truncatable numbers, but they lend themselves to slightly
# different optimizations.

max_right_truncatable_number = (n, f) ->
  # This algorithm only evaluates 37 numbers for primeness to
  # get the max right truncatable prime < 1000000.  Its
  # optimization is that it prunes candidates for
  # the first n-1 digits before having to iterate through
  # the 10 possibilities for the last digit.
  if n < 10
    candidate = n
    while candidate > 0
      return candidate if f(candidate)
      candidate -= 1
  else
    left = Math.floor n / 10
    while left > 0
      left = max_right_truncatable_number left, f
      right = 9
      while right > 0
        candidate = left * 10 + right
        return candidate if candidate <= n and f(candidate)
        right -= 1
      left -= 1
  throw Error "none found"

max_left_truncatable_number = (max, f) ->
  # This is a pretty straightforward countdown.  The first
  # optimization here would probably be to cache results of
  # calling f on small numbers.
  is_left_truncatable = (n) ->
    candidate = 0
    power_of_ten = 1
    while n > 0
      r = n  % 10
      return false if r == 0
      n = Math.floor n / 10
      candidate = r * power_of_ten + candidate
      power_of_ten *= 10
      return false unless f(candidate)
    true
  do ->
    n = max
    while n > 0
      return n if is_left_truncatable n, f
      n -= 1
    throw Error "none found"

is_prime = (n) ->
  return false if n == 1
  return true if n == 2
  for d in [2..n]
    return false if n % d == 0
    return true if d * d >= n

console.log "right", max_right_truncatable_number(999999, is_prime)
console.log "left", max_left_truncatable_number(999999, is_prime)


;; helper function that finds the rest that are less than or equal
(define (rest-less-eq x ls)
    (cond
      ((null? ls) #f)
      ((<= (car ls) x) ls)
      (else (rest-less-eq x (cdr ls)))))

;; nest the input as a tree
(define (make-tree input depth)
  (cond
   ((null? input) '())
   ((eq? input #f ) '())
   ((= depth (car input))
    (cons (car input)(make-tree(cdr input) depth)))
   ((< depth (car input))
    (cons (make-tree input (+ depth 1))
	  (make-tree (rest-less-eq depth input) depth)))
   (#t '())
   ))

(define examples
  '(()
    (1 2 4)
    (3 1 3 1)
    (1 2 3 1)
    (3 2 1 3)
    (3 3 3 1 1 3 3 3)))

(define (run-examples x)
  (if (null? x) '()
      (begin
	(display (car x))(display " -> ")
	(display (make-tree(car x) 1))(display "\n")
	(run-examples (cdr x)))))

(run-examples examples)


{-# LANGUAGE TupleSections #-}

import Data.Bifunctor (bimap)
import Data.Tree (Forest, Tree (..), drawTree, foldTree)

------------- TREE FROM NEST LEVELS (AND BACK) -----------

treeFromSparseLevels :: [Int] -> Tree (Maybe Int)
treeFromSparseLevels =
  Node Nothing
    . forestFromNestLevels
    . rooted
    . normalised

sparseLevelsFromTree :: Tree (Maybe Int) -> [Int]
sparseLevelsFromTree = foldTree go
  where
    go Nothing xs = concat xs
    go (Just x) xs = x : concat xs

forestFromNestLevels :: [(Int, a)] -> Forest a
forestFromNestLevels = go
  where
    go [] = []
    go ((n, v) : xs) =
      uncurry (:) $
        bimap (Node v . go) go (span ((n <) . fst) xs)

--------------------- TEST AND DISPLAY -------------------
main :: IO ()
main =
  mapM_
    ( \xs ->
        putStrLn ("From: " <> show xs)
          >> let tree = treeFromSparseLevels xs
              in putStrLn ((drawTree . fmap show) tree)
                   >> putStrLn
                     ( "Back to: "
                         <> show (sparseLevelsFromTree tree)
                         <> "\n\n"
                     )
    )
    [ [],
      [1, 2, 4],
      [3, 1, 3, 1],
      [1, 2, 3, 1],
      [3, 2, 1, 3],
      [3, 3, 3, 1, 1, 3, 3, 3]
    ]

----------- MAPPING TO A STRICTER DATA STRUCTURE ---------

-- Path from the virtual root to the first explicit node.
rooted :: [(Int, Maybe Int)] -> [(Int, Maybe Int)]
rooted [] = []
rooted xs = go $ filter ((1 <=) . fst) xs
  where
    go xs@((1, mb) : _) = xs
    go xs@((n, mb) : _) =
      fmap (,Nothing) [1 .. pred n] <> xs

-- Representation of implicit nodes.
normalised [] = []
normalised [x] = [(x, Just x)]
normalised (x : y : xs)
  | 1 < (y - x) =
    (x, Just x) :
    (succ x, Nothing) : normalised (y : xs)
  | otherwise = (x, Just x) : normalised (y : xs)


(defun start ()
  (format t "Largest right-truncatable ~a~%" (max-right-truncatable))
  (format t "Largest left-truncatable  ~a~%" (max-left-truncatable)))

(defun max-right-truncatable ()
  (loop for el in (6-digits-R-truncatables)
        maximizing el into max
        finally (return max)))

(defun 6-digits-R-truncatables (&optional (lst '(2 3 5 7)) (n 5))
  (if (zerop n)
    lst
    (6-digits-R-truncatables (R-trunc lst) (- n 1))))

(defun R-trunc (lst)
  (remove-if (lambda (x) (not (primep x)))
	     (loop for el in lst
		   append (mapcar (lambda (x) (+ (* 10 el) x)) '(1 3 7 9)))))

(defun max-left-truncatable ()
  (loop for el in (6-digits-L-truncatables)
        maximizing el into max
        finally (return max)))

(defun 6-digits-L-truncatables (&optional (lst '(3 7)) (n 5))
  (if (zerop n)
    lst
    (6-digits-L-truncatables (L-trunc lst (- 6 n)) (- n 1))))

(defun L-trunc (lst n)
  (remove-if (lambda (x) (not (primep x)))
	     (loop for el in lst
		   append (mapcar (lambda (x) (+ (* (expt 10 n) x) el)) '(1 2 3 4 5 6 7 8 9)))))

(defun primep (n)
  (primep-aux n 2))

(defun primep-aux (n d)
  (cond ((> d (sqrt n)) t)
        ((zerop (rem n d)) nil)
        (t (primep-aux n (+ d 1)))))


import std.stdio, std.math, std.string, std.conv, std.algorithm,
       std.range;

bool isPrime(in int n) pure nothrow {
    if (n <= 1)
        return false;
    foreach (immutable i; 2 .. cast(int)sqrt(real(n)) + 1)
        if (!(n % i))
            return false;
    return true;
}

bool isTruncatablePrime(bool left)(in int n) pure {
    immutable s = n.text;
    if (s.canFind('0'))
        return false;
    foreach (immutable i; 0 .. s.length)
        static if (left) {
            if (!s[i .. $].to!int.isPrime)
                return false;
        } else {
            if (!s[0 .. i + 1].to!int.isPrime)
                return false;
        }
    return true;
}

void main() {
    enum n = 1_000_000;
    writeln("Largest left-truncatable prime in 2 .. ", n, ": ",
            iota(n, 1, -1).filter!(isTruncatablePrime!true).front);
    writeln("Largest right-truncatable prime in 2 .. ", n, ": ",
            iota(n, 1, -1).filter!(isTruncatablePrime!false).front);
}


function makenested(list)
    nesting = 0
    str = isempty(list) ? "[]" : ""
    for n in list
        if n > nesting
            str *=  "["^(n - nesting)
            nesting = n
        elseif n < nesting
            str *= "]"^(nesting - n) * ", "
            nesting = n
        end
        str *= "$n, "
    end
    str *= "]"^nesting
    return eval(Meta.parse(str))
end

for test in [[], [1, 2, 4], [3, 1, 3, 1], [1, 2, 3, 1], [3, 2, 1, 3], [3, 3, 3, 1, 1, 3, 3, 3]]
    result = "$test  =>  $(makenested(test))"
    println(replace(result, "Any" => ""))
end


import sequtils, strutils

type
  Kind = enum kValue, kList
  Node = ref object
    case kind: Kind
    of kValue: value: int
    of kList: list: seq[Node]

proc newTree(s: varargs[int]): Node =
  ## Build a tree from a list of level values.
  var level = 1
  result = Node(kind: kList)
  var stack = @[result]
  for n in s:
    if n <= 0:
      raise newException(ValueError, "expected a positive integer, got " & $n)
    let node = Node(kind: kValue, value: n)
    if n < level:
      # Unstack lists.
      stack.setLen(n)
      level = n
    else:
      while n > level:
        # Create intermediate lists.
        let newList = Node(kind: kList)
        stack[^1].list.add newList
        stack.add newList
        inc level
    # Add value.
    stack[^1].list.add node

proc `$`(node: Node): string =
  ## Display a tree using a nested lists representation.
  if node.kind == kValue: $node.value
  else: '[' & node.list.mapIt($it).join(", ") & ']'

for list in [newSeq[int](),   # Empty list (== @[]).
             @[1, 2, 4],
             @[3, 1, 3, 1],
             @[1, 2, 3, 1],
             @[3, 2, 1, 3],
             @[3, 3, 3, 1, 1, 3, 3, 3]]:
  echo ($list).align(25), " → ", newTree(list)


uses console
declare DemoTree(string src)
DemoTree "[]"
DemoTree "[1, 2, 4]"
DemoTree "[3, 1, 3, 1]"
DemoTree "[1, 2, 3, 1]"
DemoTree "[3, 2, 1, 3]"
DemoTree "[3, 3, 3, 1, 1, 3, 3, 3]"
pause
end

/*
RESULTS:
========

[]
[]

[1, 2, 4]
[ 1,[ 2,[[ 4]]]]

[3, 1, 3, 1]
[[[ 3]], 1,[[ 3]], 1]

[1, 2, 3, 1]
[ 1,[ 2,[ 3]], 1]

[3, 2, 1, 3]
[[[ 3], 2], 1,[[ 3]]]

[3, 3, 3, 1, 1, 3, 3, 3]
[[[ 3, 3, 3]], 1, 1,[[ 3, 3, 3]]]
*/

sub DemoTree(string src)
========================

string tree=nuls 1000   'TREE OUTPUT
int i=1                 'src char iterator
int j=1                 'tree char iterator
byte bs at strptr src   'src bytes
byte bt at strptr tree  'tree bytes
int bl=len src          'end of src
int lvl                 'current tree level
int olv                 'prior tree level
int v                   'number value
string vs               'number in string form

do
  exit if i>bl
  select bs[i]
  case 91 '['
    i++
  case 93 ']'
    if i=bl
      gosub writex
    endif
    i++
  case 44 ','
    i++
    gosub writex
  case 0 to 32 'white space
    i++
    'bt[j]=" " : j++
  case 48 to 57 '0..9'
    gosub ReadDigits
  case else
    i++
  end select
loop
tree=left(tree,j-1)
output src cr
output tree cr cr
exit sub

'SUBROUTINES OF DEMOTREE:
=========================

writex:
=======
olv=lvl
  if i>=bl
    if v=0 and olv=0
      tree="[]" : j=3
      ret
    endif
  endif
  if v<olv
    gosub WriteRbr
  endif
  if olv
    gosub WriteComma
  endif
  if v>olv
    gosub WriteLbr
  endif
  gosub WriteDigits '3]]'
  if i>=bl
    v=0
    gosub WriteRbr
  endif
ret

ReadDigits:
===========
v=0
while i<=bl
  select bs[i]
  case 48 to 57 '1..9
    v*=10 : v+=bs[i]-48 'digit
  case else
    exit while
  end select
  i++
wend
ret
'
WriteDigits:
============
vs=" "+str(v) : mid(tree,j,vs) : j+=len vs
ret

WriteLbr:
=========
while v>lvl
  bt[j]=91 : j++ : lvl++
wend
ret

WriteRbr:
=========
while v<lvl
  bt[j]=93 : j++ : lvl--
wend
ret

WriteComma:
===========
bt[j]=44 : j++ ','
ret

end sub


;; does p include a 0 in its decimal representation ?
(define (nozero? n) (= -1 (string-index (number->string n) "0")))

;; right truncate : p and successive quotients by 10 (integer division) must be primes
(define (right-trunc p) (unless (zero? p)
	(and (prime? p) (right-trunc (quotient p 10)))))
(remember 'right-trunc)

;; left truncate : p and successive modulo by 10, 100, .. must be prime
(define (left-trunc p (mod 1000000))
	(unless (< mod 1)
	(and (prime? p) (nozero? p) (left-trunc (modulo p mod) (/ mod 10)))))

;; start from 999999. stop on first found
(define (fact-trunc trunc)
(for ((p (in-range 999999 100000 -1))) #:break (when (trunc p) (writeln p) #t)))


function test(sequence s, integer level=1, idx=1)
    sequence res = {}, part
    while idx<=length(s) do
        switch compare(s[idx],level) do
            case +1: {idx,part} = test(s,level+1,idx)
                     res = append(res,part)
            case  0: res &= s[idx]
            case -1: idx -= 1 exit
        end switch
        idx += 1
    end while
    return iff(level=1?res:{idx,res})
end function

constant tests = {{},
                  {1, 2, 4},
--                {1, 2, 4, 2, 2, 1}, -- (fine too)
                  {3, 1, 3, 1},
                  {1, 2, 3, 1},
                  {3, 2, 1, 3},
                  {3, 3, 3, 1, 1, 3, 3, 3}}

for i=1 to length(tests) do
    sequence ti = tests[i],
             res = test(ti),
             rpp = ppf(res,{pp_Nest,3,pp_Indent,4})
    printf(1,"%v nests to %v\n or %s\n",{ti,res,rpp})
end for


def to_tree(x, index=0, depth=1):
   so_far = []
   while index < len(x):
       this = x[index]
       if this == depth:
           so_far.append(this)
       elif this > depth:
           index, deeper = to_tree(x, index, depth + 1)
           so_far.append(deeper)
       else: # this < depth:
           index -=1
           break
       index += 1
   return (index, so_far) if depth > 1 else so_far

if __name__ ==  "__main__":
    from pprint import pformat

    def pnest(nest:list, width: int=9) -> str:
        text = pformat(nest, width=width).replace('\n', '\n    ')
        print(f" OR {text}\n")

    exercises = [
        [],
        [1, 2, 4],
        [3, 1, 3, 1],
        [1, 2, 3, 1],
        [3, 2, 1, 3],
        [3, 3, 3, 1, 1, 3, 3, 3],
        ]
    for flat in exercises:
        nest = to_tree(flat)
        print(f"{flat} NESTS TO: {nest}")
        pnest(nest)


class
	APPLICATION

create
	make

feature

	make
		do
			io.put_string ("Largest right truncatable prime: " + find_right_truncatable_primes.out)
			io.new_line
			io.put_string ("Largest left truncatable prime: " + find_left_truncatable_primes.out)
		end

	find_right_truncatable_primes: INTEGER
			-- Largest right truncatable prime below 1000000.
		local
			i, maybe_prime: INTEGER
			found, is_one: BOOLEAN
		do
			from
				i := 999999
			until
				found
			loop
				is_one := True
				from
					maybe_prime := i
				until
					not is_one  or maybe_prime.out.count = 1
				loop
					if maybe_prime.out.has ('0') or maybe_prime.out.has ('2') or maybe_prime.out.has ('4') or maybe_prime.out.has ('6') or maybe_prime.out.has ('8') then
						is_one := False
					else
						if not is_prime (maybe_prime)  then
							is_one := False
						elseif is_prime (maybe_prime) and maybe_prime.out.count > 1 then
							maybe_prime := truncate_right (maybe_prime)
						end
					end
				end
				if is_one then
					found := True
					Result := i
				end
				i := i - 2
			end
		ensure
			Result_is_smaller: Result < 1000000
		end

	find_left_truncatable_primes: INTEGER
			-- Largest left truncatable prime below 1000000.
		local
			i, maybe_prime: INTEGER
			found, is_one: BOOLEAN
		do
			from
				i := 999999
			until
				found
			loop
				is_one := True
				from
					maybe_prime := i
				until
					not is_one or maybe_prime.out.count = 1
				loop
					if not is_prime (maybe_prime) then
						is_one := False
					elseif is_prime (maybe_prime) and maybe_prime.out.count > 1 then
						if maybe_prime.out.at (2) = '0' then
							is_one := False
						else
							maybe_prime := truncate_left (maybe_prime)
						end
					end
				end
				if is_one then
					found := True
					Result := i
				end
				i := i - 2
			end
		ensure
			Result_is_smaller: Result < 1000000
		end

feature {NONE}

	is_prime (n: INTEGER): BOOLEAN
			--Is 'n' a prime number?
		require
			positiv_input: n > 0
		local
			i: INTEGER
			max: REAL_64
			math: DOUBLE_MATH
		do
			create math
			if n = 2 then
				Result := True
			elseif n <= 1 or n \\ 2 = 0 then
				Result := False
			else
				Result := True
				max := math.sqrt (n)
				from
					i := 3
				until
					i > max
				loop
					if n \\ i = 0 then
						Result := False
					end
					i := i + 2
				end
			end
		end

	truncate_left (n: INTEGER): INTEGER
			-- 'n' truncated by one digit from the left side.
		require
			truncatable: n.out.count > 1
		local
			st: STRING
		do
			st := n.out
			st.remove_head (1)
			Result := st.to_integer
		ensure
			Result_truncated: Result.out.count = n.out.count - 1
		end

	truncate_right (n: INTEGER): INTEGER
			-- 'n' truncated by one digit from the right side.
		require
			truncatable: n.out.count > 1
		local
			st: STRING
		do
			st := n.out
			st.remove_tail (1)
			Result := st.to_integer
		ensure
			Result_truncated: Result.out.count = n.out.count - 1
		end

end


  [ stack ]                       is prev     (   --> s )

  [ temp take
    swap join
    temp put ]                    is add$     ( x -->   )

  [ dup [] = if done
    0 prev put
    $ "' " temp put
    witheach
      [ dup prev take -
        over prev put
        dup 0 > iff
          [ times
              [ $ "[ " add$ ] ]
        else
          [ abs times
              [ $ "] " add$ ] ]
        number$ space join add$ ]
    prev take times
      [ $ "] " add$ ]
    temp take quackery ]          is nesttree ( [ --> [ )

  ' [ [ ]
      [ 1 2 4 ]
      [ 3 1 3 1 ]
      [ 1 2 3 1 ]
      [ 3 2 1 3 ]
      [ 3 3 3 1 1 3 3 3 ] ]

  witheach
    [ dup echo say " --> "
      nesttree echo cr cr ]


sub new_level ( @stack --> Nil ) {
    my $e = [];
    push @stack.tail, $e;
    push @stack,      $e;
}
sub to_tree_iterative ( @xs --> List ) {
    my $nested = [];
    my @stack  = $nested;

    for @xs -> Int $x {
        new_level(@stack) while $x > @stack;
        pop       @stack  while $x < @stack;
        push @stack.tail, $x;
    }

    return $nested;
}
my @tests = (), (1, 2, 4), (3, 1, 3, 1), (1, 2, 3, 1), (3, 2, 1, 3), (3, 3, 3, 1, 1, 3, 3, 3);
say .Str.fmt( '%15s => ' ), .&to_tree_iterative for @tests;


import "/seq" for Stack
import "/fmt" for Fmt

var toTree = Fn.new { |list|
    var nested = []
    var s = Stack.new()
    s.push(nested)
    for (n in list) {
        while (n != s.count) {
            if (n > s.count) {
                var inner = []
                s.peek().add(inner)
                s.push(inner)
            } else {
                s.pop()
            }
        }
        s.peek().add(n)
    }
    return nested
}

var tests = [
    [],
    [1, 2, 4],
    [3, 1, 3, 1],
    [1, 2, 3, 1],
    [3, 2, 1, 3],
    [3, 3, 3, 1, 1, 3, 3, 3]
]
for (test in tests) {
    var nest = toTree.call(test)
    Fmt.print("$24n => $n", test, nest)
}


import extensions;

const MAXN = 1000000;

extension mathOp
{
    isPrime()
    {
        int n := cast int(self);

        if (n < 2) { ^ false };
        if (n < 4) { ^ true };
        if (n.mod:2 == 0) { ^ false };
        if (n < 9) { ^ true };
        if (n.mod:3 == 0) { ^ false };

        int r := n.sqrt();
        int f := 5;
        while (f <= r)
        {
            if ((n.mod(f) == 0) || (n.mod(f + 2) == 0))
                { ^ false };

            f := f + 6
        };

        ^ true
    }

    isRightTruncatable()
    {
        int n := self;

        while (n != 0)
        {
            ifnot (n.isPrime())
                { ^ false };

            n := n / 10
        };

        ^ true
    }

    isLeftTruncatable()
    {
        int n := self;
        int tens := 1;

        while (tens < n)
            { tens := tens * 10 };

        while (n != 0)
        {
            ifnot (n.isPrime())
                { ^ false };

            tens := tens / 10;
            n := n - (n / tens * tens)
        };

        ^ true
    }
}

public program()
{
    var n := MAXN;
    var max_lt := 0;
    var max_rt := 0;

    while (max_lt == 0 || max_rt == 0)
    {
        if(n.toString().indexOf("0") == -1)
        {
            if ((max_lt == 0) && (n.isLeftTruncatable()))
                {
                    max_lt := n
                };

            if ((max_rt == 0) && (n.isRightTruncatable()))
                {
                    max_rt := n
                }
        };

        n := n - 1
    };

    console.printLine("Largest truncable left is ",max_lt);
    console.printLine("Largest truncable right is ",max_rt);

    console.readChar()
}


defmodule Prime do
  defp left_truncatable?(n, prime) do
    func = fn i when i<=9 -> 0
              i           -> to_string(i) |> String.slice(1..-1) |> String.to_integer end
    truncatable?(n, prime, func)
  end

  defp right_truncatable?(n, prime) do
    truncatable?(n, prime, fn i -> div(i, 10) end)
  end

  defp truncatable?(n, prime, trunc_func) do
    if to_string(n) |> String.match?(~r/0/),
      do:   false,
      else: trunc_loop(trunc_func.(n), prime, trunc_func)
  end

  defp trunc_loop(0, _prime, _trunc_func), do: true
  defp trunc_loop(n, prime, trunc_func) do
    if elem(prime,n), do: trunc_loop(trunc_func.(n), prime, trunc_func), else: false
  end

  def eratosthenes(limit) do            # descending order
    Enum.to_list(2..limit) |> sieve(:math.sqrt(limit), [])
  end

  defp sieve([h|_]=list, max, sieved) when h>max, do: Enum.reverse(list, sieved)
  defp sieve([h | t], max, sieved) do
    list = for x <- t, rem(x,h)>0, do: x
    sieve(list, max, [h | sieved])
  end

  defp prime_table(_, [], list), do: [false, false | list]
  defp prime_table(n, [n|t], list), do: prime_table(n-1, t,      [true|list])
  defp prime_table(n, prime, list), do: prime_table(n-1, prime, [false|list])

  def task(limit \\ 1000000) do
    prime = eratosthenes(limit)
    prime_tuple = prime_table(limit, prime, []) |> List.to_tuple
    left = Enum.find(prime, fn n -> left_truncatable?(n, prime_tuple) end)
    IO.puts "Largest left-truncatable prime : #{left}"
    right = Enum.find(prime, fn n -> right_truncatable?(n, prime_tuple) end)
    IO.puts "Largest right-truncatable prime: #{right}"
  end
end

Prime.task


USING: formatting fry grouping.extras kernel literals math
math.parser math.primes sequences ;
IN: rosetta-code.truncatable-primes

CONSTANT: primes $[ 1,000,000 primes-upto reverse ]

: number>digits ( n -- B{} ) number>string string>digits ;

: no-zeros? ( seq -- ? ) [ zero? not ] all? ;

: all-prime? ( seq -- ? ) [ prime? ] all? ;

: truncate ( seq quot -- seq' ) call( seq -- seq' )
    [ 10 digits>integer ] map ;

: truncate-right ( seq -- seq' ) [ head-clump ] truncate ;

: truncate-left ( seq -- seq' ) [ tail-clump ] truncate ;

: truncatable-prime? ( n quot -- ? ) [ number>digits ] dip
    '[ @ all-prime? ] [ no-zeros? ] bi and ; inline

: right-truncatable-prime? ( n -- ? ) [ truncate-right ]
    truncatable-prime? ;

: left-truncatable-prime? ( n -- ? ) [ truncate-left ]
    truncatable-prime? ;

: find-truncatable-primes ( -- ltp rtp )
    primes [ [ left-truncatable-prime?  ] find nip ]
           [ [ right-truncatable-prime? ] find nip ] bi ;

: main ( -- ) find-truncatable-primes
    "Left: %d\nRight: %d\n" printf ;

MAIN: main


: prime? ( n -- ? ) here + [email protected] 0= ;
: notprime! ( n -- ) here + 1 swap c! ;

: sieve ( n -- )
  here over erase
  0 notprime!
  1 notprime!
  2
  begin
    2dup dup * >
  while
    dup prime? if
      2dup dup * do
        i notprime!
      dup +loop
    then
    1+
  repeat
  2drop ;

: left_truncatable_prime? ( n -- flag )
  dup prime? invert if
    drop false exit
  then
  dup >r
  10
  begin
    2dup >
  while
    2dup mod
    dup r> = if
      2drop drop false exit
    then
    dup prime? invert if
      2drop drop false exit
    then
    >r
    10 *
  repeat
  2drop rdrop true ;

: right_truncatable_prime? ( n -- flag )
  dup prime? invert if
    drop false exit
  then
  begin
    10 / dup 0 >
  while
    dup prime? invert if
      drop false exit
    then
  repeat
  drop true ;

: max_left_truncatable_prime ( n -- )
  begin
    dup 0 >
  while
    dup left_truncatable_prime? if . cr exit then
    1-
  repeat drop ;

: max_right_truncatable_prime ( n -- )
  begin
    dup 0 >
  while
    dup right_truncatable_prime? if . cr exit then
    1-
  repeat drop ;

1000000 constant limit

limit 1+ sieve

." Largest left truncatable prime: "
limit max_left_truncatable_prime

." Largest right truncatable prime: "
limit max_right_truncatable_prime

bye


module primes_mod
  implicit none

  logical, allocatable :: primes(:)

contains

subroutine Genprimes(parr)
  logical, intent(in out) :: parr(:)
  integer :: i
! Prime sieve
  parr = .true.
  parr (1) = .false.
  parr (4 : size(parr) : 2) = .false.
  do i = 3, int (sqrt (real (size(parr)))), 2
    if (parr(i)) parr(i * i : size(parr) : i) = .false.
  end do

end subroutine

function is_rtp(candidate)
  logical :: is_rtp
  integer, intent(in) :: candidate
  integer :: n

  is_rtp = .true.
  n = candidate / 10
  do while(n > 0)
    if(.not. primes(n)) then
      is_rtp = .false.
      return
    end if
    n = n / 10
  end do

end function

function is_ltp(candidate)
  logical :: is_ltp
  integer, intent(in) :: candidate
  integer :: i, n
  character(10) :: nstr

  write(nstr, "(i10)") candidate
  is_ltp = .true.
  do i = len_trim(nstr)-1, 1, -1
    n = mod(candidate, 10**i)
    if(.not. primes(n)) then
      is_ltp = .false.
      return
    end if
  end do
end function

end module primes_mod

program Truncatable_Primes
  use primes_mod
  implicit none

  integer, parameter :: limit = 999999
  integer :: i
  character(10) :: nstr

! Generate an array of prime flags up to limit of search
  allocate(primes(limit))
  call Genprimes(primes)

! Find left truncatable prime
  do i = limit, 1, -1
    write(nstr, "(i10)") i
    if(index(trim(nstr), "0") /= 0) cycle      ! check for 0 in number
    if(is_ltp(i)) then
      write(*, "(a, i0)") "Largest left truncatable prime below 1000000 is ", i
      exit
    end if
  end do

! Find right truncatable prime
  do i = limit, 1, -1
    write(nstr, "(i10)") i
    if(index(trim(nstr), "0") /= 0) cycle      ! check for 0 in number
    if(is_rtp(i)) then
      write(*, "(a, i0)") "Largest right truncatable prime below 1000000 is ", i
      exit
    end if
  end do
end program


' FB 1.05.0 Win64

Function isPrime(n As Integer) As Boolean
  If n Mod 2 = 0 Then Return n = 2
  If n Mod 3 = 0 Then Return n = 3
  Dim d As Integer = 5
  While d * d <= n
    If n Mod d = 0 Then Return False
    d += 2
    If n Mod d = 0 Then Return False
    d += 4
  Wend
  Return True
End Function

Dim As UInteger i, j, p, pow, lMax = 2, rMax = 2
Dim s As String

' largest left truncatable prime less than 1000000
' It can't end with 1, 4, 6, 8 or 9 as these numbers are not prime
' Nor can it end in 2 if it has more than one digit as such a number would divide by 2
For i = 3 To 999997 Step 2
  s = Str(i)
  If Instr(s, "0") > 1 Then Continue For '' cannot contain 0
  j = s[Len(s) - 1] - 48
  If j = 1 OrElse j = 9 Then Continue For
  p = i
  pow = 10 ^ (Len(s) - 1)
  While pow > 1
    If Not isPrime(p) Then Continue For
    p Mod= pow
    pow \= 10
  Wend
  lMax = i
Next

' largest right truncatable prime less than 1000000
' It can't begin with 1, 4, 6, 8 or 9 as these numbers are not prime
For i = 3 To 799999 Step 2
  s = Str(i)
  If Instr(s, "0") > 1 Then Continue For '' cannot contain 0
  j = s[0] - 48
  If j = 1 OrElse j = 4 OrElse j = 6 Then Continue For
  p = i
  While p > 0
    If Not isPrime(p) Then Continue For
    p \= 10
  Wend
  rMax = i
Next

Print "Largest left  truncatable prime : "; lMax
Print "Largest right truncatable prime : "; rMax
Print
Print "Press any key to quit"
Sleep


package main

import "fmt"

func main() {
    sieve(1e6)
    if !search(6, 1e6, "left", func(n, pot int) int { return n % pot }) {
        panic("997?")
    }
    if !search(6, 1e6, "right", func(n, _ int) int { return n / 10 }) {
        panic("7393?")
    }
}

var c []bool

func sieve(ss int) {
    c = make([]bool, ss)
    c[1] = true
    for p := 2; ; {
        p2 := p * p
        if p2 >= ss {
            break
        }
        for i := p2; i < ss; i += p {
            c[i] = true
        }
        for {
            p++
            if !c[p] {
                break
            }
        }
    }
}

func search(digits, pot int, s string, truncFunc func(n, pot int) int) bool {
    n := pot - 1
    pot /= 10
smaller:
    for ; n >= pot; n -= 2 {
        for tn, tp := n, pot; tp > 0; tp /= 10 {
            if tn < tp || c[tn] {
                continue smaller
            }
            tn = truncFunc(tn, tp)
        }
        fmt.Println("max", s, "truncatable:", n)
        return true
    }
    if digits > 1 {
        return search(digits-1, pot, s, truncFunc)
    }
    return false
}


import Data.Numbers.Primes(primes, isPrime)
import Data.List
import Control.Arrow

primes1e6 = reverse. filter (notElem '0'. show) $ takeWhile(<=1000000) primes

rightT, leftT :: Int -> Bool
rightT = all isPrime. takeWhile(>0). drop 1. iterate (`div`10)
leftT x = all isPrime. takeWhile(<x).map (x`mod`) $ iterate (*10) 10

main = do
  let (ltp, rtp) = (head. filter leftT &&& head. filter rightT) primes1e6
  putStrLn $ "Left truncatable  " ++ show ltp
  putStrLn $ "Right truncatable " ++ show rtp


procedure main(arglist)
   N := 0 < integer(\arglist[1]) | 1000000              # primes to generator 1 to ... (1M or 1st arglist)
   D := (0 < integer(\arglist[2]) | 10) / 2             # primes to display (10 or 2nd arglist)
   P := sieve(N)                                        # from sieve task (modified)
   write("There are ",*P," prime numbers in the range 1 to ",N)
   if *P <= 2*D then
      every writes( "Primes: "|!sort(P)||" "|"\n" )
   else
      every writes( "Primes: "|(L := sort(P))[1 to D]||" "|"... "|L[*L-D+1 to *L]||" "|"\n" )
   largesttruncateable(P)
end

procedure largesttruncateable(P)            #: find the largest left and right trucatable numbers in P
local ltp,rtp

   every x  := sort(P)[*P to 1 by -1] do    # largest to smallest
      if not find('0',x) then {
         /ltp  := islefttrunc(P,x)
         /rtp  := isrighttrunc(P,x)
         if \ltp & \rtp then break          # until both found
         }
   write("Largest left truncatable prime  = ", ltp)
   write("Largest right truncatable prime = ", rtp)
   return
end

procedure isrighttrunc(P,x) #: return integer x if x and all right truncations of x are in P or fails
if x = 0 | (member(P,x) & isrighttrunc(P,x / 10)) then return x
end

procedure islefttrunc(P,x) #: return integer x if x and all left truncations of x are in P or fails
if *x = 0 | ( (x := integer(x)) & member(P,x) & islefttrunc(P,x[2:0]) ) then return x
end


selPrime=: #~ 1&p:
seed=: selPrime digits=: 1+i.9
step=: [email protected],@:(,&.":/&>)@{@;


import java.util.BitSet;

public class Main {

	public static void main(String[] args){

		final int MAX = 1000000;

		//Sieve of Eratosthenes (using BitSet only for odd numbers)
		BitSet primeList = new BitSet(MAX>>1);
		primeList.set(0,primeList.size(),true);

		int sqroot = (int) Math.sqrt(MAX);
		primeList.clear(0);
		for(int num = 3; num <= sqroot; num+=2)
		{
			if( primeList.get(num >> 1) )
			{
				int inc = num << 1;
				for(int factor = num * num; factor < MAX; factor += inc)
				{
					//if( ((factor) & 1) == 1)
					//{
					primeList.clear(factor >> 1);
					//}
				}
			}
		}
		//Sieve ends...

		//Find Largest Truncatable Prime. (so we start from 1000000 - 1
		int rightTrunc = -1, leftTrunc = -1;
		for(int prime = (MAX - 1) | 1; prime >= 3; prime -= 2)
		{
			if(primeList.get(prime>>1))
			{
				//Already found Right Truncatable Prime?
				if(rightTrunc == -1)
				{
					int right = prime;
					while(right > 0 && right % 2 != 0 && primeList.get(right >> 1)) right /= 10;
					if(right == 0) rightTrunc = prime;
				}

				//Already found Left Truncatable Prime?
				if(leftTrunc == -1 )
				{
					//Left Truncation
					String left = Integer.toString(prime);
					if(!left.contains("0"))
					{
						while( left.length() > 0 ){
							int iLeft = Integer.parseInt(left);
							if(!primeList.get( iLeft >> 1)) break;
							left = left.substring(1);
						}
						if(left.length() == 0) leftTrunc = prime;
					}
				}
				if(leftTrunc != -1 && rightTrunc != -1) //Found both? then Stop loop
				{
					break;
				}
			}
		}
		System.out.println("Left  Truncatable : " + leftTrunc);
		System.out.println("Right Truncatable : " + rightTrunc);
	}
}


def is_left_truncatable_prime:
    def removeleft: recurse(if length <= 1 then empty else .[1:] end);
    tostring
    | index("0") == null and
      all(removeleft|tonumber; is_prime);

def is_right_truncatable_prime:
    def removeright: recurse(if length <= 1 then empty else .[:-1] end);
    tostring
    | index("0") == null and
      all(removeright|tonumber; is_prime);

first( range(999999; 1; -2) | select(is_left_truncatable_prime)),

first( range(999999; 1; -2) | select(is_right_truncatable_prime))


function isltruncprime{T<:Integer}(n::T, base::T=10)
    isprime(n) || return false
    p = n
    f = prevpow(base, p)
    while 1 < f
        (d, p) = divrem(p, f)
        isprime(p) || return false
        d != 0 || return false
        f = div(f, base)
    end
    return true
end

function isrtruncprime{T<:Integer}(n::T, base::T=10)
    isprime(n) || return false
    p = n
    while base < p
        p = div(p, base)
        isprime(p) || return false
    end
    return true
end

hi = 10^6

for i in reverse(primes(hi))
    isltruncprime(i) || continue
    println("The largest  left truncatable prime ≤ ", hi, " is ", i, ".")
    break
end

for i in reverse(primes(hi))
    isrtruncprime(i) || continue
    println("The largest right truncatable prime ≤ ", hi, " is ", i, ".")
    break
end


//  version 1.0.5-2

fun isPrime(n: Int) : Boolean {
    if (n < 2) return false
    if (n % 2 == 0) return n == 2
    if (n % 3 == 0) return n == 3
    var d : Int = 5
    while (d * d <= n) {
        if (n % d == 0) return false
        d += 2
        if (n % d == 0) return false
        d += 4
    }
    return true
}

fun main(args: Array<String>) {
    var j: Char
    var p: Int
    var pow: Int
    var lMax: Int = 2
    var rMax: Int = 2
    var s: String

    // calculate maximum left truncatable prime less than 1 million
    loop@ for( i in 3..999997 step 2) {
        s = i.toString()
        if ('0' in s) continue
        j = s[s.length - 1]
        if (j == '1' || j == '9') continue
        p = i
        pow = 1
        for (k in 1..s.length - 1) pow *= 10
        while(pow > 1) {
            if (!isPrime(p)) continue@loop
            p %= pow
            pow /= 10
        }
        lMax = i
    }

    // calculate maximum right truncatable prime less than 1 million
    loop@ for( i in 3..799999 step 2) {
        s = i.toString()
        if ('0' in s) continue
        j = s[0]
        if (j == '1' || j == '4' || j == '6') continue
        p = i
        while(p > 0) {
            if (!isPrime(p)) continue@loop
            p /= 10
        }
        rMax = i
    }

    println("Largest left  truncatable prime : " + lMax.toString())
    println("Largest right truncatable prime : " + rMax.toString())
}


max_number = 1000000

numbers = {}
for i = 2, max_number do
    numbers[i] = i;
end

for i = 2, max_number do
    for j = i+1, max_number do
        if numbers[j] ~= 0 and j % i == 0 then numbers[j] = 0 end
    end
end

max_prime_left, max_prime_right = 2, 2
for i = 2, max_number do
    if numbers[i] ~= 0 then
        local is_prime = true

        local l = math.floor( i / 10 )
        while l > 1 do
            if numbers[l] == 0 then
                is_prime = false
                break
            end
            l = math.floor( l / 10 )
        end
        if is_prime then
            max_prime_left = i
        end

        is_prime = true
        local n = 10;
        while math.floor( i % 10 ) ~= 0 and n < max_number do
            if numbers[ math.floor( i % 10 ) ] ~= 0 then
                is_prime = false
                break
            end
            n = n * 10
        end
        if is_prime then
            max_prime_right = i
        end
    end
end

print( "max_prime_left = ", max_prime_left )
print( "max_prime_right = ", max_prime_right )


F f(x)
   R sqrt(abs(x)) + 5 * x ^ 3

V s = Array(1..11)
s.reverse()
L(x) s
   V result = f(x)
   I result > 400
      print(‘#.: #.’.format(x, ‘TOO LARGE!’))
   E
      print(‘#.: #.’.format(x, result))
print()


MaxTruncatablePrime := proc({left::truefalse:=FAIL, right::truefalse:=FAIL}, $)
local i, j, c, p, b, n, sdprimes, dir;
local tprimes := table();
    if left = true and right = true then
        error "invalid input";
    elif right = true then
        dir := "right";
    else
        dir := "left";
    end if;
    b := 10;
    n := 6;
    sdprimes := select(isprime, [seq(1..b-1)]);
    for p in sdprimes do
        if assigned(tprimes[p]) then
            next;
        end if;
        i := ilog[b](p)+1;
        j := 1;
        while p < b^n do
            if dir = "left" then
                c := j*b^i + p;
            else
                c := p*b + j;
            end if;
            if j >= b or c > b^n then # we have tried all 1 digit extensions of p, add p to tprimes and move back 1 digit
                tprimes[p] := p;
                if i = 1 then # if we are at the first digit,  go to the next 1 digit prime
                    break;
                end if;
                i := i - 1;
                j := 1;
                if dir = "left" then
                    p := p - iquo(p, b^i)*b^i;
                else
                    p := iquo(p, b);
                end if;
            elif assigned(tprimes[c]) then
                j := j + 1;
            elif isprime(c) then
                p := c;
                i := i + 1;
                j := 1;
            else
                j := j+1;
            end if;
        end do;
    end do;
    return max(indices(tprimes, 'nolist'));
end proc;


LeftTruncatablePrimeQ[n_] := Times @@ IntegerDigits[n] > 0 &&
  And @@ PrimeQ /@ ToExpression /@ StringJoin /@
      Rest[Most[NestList[Rest, #, Length[#]] &[Characters[ToString[n]]]]]
RightTruncatablePrimeQ[n_] := Times @@ IntegerDigits[n] > 0 &&
  And @@ PrimeQ /@ ToExpression /@ StringJoin /@
      Rest[Most[NestList[Most, #, Length[#]] &[Characters[ToString[n]]]]]


function largestTruncatablePrimes(boundary)

    %Helper function for checking if a prime is left of right truncatable
    function [leftTruncatable,rightTruncatable] = isTruncatable(prime,checkLeftTruncatable,checkRightTruncatable)

        numDigits = ceil(log10(prime)); %calculate the number of digits in the prime less one
        powersOfTen = 10.^(0:numDigits); %cache the needed powers of ten

        leftTruncated = mod(prime,powersOfTen); %generate a list of numbers by repeatedly left truncating the prime

        %leading zeros will cause duplicate entries thus it is possible to
        %detect leading zeros if we rotate the list to the left or right
        %and check for any equivalences with the original list
        hasLeadingZeros = any( circshift(leftTruncated,[0 1]) == leftTruncated );

        if( hasLeadingZeros || not(checkLeftTruncatable) )
            leftTruncatable = false;
        else
            %check if all of the left truncated numbers are prime
            leftTruncatable = all(isprime(leftTruncated(2:end)));
        end

        if( checkRightTruncatable )
            rightTruncated = (prime - leftTruncated) ./ powersOfTen; %generate a list of right truncated numbers
            rightTruncatable = all(isprime(rightTruncated(1:end-1))); %check if all the right truncated numbers are prime
        else
            rightTruncatable = false;
        end

    end %isTruncatable()

    nums = primes(boundary); %generate all primes <= boundary

    %Flags that indicate if the largest left or right truncatable prime has not
    %been found
    leftTruncateNotFound = true;
    rightTruncateNotFound = true;

    for prime = nums(end:-1:1) %Search through primes in reverse order

        %Get if the prime is left and/or right truncatable, ignoring
        %checking for right truncatable if it has already been found
        [leftTruncatable,rightTruncatable] = isTruncatable(prime,leftTruncateNotFound,rightTruncateNotFound);

        if( leftTruncateNotFound && leftTruncatable ) %print out largest left truncatable prime
            display([num2str(prime) ' is the largest left truncatable prime <= ' num2str(boundary) '.']);
            leftTruncateNotFound = false;
        end

        if( rightTruncateNotFound && rightTruncatable ) %print out largest right truncatable prime
            display([num2str(prime) ' is the largest right truncatable prime <= ' num2str(boundary) '.']);
            rightTruncateNotFound = false;
        end

        %Terminate loop when the largest left and right truncatable primes have
        %been found
        if( not(leftTruncateNotFound || rightTruncateNotFound) )
            break;
        end
    end
end


with Ada.Text_IO, Ada.Numerics.Generic_Elementary_Functions;

procedure Trabb_Pardo_Knuth is

   type Real is digits 6 range -400.0 .. 400.0;

   package TIO renames Ada.Text_IO;
   package FIO is new TIO.Float_IO(Real);
   package Math is new  Ada.Numerics.Generic_Elementary_Functions(Real);

   function F(X: Real) return Real is
   begin
      return (Math.Sqrt(abs(X)) + 5.0 * X**3);
   end F;

   Values: array(1 .. 11) of Real;

begin
   TIO.Put("Please enter 11 Numbers:");
   for I in Values'Range loop
      FIO.Get(Values(I));
   end loop;

   for I in reverse Values'Range loop
      TIO.Put("f(");
      FIO.Put(Values(I), Fore => 2, Aft => 3, Exp => 0);
      TIO.Put(")=");
      begin
         FIO.Put(F(Values(I)), Fore=> 4, Aft => 3, Exp => 0);
      exception
         when Constraint_Error => TIO.Put("-->too large<--");
      end;
      TIO.New_Line;
   end loop;

end Trabb_Pardo_Knuth;


scope   # TPK algorithm in Agena
  local y;
  local a := [];
  local f := proc( t :: number ) is return sqrt(abs(t))+5*t*t*t end;
  for i from 0 to 10 do a[i] := tonumber( io.read() ) od;
  for i from 10 to 0 by - 1 do
      y:=f(a[i]);
      if y > 400
      then print( "TOO LARGE" )
      else printf( "%10.4f\n", y )
      fi
  od
epocs


import sets, strutils, algorithm

proc primes(n: int64): seq[int64] =
  var multiples: HashSet[int64]
  for i in 2..n:
    if i notin multiples:
      result.add i
      for j in countup(i*i, n, i.int):
        multiples.incl j

proc truncatablePrime(n: int64): tuple[left, right: int64] =
  var
    primelist: seq[string]
  for x in primes(n):
    primelist.add($x)
  reverse primelist
  var primeset = primelist.toHashSet
  for n in primelist:
    var alltruncs: HashSet[string]
    for i in 0..n.high:
      alltruncs.incl n[i..n.high]
    if alltruncs <= primeset:
      result.left = parseInt(n)
      break
  for n in primelist:
    var alltruncs: HashSet[string]
    for i in 0..n.high:
      alltruncs.incl n[0..i]
    if alltruncs <= primeset:
      result.right = parseInt(n)
      break

echo truncatablePrime(1000000i64)


-- find largest left- & right-truncatable primes < 1 million.
-- an initial set of primes (not, at this time, we leave out 2 because
-- we'll automatically skip the even numbers.  No point in doing a needless
-- test each time through
primes = .array~of(3, 5, 7, 11)

-- check all of the odd numbers up to 1,000,000
loop j = 13 by 2 to 1000000
  loop i = 1 to primes~size
      prime = primes[i]
      -- found an even prime divisor
      if j // prime == 0 then iterate j
      -- only check up to the square root
      if prime*prime > j then leave
  end
  -- we only get here if we don't find a divisor
  primes~append(j)
end

-- get a set of the primes that we can test more efficiently
primeSet = .set~of(2)
primeSet~putall(primes)

say 'The last prime is' primes[primes~last] "("primeSet~items 'primes under one million).'
say copies('-',66)

lastLeft = 0

-- we're going to use the array version to do these in order.  We're still
-- missing "2", but that's not going to be the largest
loop prime over primes

    -- values containing 0 can never work
    if prime~pos(0) \= 0 then iterate
    -- now start the truncations, checking against our set of
    -- known primes
    loop i = 1 for prime~length - 1
        subprime = prime~right(i)
        -- not in our known set, this can't work
        if \primeset~hasIndex(subprime) then iterate prime
    end
    -- this, by definition, with be the largest left-trunc prime
    lastLeft = prime
end
-- now look for right-trunc primes
lastRight = 0
loop prime over primes

    -- values containing 0 can never work
    if prime~pos(0) \= 0 then iterate
    -- now start the truncations, checking against our set of
    -- known primes
    loop i = 1 for prime~length - 1
        subprime = prime~left(i)
        -- not in our known set, this can't work
        if \primeset~hasIndex(subprime) then iterate prime
    end
    -- this, by definition, with be the largest left-trunc prime
    lastRight = prime
end

say 'The largest  left-truncatable prime is' lastLeft '(under one million).'
say 'The largest right-truncatable prime is' lastRight '(under one million).'


begin
  integer i; real y; real array a[0:10];
  real procedure f(t); value t; real t;
    f:=sqrt(abs(t))+5*t^3;
  for i:=0 step 1 until 10 do inreal(0, a[i]);
  for i:=10 step -1 until 0 do
    begin
       y:=f(a[i]);
       if y > 400 then outstring(1, "TOO LARGE")
                  else outreal(1,y);
       outchar(1, "\n", 1)
    end
end


[ 0 : 10 ]REAL a;
PROC f = ( REAL t )REAL:
    sqrt(ABS t)+5*t*t*t;
FOR i FROM LWB a TO UPB a DO read( ( a[ i ] ) ) OD;
FOR i FROM UPB a BY -1 TO LWB a DO
       REAL y=f(a[i]);
       IF y > 400 THEN print( ( "TOO LARGE", newline ) )
                  ELSE print( ( fixed( y, -9, 4 ), newline ) )
       FI
OD


begin
  real y; real array a( 0 :: 10 );
  real procedure f( real value t );
    sqrt(abs(t))+5*t*t*t;
  for i:=0 until 10 do read( a(i) );
  r_format := "A"; r_w := 9; r_d := 4;
  for i:=10 step -1 until 0 do
    begin
       y:=f(a(i));
       if y > 400 then write( "TOO LARGE" )
                  else write( y );
    end
end.


FUNCTION isPrime RETURNS LOGICAL (
   i_i AS INT
):

   DEF VAR ii AS INT.

   DO ii = 2 TO SQRT( i_i ):

      IF i_i MODULO ii = 0 THEN
         RETURN FALSE.

   END.

   RETURN TRUE AND i_i > 1.

END FUNCTION. /* isPrime */

FUNCTION isLeftTruncatablePrime RETURNS LOGICAL (
   i_i AS INT
):

   DEF VAR ii        AS INT.
   DEF VAR cc        AS CHAR.
   DEF VAR lresult   AS LOGICAL INITIAL TRUE.

   cc = STRING( i_i ).

   DO WHILE cc > "":
      lresult = lresult AND isPrime( INTEGER( cc ) ).
      cc = SUBSTRING( cc, 2 ).
   END.

   RETURN lresult.

END FUNCTION. /* isLeftTruncatablePrime */

FUNCTION isRightTruncatablePrime RETURNS LOGICAL (
   i_i AS INT
):

   DEF VAR ii        AS INT.
   DEF VAR cc        AS CHAR.
   DEF VAR lresult   AS LOGICAL INITIAL TRUE.

   cc = STRING( i_i ).

   DO WHILE cc > "":
      lresult = lresult AND isPrime( INTEGER( cc ) ).
      cc = SUBSTRING( cc, 1, LENGTH( cc ) - 1 ).
   END.

   RETURN lresult.

END FUNCTION. /* isRightTruncatablePrime */

FUNCTION getHighestTruncatablePrimes RETURNS CHARACTER (
   i_imax AS INTEGER
):

   DEF VAR ii        AS INT.
   DEF VAR ileft     AS INT.
   DEF VAR iright    AS INT.

   DO ii = i_imax TO 1 BY -1 WHILE ileft = 0 OR iright = 0:

      IF INDEX( STRING( ii ), "0" ) = 0 THEN DO:
         IF ileft = 0 AND isLeftTruncatablePrime( ii ) THEN
            ileft = ii.
         IF iright = 0 AND isRightTruncatablePrime( ii ) THEN
            iright = ii.
      END.

   END.

   RETURN SUBSTITUTE("Left: &1~nRight: &2", ileft, iright ).

END FUNCTION. /* getHighestTruncatablePrimes */

MESSAGE
   getHighestTruncatablePrimes( 1000000 )
VIEW-AS ALERT-BOX.


∇ {res}←Trabb;f;S;i;a;y              ⍝ define a function Trabb
  f←{(0.5*⍨|⍵)+5×⍵*3}                ⍝ define a function f
  S←,⍎{⍞←⍵ ⋄ (≢⍵)↓⍞}'Please, enter 11 numbers: '
  :For i a :InEach (⌽⍳≢S)(⌽S)        ⍝ loop through N..1 and reversed S
      :If 400<y←f(a)
          ⎕←'Too large: ',⍕i
      :Else
          ⎕←i,y
      :EndIf
  :EndFor
∇


proc: function [x]->
    ((abs x) ^ 0.5) + 5 * x ^ 3

ask: function [msg][
    to [:floating] first.n: 11 split.words strip input msg
]

loop reverse ask "11 numbers: " 'n [
    result: proc n
    print [n ":" (result > 400)? -> "TOO LARGE!" -> result]
]


REM Trabb Pardo-Knuth algorithm
REM Used "magic numbers" because of strict specification of the algorithm.
DIM [email protected](10)
PRINT "Enter 11 numbers."
FOR I = 0 TO 10
  I1= I + 1
  PRINT I1;
  PRINT " => ";
  INPUT [email protected]
  [email protected](I) = [email protected]
NEXT I
PRINT
REM Reverse
HALFIMAX = 10 / 2
FOR I = 0 TO HALFIMAX
  IREV = 10 - I
  [email protected] = [email protected](I)
  [email protected](I) = [email protected](IREV)
  [email protected](IREV) = [email protected]
NEXT I
REM Results
REM Leading spaces in printed numbers are removed
CLS
FOR I = 0 TO 10
  PRINT "f(";
  STMP$ = STR$([email protected](I))
  STMP$ = LTRIM$(STMP$)
  PRINT STMP$;
  PRINT ") = ";
  [email protected] = [email protected](I)
  GOSUB CALCF:
  [email protected] = [email protected]
  IF [email protected] > 400 THEN
    PRINT "overflow"
  ELSE
    STMP$ = STR$([email protected])
    STMP$ = LTRIM$(STMP$)
    PRINT STMP$
  ENDIF
NEXT I
END

CALCF:
REM Calculates f([email protected])
REM Result in [email protected]
[email protected] = ABS([email protected])
GOSUB CALCSQRT:
[email protected] = 5.0 * [email protected]
[email protected] = [email protected] * [email protected]
[email protected] = [email protected] * [email protected]
[email protected] = [email protected] + [email protected]
RETURN

CALCSQRT:
REM Calculates approximate (+- 0.00001) square root of [email protected] for [email protected] >= 0 (bisection method)
REM Result in [email protected]
[email protected] = 0.0
IF [email protected] >= 1.0 THEN
  [email protected] = [email protected]
ELSE
  [email protected] = 1.0
ENDIF
[email protected] = [email protected] - [email protected]
[email protected] = ABS([email protected])
WHILE [email protected] > 0.00001
  [email protected] = [email protected] + [email protected]
  [email protected] = [email protected] / 2
  [email protected] = [email protected] * [email protected]
  IF [email protected] < [email protected] THEN
    [email protected] = [email protected]
  ELSE
    [email protected] = [email protected]
  ENDIF
  [email protected] = [email protected] - [email protected]
  [email protected] = ABS([email protected])
WEND
[email protected] = [email protected]
RETURN


use ntheory ":all";
sub isltrunc {
  my $n = shift;
  return (is_prime($n) && $n !~ /0/ && ($n < 10 || isltrunc(substr($n,1))));
}
sub isrtrunc {
  my $n = shift;
  return (is_prime($n) && $n !~ /0/ && ($n < 10 || isrtrunc(substr($n,0,-1))));
}
for (reverse @{primes(1e6)}) {
  if (isltrunc($_)) { print "ltrunc: $_\n"; last; }
}
for (reverse @{primes(1e6)}) {
  if (isrtrunc($_)) { print "rtrunc: $_\n"; last; }
}


; Trabb Pardo–Knuth algorithm
; by James1337 (autoit.de)
; AutoIt Version: 3.3.8.1

Local $S, $i, $y

Do
	$S = InputBox("Trabb Pardo–Knuth algorithm", "Please enter 11 numbers:", "1 2 3 4 5 6 7 8 9 10 11")
	If @error Then Exit
	$S = StringSplit($S, " ")
Until ($S[0] = 11)

For $i = 11 To 1 Step -1
	$y = f($S[$i])
	If ($y > 400) Then
		ConsoleWrite("f(" & $S[$i] & ") = Overflow!" & @CRLF)
	Else
		ConsoleWrite("f(" & $S[$i] & ") = " & $y & @CRLF)
	EndIf
Next

Func f($x)
	Return Sqrt(Abs($x)) + 5*$x^3
EndFunc


# syntax: GAWK -f TRABB_PARDO-KNUTH_ALGORITHM.AWK
BEGIN {
    printf("enter 11 numbers: ")
    getline S
    n = split(S,arr," ")
    if (n != 11) {
      printf("%d numbers entered; S/B 11\n",n)
      exit(1)
    }
    for (i=n; i>0; i--) {
      x = f(arr[i])
      printf("f(%s) = %s\n",arr[i],(x>400) ? "too large" : x)
    }
    exit(0)
}
function abs(x) { if (x >= 0) { return x } else { return -x } }
function f(x) { return sqrt(abs(x)) + 5 * x ^ 3 }