\ this prints five lines containing elements from the two
\ words 'proc1' and 'proc2'. gotos are used here to jump
\ into and out of the two words at various points, as well
\ as to create a loop. this functions with ficl, pfe,
\ gforth, bigforth, swiftforth, iforth, and vfxforth; it
\ may work with other forths as well.

create goto1 1 cells allot create goto2 1 cells allot
create goto3 1 cells allot create goto4 1 cells allot
create goto5 1 cells allot create goto6 1 cells allot
create goto7 1 cells allot create goto8 1 cells allot
create goto9 1 cells allot create goto10 1 cells allot

: proc1
[ here goto1 ! ] s" item1 " type goto7 @ >r exit
[ here goto2 ! ] s" item2 " type goto8 @ >r exit
[ here goto3 ! ] s" item3 " type goto9 @ >r exit
[ here goto4 ! ] s" item4 " type goto10 @ >r exit
[ here goto5 ! ] s" item5" type cr 2dup = if 2drop exit then 1+ goto6 @ >r ;

: proc2
[ here goto6 ! ] s" line " type dup . s" --> item6 " type goto1 @ >r exit
[ here goto7 ! ] s" item7 " type goto2 @ >r exit
[ here goto8 ! ] s" item8 " type goto3 @ >r exit
[ here goto9 ! ] s" item9 " type goto4 @ >r exit
[ here goto10 ! ] s" item10 " type goto5 @ >r ;

5 1 proc2
bye


type

  Point[Dim: static Natural; T: SomeNumber] = array[Dim, T]

  KdNode[Dim: static Natural; T: SomeNumber] = ref object
    x: Point[Dim, T]
    left, right: KdNode[Dim, T]

func toKdNodes[N, Dim: static Natural; T](a: array[N, array[Dim, T]]): array[N, KdNode[Dim, T]] =
  ## Create an array of KdNodes from an array of list of numerical values.
  for i in 0..<N:
    result[i] = KdNode[Dim, T](x: a[i])

func dist(a, b: Point): Point.T =
  ## Return the squared distance between two points.
  for i in 0..<Point.Dim:
    let t = a[i] - b[i]
    result += t * t

func findMedian(nodes: openArray[KdNode]; slice: Slice; idx: Natural): int =
  ## Return the index of the median node in a list of nodes.
  ## The list is defined by the full list of nodes and an slice.

  var first = slice.a
  var last = slice.b
  if last < first: return -1
  if last == first: return first

  let md = first + (last - first + 1) div 2

  while true:
    let pivot = nodes[md].x[idx]

    swap nodes[md].x, nodes[last].x
    var store = first
    for i in first..last:
      if nodes[i].x[idx] < pivot:
        if i != store:
          swap nodes[i].x, nodes[store].x
        inc store
    swap nodes[store].x, nodes[last].x

    if nodes[store].x[idx] == nodes[md].x[idx]:
      return md

    if store > md:
      last = store
    else:
      first = store

func makeTree(nodes: openArray[KdNode]; slice: Slice; idx: Natural = 0): KdNode =
  ## Build a tree from a list of nodes. Return the root of the tree.

  if slice.b < slice.a: return nil

  let n = nodes.findMedian(slice, idx)
  if n < 0: return nil

  let idx = (idx + 1) mod result.Dim
  nodes[n].left = nodes.makeTree(slice.a..<n, idx)
  nodes[n].right = nodes.makeTree((n + 1)..slice.b, idx)
  result = nodes[n]

func nearest(root,: KdNode; point: Point; idx: Natural;
             best: var KdNode; bestDist: var root.T; nVisited: var int) =
  ## Return the node of a tree which is the nearest to a given point.

  if root.isNil: return

  let d = dist(root.x, point)
  let dx = root.x[idx] - point[idx]
  inc nVisited

  if best.isNil or d < bestDist:
    bestDist = d
    best = root

  if bestDist == 0: return

  let idx = (idx + 1) mod root.Dim

  nearest(if dx > 0: root.left else: root.right, point, idx, best, bestDist, nVisited)
  if dx * dx >= bestDist: return
  nearest(if dx > 0: root.right else: root.left, point, idx, best, bestDist, nVisited)

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

when isMainModule:

  import math, random, strformat

  proc displayResult(title: string; thisPt: Point;
                     found: KdNode; bestDist: thisPt.T; nVisited: int) =
    echo title & ':'
    echo &"  Searching for {thisPt}"
    echo &"  Found {found.x}, dist = {sqrt(float(bestDist)):.5f}"
    echo &"  Seen {nVisited} nodes."
    echo ""

  proc initRandom(point: var Point) =
    for item in point.mitems:
      item = rand(1.0)

  proc runSmallTest() =

    let
      wp = [[2, 3], [5, 4], [9, 6], [4, 7], [8, 1], [7, 2]].toKdNodes()
      #thisPt = newPoint([9, 2])
      thisPt = Point([9, 2])
      root = wp.makeTree(0..wp.high)

    var
      found: KdNode[root.Dim, root.T]
      bestDist = root.T(0)
      nVisited = 0

    root.nearest(thisPt, 0, found, bestDist, nVisited)
    displayResult("WP tree", thisPt, found, bestDist, nVisited)

  proc runBigTest() =

    const N = 1_000_000
    const TestRuns = 100_000

    randomize()

    var bigTree: array[N, KdNode[3, float]]
    for node in bigTree.mitems:
      new(node)
      node.x.initRandom()

    let root = bigTree.makeTree(0..bigTree.high)
    var thisPt: Point[3, float]
    thisPt.initRandom()

    var
      found: KdNode[3, float]
      bestDist = 0.0
      nVisited = 0

    root.nearest(thisPt, 0, found, bestDist, nVisited)
    displayResult("Big Tree", thisPt, found, bestDist, nVisited)

    var sum = 0
    for _ in 0..<TestRuns:
      found = nil
      nVisited = 0
      thisPt.initRandom()
      root.nearest(thisPt, 0, found, bestDist, nVisited)
      sum += nVisited

    echo "Big tree:"
    echo &"  Visited {sum} nodes for {TestRuns} random searches ({sum / TestRuns:.2f} per lookup)."

runSmallTest()
runBigTest()


-- demo\rosetta\kd_tree.exw
with javascript_semantics
enum X,LEFT,RIGHT    -- (keeping the IDX on each node too would not be a bad idea..)
                    -- (the code below deduces it from the (unbalanced) tree depth)

sequence kd_nodes   -- nb probably not best coding style

function sqdist(sequence p,q)
    return sum(sq_power(sq_sub(p,q),2))
end function

procedure swap(integer x,y)
    {kd_nodes[x],kd_nodes[y]} = {kd_nodes[y],kd_nodes[x]}
end procedure

function find_median(integer first, last, idx)
    if last<=first then return NULL end if
    if last==first+1 then return first end if

    integer p, stor, md = first+floor((last-first)/2)
    while true do
        atom pivot = kd_nodes[md][X][idx]

        swap(md, last-1)
        stor = first
        for p=first to last-1 do
            if kd_nodes[p][X][idx]<pivot then
                if p!=stor then
                    swap(p, stor)
                end if
                stor += 1
            end if
        end for
        swap(stor, last-1)

        /* median has duplicate values */
        atom sx = kd_nodes[stor][X][idx],
             mx = kd_nodes[md][X][idx]
        if sx == mx then exit end if
        if stor>md then last = stor else first = stor end if
    end while
    return md
end function

function make_tree(object t, len, i, dim)
    if sequence(t) then
        kd_nodes = deep_copy(t)
        t = 1
    end if
    integer n = iff(len=0?0:find_median(t, t+len, i))
    if n then
        i = mod(i,dim)+1
        if length(kd_nodes[n])!=1 then ?9/0 end if -- (once)
        kd_nodes[n] = {kd_nodes[n][X],0,0} -- (add l/r slots)
        kd_nodes[n][LEFT] = make_tree(t, n-t, i, dim)
        kd_nodes[n][RIGHT] = make_tree(n+1, t+len-(n+1), i, dim)
    end if
    return n
end function

integer visited, best
atom best_dist

procedure nearest(integer root, sequence nd, integer i, dim)
    if root=0 then return end if
    atom d = sqdist(kd_nodes[root][X],nd[X]),
         dx = kd_nodes[root][X][i] - nd[X][i],
         dx2 = dx * dx;

    visited += 1

    if best=0 or d<best_dist then
        best_dist = d;
        best = root;
    end if

    /* if chance of exact match is high */
    if best_dist=0 then return end if

    i = mod(i,dim)+1
    integer {l,r} = kd_nodes[root][LEFT..RIGHT]
    if dx<=0 then {l,r} = {r,l} end if
    nearest(l, nd, i, dim)
    if (dx2 >= best_dist) then return end if
    nearest(r, nd, i, dim)
end procedure

function rand_pt() return sq_rnd({{0,0,0}}) end function

function make_3D()
    sequence s = {}
    for i=0 to 9 do
        for j=0 to 9 do
            for k=0 to 9 do
                s = append(s,{{i,j,k}})
            end for
        end for
    end for
    return s
end function

// aside: shave a little off under pwa/p2js, but 1e6 build still takes ~20s
constant test_runs = iff(platform()=JS?10_000:100_000)

procedure test(string id, sequence nodes, test_node, bool show_average_behaviour=false)
    integer dim = length(nodes[1][X]),
            root = make_tree(nodes, length(nodes), 1, dim)
    best = 0
    visited = 0
    nearest(root, test_node, 1, dim)
    printf(1,"\n>> %s tree\nsearching for %v\nfound %v dist %g\nseen %d nodes\n",
             {id, test_node[X], kd_nodes[best][X], sqrt(best_dist), visited})

    if show_average_behaviour then
        --
        -- search many random points to see average behavior.
        --
        -- tree size vs avg nodes visited:
        -- 10          ~  7
        -- 100         ~ 16.5
        -- 1000        ~ 25.5
        -- 10000       ~ 32.8
        -- 100000      ~ 38.3
        -- 1000000     ~ 42.6
        -- 10000000    ~ 46.7
        --
        integer total = 0
        for i=1 to test_runs do
            best = 0
            visited = 0
            test_node = rand_pt()
            nearest(root, test_node, 1, 3)
            total += visited
        end for
        printf(1,"average behaviour: "&
                 "visited %d nodes for %,d random findings (%f per lookup)\n",
                {total, test_runs, total/test_runs});
    end if
end procedure

atom t0 = time()
sequence wp = {{{2, 3}}, {{5, 4}}, {{9, 6}}, {{4, 7}}, {{8, 1}}, {{7, 2}}},
         test_node = {{9, 2}}
test("WP",wp,test_node)

sequence cube = make_3D()
test_node = sq_mul(rand_pt(),10)
test("3D",cube,test_node,true)

constant N = 1_000_000
sequence million = repeat(0,N)
for i=1 to N do million[i] = rand_pt() end for
test_node = rand_pt()
test("Million",million,test_node,true)

?elapsed(time()-t0)
if platform()!=JS then
    ?"done"
    {} = wait_key()
end if


' FB 1.05.0 Win64

' compiled with -lang fb (the default) and -e switches

Sub MySub()
  Goto localLabel
  Dim a As Integer = 10  '' compiler warning that this variable definition is being skipped
  localLabel:
  Print "localLabel reached"
  Print "a = "; a  '' prints garbage as 'a' is uninitialized
End Sub

Sub MySub2()
  On Error Goto handler
  Open "zzz.zz" For Input As #1 '' this file doesn't exist!
  On Error Goto 0 '' turns off error handling
  End

  handler:
  Dim e As Integer = Err '' cache error number before printing message
  Print "Error number"; e; " occurred - file not found"
End Sub

Sub MySub3()
  Dim b As Integer = 2
  On b Goto label1, label2 '' jumps to label2

  label1:
  Print "Label1 reached"
  Return '' premature return from Sub

  label2:
  Print "Label2 reached"
End Sub

Sub MySub4()
  Dim c As Integer = 3
  If c = 3 Goto localLabel2 '' better to use If ... Then Goto ... in new code
  Print "This won't be seen"
  localLabel2:
  Print "localLabel2 reached"
End Sub

MySub
MySub2
MySub3
MySub4
Print
Print "Pres any key to quit"
Print


from random import seed, random
from time import time
from operator import itemgetter
from collections import namedtuple
from math import sqrt
from copy import deepcopy

def sqd(p1, p2):
    return sum((c1 - c2) ** 2 for c1, c2 in zip(p1, p2))

class KdNode(object):
    __slots__ = ("dom_elt", "split", "left", "right")

    def __init__(self, dom_elt, split, left, right):
        self.dom_elt = dom_elt
        self.split = split
        self.left = left
        self.right = right

class Orthotope(object):
    __slots__ = ("min", "max")

    def __init__(self, mi, ma):
        self.min, self.max = mi, ma

class KdTree(object):
    __slots__ = ("n", "bounds")

    def __init__(self, pts, bounds):
        def nk2(split, exset):
            if not exset:
                return None
            exset.sort(key=itemgetter(split))
            m = len(exset) // 2
            d = exset[m]
            while m + 1 < len(exset) and exset[m + 1][split] == d[split]:
                m += 1
            d = exset[m]

            s2 = (split + 1) % len(d)  # cycle coordinates
            return KdNode(d, split, nk2(s2, exset[:m]),
                                    nk2(s2, exset[m + 1:]))
        self.n = nk2(0, pts)
        self.bounds = bounds

T3 = namedtuple("T3", "nearest dist_sqd nodes_visited")

def find_nearest(k, t, p):
    def nn(kd, target, hr, max_dist_sqd):
        if kd is None:
            return T3([0.0] * k, float("inf"), 0)

        nodes_visited = 1
        s = kd.split
        pivot = kd.dom_elt
        left_hr = deepcopy(hr)
        right_hr = deepcopy(hr)
        left_hr.max[s] = pivot[s]
        right_hr.min[s] = pivot[s]

        if target[s] <= pivot[s]:
            nearer_kd, nearer_hr = kd.left, left_hr
            further_kd, further_hr = kd.right, right_hr
        else:
            nearer_kd, nearer_hr = kd.right, right_hr
            further_kd, further_hr = kd.left, left_hr

        n1 = nn(nearer_kd, target, nearer_hr, max_dist_sqd)
        nearest = n1.nearest
        dist_sqd = n1.dist_sqd
        nodes_visited += n1.nodes_visited

        if dist_sqd < max_dist_sqd:
            max_dist_sqd = dist_sqd
        d = (pivot[s] - target[s]) ** 2
        if d > max_dist_sqd:
            return T3(nearest, dist_sqd, nodes_visited)
        d = sqd(pivot, target)
        if d < dist_sqd:
            nearest = pivot
            dist_sqd = d
            max_dist_sqd = dist_sqd

        n2 = nn(further_kd, target, further_hr, max_dist_sqd)
        nodes_visited += n2.nodes_visited
        if n2.dist_sqd < dist_sqd:
            nearest = n2.nearest
            dist_sqd = n2.dist_sqd

        return T3(nearest, dist_sqd, nodes_visited)

    return nn(t.n, p, t.bounds, float("inf"))

def show_nearest(k, heading, kd, p):
    print(heading + ":")
    print("Point:           ", p)
    n = find_nearest(k, kd, p)
    print("Nearest neighbor:", n.nearest)
    print("Distance:        ", sqrt(n.dist_sqd))
    print("Nodes visited:   ", n.nodes_visited, "\n")

def random_point(k):
    return [random() for _ in range(k)]

def random_points(k, n):
    return [random_point(k) for _ in range(n)]

if __name__ == "__main__":
    seed(1)
    P = lambda *coords: list(coords)
    kd1 = KdTree([P(2, 3), P(5, 4), P(9, 6), P(4, 7), P(8, 1), P(7, 2)],
                  Orthotope(P(0, 0), P(10, 10)))
    show_nearest(2, "Wikipedia example data", kd1, P(9, 2))

    N = 400000
    t0 = time()
    kd2 = KdTree(random_points(3, N), Orthotope(P(0, 0, 0), P(1, 1, 1)))
    t1 = time()
    text = lambda *parts: "".join(map(str, parts))
    show_nearest(2, text("k-d tree with ", N,
                         " random 3D points (generation time: ",
                         t1-t0, "s)"),
                 kd2, random_point(3))


;;/usr/bin/petite
;;encoding:utf-8
;;Author:Panda
;;Mail:[email protected]
;;Created Time:Thu 29 Jan 2015 10:18:49 AM CST
;;Description:

;;size of the chessboard
(define X 8)
(define Y 8)
;;position is an integer that could be decoded into the x coordinate and y coordinate
 (define(decode position)
  (cons (div position Y) (remainder position Y)))
 ;;record the paths and number of territories you have conquered
 (define dictionary '())
 (define counter 1)
 ;;define the forbiddend territories(conquered and cul-de-sac)
 (define forbiddened '())
 ;;renew when havn't conquered the world.
 (define (renew position)
  (define possible
   (let ((rules (list (+ (* 2 Y) 1 position)
                      (+ (* 2 Y) -1 position)
                      (+ (* -2 Y) 1 position)
                      (+ (* -2 Y) -1 position)
                      (+ Y 2 position)
                      (+ Y -2 position)
                      (- position Y 2)
                      (- position Y -2))))
    (filter (lambda(x) (not (or (member x forbiddened) (< x 0) (>= x (* X Y))))) rules)))
  (if (null? possible)
   (begin (set! forbiddened (cons (car dictionary) forbiddened))
          (set! dictionary (cdr dictionary))
          (set! counter (- counter 1))
          (car dictionary))
   (begin (set! dictionary (cons (car possible) dictionary))
          (set! forbiddened dictionary)
          (set! counter (+ counter 1))
          (car possible))))
;;go to search
(define (go position)
 (if (= counter (* X Y))
  (begin
  (set! result (reverse dictionary))
  (display (map (lambda(x) (decode x)) result)))
  (go (renew position))))


include "ConsoleWindow"

print "First line."
gosub "sub1"
print "Fifth line."
goto "Almost over"
"sub1"
print "Second line."
gosub "sub2"
print "Fourth line."
return
"Almost over"
print "We're just about done..."
goto "Outa here"
"sub2"
print "Third line."
return
"Outa here"
print "... with goto and gosub, thankfully."
end


package main

import "fmt"

func main() {
    outer:
    for i := 0; i < 4; i++ {
        for j := 0; j < 4; j++ {
            if i + j == 4 { continue outer }
            if i + j == 5 { break outer }
            fmt.Println(i + j)
        }
    }

    k := 3
    if k == 3 { goto later }
    fmt.Println(k)  // never executed
    later:
    k++
    fmt.Println(k)
}


import Control.Monad.Cont

data LabelT r m = LabelT (ContT r m ())

label :: ContT r m (LabelT r m)
label = callCC subprog
  where subprog lbl = let l = LabelT (lbl l) in return l

goto :: LabelT r m -> ContT r m b
goto (LabelT l) = const undefined <$> l

runProgram :: Monad m => ContT r m r -> m r
runProgram program = runContT program return


#lang racket

; A tree consists of a point, a left and a right subtree.
(struct tree (p l r) #:transparent)
; If the node is in depth d, then the points in l has
; the (d mod k)'th coordinate less than the same coordinate in p.

(define (kdtree d k ps)
  (cond [(empty? ps) #f] ; #f represents an empty subtree
        [else (define-values (p l r) (split-points ps (modulo d k)))
              (tree p (kdtree (+ d 1) k l) (kdtree (+ d 1) k r))]))

(define (split-points ps d)
  (define (ref p) (vector-ref p d))
  (define sorted-ps (sort ps < #:key ref))
  (define mid (quotient (+ (length ps)) 2))
  (define median (ref (list-ref sorted-ps mid)))
  (define-values (l r) (partition(λ(x)(< (ref x) median))sorted-ps))
  (values (first r) l (rest r)))

; The bounding box of a subtree:
(struct bb (mins maxs) #:transparent)

(define (infinite-bb k)
  (bb (make-vector k -inf.0) (make-vector k +inf.0)))

(define/match (copy-bb h)
  [((bb mins maxs))
   (bb (vector-copy mins) (vector-copy maxs))])

(define (dist v w) (for/sum ([x v] [y w]) (sqr (- x y))))
(define (intersects? g r hr) (<= (dist (closest-in-hr g hr) g) r))
(define (closest-in-hr g hr)
  (for/vector ([gi g] [mini (bb-mins hr)] [maxi (bb-maxs hr)])
    (cond [(<=     gi mini) mini]
          [(< mini gi maxi) gi]
          [else             maxi])))

(define (split-bb hr d x)
  (define left  (copy-bb hr))
  (define right (copy-bb hr))
  (vector-set! (bb-maxs left) d x)
  (vector-set! (bb-mins right) d x)
  (values left right))

(define visits 0) ; for statistics only
(define (visit) (set! visits (+ visits 1)))
(define (reset-visits) (set! visits 0))
(define (regret-visit) (set! visits (- visits 1)))

(define (nearest-neighbor g t k)
  (define (nearer? p q) (< (dist p g) (dist q g)))
  (define (nearest p q) (if (nearer? p q) p q))
  (define (nn d t bb) (visit)
    (define (ref p) (vector-ref p (modulo d k)))
    (match t
      [#f (regret-visit) #(+inf.0 +inf.0 +inf.0)]
      [(tree p l r)
       (define-values (lbb rbb) (split-bb bb (modulo d k) (ref p)))
       (define-values (near near-bb far far-bb)
         (if (< (ref g) (ref p))
             (values l lbb r rbb)
             (values r rbb l lbb)))
       (define n (nearest p (nn (+ d 1) near near-bb)))
       (if (intersects? g (dist n g) far-bb)
           (nearest n (nn (+ d 1) far far-bb))
           n)]))
  (nn 0 t (infinite-bb k)))


class Kd_node {
    has $.d;
    has $.split;
    has $.left;
    has $.right;
}

class Orthotope {
    has $.min;
    has $.max;
}

class Kd_tree {
    has $.n;
    has $.bounds;
    method new($pts, $bounds) { self.bless(n => nk2(0,$pts), bounds => $bounds) }

    sub nk2($split, @e) {
        return () unless @e;
        my @exset = @e.sort(*.[$split]);
        my $m = +@exset div 2;
        my @d = @exset[$m][];
        while $m+1 < @exset and @exset[$m+1][$split] eqv @d[$split] {
            ++$m;
        }

        my $s2 = ($split + 1) % @d; # cycle coordinates
        Kd_node.new: :@d, :$split,
                left  => nk2($s2, @exset[0 ..^ $m]),
                right => nk2($s2, @exset[$m ^.. *]);
    }
}

class T3 {
    has $.nearest;
    has $.dist_sqd = Inf;
    has $.nodes_visited = 0;
}

sub find_nearest($k, $t, @p) {
    return nn($t.n, @p, $t.bounds, Inf);

    sub nn($kd, @target, $hr, $max_dist_sqd is copy) {
        return T3.new(:nearest([0.0 xx $k])) unless $kd;

        my $nodes_visited = 1;
        my $s = $kd.split;
        my $pivot = $kd.d;
        my $left_hr = $hr.clone;
        my $right_hr = $hr.clone;
        $left_hr.max[$s] = $pivot[$s];
        $right_hr.min[$s] = $pivot[$s];

        my $nearer_kd;
        my $further_kd;
        my $nearer_hr;
        my $further_hr;
        if @target[$s] <= $pivot[$s] {
            ($nearer_kd, $nearer_hr) = $kd.left, $left_hr;
            ($further_kd, $further_hr) = $kd.right, $right_hr;
        }
        else {
            ($nearer_kd, $nearer_hr) = $kd.right, $right_hr;
            ($further_kd, $further_hr) = $kd.left, $left_hr;
        }

        my $n1 = nn($nearer_kd, @target, $nearer_hr, $max_dist_sqd);
        my $nearest = $n1.nearest;
        my $dist_sqd = $n1.dist_sqd;
        $nodes_visited += $n1.nodes_visited;

        if $dist_sqd < $max_dist_sqd {
            $max_dist_sqd = $dist_sqd;
        }
        my $d = ($pivot[$s] - @target[$s]) ** 2;
        if $d > $max_dist_sqd {
            return T3.new(:$nearest, :$dist_sqd, :$nodes_visited);
        }
        $d = [+] (@$pivot Z- @target) X** 2;
        if $d < $dist_sqd {
            $nearest = $pivot;
            $dist_sqd = $d;
            $max_dist_sqd = $dist_sqd;
        }

        my $n2 = nn($further_kd, @target, $further_hr, $max_dist_sqd);
        $nodes_visited += $n2.nodes_visited;
        if $n2.dist_sqd < $dist_sqd {
            $nearest = $n2.nearest;
            $dist_sqd = $n2.dist_sqd;
        }

        T3.new(:$nearest, :$dist_sqd, :$nodes_visited);
    }
}

sub show_nearest($k, $heading, $kd, @p) {
    print qq:to/END/;
        $heading:
        Point:            [@p.join(',')]
        END
    my $n = find_nearest($k, $kd, @p);
    print qq:to/END/;
        Nearest neighbor: [$n.nearest.join(',')]
        Distance:         &sqrt($n.dist_sqd)
        Nodes visited:    $n.nodes_visited()

        END
}

sub random_point($k) { [rand xx $k] }
sub random_points($k, $n) { [random_point($k) xx $n] }

sub MAIN {
    my $kd1 = Kd_tree.new([[2, 3],[5, 4],[9, 6],[4, 7],[8, 1],[7, 2]],
                  Orthotope.new(:min([0, 0]), :max([10, 10])));
    show_nearest(2, "Wikipedia example data", $kd1, [9, 2]);

    my $N = 1000;
    my $t0 = now;
    my $kd2 = Kd_tree.new(random_points(3, $N), Orthotope.new(:min([0,0,0]), :max([1,1,1])));
    my $t1 = now;
    show_nearest(2,
        "k-d tree with $N random 3D points (generation time: {$t1 - $t0}s)",
         $kd2, random_point(3));
}


import <Utilities/Sequence.sl>;
import <Utilities/Conversion.sl>;

main(args(2)) :=
	let
		N := stringToInt(args[1]) when size(args) > 0 else 8;
		M := stringToInt(args[2]) when size(args) > 1 else N;
		startX := stringToInt(args[3]) when size(args) > 2 else 1;
		startY := stringToInt(args[4]) when size(args) > 3 else 1;
		board[i,j] := 0 foreach i within 1 ... N, j within 1 ... M;
		spacing := size(toString(N*M)) + 1;
	in
		join(printRow(
		        tour(setBoard(board, startX, startX, 1), [startX,startY], 2),
		    spacing));

potentialMoves := [[2,1], [2,-1], [1,2], [1,-2], [-1,2], [-1,-2], [-2,1], [-2,-1]];

printRow(row(1), spacing) := join(printSquare(row, spacing)) ++ "\n";

printSquare(val, spacing) :=
	let
		str := toString(val);
	in
		duplicate(' ', spacing - size(str)) ++ str;

tour(board(2), current(1), move) :=
	let
		validMoves := validMove(board, current + potentialMoves);
		numMoves[i] := size(validMove(board, validMoves[i] + potentialMoves));
		chosenMove := minPosition(numMoves);
	in
	board when move > size(board) * size(board[1]) else
	[] when size(validMoves) = 0 else
	[] when move < size(board) * size(board[1]) and numMoves[chosenMove] = 0 else
	tour(setBoard(board, validMoves[chosenMove][1], validMoves[chosenMove][2], move), validMoves[chosenMove], move + 1);

validMove(board(2), position(1)) :=
	(position when board[position[1], position[2]] = 0)
		when position[1] >= 1 and position[1] <= size(board) and position[2] >= 1 and position[2] <= size(board);

minPosition(x(1)) := minPositionHelper(x, 2, 1, x[1]);
minPositionHelper(x(1), i, minPos, minVal) :=
	minPos when i > size(x) else
	minPositionHelper(x, i + 1, minPos, minVal) when x[i] > minVal else
	minPositionHelper(x, i + 1, i, x[i]);

setBoard(board(2), x, y, value)[i,j] :=
	value when x = i and y = j else
	board[i,j] foreach i within 1 ... size(board), j within 1 ... size(board[1]);


//'i' does not have goto statements, instead control flow is the only legal way to navigate the program.
concept there() {
	print("Hello there")
	return //The return statement goes back to where the function was called.
	print("Not here")
}

software {
	loop {
		break //This breaks the loop, the code after the loop block will be executed next.

		print("This will never print")
	}

	loop {
		loop {
			loop {
				break //This breaks out of 1 loop.
			}
			print("This will print")
			break 2 //This breaks out of 2 loops.
		}
		print("This will not print")
	}

	//Move to the code contained in the 'there' function.
	there()
}


F=: verb define
  smoutput 'Now we are in F'
  G''
  smoutput 'Now we are back in F'
)

G=: verb define
  smoutput 'Now we are in G'
  throw.
)

   F''
Now we are in F
Now we are in G


loop1: while (x != 0) {
    loop2: for (int i = 0; i < 10; i++) {
        loop3: do {
            //some calculations...
            if (/*some condition*/) {
                //this continue will skip the rest of the while loop code and start it over at the next iteration
                continue loop1;
            }
            //more calculations skipped by the continue if it is executed
            if (/*another condition*/) {
                //this break will end the for loop and jump to its closing brace
                break loop2;
            }
        } while (y < 10);
        //loop2 calculations skipped if the break is executed
    }
    //loop1 calculations executed after loop2 is done or if the break is executed, skipped if the continue is executed
}


function example()
    println("Hello ")
    @goto world
    println("Never printed")
    @label world
    println("world")
end


// version 1.0.6

fun main(args: Array<String>) {
    intArrayOf(4, 5, 6).forEach lambda@ {
        if (it == 5) return@lambda
        println(it)
    }
    println()
    loop@ for (i in 0 .. 3) {
        for (j in 0 .. 3) {
            if (i + j == 4) continue@loop
            if (i + j == 5) break@loop
            println(i + j)
        }
    }
}


use std::cmp::Ordering;
use std::cmp::Ordering::Less;
use std::ops::Sub;
use std::time::Instant;

use rand::prelude::*;

#[derive(Clone, PartialEq, Debug)]
struct Point {
    pub coords: Vec<f32>,
}

impl<'a, 'b> Sub<&'b Point> for &'a Point {
    type Output = Point;

    fn sub(self, rhs: &Point) -> Point {
        assert_eq!(self.coords.len(), rhs.coords.len());
        Point {
            coords: self
                .coords
                .iter()
                .zip(rhs.coords.iter())
                .map(|(&x, &y)| x - y)
                .collect(),
        }
    }
}

impl Point {
    fn norm_sq(&self) -> f32 {
        self.coords.iter().map(|n| n * n).sum()
    }
}

struct KDTreeNode {
    point: Point,
    dim: usize,
    // Construction could become faster if we use an arena allocator,
    // but this is easier to use.
    left: Option<Box<KDTreeNode>>,
    right: Option<Box<KDTreeNode>>,
}

impl KDTreeNode {
    /// Create a new KDTreeNode around the `dim`th dimension.
    /// Alternatively, we could dynamically determine the dimension to
    /// split on by using the longest dimension.
    pub fn new(points: &mut [Point], dim: usize) -> KDTreeNode {
        let points_len = points.len();
        if points_len == 1 {
            return KDTreeNode {
                point: points[0].clone(),
                dim,
                left: None,
                right: None,
            };
        }

        // Split around the median
        let pivot = quickselect_by(points, points_len / 2, &|a, b| {
            a.coords[dim].partial_cmp(&b.coords[dim]).unwrap()
        });

        let left = Some(Box::new(KDTreeNode::new(
            &mut points[0..points_len / 2],
            (dim + 1) % pivot.coords.len(),
        )));
        let right = if points.len() >= 3 {
            Some(Box::new(KDTreeNode::new(
                &mut points[points_len / 2 + 1..points_len],
                (dim + 1) % pivot.coords.len(),
            )))
        } else {
            None
        };

        KDTreeNode {
            point: pivot,
            dim,
            left,
            right,
        }
    }

    pub fn find_nearest_neighbor<'a>(&'a self, point: &Point) -> (&'a Point, usize) {
        self.find_nearest_neighbor_helper(point, &self.point, (point - &self.point).norm_sq(), 1)
    }

    fn find_nearest_neighbor_helper<'a>(
        &'a self,
        point: &Point,
        best: &'a Point,
        best_dist_sq: f32,
        n_visited: usize,
    ) -> (&'a Point, usize) {
        let mut my_best = best;
        let mut my_best_dist_sq = best_dist_sq;
        let mut my_n_visited = n_visited;

        // We should always examine the near side
        if self.point.coords[self.dim] < point.coords[self.dim] && self.right.is_some() {
            let (a, b) = self.right.as_ref().unwrap().find_nearest_neighbor_helper(
                point,
                my_best,
                my_best_dist_sq,
                my_n_visited,
            );
            my_best = a;
            my_n_visited = b;
        } else if self.left.is_some() {
            let (a, b) = self.left.as_ref().unwrap().find_nearest_neighbor_helper(
                point,
                my_best,
                my_best_dist_sq,
                my_n_visited,
            );
            my_best = a;
            my_n_visited = b;
        }

        // distance along this node's axis
        let axis_dist_sq = (self.point.coords[self.dim] - point.coords[self.dim]).powi(2);
        if axis_dist_sq <= my_best_dist_sq {
            // self can only be nearer than best if axis_dist_sq is less than
            // best_dist_sq because axis_dist_sq is a lower bound for
            // self_dist_sq
            let self_dist_sq = (point - &self.point).norm_sq();
            if self_dist_sq < my_best_dist_sq {
                my_best = &self.point;
                my_best_dist_sq = self_dist_sq;
            }

            // bookkeeping
            my_n_visited += 1;

            // same reasoning applies for the far side of the split
            if self.point.coords[self.dim] < point.coords[self.dim] && self.left.is_some() {
                let (a, b) = self.left.as_ref().unwrap().find_nearest_neighbor_helper(
                    point,
                    my_best,
                    my_best_dist_sq,
                    my_n_visited,
                );
                my_best = a;
                my_n_visited = b;
            } else if self.right.is_some() {
                let (a, b) = self.right.as_ref().unwrap().find_nearest_neighbor_helper(
                    point,
                    my_best,
                    my_best_dist_sq,
                    my_n_visited,
                );
                my_best = a;
                my_n_visited = b;
            }
        }

        (my_best, my_n_visited)
    }
}

pub fn main() {
    let mut rng = thread_rng();

    // wordpress
    let mut wp_points: Vec<Point> = [
        [2.0, 3.0],
        [5.0, 4.0],
        [9.0, 6.0],
        [4.0, 7.0],
        [8.0, 1.0],
        [7.0, 2.0],
    ]
    .iter()
    .map(|x| Point { coords: x.to_vec() })
    .collect();
    let wp_tree = KDTreeNode::new(&mut wp_points, 0);

    let wp_target = Point {
        coords: vec![9.0, 2.0],
    };
    let (point, n_visited) = wp_tree.find_nearest_neighbor(&wp_target);
    println!("Wikipedia example data:");
    println!("Point: [9, 2]");
    println!("Nearest neighbor: {:?}", point);
    println!("Distance: {}", (point - &wp_target).norm_sq().sqrt());
    println!("Nodes visited: {}", n_visited);

    // randomly generated 3D
    let n_random = 1000;
    let mut make_random_point = || Point {
        coords: (0..3).map(|_| (rng.gen::<f32>() - 0.5) * 1000.0).collect(),
    };
    let mut random_points: Vec<Point> = (0..n_random).map(|_| make_random_point()).collect();

    let start_cons_time = Instant::now();
    let random_tree = KDTreeNode::new(&mut random_points, 0);
    let cons_time = start_cons_time.elapsed();
    println!(
        "1,000 3d points (Construction time: {}ms)",
        cons_time.as_millis(),
    );

    let random_target = make_random_point();

    let (point, n_visited) = random_tree.find_nearest_neighbor(&random_target);
    println!("Point: {:?}", random_target);
    println!("Nearest neighbor: {:?}", point);
    println!("Distance: {}", (point - &random_target).norm_sq().sqrt());
    println!("Nodes visited: {}", n_visited);

    // benchmark search time
    let n_searches = 1000;
    let random_targets: Vec<Point> = (0..n_searches).map(|_| make_random_point()).collect();

    let start_search_time = Instant::now();
    let mut total_n_visited = 0;
    for target in &random_targets {
        let (_, n_visited) = random_tree.find_nearest_neighbor(target);
        total_n_visited += n_visited;
    }
    let search_time = start_search_time.elapsed();
    println!(
        "Visited an average of {} nodes on {} searches in {} ms",
        total_n_visited as f32 / n_searches as f32,
        n_searches,
        search_time.as_millis(),
    );
}

fn quickselect_by<T>(arr: &mut [T], position: usize, cmp: &dyn Fn(&T, &T) -> Ordering) -> T
where
    T: Clone,
{
    // We use `thread_rng` here because it was already initialized in `main`.
    let mut pivot_index = thread_rng().gen_range(0, arr.len());
    // Need to wrap in another closure or we get ownership complaints.
    // Tried using an unboxed closure to get around this but couldn't get it to work.
    pivot_index = partition_by(arr, pivot_index, &|a: &T, b: &T| cmp(a, b));
    let array_len = arr.len();
    match position.cmp(&pivot_index) {
        Ordering::Equal => arr[position].clone(),
        Ordering::Less => quickselect_by(&mut arr[0..pivot_index], position, cmp),
        Ordering::Greater => quickselect_by(
            &mut arr[pivot_index + 1..array_len],
            position - pivot_index - 1,
            cmp,
        ),
    }
}

fn partition_by<T>(arr: &mut [T], pivot_index: usize, cmp: &dyn Fn(&T, &T) -> Ordering) -> usize {
    let array_len = arr.len();
    arr.swap(pivot_index, array_len - 1);
    let mut store_index = 0;
    for i in 0..array_len - 1 {
        if cmp(&arr[i], &arr[array_len - 1]) == Less {
            arr.swap(i, store_index);
            store_index += 1;
        }
    }
    arr.swap(array_len - 1, store_index);
    store_index
}


object KDTree {
  import Numeric._

  // Task 1A. Build tree of KDNodes. Translated from Wikipedia.
  def apply[T](points: Seq[Seq[T]], depth: Int = 0)(implicit num: Numeric[T]): Option[KDNode[T]] = {
    val dim = points.headOption.map(_.size) getOrElse 0
    if (points.isEmpty || dim < 1) None
    else {
      val axis = depth % dim
      val sorted = points.sortBy(_(axis))
      val median = sorted(sorted.size / 2)(axis)
      val (left, right) = sorted.partition(v => num.lt(v(axis), median))
      Some(KDNode(right.head, apply(left, depth + 1), apply(right.tail, depth + 1), axis))
    }
  }

  // Task 1B. Find the nearest node in this subtree. Translated from Wikipedia.
  case class KDNode[T](value: Seq[T], left: Option[KDNode[T]], right: Option[KDNode[T]], axis: Int)(implicit num: Numeric[T]) {
    def nearest(to: Seq[T]): Nearest[T] = {
      val default = Nearest(value, to, Set(this))
      compare(to, value) match {
        case 0 => default // exact match
        case t =>
          lazy val bestL = left.map(_ nearest to).getOrElse(default)
          lazy val bestR = right.map(_ nearest to).getOrElse(default)
          val branch1 = if (t < 0) bestL else bestR
          val best = if (num.lt(branch1.distsq, default.distsq)) branch1 else default
          val splitDist = num.minus(to(axis), value(axis))
          if (num.lt(num.times(splitDist, splitDist), best.distsq)) {
            val branch2 = if (t < 0) bestR else bestL
            val visited = branch2.visited ++ best.visited + this
            if (num.lt(branch2.distsq, best.distsq))
              branch2.copy(visited = visited)
              else best.copy(visited = visited)
          } else best.copy(visited = best.visited + this)
      }
    }
  }

  // Keep track of nodes visited, as per task. Pretty-printable.
  case class Nearest[T](value: Seq[T], to: Seq[T], visited: Set[KDNode[T]] = Set[KDNode[T]]())(implicit num: Numeric[T]) {
    lazy val distsq = KDTree.distsq(value, to)
    override def toString = f"Searched for=${to} found=${value} distance=${math.sqrt(num.toDouble(distsq))}%.4f visited=${visited.size}"
  }

  // Numeric utilities
  def distsq[T](a: Seq[T], b: Seq[T])(implicit num: Numeric[T]) =
    a.zip(b).map(c => num.times(num.minus(c._1, c._2), num.minus(c._1, c._2))).sum
  def compare[T](a: Seq[T], b: Seq[T])(implicit num: Numeric[T]): Int =
    a.zip(b).find(c => num.compare(c._1, c._2) != 0).map(c => num.compare(c._1, c._2)).getOrElse(0)
}


var board = []
var I = 8
var J = 8
var F = (I*J > 99 ? '%3d' : '%2d')

var (i, j) = (I.irand, J.irand)

func from_algebraic(square) {
     if (var match = square.match(/^([a-z])([0-9])\z/)) {
         return(I - Num(match[1]), match[0].ord - 'a'.ord)
     }
     die "Invalid block square: #{square}"
}

func possible_moves(i,j) {
    gather {
        for ni,nj in [
            [i-2,j-1], [i-2,j+1], [i-1,j-2], [i-1,j+2],
            [i+1,j-2], [i+1,j+2], [i+2,j-1], [i+2,j+1],
        ] {
            if ((ni ~~ ^I) && (nj ~~ ^J) && !board[ni][nj]) {
                take([ni, nj])
            }
        }
    }
}

func to_algebraic(i,j) {
    ('a'.ord + j).chr + Str(I - i)
}

if (ARGV[0]) {
    (i, j) = from_algebraic(ARGV[0])
}

var moves = []
for move in (1 .. I*J) {
    moves << to_algebraic(i, j)
    board[i][j] = move
    var min = [9]
    for target in possible_moves(i, j) {
        var (ni, nj) = target...
        var nxt = possible_moves(ni, nj).len
        if (nxt < min[0]) {
            min = [nxt, ni, nj]
        }
    }

    (i, j) = min[1,2]
}

say (moves/4 -> map { .join(', ') }.join("\n") + "\n")

for i in ^I {
    for j in ^J {
        (i%2 == j%2) && print "\e[7m"
        F.printf(board[i][j])
        print "\e[0m"
    }
    print "\n"
}


on foo
  abort()
end

on bar ()
  foo()
  put "This will never be printed"
end


-- Forward jump
goto skip_print
print "won't print"
::skip_print::

-- Backward jump
::loop::
print "infinite loop"
goto loop

-- Labels follow the same scoping rules as local variables, but with no equivalent of upvalues
goto next
do
    ::next:: -- not visible to above goto
    print "won't print"
end
::next:: -- goto actually jumps here

-- goto cannot jump into or out of a function
::outside::
function nope () goto outside end -- error: no visible label 'outside' for <goto> at line 2

goto inside
function nope () ::inside:: end -- error: no visible label 'inside' for <goto> at line 1

-- Convenient for breaking out of nested loops
for i = 1, 10 do
    for j = 1, 10 do
        for k = 1, 10 do
            if i^2 + j^2 == k^2 then
                print(("found: i=%d j=%d k=%d"):format(i, j, k))
                goto exit
            end
        end
    end
end
print "not found"
::exit::


struct Kd_node {
    d,
    split,
    left,
    right,
}

struct Orthotope {
    min,
    max,
}

class Kd_tree(n, bounds) {

    method init {
        n = self.nk2(0, n);
    }

    method nk2(split, e) {
        return(nil) if (e.len <= 0);
        var exset = e.sort_by { _[split] }
        var m = (exset.len // 2);
        var d = exset[m];
        while ((m+1 < exset.len) && (exset[m+1][split] == d[split])) {
            ++m;
        }

        var s2 = ((split + 1) % d.len);     # cycle coordinates
        Kd_node(d: d, split: split,
                left:  self.nk2(s2, exset.first(m)),
                right: self.nk2(s2, exset.last(m-1)));
    }
}

struct T3 {
    nearest,
    dist_sqd = Inf,
    nodes_visited = 0,
}

func find_nearest(k, t, p) {
    func nn(kd, target, hr, max_dist_sqd) {
        kd || return T3(nearest: [0]*k);

        var nodes_visited = 1;
        var s = kd.split;
        var pivot = kd.d;
        var left_hr = Orthotope(hr.min, hr.max);
        var right_hr = Orthotope(hr.min, hr.max);
        left_hr.max[s] = pivot[s];
        right_hr.min[s] = pivot[s];

        var nearer_kd;
        var further_kd;
        var nearer_hr;
        var further_hr;
        if (target[s] <= pivot[s]) {
            (nearer_kd, nearer_hr) = (kd.left, left_hr);
            (further_kd, further_hr) = (kd.right, right_hr);
        }
        else {
            (nearer_kd, nearer_hr) = (kd.right, right_hr);
            (further_kd, further_hr) = (kd.left, left_hr);
        }

        var n1 = nn(nearer_kd, target, nearer_hr, max_dist_sqd);
        var nearest = n1.nearest;
        var dist_sqd = n1.dist_sqd;
        nodes_visited += n1.nodes_visited;

        if (dist_sqd < max_dist_sqd) {
            max_dist_sqd = dist_sqd;
        }
        var d = (pivot[s] - target[s] -> sqr);
        if (d > max_dist_sqd) {
            return T3(nearest: nearest, dist_sqd: dist_sqd, nodes_visited: nodes_visited);
        }
        d = (pivot ~Z- target »sqr»() «+»);
        if (d < dist_sqd) {
            nearest = pivot;
            dist_sqd = d;
            max_dist_sqd = dist_sqd;
        }

        var n2 = nn(further_kd, target, further_hr, max_dist_sqd);
        nodes_visited += n2.nodes_visited;
        if (n2.dist_sqd < dist_sqd) {
            nearest = n2.nearest;
            dist_sqd = n2.dist_sqd;
        }

        T3(nearest: nearest, dist_sqd: dist_sqd, nodes_visited: nodes_visited);
    }

    return nn(t.n, p, t.bounds, Inf);
}

func show_nearest(k, heading, kd, p) {
    print <<-"END"
        #{heading}:
        Point:            [#{p.join(',')}]
        END
    var n = find_nearest(k, kd, p);
    print <<-"END"
        Nearest neighbor: [#{n.nearest.join(',')}]
        Distance:         #{sqrt(n.dist_sqd)}
        Nodes visited:    #{n.nodes_visited()}

        END
}

func random_point(k) { k.of { 1.rand } }
func random_points(k, n) { n.of { random_point(k) } }

var kd1 = Kd_tree([[2, 3],[5, 4],[9, 6],[4, 7],[8, 1],[7, 2]],
              Orthotope(min: [0, 0], max: [10, 10]));
show_nearest(2, "Wikipedia example data", kd1, [9, 2]);

var N = 1000
var t0 = Time.micro
var kd2 = Kd_tree(random_points(3, N), Orthotope(min: [0,0,0], max: [1,1,1]))

var t1 = Time.micro
show_nearest(2,
    "k-d tree with #{N} random 3D points (generation time: #{t1 - t0}s)",
     kd2, random_point(3))


public struct CPoint {
  public var x: Int
  public var y: Int

  public init(x: Int, y: Int) {
    (self.x, self.y) = (x, y)
  }

  public func move(by: (dx: Int, dy: Int)) -> CPoint {
    return CPoint(x: self.x + by.dx, y: self.y + by.dy)
  }
}

extension CPoint: Comparable {
  public static func <(lhs: CPoint, rhs: CPoint) -> Bool {
    if lhs.x == rhs.x {
      return lhs.y < rhs.y
    } else {
      return lhs.x < rhs.x
    }
  }
}

public class KnightsTour {
  public var size: Int { board.count }

  private var board: [[Int]]

  public init(size: Int) {
    board = Array(repeating: Array(repeating: 0, count: size), count: size)
  }

  public func countMoves(forPoint point: CPoint) -> Int {
    return KnightsTour.knightMoves.lazy
      .map(point.move)
      .reduce(0, {count, movedTo in
        return squareAvailable(movedTo) ? count + 1 : count
    })
  }

  public func printBoard() {
    for row in board {
      for x in row {
        print("\(x) ", terminator: "")
      }

      print()
    }

    print()
  }

  private func reset() {
    for i in 0..<size {
      for j in 0..<size {
        board[i][j] = 0
      }
    }
  }

  public func squareAvailable(_ p: CPoint) -> Bool {
    return 0 <= p.x
      && p.x < size
      && 0 <= p.y
      && p.y < size
      && board[p.x][p.y] == 0
  }

  public func tour(startingAt point: CPoint = CPoint(x: 0, y: 0)) -> Bool {
    var step = 2
    var p = point

    reset()

    board[p.x][p.y] = 1

    while step <= size * size {
      let candidates = KnightsTour.knightMoves.lazy
        .map(p.move)
        .map({moved in (moved, self.countMoves(forPoint: moved), self.squareAvailable(moved)) })
        .filter({ $0.2 })

      guard let bestMove = candidates.sorted(by: bestChoice).first else {
        return false
      }

      p = bestMove.0
      board[p.x][p.y] = step

      step += 1
    }

    return true
  }
}

private func bestChoice(_ choice1: (CPoint, Int, Bool), _ choice2: (CPoint, Int, Bool)) -> Bool {
  if choice1.1 == choice2.1 {
    return choice1.0 < choice2.0
  }

  return choice1.1 < choice2.1
}

extension KnightsTour {
  fileprivate static let knightMoves = [
    (2, 1),
    (1, 2),
    (-1, 2),
    (-2, 1),
    (-2, -1),
    (-1, -2),
    (1, -2),
    (2, -1),
  ]
}

let b = KnightsTour(size: 8)

print()

let completed = b.tour(startingAt: CPoint(x: 3, y: 1))

if completed {
  print("Completed tour")
} else {
  print("Did not complete tour")
}

b.printBoard()


Module Checkit {
      Module Alfa {
            10 Rem this code is like basic
            20 Let K%=1
            30 Let A=2
            40 Print "Begin"
            50 On K% Gosub 110
            60 If A=2 then 520
            70 For I=1 to 10
            80 if i>5 then exit for 120
            90 Gosub 110
            100 Next i
            110 On A Goto 150,  500
            120 Print "This is the End ?"
            130 Return
            150 Print "from loop pass here", i
            160 Return
            200 Print "ok"
            210 Return
            500 Print "Routine 500"
            510 Goto 200
            520 Let A=1
            530 Gosub 70
            540 Print "Yes"
      }
      Alfa
      \\ this can be done. Code executed like it is from this module
      \\ because 200 is a label inside code of Module Checkit
      \\ and search is not so smart. After first search. position saved in a hash table
      Gosub 200  ' print "ok"
      Gosub 200  ' print "ok"
}
Checkit


 ;Go to a label within the program file
 Goto Label
 ;Go to a line below a label
 Goto Label+lines
 ;Go to a different file
 Goto ^Routine
 ;Go to a label within a different file
 Goto Label^Routine
 ;and with offset
 Goto Label+2^Routine
 ;
 ;The next two goto commands will both return error M45 in ANSI MUMPS.
NoNo
 For
 . Goto Out
Out Quit
 Goto NoNo+2


$print("start\n")
$goto(skip)
$print("Jumped over")
skip:
$print("end\n")


block outer:
  for i in 0..1000:
    for j in 0..1000:
      if i + j == 3:
        break outer


package require TclOO

oo::class create KDTree {
    variable t dim
    constructor {points} {
	set t [my Build 0 $points 0 end]
	set dim [llength [lindex $points 0]]
    }
    method Build {split exset from to} {
	set exset [lsort -index $split -real [lrange $exset $from $to]]
	if {![llength $exset]} {return 0}
	set m [expr {[llength $exset] / 2}]
	set d [lindex $exset $m]
	while {[set mm $m;incr mm] < [llength $exset] && \
		[lindex $exset $mm $split] == [lindex $d $split]} {
	    set m $mm
	}
	set s [expr {($split + 1) % [llength $d]}]
	list 1 $d $split [my Build $s $exset 0 [expr {$m-1}]] \
		[my Build $s $exset [expr {$m+1}] end]
    }

    method findNearest {p} {
	lassign [my FN $t $p inf] p d2 count
	return [list $p [expr {sqrt($d2)}] $count]
    }
    method FN {kd target maxDist2} {
	if {[lindex $kd 0] == 0} {
	    return [list [lrepeat $dim 0.0] inf 0]
	}

	set nodesVisited 1
	lassign $kd -> pivot s

	if {[lindex $target $s] <= [lindex $pivot $s]} {
	    set nearerKD [lindex $kd 3]
	    set furtherKD [lindex $kd 4]
	} else {
	    set nearerKD [lindex $kd 4]
	    set furtherKD [lindex $kd 3]
	}

	lassign [my FN $nearerKD $target $maxDist2] nearest dist2 count
	incr nodesVisited $count

	if {$dist2 < $maxDist2} {
	    set maxDist2 $dist2
	}
	set d2 [expr {([lindex $pivot $s]-[lindex $target $s])**2}]
	if {$d2 > $maxDist2} {
	    return [list $nearest $dist2 $nodesVisited]
	}
	set d2 0.0
	foreach pp $pivot tp $target {set d2 [expr {$d2+($pp-$tp)**2}]}
	if {$d2 < $dist2} {
	    set nearest $pivot
	    set maxDist2 [set dist2 $d2]
	}

	lassign [my FN $furtherKD $target $maxDist2] fNearest fDist2 count
	incr nodesVisited $count
	if {$fDist2 < $dist2} {
	    set nearest $fNearest
	    set dist2 $fDist2
	}

	return [list $nearest $dist2 $nodesVisited]
    }
}


package require Tcl 8.6;    # For object support, which makes coding simpler

oo::class create KnightsTour {
    variable width height visited

    constructor {{w 8} {h 8}} {
	set width $w
	set height $h
	set visited {}
    }

    method ValidMoves {square} {
	lassign $square c r
	set moves {}
	foreach {dx dy} {-1 -2  -2 -1  -2 1  -1 2  1 2  2 1  2 -1  1 -2} {
	    set col [expr {($c % $width) + $dx}]
	    set row [expr {($r % $height) + $dy}]
	    if {$row >= 0 && $row < $height && $col >=0 && $col < $width} {
		lappend moves [list $col $row]
	    }
	}
	return $moves
    }

    method CheckSquare {square} {
	set moves 0
	foreach site [my ValidMoves $square] {
	    if {$site ni $visited} {
		incr moves
	    }
	}
	return $moves
    }

    method Next {square} {
	set minimum 9
	set nextSquare {-1 -1}
	foreach site [my ValidMoves $square] {
	    if {$site ni $visited} {
		set count [my CheckSquare $site]
		if {$count < $minimum} {
		    set minimum $count
		    set nextSquare $site
		} elseif {$count == $minimum} {
		    set nextSquare [my Edgemost $nextSquare $site]
		}
	    }
	}
	return $nextSquare
    }

    method Edgemost {a b} {
	lassign $a ca ra
	lassign $b cb rb
	# Calculate distances to edge
	set da [expr {min($ca, $width - 1 - $ca, $ra, $height - 1 - $ra)}]
	set db [expr {min($cb, $width - 1 - $cb, $rb, $height - 1 - $rb)}]
	if {$da < $db} {return $a} else {return $b}
    }

    method FormatSquare {square} {
	lassign $square c r
	format %c%d [expr {97 + $c}] [expr {1 + $r}]
    }

    method constructFrom {initial} {
	while 1 {
	    set visited [list $initial]
	    set square $initial
	    while 1 {
		set square [my Next $square]
		if {$square eq {-1 -1}} {
		    break
		}
		lappend visited $square
	    }
	    if {[llength $visited] == $height*$width} {
		return
	    }
	    puts stderr "rejecting path of length [llength $visited]..."
	}
    }

    method constructRandom {} {
	my constructFrom [list \
		[expr {int(rand()*$width)}] [expr {int(rand()*$height)}]]
    }

    method print {} {
	set s "      "
	foreach square $visited {
	    puts -nonewline "$s[my FormatSquare $square]"
	    if {[incr i]%12} {
		set s " -> "
	    } else {
		set s "\n   -> "
	    }
	}
	puts ""
    }

    method isClosed {} {
	set a [lindex $visited 0]
	set b [lindex $visited end]
	expr {$a in [my ValidMoves $b]}
    }
}


; recursion:
(let loop ((n 10))
   (unless (= n 0)
      (loop (- n 1))))

; continuation
(call/cc (lambda (break)
   (let loop ((n 10))
      (if (= n 0)
         (break 0))
      (loop (- n 1)))))

(print "ok.")


sub outer {
    print "In outer, calling inner:\n";
    inner();
  OUTER:
    print "at label OUTER\n";
}

sub inner {
    print "In inner\n";

    goto SKIP;      # goto same block level
    print "This should be skipped\n";
  SKIP:
    print "at label SKIP\n";

    goto OUTER;     # goto whatever OUTER label there is on frame stack.
                    # if there isn't any, exception will be raised
    print "Inner should never reach here\n";
}

sub disguise {
    goto &outer;    # a different type of goto, it replaces the stack frame
                    # with the outer() function's and pretend we called
                    # that function to begin with
    print "Can't reach this statement\n";
}

print "Calling outer:\n";
outer();

print "\nCalling disguise:\n";
disguise();

print "\nCalling inner:\n";
inner();                # will die


import "/dynamic" for Tuple
import "/math" for Nums
import "/seq" for Lst
import "/sort" for Sort
import "random" for Random

// A Point is represented by a 2 element List of Nums
var PtSqd = Fn.new { |p, q| Nums.sum(Lst.zip(p, q).map { |r| (r[0] - r[1]) * (r[0] - r[1]) }) }

var HyperRect = Tuple.create("HyperRect", ["min", "max"])

var HrCopy = Fn.new { |hr| HyperRect.new(hr.min.toList, hr.max.toList) }

var NearestNeighbor = Tuple.create("NearestNeighbor", ["nearest", "distSqd", "nodesVisited"])

var KdNode = Tuple.create("KdNode", ["domElt", "split", "left", "right"])

class KdTree {
    construct new(pts, bounds) {
        var nk2 // recursive closure
        nk2 = Fn.new { |exset, split|
            if (exset.count == 0) return null
            var cmp = Fn.new { |p, q| (p[split] - q[split]).sign }
            Sort.quick(exset, 0, exset.count - 1, cmp)
            var m = (exset.count/2).floor
            var d = exset[m]
            while (m + 1 < exset.count && exset[m + 1][split] == d[split]) m = m + 1
            var s2 = split + 1
            if (s2 == d.count) s2 = 0
            return KdNode.new(
                d,
                split,
                nk2.call(exset[0...m], s2),
                nk2.call(exset[m + 1..-1], s2)
            )
        }
        _n = nk2.call(pts, 0)
        _bounds = bounds
    }

    nearest(p) { nn_(_n, p, _bounds, 1/0) }

    nn_(kd, target, hr, maxDistSqd) {
        if (!kd) return NearestNeighbor.new(null, 1/0, 0)
        var nodesVisited = 1
        var s = kd.split
        var pivot = kd.domElt
        var leftHr = HrCopy.call(hr)
        var rightHr = HrCopy.call(hr)
        leftHr.max[s] = pivot[s]
        rightHr.min[s] = pivot[s]
        var targetInLeft = target[s] <= pivot[s]
        var nearerKd  = (targetInLeft) ? kd.left : kd.right
        var nearerHr  = (targetInLeft) ? leftHr : rightHr
        var furtherKd = (targetInLeft) ? kd.right : kd.left
        var furtherHr = (targetInLeft) ? rightHr : leftHr
        var res = nn_(nearerKd, target, nearerHr, maxDistSqd)
        var nearest = res.nearest
        var distSqd = res.distSqd
        var nv = res.nodesVisited
        nodesVisited = nodesVisited + nv
        var maxDistSqd2 = (distSqd < maxDistSqd) ? distSqd : maxDistSqd
        var d = pivot[s] - target[s]
        d = d * d
        if (d > maxDistSqd2) return NearestNeighbor.new(nearest, distSqd, nodesVisited)
        d = PtSqd.call(pivot, target)
        if (d < distSqd) {
            nearest = pivot
            distSqd = d
            maxDistSqd2 = distSqd
        }
        var temp = nn_(furtherKd, target, furtherHr, maxDistSqd2)
        nodesVisited = nodesVisited + temp.nodesVisited
        if (temp.distSqd < distSqd) {
            nearest = temp.nearest
            distSqd = temp.distSqd
        }
        return NearestNeighbor.new(nearest, distSqd, nodesVisited)
    }
}

var rand = Random.new()

var randomPt = Fn.new { |dim|
     var pt = List.filled(dim, 0)
     for (i in 0...dim) pt[i] = rand.float()
     return pt
}

var randomPts = Fn.new { |dim, n|
    var pts = List.filled(n, null)
    for (i in 0...n) pts[i] = randomPt.call(dim)
    return pts
}

var showNearest = Fn.new { |heading, kd, p|
    System.print("%(heading):")
    System.print("Point            : %(p)")
    var res = kd.nearest(p)
    System.print("Nearest neighbor : %(res.nearest)")
    System.print("Distance         : %(res.distSqd.sqrt)")
    System.print("Nodes visited    : %(res.nodesVisited)")
    System.print()
}

var points = [[2, 3], [5, 4], [9, 6], [4, 7], [8, 1], [7, 2]]
var hr = HyperRect.new([0, 0], [10, 10])
var kd = KdTree.new(points, hr)
showNearest.call("WP example data", kd, [9, 2])

hr = HyperRect.new([0, 0, 0], [1, 1, 1])
kd = KdTree.new(randomPts.call(3, 1000), hr)
showNearest.call("1,000 random 3D points", kd, randomPt.call(3))

hr = HrCopy.call(hr)
kd = KdTree.new(randomPts.call(3, 400000), hr)
showNearest.call("400,000 random 3D points", kd, randomPt.call(3))


*        Kaprekar numbers          22/03/ 2017
KAPREKAR CSECT
         USING  KAPREKAR,R13       base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R10,0              n=0
         LA     R6,1               i=1
       DO WHILE=(C,R6,LE,=F'1000000')  do i=1 to 1000000
         CVD    R6,PI                pi=i
         ZAP    PS,PI                ps=pi
         MP     PS,PI                ps=pi*pi
         ZAP    PX,PS                ps
         OI     PX+7,X'0F'           zap sign
         UNPK   SW,PX                packed PL8 to zoned CL16
         MVC    SS(16),SW            s=pic(ps,16)
         MVI    OK,X'00'             ok=false
         LA     R7,1                 j=1
       DO WHILE=(C,R7,LE,=F'15')     do j=1 to 15
         LA     R2,16                  16
         SR     R2,R7                  -j
         ST     R2,LL                  l=16-j
         LA     R2,S1                  @s1
         LA     R3,20                  20
         LA     R4,SS                  @s
         LR     R5,R7                  j
         ICM    R5,B'1000',=C' '       pad
         MVCL   R2,R4                  s1=substr(s,1,j)
         LA     R2,S2                  @s2
         LA     R3,20                  20
         LA     R4,SS                  @s
         AR     R4,R7                  +j
         L      R5,LL                  l
         ICM    R5,B'1000',=C' '       pad
         MVCL   R2,R4                  s2=substr(s,j+1,l)
         MVC    ZZ,=20C'0'             zw=(20)'0'
         LA     R2,S1                  @s1
         LR     R3,R7                  j
         LA     R4,ZZ                  @zz
         LR     R5,R7                  j
         CLCL   R2,R4                  if substr(s1,1,j)=substr(zz,1,j)
         BE     ITERJ                  then iterate j
         LA     R2,S2                  @s2
         L      R3,LL                  l
         LA     R4,ZZ                  @zz
         L      R5,LL                  l
         CLCL   R2,R4                  if substr(s2,1,l)=substr(zz,1,l)
         BE     EXITJ                  then leave j
         XDECI  R2,S1                  unedit s1
         ST     R2,M1                  m1=s1
         XDECI  R2,S2                  unedit s2
         ST     R2,M2                  m2=s2
         L      R2,M1                  m1
         A      R2,M2                  +m2
         ST     R2,MM                  m=m1+m2
       IF C,R6,EQ,MM THEN              if i=m then
         MVI    OK,X'01'                 ok=true
         B      EXITJ                    leave j
       ENDIF    ,                      end if
ITERJ    LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
EXITJ    EQU    *                    exitj:
       IF CLI,OK,EQ,X'01',OR,C,R6,EQ,=F'1' THEN  if ok or i=1 then
         LA     R10,1(R10)               n=n+1
         XDECO  R10,PG                   edit n
         XDECO  R6,PG+12                 edit i
         XPRNT  PG,L'PG                  print buffer
       ENDIF    ,                      end if
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         L      R13,4(0,R13)       restore previous savearea pointer
         LM     R14,R12,12(R13)    restore previous context
         XR     R15,R15            rc=0
         BR     R14                exit
OK       DS     X                  ok logical
LL       DS     F                  l  binary
MM       DS     F                  m  "
M1       DS     F                  m1 "
M2       DS     F                  m2 "
         DS     0D                 -- alignment for cvd
PI       DS     PL8                pi fixed decimal(15)
PM       DS     PL8                pm "
PS       DS     PL8                ps "
PX       DS     PL8                px "
SS       DC     CL20' '            s  character(20)
S1       DS     CL20               s1 "
S2       DS     CL20               s2 "
ZZ       DS     CL20               z  "
SW       DS     CL16               sw character(16)
PG       DC     CL80' '            buffer
         YREGS
         END    KAPREKAR


with Ada.Text_IO;
with Ada.Strings.Fixed;

procedure Kaprekar2 is
   use Ada.Strings.Fixed;

   To_Digit : constant String := "0123456789abcdefghijklmnopqrstuvwxyz";

   type Int is mod 2 ** 64;
   subtype Base_Number is Int range 2 .. 36;

   From_Digit : constant array (Character) of Int :=
     ('0'    => 0,
      '1'    => 1,
      '2'    => 2,
      '3'    => 3,
      '4'    => 4,
      '5'    => 5,
      '6'    => 6,
      '7'    => 7,
      '8'    => 8,
      '9'    => 9,
      'a'    => 10,
      'b'    => 11,
      'c'    => 12,
      'd'    => 13,
      'e'    => 14,
      'f'    => 15,
      'g'    => 16,
      'h'    => 17,
      'i'    => 18,
      'j'    => 19,
      'k'    => 20,
      'l'    => 21,
      'm'    => 22,
      'n'    => 23,
      'o'    => 24,
      'p'    => 25,
      'q'    => 26,
      'r'    => 27,
      's'    => 28,
      't'    => 29,
      'u'    => 30,
      'v'    => 31,
      'w'    => 32,
      'x'    => 33,
      'y'    => 34,
      'z'    => 35,
      others => 0);

   function To_String (Item : Int; Base : Base_Number := 10) return String is
      Value       : Int := Item;
      Digit_Index : Natural;
      Result      : String (1 .. 64);
      First       : Natural := Result'Last;
   begin
      while Value > 0 loop
         Digit_Index := Natural (Value mod Base);
         Result (First) := To_Digit (Digit_Index + 1);
         Value := Value / Base;
         First := First - 1;
      end loop;
      return Result (First + 1 .. Result'Last);
   end To_String;

   procedure Get (From : String; Item : out Int; Base : Base_Number := 10) is
   begin
      Item := 0;
      for I in From'Range loop
         Item := Item * Base;
         Item := Item + From_Digit (From (I));
      end loop;
   end Get;

   function Is_Kaprekar (N : Int; Base : Base_Number := 10) return Boolean is
      Square : Int;
   begin
      if N = 1 then
         return True;
      else
         Square := N ** 2;
         declare
            Image : String := To_String (Square, Base);
            A, B  : Int;
         begin
            for I in Image'First .. Image'Last - 1 loop
               exit when Count (Image (I + 1 .. Image'Last), "0")
                 = Image'Last - I;
               Get (From => Image (Image'First .. I),
                    Item => A,
                    Base => Base);
               Get (From => Image (I + 1 .. Image'Last),
                    Item => B,
                    Base => Base);
               if A + B = N then
                  return True;
               end if;
            end loop;
         end;
      end if;
      return False;
   end Is_Kaprekar;

   Count : Natural := 0;
begin
   for I in Int range 1 .. 10_000 loop
      if Is_Kaprekar (I) then
         Count := Count + 1;
         Ada.Text_IO.Put (To_String (I) & ",");
      end if;
   end loop;
   Ada.Text_IO.Put_Line (" Total:" & Integer'Image (Count));

   for I in Int range 10_001 .. 1_000_000 loop
      if Is_Kaprekar (I) then
         Count := Count + 1;
      end if;
   end loop;
   Ada.Text_IO.Put_Line ("Kaprekar Numbers below 1000000:" &
                         Integer'Image (Count));

   Count := 0;
   Ada.Text_IO.Put_Line ("Kaprekar Numbers below 1000000 in base 17:");
   for I in Int range 1 .. 17 ** 6 loop
      if Is_Kaprekar (I, 17) then
         Count := Count + 1;
         Ada.Text_IO.Put (To_String (I, 17) & ",");
      end if;
   end loop;
   Ada.Text_IO.Put_Line (" Total:" & Integer'Image (Count));
end Kaprekar2;


class Square {
    construct new(x, y) {
        _x = x
        _y = y
    }

    x { _x }
    y { _y }

    ==(other) { _x == other.x && _y == other.y }
}

var board = List.filled(8 * 8, null)
for (i in 0...board.count) board[i] = Square.new((i/8).floor + 1, i%8 + 1)
var axisMoves = [1, 2, -1, -2]

var allPairs = Fn.new { |a|
    var pairs = []
    for (i in a) {
        for (j in a) pairs.add([i, j])
    }
    return pairs
}

var knightMoves = Fn.new { |s|
    var moves = allPairs.call(axisMoves).where { |p| p[0].abs != p[1].abs }
    var onBoard = Fn.new { |s| board.any { |i| i == s } }
    return moves.map { |p| Square.new(s.x + p[0], s.y + p[1]) }.where(onBoard)
}

var knightTour // recursive
knightTour = Fn.new { |moves|
    var findMoves = Fn.new { |s|
        return knightMoves.call(s).where { |m| !moves.any { |m2| m2 == m } }.toList
    }
    var fm = findMoves.call(moves[-1])
    if (fm.isEmpty) return moves
    var lowest = findMoves.call(fm[0]).count
    var lowestIndex = 0
    for (i in 1...fm.count) {
        var count = findMoves.call(fm[i]).count
        if (count < lowest) {
            lowest = count
            lowestIndex = i
        }
    }
    var newSquare = fm[lowestIndex]
    return knightTour.call(moves + [newSquare])
}

var knightTourFrom = Fn.new { |start| knightTour.call([start]) }

var col = 0
for (p in knightTourFrom.call(Square.new(1, 1))) {
    System.write("%(p.x),%(p.y)")
    System.write((col == 7) ? "\n" : "  ")
    col = (col + 1) % 8
}


#ilASM{ jmp :%somelabel }
    ...
#ilASM{ :%somelabel }


(de foo (N)
   (prinl "This is 'foo'")
   (printsp N)
   (or (=0 (dec 'N)) (run (cddr foo))) )


DECLARE
    i number := 5;
    divide_by_zero EXCEPTION;
    PRAGMA exception_init(divide_by_zero, -20000);
BEGIN
    DBMS_OUTPUT.put_line( 'startLoop' );
    <<startLoop>>
        BEGIN
            if i = 0 then
                raise divide_by_zero;
            end if;
            DBMS_OUTPUT.put_line( 100/i );
            i := i - 1;
            GOTO startLoop;
        EXCEPTION
        WHEN divide_by_zero THEN
            DBMS_OUTPUT.put_line( 'Oops!' );
            GOTO finally;
        END;
    <<endLoop>>
    DBMS_OUTPUT.put_line( 'endLoop' );

    <<finally>>
    DBMS_OUTPUT.put_line( 'Finally' );
END;
/


class KdTree{
   const NEAREST=0, DIST_SQD=1, NODES_VISITED=2;
   class KdNode{
      fcn init(_dom_elt,_split,_left,_right){
	 var dom_elt=_dom_elt.apply("toFloat"),
	     split=_split, left=_left, right=_right;
      }
   }
   fcn init(pts,_bounds){  // pts is points is ( (x,y,..),..)
      var n=fcn(split, exset){
	   if(not exset) return(Void);
	   exset=exset.copy()  // mutable lists sort much quicker than read only
		      .sort('wrap(abc,xyz){ abc[split]<xyz[split] });
	   m,d:=exset.len()/2, exset[m];
	   while(m+1<exset.len() and exset[m + 1][split]==d[split]){ m+=1 }
	   s2:=(split+1)%d.len();  # cycle coordinates
	   KdNode(d,split,self.fcn(s2,exset[0,m]),
			  self.fcn(s2,exset[m+1,*]))
         }(0,pts);
      var bounds=_bounds;
   }
   fcn findNearest(k,p){
      fcn(node,target,hr,max_dist_sqd,k){
	 if(not node) return(k.pump(List,0.0), (0.0).MAX, 0); // fake node far away
	 nodes_visited,s,pivot:=1, node.split, node.dom_elt;
	 left_hr,right_hr:=hr.copy(True), hr.copy(True);  // deep-ish copy
	 left_hr.max[s]=right_hr.min[s]=pivot[s];

	 reg nearer_node,  nearer_hr, further_node, further_hr;
	 if(target[s]<=pivot[s]){
	    nearer_node,  nearer_hr  = node.left,  left_hr;
	    further_node, further_hr = node.right, right_hr;
	 }else{
	    nearer_node,  nearer_hr  = node.right, right_hr;
	    further_node, further_hr = node.left,  left_hr;
	 }
	 n1:=self.fcn(nearer_node, target, nearer_hr, max_dist_sqd, k);
	 nearest,dist_sqd:=n1;   // n1 is ( (a,b),distance,#visited )
	 nodes_visited+=n1[NODES_VISITED];

	 if(dist_sqd<max_dist_sqd) max_dist_sqd=dist_sqd;
	 d:=(pivot[s] - target[s]).pow(2);
	 if(d>max_dist_sqd) return(nearest, dist_sqd, nodes_visited);
	 d:=sqd(pivot,target);
	 if(d<dist_sqd) nearest,dist_sqd,max_dist_sqd=pivot,d,dist_sqd;
	 n2:=self.fcn(further_node, target, further_hr, max_dist_sqd,k);
	 nodes_visited+=n2[NODES_VISITED];
	 if(n2[DIST_SQD]<dist_sqd) nearest,dist_sqd=n2;
	 return(nearest, dist_sqd, nodes_visited)
      }(n, p, bounds, (0.0).MAX,k)
   }
   fcn [private] sqd(p1,p2){ // point deltas squared and summed
      p1.zipWith(fcn(a,b){ (a-b).pow(2) }, p2).sum(0.0)
   }
   fcn show_nearest(k, heading, p){
      println(heading,":");
      println("Point:           ",p);
      n:=findNearest(k,p);
      println("Nearest neighbor:", n[NEAREST]);
      println("Distance:        ", n[DIST_SQD].sqrt());
      println("Nodes visited:   ", n[NODES_VISITED], "\n");
   }
}


# find some Kaprekar numbers                              #

# returns TRUE if n is a Kaprekar number, FALSE otherwise #
PROC is kaprekar = ( INT n )BOOL:
     IF n < 1 THEN
         # 0 and -ve numbers are not Kaprekar numbers     #
         FALSE
     ELIF n = 1 THEN
         # 1 is defined to be a Kaprekar number           #
         TRUE
     ELSE
         # n is a Kaprekar number if the digits of its    #
         # square can be partitioned into two numbers     #
         # that sum to n                                  #
         LONG INT  n squared     = LENG n * n;
         LONG INT  power of ten := 10;
         BOOL result            := FALSE;
         WHILE n squared > power of ten AND NOT result DO
             LONG INT left  = n squared OVER power of ten;
             LONG INT right = n squared  MOD power of ten;
             result := ( ( left + right ) = n AND right /= 0 );
             power of ten *:= 10
         OD;
         result
     FI # is kaprekar # ;

# count the number of Kaprekar numbers up to 1 000 000    #
# printing all those below 10 000                         #
INT max number           = 1 000 000;
INT k count             := 0;
[ 1 : 2 ]LONG INT split := ( 0, 0 );
print( ( "Kaprekar numbers below 10 000: ", newline ) );
FOR n TO max number DO
    IF is kaprekar( n ) THEN
        k count +:= 1;
        IF n < 10 000 THEN
            print( ( " ", whole( n, -4 ) ) )
        FI
    FI
OD;
print( ( newline ) );
print( ( "There are ", whole( k count, 0 ), " Kaprekar numbers below ", whole( max number, 0 ), newline ) )


int     Board(8+2+2, 8+2+2);            \board array with borders
int     LegalX, LegalY;                 \arrays of legal moves
def     IntSize=4;                      \number of bytes in an integer (4 or 2)
include c:\cxpl\codes;                  \intrinsic 'code' declarations

func    Try(I, X, Y);                   \Make a tentative move from X,Y
int     I, X, Y;
int     K, U, V;
[for K:= 0 to 8-1 do                    \for all possible moves...
    [U:= X + LegalX(K);                 \U and V are next square
     V:= Y + LegalY(K);
     if Board(U,V) = 0 then             \if square has not been visited then
        [Board(U,V):= I;                \ mark square with sequence number
        if I = 8*8 then return true;
        if Try(I+1, U, V) then return true      \led to solution?
        else Board(U,V):= 0;                    \no, undo tenative move
        ];
    ];
return false;
];      \Try

int  I, J;
[LegalX:= [2, 1, -1, -2, -2, -1, 1, 2];
 LegalY:= [1, 2, 2, 1, -1, -2, -2, -1];

for J:= 0 to 8+2+2-1 do                 \set up surrounding border for speed
    for I:= 0 to 8+2+2-1 do
        Board(I,J):= 1;
for J:= 0 to 8+2+2-1 do                 \reposition Board(0,0) to Board(2,2)
        Board(J):= Board(J) + 2*IntSize;
Board:= Board + 2*IntSize;
for J:= 0 to 8-1 do                     \empty board
    for I:= 0 to 8-1 do
        Board(I,J):= 0;
Text(0, "Starting square (1-8,1-8): ");  I:= IntIn(0)-1;  J:= IntIn(0)-1;
Board(I,J):= 1;                         \starting location is 0,0

if Try(2, I, J) then                    \try to find second square
        [for J:= 0 to 8-1 do            \draw board with knight's move sequence
            [for I:= 0 to 8-1 do
                [if Board(I,J) < 10 then ChOut(0, ^ );
                IntOut(0, Board(I,J));
                ChOut(0, ^ );
                ];
            CrLf(0);
            ];
        ]
else    Text(0, "No Solution.^M^J");
]


:myLabel while (<condition>) { <statement list>}


OnErrorGoto(?ErrorHandler)
OpenConsole()
Gosub label4
Goto label3

label1:
Print("eins ")
Return

label2:
Print("zwei ")
Return

label3:
Print("drei ")

label4:
While i<3
  i+1
  Gosub label1
  Gosub label2
Wend
Print("- ")
i+1
If i<=4 : Return : EndIf
x.i=Val(Input()) : y=1/x
Input()
End

ErrorHandler:
PrintN(ErrorMessage()) : Goto label4


# Example 2: Restarting a loop:
from goto import goto, label
label .start
for i in range(1, 4):
    print i
    if i == 2:
        try:
            output = message
        except NameError:
            print "Oops - forgot to define 'message'!  Start again."
            message = "Hello world"
            goto .start
print output, "\n"


PRINT "First line."
GOSUB sub1
PRINT "Fifth line."
GOTO Ending

sub1:
PRINT "Second line."
GOSUB sub2
PRINT "Fourth line."
RETURN

Ending:
PRINT "We're just about done..."
GOTO Finished

sub2:
PRINT "Third line."
RETURN

Finished:
PRINT "... with goto and gosub, thankfully."
END


' Jumps in QB64 are inherited by Qbasic/ QuickBasic/ GWBasic
' here a GOTO demo  of loops FOR-NEXT and WHILE-WEND

Dim S As String, Q As Integer
Randomize Timer
0:
Locate 1, 1: Print "jump demostration"
Print "Press J to jump to FOR NEXT emulator or"
Print "L to jump to WHILE WEND emulator or"
Print "Q for quitting"
Print
S = UCase$(Input$(1))
Cls , Rnd * 7 + 1: Locate 7
Q = 0
If S = "Q" Then End
If S = "J" Then GoTo 1
If S = "L" Then GoTo 2
GoTo 0

1:
If Q = 0 Then Print "FOR NEXT Loop emulation"
Print " Q = "; Q
Q = Q + 1
If Q < 10 Then
    GoTo 1
Else
    Print "For Next emulation terminated":
    GoTo 0
End If

2:
If Q = 0 Then Print " WHILE WEND emulator"
Print " Q = 9 is ";
If Q = 9 Then
    Print "True"
    Print "WHILE WEND emulator terminated"
    GoTo 0
Else
    Print "False"
End If
Q = Q + 1
GoTo 2


k?: function [n][
    n2: to :string n*n
    loop 0..dec size n2 'i [
        a: (i > 0)? -> to :integer slice n2 0 dec i -> 0
        b: to :integer slice n2 i dec size n2
        if and? b > 0 n = a + b -> return true
    ]
    return false
]

loop 1..10000 'x [
    if k? x -> print x
]


Kaprekar(L) {
    Loop, % L + ( C := 0 ) {
        S := ( N := A_Index ) ** 2
        Loop % StrLen(N) {
            B := ( B := SubStr(S,1+A_Index) ) ? B : 0
            If !B & ( (A := SubStr(S,1,A_Index)) <> 1 )
                Break
            If ( N == A+B ) {
                R .= ", " N , C++
                Break
            }
        }
    }
    Return C " Kaprekar numbers in [1-" L "]:`n" SubStr(R,3)
}


<xsl:package xsl:version="3.0"
  xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
  xmlns:xs="http://www.w3.org/2001/XMLSchema"
  xmlns:fn="http://www.w3.org/2005/xpath-functions"
  xmlns:tour="http://www.seanbdurkin.id.au/tour"
  name="tour:tours">
<xsl:stylesheet>
  <xsl:function name="tour:manufacture-square"
       as="element(square)" visibility="public">
    <xsl:param name="rank" as="xs:integer" />
    <xsl:param name="file" as="xs:integer" />
    <square file="$file" rank="$rank" />
  </xsl:function>

  <xsl:function name="tour:on-board" as="xs:boolean" visibility="public">
    <xsl:param name="rank" as="xs:integer" />
    <xsl:param name="file" as="xs:integer" />
    <xsl:copy-of select="($rank ge 1) and ($rank le 8) and
                         ($file ge 1) and ($file le 8)" />
  </xsl:function>

  <xsl:function name="tour:solve-tour" as="item()*" visibility="public">
    <!-- Solves the tour for any specified piece. -->
    <!-- Outputs either a full solution of 64 squares, of if fail,
         a copy of the $state input. -->
    <xsl:param name="state" as="item()+" />
    <xsl:variable name="compute-possible-moves"
      select="$state[. instance of function(*)]"
      as="function(element(square)) as element(square)*">
    <xsl:variable name="way-points" select="$state/self::square" />
    <xsl:choose>
      <xsl:when test="count($way-points) eq 64">
        <xsl:sequence ="$state" />
      </xsl:when>
      <xsl:otherwise>
        <xsl:sequence select="
      let $try-move := function( $state as item()*, $move as item()) as item()*)
            {
             if $state/self::square[@file=$move/@file]
                                   [@rank=$move/@rank]
               then $state
               else tour:solve-tour( ( $state, $move) )
                },
              $possible-moves := $compute-possible-moves( $way-points[last()])
          return if empty( $possible-moves) then $state
                     else fn:fold-left( $try-move, $state, $possible-moves)" />
      </xsl:otherwise>
    </xsl:choose>
  </xsl:variable></xsl:function>
</xsl:stylesheet>

<xsl:expose component="function"
  names="tour:manufacture-square tour:on-board tour:solve-tour"
  visibility="public" />

</xsl:package>


  [ ]'[ ]do[ ' ]else[ swap of ]do[ ] is jump-into ( n --> )

  5 jump-into
    [ 0 echo 1 echo done
(     0   1  2   3    4       offsets of each item )
(     5   6  7   8    9         from start of nest )
      2 echo 3 echo again ]


#lang racket
(define (never-divides-by-zero return)
  (displayln "I'm here")
  (return "Leaving")
  (displayln "Never going to reach this")
  (/ 1 0))

(call/cc never-divides-by-zero)

;    outputs:
;        I'm here
;        "Leaving"    (because that's what the function returns)


    outer-loop: loop {
        inner-loop: loop {
            # NYI # goto inner-loop if rand > 0.5; # Hard goto
            next inner-loop if rand > 0.5; # Next loop iteration
            redo inner-loop if rand > 0.5; # Re-execute block
            last outer-loop if rand > 0.5; # Exit the loop
            ENTER { say "Entered inner loop block" }
            LEAVE { say "Leaving inner loop block" }
        }
        ENTER { say "Entered outer loop block" }
        LEAVE { say "Leaving outer loop block" }
        LAST  { say "Ending outer loop" }
    }


/*REXX pgm demonstrates various jumps (GOTOs).  In REXX, it's a SIGNAL. */
say 'starting...'
signal aJump
say 'this statement is never executed.'

aJump:  say 'and here we are at aJump.'
                                           do j=1  to 10
                                           say  'j=' j
                                           if j==7 then signal bJump
                                           end  /*j*/
bJump:  say 'and here we are at bJump.'

signal cJump
say 'this statement is never executed.'
                                           do k=1 to 10
                                           say 'k=' k
                                   cJump:  say 'and here we are at cJump.'
                                           exit
                                           end  /*k*/


# syntax: GAWK -f KAPREKAR_NUMBERS.AWK
BEGIN {
    limit = 1000000
    printf("%d\n",1)
    n = 1
    for (i=2; i<limit; i++) {
      squared = sprintf("%.0f",i*i)
      for (j=1; j<=length(squared); j++) {
        L = substr(squared,1,j) + 0
        R = substr(squared,j+1) + 0
        if (R == 0) {
          continue
        }
        if (L + R == i) {
          n++
          if (i <= 10000) {
            printf("%d\n",i)
          }
          break
        }
      }
    }
    printf("%d Kaprekar numbers < %s\n",n,limit)
    exit(0)
}


@echo off
setlocal enabledelayedexpansion

for /l %%i in (1,1,9999) do (
  title Processing - %%i
  call:kaprekar %%i
)

pause>nul
exit /b

:kaprekar
set num=%1
if %num% leq 0 exit /b
set /a num2=%num%*%num%

if %num2% leq 9 (
  if %num2%==%num% (
    echo %num%
    exit /b
  ) else (
    exit /b
  )
)

call:strlength %num2%
set len=%errorlevel%
set /a offset=%len%-1
set tempcount=1

:loop

set /a offset2=%len%-%tempcount%
set numleft=!num2:~0,%tempcount%!
set numright=!num2:~%tempcount%,%offset2%!

for /f "tokens=* delims=0" %%i in ("%numright%") do set "numright=%%i"
if not defined numright exit /b
set /a sum=%numleft%+%numright%

if %sum%==%num% (
  echo %num%
  exit /b
)

if %tempcount%==%len% exit /b
set /a tempcount+=1
goto loop

:strlength
setlocal enabledelayedexpansion
set str=%1
set tempcount=1
:lengthloop
set /a length=%tempcount%-1
if "!str:~%tempcount%,1!"=="" exit /b %tempcount%
set /a tempcount+=1
goto lengthloop


   // Use Warnsdorff's rule to perform a knights tour of a 8x8 board in
   // linear time.
   // See Pohl, Ira (July 1967),
   //   "A method for finding Hamilton paths and Knight's tours"
   //   http://portal.acm.org/citation.cfm?id=363463
   // Uses back tracking as a tie breaker (for the few cases in a 8x8 tour)
class Board{
   var[const]deltas=[[(dx,dy); T(-2,2); T(-1,1); _]].extend(
                    [[(dx,dy); T(-1,1); T(-2,2); _]]);
   fcn init{
      var board=L();
      (0).pump(64,board.append.fpM("1-",Void)); // fill board with Void
   }
   fcn idx(x,y)     { x*8+y }
   fcn isMoveOK(x,y){ (0<=x<8) and (0<=y<8) and Void==board[idx(x,y)] }
   fcn gyrate(x,y,f){   // walk all legal moves from (a,b)
      deltas.pump(List,'wrap([(dx,dy)]){
         x+=dx; y+=dy; if(isMoveOK(x,y)) f(x,y); else Void.Skip
      });
   }
   fcn count(x,y){ n:=Ref(0); gyrate(x,y,n.inc); n.value }
   fcn moves(x,y){ gyrate(x,y,fcn(x,y){ T(x,y,count(x,y)) })}
   fcn knightsTour(x=0,y=0,n=1){  // using Warnsdorff's rule
      board[idx(x,y)]=n;
      while(m:=moves(x,y)){
         min:=m.reduce('wrap(pc,[(_,_,c)]){ (pc<c) and pc or c },9);
	 m=m.filter('wrap([(_,_,c)]){ c==min });  // moves with same min moves
	 if(m.len()>1){ // tie breaker time, may need to backtrack
	    bs:=board.copy();
	    if (64==m.pump(Void,'wrap([(a,b)]){
	       board[idx(a,b)]=n;
	       n2:=knightsTour(a,b,n+1);
	       if (n2==64) return(Void.Stop,n2); // found a solution
	       board=bs.copy();
	    })) return(64);
	    return(0);
         }
	 else{
	    x,y=m[0]; n+=1;
	    board[idx(x,y)]=n;
	 }
      } //while
      return(n);
   }
   fcn toString{ board.pump(String,T(Void.Read,7),
         fcn(ns){ vm.arglist.apply("%2s".fmt).concat(",")+"\n" });
   }
}


. "The label 'touch' is used to let the player touch the robot"
. "to execute the following"
end
: "touch"
goto "label_b"

: "label_a"
* "Label A was reached"
end

: "label_b"
* "Label B was reached"
end


require 'continuation' unless defined? Continuation

if a = callcc { |c| [c, 1] }
  c, i = a
  c[nil] if i > 100

  case 0
  when i % 3
    print "Fizz"
    case 0
    when i % 5
      print "Buzz"
    end
  when i % 5
    print "Buzz"
  else
    print i
  end

  puts
  c[c, i + 1]
end


Public Sub jump()
    Debug.Print "VBA only allows"
    GoTo 1
    Debug.Print "no global jumps"
1:
    Debug.Print "jumps in procedures with GoTo"
    Debug.Print "However,"
    On 2 GoSub one, two
    Debug.Print "named in the list after 'GoSub'"
    Debug.Print "and execution will continue on the next line"
    On 1 GoTo one, two
    Debug.Print "For On Error, see Exceptions"
one:
    Debug.Print "On <n> GoTo let you jump to the n-th label"
    Debug.Print "and won't let you continue."
    Exit Sub
two:
    Debug.Print "On <n> GoSub let you jump to the n-th label": Return
End Sub


n = 0
for i = 1 to 1999999
	if Kaprekar(i) then
		n = n + 1
		if i < 100001 then print n; ": "; i
	endif
next i
print
print "Total de números de Kaprekar por debajo de 1.000.000 = "; n
end

function Kaprekar(n)
	s = n ^ 2
	t = 10 ^ (int(log(s)) + 1)
	do
		t = t / 10
		if t <= n then exit do #break
		if s-n = int(s/t)*(t-1) then return TRUE
	until t <= n
	return n = 1
end function


      *FLOAT 64
      n% = 0
      FOR i% = 1 TO 999999
        IF FNkaprekar(i%) THEN
          n% += 1
          IF i% < 100001PRINT ; n% ":", i%
        ENDIF
      NEXT
      PRINT "Total Kaprekar numbers under 1,000,000 = "; n%
      END

      DEF FNkaprekar(n)
      LOCAL s, t
      s = n^2
      t = 10^(INT(LOG(s)) + 1)
      REPEAT
        t /= 10
        IF t<=n EXIT REPEAT
        IF s-n = INT(s/t)*(t-1) THEN = TRUE
      UNTIL FALSE
      = (n=1)


var func = Fn.new {
    for (i in 1..10) {
        if (i == 1) continue // jumps to next iteration when 'i' equals 1
        System.print("i = %(i)")
        if (i > 4) break     // exits the loop when 'i' exceeds 4
    }
    for (j in 1..10) {
        System.print("j = %(j)")
        if (j == 3) return   // returns from the function when 'j' exceeds 3
    }
}

var fiber = Fiber.new {
    System.print("starting")
    Fiber.yield()            // yields control back to the calling fiber
    System.print("resuming") // resumes here when called again
    Fiber.abort("aborting")  // aborts the script
}

func.call()                  // calls the function
fiber.call()                 // calls the fiber
System.print("yielding")
fiber.call()                 // resumes the fiber
return                       // would exit the module (and script) without error but won't be reached


print "First line."
gosub sub1
print "Fifth line."
goto Ending

sub1:
print "Second line."
gosub sub2
print "Fourth line."
return

Ending:
print "We're just about done..."
goto Finished

sub2:
print "Third line."
return

Finished:
print "... with goto and gosub, thankfully."
end


kaprekar = { limit |
  results = []

  1.to limit, { num |
    true? num == 1
    { results << 1 }
    {
      sqr = (num ^ 2).to_s

      0.to (sqr.length - 1) { i |
        lhs = sqr[0,i].to_i
        rhs = sqr[i + 1,-1].to_i

        true? (rhs > 0) && { lhs + rhs == num }
        { results << num }
      }
    }
  }

  results
}

p "Kaprekar numbers below 10,000:"
p kaprekar 10000

p "Number of Kaprekar numbers below 1,000,000:"
p kaprekar(1000000).length


#include <stdio.h>
#include <stdint.h>
typedef uint64_t ulong;

int kaprekar(ulong n, int base)
{
	ulong nn = n * n, r, tens = 1;

	if ((nn - n) % (base - 1)) return 0;

	while (tens < n) tens *= base;
	if (n == tens) return 1 == n;

	while ((r = nn % tens) < n) {
		if (nn / tens + r == n) return tens;
		tens *= base;
	}

	return 0;
}

void print_num(ulong n, int base)
{
	ulong q, div = base;

	while (div < n) div *= base;
	while (n && (div /= base)) {
		q = n / div;
		if (q < 10)     putchar(q + '0');
		else            putchar(q + 'a' - 10);
		n -= q * div;
	}
}

int main()
{
	ulong i, tens;
	int cnt = 0;
	int base = 10;

	printf("base 10:\n");
	for (i = 1; i < 1000000; i++)
		if (kaprekar(i, base))
			printf("%3d: %llu\n", ++cnt, i);

	base = 17;
	printf("\nbase %d:\n  1: 1\n", base);
	for (i = 2, cnt = 1; i < 1000000; i++)
		if ((tens = kaprekar(i, base))) {
			printf("%3d: %llu", ++cnt, i);
			printf(" \t"); print_num(i, base);
			printf("\t");  print_num(i * i, base);
			printf("\t");  print_num(i * i / tens, base);
			printf(" + "); print_num(i * i % tens, base);
			printf("\n");
		}

	return 0;
}


and &01 ;returns 0 if the accumulator is even and 1 if odd. Also sets the zero flag accordingly.
jr z,SkipOddCode
   ;whatever you want to do when the accumulator is odd goes here, but it must be 127 bytes or fewer.
SkipOddCode:
   ;rest of program


using System;
using System.Collections.Generic;

public class KaprekarNumbers {

    /// <summary>
    /// The entry point of the program, where the program control starts and ends.
    /// </summary>
    public static void Main() {
        int count = 0;

        foreach ( ulong i in _kaprekarGenerator(999999) ) {
            Console.WriteLine(i);
            count++;
        }

        Console.WriteLine("There are {0} Kaprekar numbers less than 1000000.", count);
    }

    /// <summary>
    /// Generator function which generates the Kaprekar numbers.
    /// </summary>
    /// <returns>The generator.</returns>
    /// <param name="max">The maximum value of the numbers generated.</param>
    private static IEnumerable<ulong> _kaprekarGenerator(ulong max) {

        ulong next = 1;

        // 1 is always a Kaprekar number.
        yield return next;

        for ( next = 2; next <= max; next++ ) {

            ulong square = next * next;

            for ( ulong check = 10; check <= 10000000000000000000; check *= 10 ) {
                // Check the square against each power of 10 from 10^1 to 10^19 (highest which can be
                // represented by a ulong)

                // If the power of 10 to be checked against is greater than or equal to the square, stop checking
                if ( square <= check )
                    break;

                // Given a power of 10 as 10^n, the remainder when dividing the square number by that power
                // of 10 is equal to the last n digits of the number (starting from the right) and the
                // quotient gives the remaining digits.
                // If the last n digits are all zeroes, then the remainder will be zero, which is not
                // accepted.

                ulong r = square % check;
                ulong q = (square - r) / check;

                if ( r != 0 && q + r == next ) {
                    yield return next;
                    break;
                }
            }

        }

    }

}


#include <vector>
#include <string>
#include <iostream>
#include <sstream>
#include <algorithm>
#include <iterator>
#include <utility>

long string2long( const std::string & s ) {
   long result ;
   std::istringstream( s ) >> result ;
   return result ;
}

bool isKaprekar( long number ) {
   long long squarenumber = ((long long)number) * number ;
   std::ostringstream numberbuf ;
   numberbuf << squarenumber ;
   std::string numberstring = numberbuf.str( ) ;
   for ( int i = 0 ; i < numberstring.length( ) ; i++ ) {
      std::string firstpart = numberstring.substr( 0 , i ) ,
                  secondpart = numberstring.substr( i ) ;
      //we do not accept figures ending in a sequence of zeroes
      if ( secondpart.find_first_not_of( "0" ) == std::string::npos ) {
	 return false ;
      }
      if ( string2long( firstpart ) + string2long( secondpart ) == number ) {
	 return true ;
      }
   }
   return false ;
}

int main( ) {
   std::vector<long> kaprekarnumbers ;
   kaprekarnumbers.push_back( 1 ) ;
   for ( int i = 2 ; i < 1000001 ; i++ ) {
      if ( isKaprekar( i ) )
	 kaprekarnumbers.push_back( i ) ;
   }
   std::vector<long>::const_iterator svi = kaprekarnumbers.begin( ) ;
   std::cout << "Kaprekar numbers up to 10000: \n" ;
   while ( *svi < 10000 ) {
      std::cout << *svi << " " ;
      svi++ ;
   }
   std::cout << '\n' ;
   std::cout << "All the Kaprekar numbers up to 1000000 :\n" ;
   std::copy( kaprekarnumbers.begin( ) , kaprekarnumbers.end( ) ,
	 std::ostream_iterator<long>( std::cout , "\n" ) ) ;
   std::cout << "There are " << kaprekarnumbers.size( )
      << " Kaprekar numbers less than one million!\n" ;
   return 0 ;
}


% This program assumes a 64-bit system.
% On a 32-bit system, the main task (show Kaprekar numbers < 10,000)
% will run correctly, but the extra credit part will crash with
% an overflow exception.

% Yield all positive splits of a number
splits = iter (n, base: int) yields (int,int)
    step: int := base
    while n >= step do
        left: int := n / step
        right: int := n // step
        if left ~= 0 & right ~= 0 then
            yield(left, right)
        end
        step := step * base
    end
end splits

% Check whether a number is a Kaprekar number, and if so,
% return the proper split.
kap_split = struct[left, right: int]
maybe_kap = oneof[yes: kap_split, no: null]
kaprekar = proc (n, base: int) returns (maybe_kap)
    for left, right: int in splits(n**2, base) do
        if left + right = n then
            return(maybe_kap$make_yes(
                kap_split${left:left, right:right}))
        end
    end
    return(maybe_kap$make_no(nil))
end kaprekar

% Format a number in a given base
to_base = proc (n, base: int) returns (string)
    own digits: string := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    if n=0 then return("0") end
    ds: array[char] := array[char]$[]
    while n>0 do
        array[char]$addl(ds,digits[n // base + 1])
        n := n / base
    end
    return(string$ac2s(ds))
end to_base

% If a number is a Kaprekar number, show it, its square, and the split
display = proc (o: stream, n, base: int)
    tagcase kaprekar(n, base)
        tag yes (s: kap_split):
            stream$putright(o, to_base(n, 10), 6)
            if base ~= 10 then
                stream$putright(o, to_base(n, base), 7)
            end
            stream$putright(o, to_base(n**2, base), 13)
            stream$putl(o, "  " ||
                        to_base(s.left, base) || " + " ||
                        to_base(s.right, base))
       tag no:
    end
end display

start_up = proc ()
    po: stream := stream$primary_output()

    % Find and output all the Kaprekar numbers under 10,000.
    stream$putl(po, "Kaprekar numbers < 10,000:")
    for i: int in int$from_to(1, 9999) do
        display(po, i, 10)
    end

    % Count all the Kaprekar numbers under 1,000,000.
    kaps: int := 0
    for i: int in int$from_to(1, 999999) do
        tagcase kaprekar(i, 10)
            tag yes (s: kap_split): kaps := kaps + 1
            tag no:
        end
    end
    stream$putl(po, "\nThere are " || int$unparse(kaps) ||
                " Kaprekar numbers under 1,000,000.\n")

    % Find and output all base-17 Kaprekar numbers under 1,000,000.
    stream$putl(po, "Base-17 Kaprekar numbers < 1,000,000:")
    for i: int in int$from_to(1, 999999) do
        display(po, i, 17)
    end
end start_up


splitAt = (str, idx) ->
    ans = [ str.substring(0, idx), str.substring(idx) ]
    if ans[0] == ""
        ans[0] = "0"
    ans

getKaprekarParts = (longValue, sqrStr, base) ->
    for j in [ 0 .. sqrStr.length / 2 ]
        parts = splitAt(sqrStr, j)
        nums = (parseInt(n, base) for n in parts)

        # if the right part is all zeroes, then it will be forever, so break
        if nums[1] == 0
            return null
        if nums[0] + nums[1] == longValue
            return parts
    null

base = 10
count = 0
max = 1000000
for i in [1..max]
    i2 = i * i
    s = i2.toString(base)
    p = getKaprekarParts i, s, base
    if p
        console.log i, i.toString(base), s, p.join '+'
        count++
console.log "#{count} Kaprekar numbers < #{max} (base 10) in base #{base}"


;; make an infinite list whose accumulated sums give all
;; numbers n where n mod (base - 1) == n^2 mod (base - 1)
(defun res-list (base)
    (let* ((b (- base 1))
           (l (remove-if-not
		    (lambda (x) (= (rem x b) (rem (* x x) b)))
		    (loop for x from 0 below b collect x)))
	   (ret (append l (list b)))
	   (cycle (mapcar #'- (cdr ret) ret)))
	(setf (cdr (last cycle)) cycle)))

(defun kaprekar-p (n &optional (base 10))
   "tests if n is kaprekar in base; if so, return left and right half"
   (let ((nn (* n n)) (tens 1))
	; Find a start value for base power.  nn/tens + (nn mod tens) == n
	; can't be sastified if tens <= n: nn/tens = n * n / tens > n
	(loop while (< tens n) do
	      (setf tens (* tens base)))
	(if (= tens n)  ; n a power of base, can't be a solution except 1
	    (if (= n 1) (values T 0 1))
	    (loop
	       (let ((left (truncate nn tens)) (right (mod nn tens)))
		    (cond ((>= right n) (return nil))
			  ((= n (+ left right)) (return (values T left right))))
		    (setf tens (* base tens)))))))

(defun ktest (top &optional (base 10))
   (format t "   #    Value     Left    Right       Squared (base ~D)~%" base)
   (let ((fmt (format nil "~~4D ~~~D,8R ~~~D,8R ~~~D,8R ~~~D,13R~~%"
                      base base base base base))
	 (res (res-list base))
	 (n 0))
   	 (loop with cnt = 0 while (<= n top) do
	 	(setf n (+ n (car res)))
		(setf res (cdr res))
	 	(multiple-value-bind (k l r) (kaprekar-p n base)
		   (when k (format t fmt (incf cnt) n l r (* n n)))))))

(ktest 1000000)
(terpri)
(ktest 1000000 17)


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

bool isKaprekar(in long n) pure /*nothrow*/ @safe
in {
    assert(n > 0, "isKaprekar(n) is defined for n > 0.");
} body {
    if (n == 1)
        return true;
    immutable sn = text(n ^^ 2);

    foreach (immutable i; 1 .. sn.length) {
        immutable a = sn[0 .. i].to!long;
        immutable b = sn[i .. $].to!long;
        if (b && a + b == n)
            return true;
    }

    return false;
}

void main() {
    iota(1, 10_000).filter!isKaprekar.writeln;
    iota(1, 1_000_000).count!isKaprekar.writeln;
}


defmodule KaprekarNumber do
  def check(n), do: check(n, 10)

  def check(1,_base), do: {"1", ""}
  def check(n, base) when rem(n*(n-1), (base-1)) != 0, do: false      # casting out nine
  def check(n, base) do
    square = Integer.to_string(n*n, base)
    check(n, base, square, 1, String.length(square)-1)
  end

  defp check(_, _, _, _, 0), do: false
  defp check(n, base, square, i, remainder) do
    {a, b} = String.split_at(square, i)
    if String.to_integer(b, base) == 0 do
      false
    else
      sum = String.to_integer(a, base) + String.to_integer(b, base)
      if n == sum, do: {a, b}, else: check(n, base, square, i+1, remainder-1)
    end
  end
end

Enum.each(1..9_999, fn n ->
  if result = KaprekarNumber.check(n) do
    {a, b} = result
    :io.fwrite "~6w  ~8s  ~s + ~s~n", [n, a<>b, a, b]
  end
end)

# Extra credit
count = Enum.reduce(1..999_999, 0, fn n,acc ->
  if KaprekarNumber.check(n), do: acc + 1, else: acc
end)
IO.puts "\n#{count} kaprekar numbers under 1,000,000"

# Extra extra credit
base = 17
IO.puts "\nbase #{base} kaprekar numbers under 1,000,000(base10)"
Enum.each(1..999_999, fn n ->
  if result = KaprekarNumber.check(n, base) do
    {a, b} = result
    :io.fwrite "~7w  ~5s  ~9s  ~s + ~s~n", [n, Integer.to_string(n,base), a<>b, a, b]
  end
end)


-mode(compile).
-import(lists, [seq/2]).

kaprekar(1) -> true;
kaprekar(N) when N < 1 -> false;
kaprekar(N) ->
    Sq = N*N,
    if
        (N rem 9) =/= (Sq rem 9) -> false;
        true -> kaprekar(N, Sq, 10)
    end.

kaprekar(_, Sq,  M) when (Sq div M) =:= 0 -> false;
kaprekar(N, Sq, M) ->
    L = Sq div M,
    R = Sq rem M,
    if
        R =/= 0 andalso (L + R) =:= N -> true;
        true -> kaprekar(N, Sq, M * 10)
    end.

main(_) ->
    Numbers = [N || N <- seq(1, 9999), kaprekar(N)],
    io:format("The Kaprekar numbers < 10,000 are ~p~n", [Numbers]),

    CountTo1e6 = length(Numbers) + length([N || N <- seq(10001, 999999), kaprekar(N)]),
    io:format("There are ~p Kaprekar numbers < 1,000,000", [CountTo1e6]).