bsd = tail . iterate (\n -> (n * 1103515245 + 12345) `mod` 2^31)
msr = map (`div` 2^16) . tail . iterate (\n -> (214013 * n + 2531011) `mod` 2^31)

main = do
	print $ take 10 $ bsd 0 -- can take seeds other than 0, of course
	print $ take 10 $ msr 0


link printf

procedure main()
   printf("       BSD        MS\n")
   every 1 to 10 do
      printf("%10s %10s\n",rand_BSD(),rand_MS())
end

procedure srand_BSD(x)             #: seed random
static seed
   return seed := \x | \seed | 0   # parm or seed or zero if none
end

procedure rand_BSD()               #: lcrng
   return srand_BSD((1103515245 * srand_BSD() + 12345) % 2147483648)
end

procedure srand_MS(x)              #: seed random
static seed
   return seed := \x | \seed | 0   # parm or seed or zero if none
end

procedure rand_MS()                #: lcrng
   return ishift(srand_MS((214013 * srand_MS() + 2531011) % 2147483648),-16)
end


void main() {
    import std.stdio, std.algorithm;

    immutable s1 = "rosettacode";
    immutable s2 = "raisethysword";

    string s1b, s2b;
    size_t pos1, pos2;

    foreach (immutable c; levenshteinDistanceAndPath(s1, s2)[1]) {
        final switch (c) with (EditOp) {
            case none, substitute:
                s1b ~= s1[pos1++];
                s2b ~= s2[pos2++];
                break;
            case insert:
                s1b ~= "_";
                s2b ~= s2[pos2++];
                break;
            case remove:
                s1b ~= s1[pos1++];
                s2b ~= "_";
                break;
        }
    }

    writeln(s1b, "\n", s2b);
}


distance (source, target: STRING): INTEGER
		-- Minimum number of operations to turn `source' into `target'.
	local
		l_distance: ARRAY2 [INTEGER]
		del, ins, subst: INTEGER
	do
		create l_distance.make (source.count, target.count)
		⟳ ic:(1 |..| source.count) ¦ l_distance [ic, 1] := ic - 1 ⟲
		⟳ ij:(1 |..| target.count) ¦ l_distance [1, ij] := ij - 1 ⟲

		⟳ ic:(2 |..| source.count) ¦
			⟳ jc:(2 |..| target.count) ¦
				if source [ic] = target [jc] then			-- same char
					l_distance [ic, jc] := l_distance [ic - 1, jc - 1]
				else							-- diff char
					del := l_distance [ic - 1, jc]			-- delete?
					ins := l_distance [ic, jc - 1]			-- insert?
					subst := l_distance [ic - 1, jc -1]		-- substitute/swap?
					l_distance [ic, jc] := del.min (ins.min (subst)) + 1
				end
			⟲
		⟲
		Result:= l_distance [source.count, target.count]
	end


package main

import (
    "fmt"

    "github.com/biogo/biogo/align"
    ab "github.com/biogo/biogo/alphabet"
    "github.com/biogo/biogo/feat"
    "github.com/biogo/biogo/seq/linear"
)

func main() {
    // Alphabets for things like DNA are predefined in biogo, but we
    // define our own here.
    lc := ab.Must(ab.NewAlphabet("-abcdefghijklmnopqrstuvwxyz",
        feat.Undefined, '-', 0, true))
    // Construct scoring matrix for Needleman-Wunch algorithm.
    // We leave zeros on the diagonal for the Levenshtein distance of an
    // exact match and put -1s everywhere else for the Levenshtein distance
    // of an edit.
    nw := make(align.NW, lc.Len())
    for i := range nw {
        r := make([]int, lc.Len())
        nw[i] = r
        for j := range r {
            if j != i {
                r[j] = -1
            }
        }
    }
    // define input sequences
    a := &linear.Seq{Seq: ab.BytesToLetters([]byte("rosettacode"))}
    a.Alpha = lc
    b := &linear.Seq{Seq: ab.BytesToLetters([]byte("raisethysword"))}
    b.Alpha = lc
    // perform alignment
    aln, err := nw.Align(a, b)
    // format and display result
    if err != nil {
        fmt.Println(err)
        return
    }
    fa := align.Format(a, b, aln, '-')
    fmt.Printf("%s\n%s\n", fa[0], fa[1])
    aa := fmt.Sprint(fa[0])
    ba := fmt.Sprint(fa[1])
    ma := make([]byte, len(aa))
    for i := range ma {
        if aa[i] == ba[i] {
            ma[i] = ' '
        } else {
            ma[i] = '|'
        }
    }
    fmt.Println(string(ma))
}


Addbags[configs_List] :=
 DeleteDuplicates[
  Map[LexicographicSort,
   Catenate[AddbagAll /@ configs], \[Infinity]]]
AddbagAll[config_] :=
 Addbag[config, #] & /@ Position[config, bag[___], \[Infinity]]
Addbag[config_, pos_] :=
 ReplacePart[config, pos -> Append[Extract[config, pos], bag[]]]
With[{n = 5}, Nest[Addbags, {cabinet[bag[]]}, n - 1] // Column]


import os, strformat, strutils

type
  Tree = int
  Trees = object
    list: seq[Tree]
    offsets: array[32, int]

func isOdd(n: int): bool = (n and 1) != 0

func append(trees: var Trees; tree: Tree) =
  trees.list.add(1 or tree shl 1)

proc show(tree: Tree; n: int) =
  var tree = tree
  var n = n
  while n > 0:
    dec n
    stdout.write if tree.isOdd: '(' else: ')'
    tree = tree shr 1
  stdout.write '\n'

proc print(trees: Trees; n: int) =
  for i in trees.offsets[n]..<trees.offsets[n + 1]:
    trees.list[i].show(n * 2)

#[ Assemble tree from subtrees
	 n:   length of tree we want to make
	 t:   assembled parts so far
	 sl:  length of subtree we are looking at
	 pos: offset of subtree we are looking at
	 rem: remaining length to be put together
]#

func assemble(trees: var Trees; n: int; t: Tree; sl, pos, rem: int) =

  if rem == 0:
    trees.append(t)
    return

  var p = pos
  var s = sl

  if s > rem:
    s = rem
    p = trees.offsets[s]
  elif p >= trees.offsets[s + 1]:
    # Used up sl-trees, try smaller ones.
    dec s
    if s == 0: return
    p = trees.offsets[s]

  trees.assemble(n, t shl ( 2 * s) or trees.list[p], s, p, rem - s)
  trees.assemble(n, t, s, p + 1, rem)

func make(trees: var Trees; n: int) =
  if trees.offsets[n + 1] != 0: return
  if n > 0: trees.make(n - 1)
  trees.assemble(n, 0, n - 1, trees.offsets[n - 1], n - 1)
  trees.offsets[n + 1] = trees.list.len

when isMainModule:

  if paramCount() != 1:
    raise newException(ValueError, "there must be exactly one command line argument")
  let n = try:
            paramStr(1).parseInt()
          except ValueError:
            raise newException(ValueError, "argument is not a valid number")
  # Insure "n" is limited to 12 to avoid overflowing default stack.
  if n notin 1..12:
    raise newException(ValueError, "argument must be between 1 and 12")

  # Init 1-tree.
  var trees: Trees
  trees.offsets[1] = 1
  trees.append(0)

  trees.make(n)
  echo &"Number of {n}-trees: {trees.offsets[n + 1] - trees.offsets[n]}"
  trees.print(n)


use strict;
use warnings;
use feature 'say';

sub bagchain {
    my($x, $n, $bb, $start) = @_;
    return [@$x] unless $n;

    my @sets;
    $start //= 0;
    for my $i ($start .. @$bb-1) {
        my($c, $s) = @{$$bb[$i]};
        push @sets, bagchain([$$x[0] + $c, $$x[1] . $s], $n-$c, $bb, $i) if $c <= $n
    }
    @sets
}

sub bags {
    my($n) = @_;
    return [0, ''] unless $n;

    my(@upto,@sets);
    push @upto, bags($_) for reverse 1 .. $n-1;
    for ( bagchain([0, ''], $n-1, \@upto) ) {
        my($c,$s) = @$_;
        push @sets, [$c+1, '(' . $s . ')']
    }
    @sets;
}

sub replace_brackets {
    my $bags;
    my $depth = 0;
    for my $b (split //, $_[0]) {
        if ($b eq '(') { $bags .= (qw<( [ {>)[$depth++ % 3] }
        else           { $bags .= (qw<) ] }>)[--$depth % 3] }
    }
    $bags
}

say replace_brackets $$_[1] for bags(5);


import java.util.stream.IntStream;
import static java.util.stream.IntStream.iterate;

public class LinearCongruentialGenerator {
    final static int mask = (1 << 31) - 1;

    public static void main(String[] args) {
        System.out.println("BSD:");
        randBSD(0).limit(10).forEach(System.out::println);

        System.out.println("\nMS:");
        randMS(0).limit(10).forEach(System.out::println);
    }

    static IntStream randBSD(int seed) {
        return iterate(seed, s -> (s * 1_103_515_245 + 12_345) & mask).skip(1);
    }

    static IntStream randMS(int seed) {
        return iterate(seed, s -> (s * 214_013 + 2_531_011) & mask).skip(1)
                .map(i -> i >> 16);
    }
}


# 15-bit integers generated using the same formula as rand()
# from the Microsoft C Runtime.
# Input: [ count, state, rand ]
def next_rand_Microsoft:
  .[0] as $count | .[1] as $state
  | ( (214013 * $state) + 2531011) % 2147483648 # mod 2^31
  | [$count+1 , ., (. / 65536 | floor) ];

# Generate the first n pseudo-random numbers:
def rand_Microsoft(seed; n):
  [0,seed]
  | next_rand_Microsoft  # the seed is not so random
  | recurse(if .[0] < n then next_rand_Microsoft else empty end)
  | .[2];


using Printf

function getlgc(r::Integer, a::Integer, c::Integer, m::Integer, sh::Integer)
    state = r
    return function lgcrand()
        state = mod(a * state + c, m)
        return state >> sh
    end
end

seed, nrep = 0, 10
bsdrand = getlgc(seed, 1103515245, 12345, 2 ^ 31, 0)

println("The first $nrep results for a BSD rand seeded with $seed:")
for _ in 1:nrep
    @printf("%14d\n", bsdrand())
end

msrand = getlgc(seed, 214013, 2531011, 2 ^ 31, 16)

println("\nThe first $nrep results for a M\$ rand seeded with $seed:")
for _ in 1:nrep
    @printf("%14d\n", msrand())
end


costs :: String -> String -> [[Int]]
costs s1 s2 = reverse $ reverse <$> matrix
  where
    matrix = scanl transform [0 .. length s1] s2
    transform ns@(n:ns1) c = scanl calc (n + 1) $ zip3 s1 ns ns1
      where
        calc z (c1, x, y) = minimum [ y + 1, z + 1
                                    , x + fromEnum (c1 /= c)]

levenshteinDistance :: String -> String -> Int
levenshteinDistance s1 s2 = head.head $ costs s1 s2


public class LevenshteinAlignment {

    public static String[] alignment(String a, String b) {
        a = a.toLowerCase();
        b = b.toLowerCase();
        // i == 0
        int[][] costs = new int[a.length()+1][b.length()+1];
        for (int j = 0; j <= b.length(); j++)
            costs[0][j] = j;
        for (int i = 1; i <= a.length(); i++) {
            costs[i][0] = i;
            for (int j = 1; j <= b.length(); j++) {
                costs[i][j] = Math.min(1 + Math.min(costs[i-1][j], costs[i][j-1]), a.charAt(i - 1) == b.charAt(j - 1) ? costs[i-1][j-1] : costs[i-1][j-1] + 1);
            }
        }

	// walk back through matrix to figure out path
	StringBuilder aPathRev = new StringBuilder();
	StringBuilder bPathRev = new StringBuilder();
	for (int i = a.length(), j = b.length(); i != 0 && j != 0; ) {
	    if (costs[i][j] == (a.charAt(i - 1) == b.charAt(j - 1) ? costs[i-1][j-1] : costs[i-1][j-1] + 1)) {
		aPathRev.append(a.charAt(--i));
		bPathRev.append(b.charAt(--j));
	    } else if (costs[i][j] == 1 + costs[i-1][j]) {
		aPathRev.append(a.charAt(--i));
		bPathRev.append('-');
	    } else if (costs[i][j] == 1 + costs[i][j-1]) {
		aPathRev.append('-');
		bPathRev.append(b.charAt(--j));
	    }
	}
        return new String[]{aPathRev.reverse().toString(), bPathRev.reverse().toString()};
    }

    public static void main(String[] args) {
	String[] result = alignment("rosettacode", "raisethysword");
	System.out.println(result[0]);
	System.out.println(result[1]);
    }
}


with javascript_semantics
atom t0 = time()
sequence list = {1},
         offset = repeat(0,32)
         offset[1..2] = 1

function show(integer t, l)
    string res = repeat('?',l)
    integer level = 0
    for i=l to 1 by -1 do
        integer r2 = remainder(t,2)
        res[i] = "[}(]{)"[mod(level-r2,6)+1]
        level += r2*4-2
        t = floor(t/2)
    end for
    if level!=0 then ?9/0 end if
    return res
end function

procedure listTrees(integer n)
    for i:=offset[n+1]+1 to offset[n+2] do
        printf(1,"%s\n",{show(list[i], n*2)})
    end for
end procedure

procedure assemble(atom t, integer n, sl, pos, rem)
--
-- assemble tree from subtrees
--  t:   assembled parts so far
--  n:   length of tree we want to make
--  sl:  length of subtree we are looking at
--  pos: offset of subtree we are looking at
--  rem: remaining length to be put together
--
    if rem == 0 then
        list = append(list, t*2+1)
    else
        if sl>rem then -- need smaller sub-trees
            sl = rem
            pos = offset[sl+1]
        elsif pos>=offset[sl+2] then
            -- used up sl-trees, try smaller ones
            if sl == 1 then return end if
            pos = offset[sl]
            sl -= 1
        end if

        atom u = or_bits(t*power(2,2*sl),list[pos+1])
        assemble(u, n, sl, pos, rem-sl)
        assemble(t, n, sl, pos+1, rem)
    end if
end procedure

procedure mktrees(integer n)
    if offset[n+2]=0 then
        if n>0 then
            mktrees(n - 1)
        end if
        assemble(0, n, n-1, offset[n], n-1)
        offset[n+2] = length(list)
    end if
end procedure

procedure main(integer n)
    mktrees(n)
    atom nt = offset[n+2]-offset[n+1],
         td = time()-t0
    string e = iff(td>0.1?" ("&elapsed(td)&")":"")
    printf(1,"Number of %d-trees: %,d%s\n", {n, nt, e})
    if n<=5 then listTrees(n) end if
end procedure
for i=0 to iff(platform()=JS?12:20) do
    main(i)
end for


// version 1.1.3

class Lcg(val a: Long, val c: Long, val m: Long, val d: Long, val s: Long) {
    private var state = s

    fun nextInt(): Long {
        state = (a * state + c) % m
        return state / d
    }
}

fun main(args: Array<String>) {
    println("First 10 BSD random numbers - seed 0")
    val bsd = Lcg(1103515245, 12345, 1 shl 31, 1, 0)
    for (i in 1..10) println("${bsd.nextInt()}")
    println("\nFirst 10 MSC random numbers - seed 0")
    val msc = Lcg(214013, 2531011, 1 shl 31, 1 shl 16, 0)
    for (i in 1..10) println("${msc.nextInt()}")
}


'by default these are 0
global BSDState
global MSState

for i = 1 to 10
    print randBSD()
next i

print

for i = 1 to 10
    print randMS()
next i

function randBSD()
    randBSD = (1103515245 * BSDState + 12345) mod (2 ^ 31)
    BSDState = randBSD
end function

function randMS()
    MSState = (214013 * MSState + 2531011) mod (2 ^ 31)
    randMS = int(MSState / 2 ^ 16)
end function


function levenshteinalign(a::AbstractString, b::AbstractString)
    a = lowercase(a)
    b = lowercase(b)
    len_a = length(a)
    len_b = length(b)

    costs = Matrix{Int}(len_a + 1, len_b + 1)
    costs[1, :] .= 0:len_b
    @inbounds for i in 2:(len_a + 1)
        costs[i, 1] = i
        for j in 2:(len_b + 1)
            tmp = ifelse(a[i-1] == b[j-1], costs[i-1, j-1], costs[i-1, j-1] + 1)
            costs[i, j] = min(1 + min(costs[i-1, j], costs[i, j-1]), tmp)
        end
    end

    apathrev = IOBuffer()
    bpathrev = IOBuffer()
    local i = len_a + 1
    local j = len_b + 1
    @inbounds while i != 1 && j != 1
        tmp = ifelse(a[i-1] == b[j-1], costs[i-1, j-1], costs[i-1, j-1] + 1)
        if costs[i, j] == tmp
            i -= 1
            j -= 1
            print(apathrev, a[i])
            print(bpathrev, b[j])
        elseif costs[i, j] == 1 + costs[i-1, j]
            i -= 1
            print(apathrev, a[i])
            print(bpathrev, '-')
        elseif costs[i, j] == 1 + costs[i, j-1]
            j -= 1
            print(apathrev, '-')
            print(bpathrev, b[j])
        end
    end

    return reverse(String(take!(apathrev))), reverse(String(take!(bpathrev)))
end

foreach(println, levenshteinalign("rosettacode", "raisethysword"))
foreach(println, levenshteinalign("place", "palace"))


// version 1.1.3

fun levenshteinAlign(a: String, b: String): Array<String> {
    val aa = a.toLowerCase()
    val bb = b.toLowerCase()
    val costs = Array(a.length + 1) { IntArray(b.length + 1) }
    for (j in 0..b.length) costs[0][j] = j
    for (i in 1..a.length) {
        costs[i][0] = i
        for (j in 1..b.length) {
            val temp = costs[i - 1][j - 1] + (if (aa[i - 1] == bb[j - 1]) 0 else 1)
            costs[i][j] = minOf(1 + minOf(costs[i - 1][j], costs[i][j - 1]), temp)
        }
    }

    // walk back through matrix to figure out path
    val aPathRev = StringBuilder()
    val bPathRev = StringBuilder()
    var i = a.length
    var j = b.length
    while (i != 0 && j != 0) {
        val temp = costs[i - 1][j - 1] + (if (aa[i - 1] == bb[j - 1]) 0 else 1)
        when (costs[i][j]) {
            temp -> {
                aPathRev.append(aa[--i])
                bPathRev.append(bb[--j])
            }

            1 + costs[i-1][j] -> {
                aPathRev.append(aa[--i])
                bPathRev.append('-')
            }

            1 + costs[i][j-1] -> {
                aPathRev.append('-')
                bPathRev.append(bb[--j])
            }
        }
    }
    return arrayOf(aPathRev.reverse().toString(), bPathRev.reverse().toString())
}

fun main(args: Array<String>) {
    var result = levenshteinAlign("place", "palace")
    println(result[0])
    println(result[1])
    println()
    result = levenshteinAlign("rosettacode","raisethysword")
    println(result[0])
    println(result[1])
}


def bags(n,cache={}):
	if not n: return [(0, "")]

	upto = sum([bags(x) for x in range(n-1, 0, -1)], [])
	return [(c+1, '('+s+')') for c,s in bagchain((0, ""), n-1, upto)]

def bagchain(x, n, bb, start=0):
	if not n: return [x]

	out = []
	for i in range(start, len(bb)):
		c,s = bb[i]
		if c <= n: out += bagchain((x[0] + c, x[1] + s), n-c, bb, i)
	return out

# Maybe this lessens eye strain. Maybe not.
def replace_brackets(s):
	depth,out = 0,[]
	for c in s:
		if c == '(':
			out.append("([{"[depth%3])
			depth += 1
		else:
			depth -= 1
			out.append(")]}"[depth%3])
	return "".join(out)

for x in bags(5): print(replace_brackets(x[1]))


#lang racket
(require racket/splicing data/order)

(define (filtered-cartesian-product #:f (fltr (λ (cand left) #t)) l . more-ls)
  (let inr ((lls (cons l more-ls)) (left null))
    (match lls
      [(list) '(())]
      [(cons lla lld)
       (for*/list ((a (in-list (filter (curryr fltr left) lla)))
                   (d (in-list (inr lld (cons a left)))))
         (cons a d))])))

;; The "order" of an LRT
(define LRT-order (match-lambda [(list (app LRT-order o) ...) (apply + 1 o)]))

;; Some order for List Rooted Trees
(define LRT<=
  (match-lambda**
   [(_ (list)) #t]
   [((and bar (app LRT-order baro)) (cons (and badr (app LRT-order badro)) bddr))
    (and (or (< baro badro) (not (eq? '> (datum-order bar badr)))) (LRT<= badr bddr))]))

(splicing-letrec ((t# (make-hash '((1 . (())))))
                  (p# (make-hash '((0 . (()))))))
  ;; positive-integer -> (listof (listof positive-integer))
  (define (partitions N)
    (hash-ref! p# N
               (λ () (for*/list ((m (in-range 1 (add1 N)))
                                 (p (partitions (- N m)))
                                 #:when (or (null? p) (>= m (car p))))
                       (cons m p)))))

  ;; positive-integer -> (listof trees)
  (define (LRTs N)
    (hash-ref! t# N
               (λ ()
                 ;; sub1 because we will use the N'th bag to wrap the lot!
                 (define ps (partitions (sub1 N)))
                 (append*
                  (for/list ((p ps))
                    (apply filtered-cartesian-product (map LRTs p) #:f LRT<=)))))))

(module+ main
  (for-each displayln (LRTs 5))
  (equal? (map (compose length LRTs) (range 1 (add1 13)))
          '(1 1 2 4 9 20 48 115 286 719 1842 4766 12486))) ;; https://oeis.org/A000081


; Configuration parameters for Microsoft and BSD implementations
make "LCG_MS [214013 2531011 65536 2147483648]
make "LCG_BSD [1103515245 12345 1 2147483648]

; Default seed is 0
make "_lcg_value 0

; set the seed
to lcg_seed :seed
  make "_lcg_value :seed
end

; generate the next number in the series using the given parameters
to lcg_rand [:config :LCG_MS]
  local "a local "c local "d local "m
  foreach [a c d m] [
    make ? item # :config
  ]
  make "_lcg_value (modulo (sum (product :a :_lcg_value) :c) :m)
  output int quotient :_lcg_value :d
end

foreach (list :LCG_BSD :LCG_MS) [
  lcg_seed 0
  repeat 10 [
    print (lcg_rand ?)
  ]
  print []
]
bye


local RNG = {
  new = function(class, a, c, m, rand)
    local self = setmetatable({}, class)
    local state = 0
    self.rnd = function()
      state = (a * state + c) % m
      return rand and rand(state) or state
    end
    self.seed = function(new_seed)
      state = new_seed % m
    end
    return self
  end
}

bsd = RNG:new(1103515245, 12345, 1<<31)
ms = RNG:new(214013, 2531011, 1<<31, function(s) return s>>16 end)

print"BSD:"
for _ = 1,10 do
  print(("\t%10d"):format(bsd.rnd()))
end
print"Microsoft:"
for _ = 1,10 do
  print(("\t%10d"):format(ms.rnd()))
end


import algorithm, sequtils, strutils

proc levenshteinAlign(a, b: string): tuple[a, b: string] =
  let a = a.toLower()
  let b = b.toLower()
  var costs = newSeqWith(a.len + 1, newSeq[int](b.len + 1))
  for j in 0..b.len: costs[0][j] = j
  for i in 1..a.len:
    costs[i][0] = i
    for j in 1..b.len:
      let tmp = costs[i - 1][j - 1] + ord(a[i - 1] != b[j - 1])
      costs[i][j] = min(1 + min(costs[i - 1][j], costs[i][j - 1]), tmp)

  # Walk back through matrix to figure out path.
  var aPathRev, bPathRev: string
  var i = a.len
  var j = b.len
  while i != 0 and j != 0:
    let tmp = costs[i - 1][j - 1] + ord(a[i - 1] != b[j - 1])
    if costs[i][j] == tmp:
      dec i
      dec j
      aPathRev.add a[i]
      bPathRev.add b[j]
    elif costs[i][j] == 1 + costs[i-1][j]:
      dec i
      aPathRev.add a[i]
      bPathRev.add '-'
    elif costs[i][j] == 1 + costs[i][j-1]:
      dec j
      aPathRev.add '-'
      bPathRev.add b[j]
    else:
      quit "Internal error"

  result = (reversed(aPathRev).join(), reversed(bPathRev).join())

when isMainModule:

  var result = levenshteinAlign("place", "palace")
  echo result.a
  echo result.b
  echo ""

  result = levenshteinAlign("rosettacode","raisethysword")
  echo result.a
  echo result.b


use v6;

multi expand-tree ( Bag $tree ) {
    bag(bag(bag()) (+) $tree) (+)
    [(+)] (
        $tree.keys ==> map {
            $^a.&expand-tree.map: * (+) ( $tree (-) bag($^a) )
        }
    );
}

multi expand-trees ( Bag $trees ) {
    [(+)] $trees.keys.map:  { $_.&expand-tree } ;
}

my $n = 5;
for ( bag(), bag(bag()), *.&expand-trees ... * )[$n] {
    print ++$,".\t";
    .say
};


/*REXX program lists  n─node  rooted trees  (by enumerating all ways of nesting N bags).*/
parse arg N .                                    /*obtain optional argument from the CL.*/
if N=='' | N==","  then N=5                      /*Not specified?  Then use the default.*/
if N>5  then do;  say N  "isn't supported for this program at this time.";   exit 13;  end
nn= N + N - 1                                    /*power of 2 that is used for dec start*/
numeric digits 200                               /*use enough digs for next calculation.*/
numeric digits max(9, 1 + length( x2b( d2x(2**(nn+1) - 1) ) ) )  /*limit decimal digits.*/
start= 2**nn    +    (2**nn) % 2                 /*calculate the starting decimal number*/
if N==1  then start= 2**1                        /*treat the start for unity as special.*/
@= copies('─', 20)"► ";    o = 'o'               /*demonstrative literal for solutions. */
#= 0                                             /*count of ways to nest bags (so far). */
$=                                               /*string holds possible duplicious strs*/
    do j=start + start//2  to 2**(nn+1)-1  by 2  /*limit the search, smart start and end*/
    t= x2b( d2x(j) )   +   0                     /*convert dec number to a binary string*/
    z= length( space( translate(t, , 0), 0) )    /*count the number of zeros in bit str.*/
    if z\==n  then iterate                       /*Not enough zeroes?  Then skip this T.*/
    if N>1  then if  left(t, N)==right(t, N)  then iterate     /*left side ≡ right side?*/
    if N>2  then if right(t, 2)==    10  then iterate  /*has a right─most isolated bag ?*/
    if N>3  then if right(t, 4)==  1100  then iterate  /* "  "      "         "     "   */
    if N>4  then if right(t, 6)==111000  then iterate  /* "  "      "         "     "   */
    if N>4  then if right(t, 6)==110100  then iterate  /* "  "      "         "     "   */
    if N>4  then if right(t, 6)==100100  then iterate  /* "  "      "         "     "   */
    if wordpos(t, $)\==0                 then iterate  /*this a duplicate bag stuffing? */
    say @ changestr('()', translate(t, "()", 10),  o)  /*show a compact display with oh.*/
    #= # + 1                                     /*bump count of ways of nesting bags.  */
    $= $  translate( reverse(t), 01, 10)         /*save a (possible) duplicious string. */
    end   /*j*/
say                                              /*separate number─of─ways with a blank.*/
say # ' is the number of ways to nest' n "bags." /*stick a fork in it,  we're all done. */


proc bsdRand(seed: int): iterator: int =
  var state = seed
  result = iterator: int =
    while true:
      state = (1_103_515_245 * state + 12_345) and 0x7fffffff
      yield state

proc msvcrtRand(seed: int): iterator: int =
  var state = seed
  result = iterator: int =
    while true:
      state = (214_013 * state + 2_531_011) and 0x7fffffff
      yield state shr 16

echo "BSD with seed = 1 (OEIS A096553):"
var count = 0
let iter1 = bsdRand(1)
for val in iter1():
  echo val
  inc count
  if count == 10:
    break

echo ""
echo "Microsoft with seed = 0 (OEIS A096558):"
count = 0
let iter2 = msvcrtRand(0)
for val in iter2():
  echo val
  inc count
  if count == 10:
    break


: genLCG(a, c, m, seed)
| ch |
   Channel newSize(1) dup send(seed) drop ->ch
   #[ ch receive a * c + m mod dup ch send drop ] ;


Program LinearCongruentialGenerator(output);
{$mode iso}
var
  x1, x2: int64;

function bsdrand: cardinal;
  const
    a = 1103515245;
    c = 12345;
    m = 2147483648;
  begin
    x1 := (a * x1 + c) mod m;
    bsdrand := x1;
  end;

function msrand: cardinal;
  const
    a = 214013;
    c = 2531011;
    m = 2147483648;
  begin
    x2 := (a * x2 + c) mod m;
    msrand := x2 div 65536;
  end;

var
  i: cardinal;
begin
  writeln('      BSD            MS');
  x1 := 0;
  x2 := 0;
  for i := 1 to 10 do
    writeln(bsdrand:12, msrand:12);
end.


function LevenshteinAlignment(string a, b)
    integer la = length(a)+1,
            lb = length(b)+1
    sequence costs = repeat(repeat(0,lb),la)
    for j=1 to lb do
        costs[1][j] = j
    end for
    for i=2 to la do
        costs[i][1] = i
        for j=2 to lb do
            integer tmp1 = 1+min(costs[i-1][j], costs[i][j-1]),
                    tmp2 = costs[i-1][j-1] + (a[i-1]!=b[j-1])
            costs[i][j] = min(tmp1, tmp2)
        end for
    end for
    -- walk back through matrix to figure out the path
    string arev = "",
           brev = ""
    integer i = la, j = lb
    while i>1 and j>1 do
        integer tmp = costs[i-1][j-1] + (a[i-1]!=b[j-1])
        switch costs[i][j] do
            case tmp:                   i -= 1; arev &= a[i]
                                        j -= 1; brev &= b[j]
            case 1 + costs[i-1][j]:     i -= 1; arev &= a[i]
                                        brev &= '-'
            case 1 + costs[i][j-1]:     arev &= '-'
                                        j -= 1; brev &= b[j]
        end switch
    end while
    return {reverse(arev),reverse(brev)}
end function

procedure test(string a,b)
    {a,b} = LevenshteinAlignment(a,b)
    string c = sq_add(repeat(' ',length(a)),sq_mul(sq_ne(a,b),'|'-' '))
    printf(1,"%s\n%s\n%s\n\n",{a,b,c})
end procedure
test("rosettacode", "raisethysword")
test("place", "palace")


# Project : List rooted trees

list = "()"
addstr = []
flag = 0
newstr = []
str = []
np = [1,2,3,4]
for nr = 1 to len(np)
      if nr = 1
         bg1 = "bag"
       else
         bg1 = "bags"
      ok
      see "for " + nr + " " + bg1 + " :" + nl
     permutation(list,nr*2)
     listroot(nr*2)
next
see "ok" + nl

func listroot(pn)
        for n = 1 to len(addstr)
             result(addstr[n],pn)
             if flag = 1
                see "" + addstr[n] + nl
                addstr[n]
             ok
        next

func result(list,pn)
        flag = 0
        newstr = list
        while substr(newstr, "()") != 0
                 if list = "()" or list = "(())"
                    flag = 1
                    exit
                 ok
                 num = substr(newstr, "()")
                 newstr = substr(newstr, "()", "")
                 if left(list,2) = "()" or right(list,2) = "()" or left(list,4) = "(())" or right(list,4) = "(())"
                    flag = 0
                    exit
                 else
                    if len(list) != 2 and len(list) != 4 and newstr = ""
                       flag = 1
                       exit
                    ok
                 ok
        end

func permutation(list,pn)
       addstr = []
       while true
               str = ""
               for n = 1 to pn
                    rnd = random(1) + 1
                    str = str + list[rnd]
               next
               add(addstr,str)
               for m = 1 to len(addstr)
                    for p = m + 1 to len(addstr) - 1
                         if addstr[m] = addstr[p]
                            del(addstr,p)
                         ok
                    next
               next
               if len(addstr) = pow(2,pn)
                  exit
               ok
       end


TREE_LIST = []
OFFSET = []

for i in 0..31
    if i == 1 then
        OFFSET << 1
    else
        OFFSET << 0
    end
end

def append(t)
    TREE_LIST << (1 | (t << 1))
end

def show(t, l)
    while l > 0
        l = l - 1
        if t % 2 == 1 then
            print '('
        else
            print ')'
        end
        t = t >> 1
    end
end

def listTrees(n)
    for i in OFFSET[n] .. OFFSET[n + 1] - 1
        show(TREE_LIST[i], n * 2)
        print "\n"
    end
end

def assemble(n, t, sl, pos, rem)
    if rem == 0 then
        append(t)
        return
    end

    if sl > rem then
        sl = rem
        pos = OFFSET[sl]
    elsif pos >= OFFSET[sl + 1] then
        sl = sl - 1
        if sl == 0 then
            return
        end
        pos = OFFSET[sl]
    end

    assemble(n, t << (2 * sl) | TREE_LIST[pos], sl, pos, rem - sl)
    assemble(n, t, sl, pos + 1, rem)
end

def makeTrees(n)
    if OFFSET[n + 1] != 0 then
        return
    end
    if n > 0 then
        makeTrees(n - 1)
    end
    assemble(n, 0, n - 1, OFFSET[n - 1], n - 1)
    OFFSET[n + 1] = TREE_LIST.length()
end

def test(n)
    if n < 1 || n > 12 then
        raise ArgumentError.new("Argument must be between 1 and 12")
    end

    append(0)

    makeTrees(n)
    print "Number of %d-trees: %d\n" % [n, OFFSET[n + 1] - OFFSET[n]]
    listTrees(n)
end

test(5)


use strict;
package LCG;

use overload '0+'  => \&get;

use integer;
sub gen_bsd { (1103515245 * shift() + 12345) % (1 << 31) }

sub gen_ms  {
	my $s = (214013 * shift() + 2531011) % (1 << 31);
	$s, $s / (1 << 16)
}

sub set { $_[0]->{seed} = $_[1] } # srand
sub get {
	my $o = shift;
	($o->{seed}, my $r) = $o->{meth}->($o->{seed});
	$r //= $o->{seed}
}

sub new {
	my $cls = shift;
	my %opts = @_;
	bless {
		seed => $opts{seed},
		meth => $opts{meth} eq 'MS' ? \&gen_ms : \&gen_bsd,
	}, ref $cls || $cls;
}

package main;

my $rand = LCG->new;

print "BSD:\n";
print "$rand\n" for 1 .. 10;

$rand = LCG->new(meth => 'MS');

print "\nMS:\n";
print "$rand\n" for 1 .. 10;


with javascript_semantics
atom seed

include builtins/mpfr.e

function BSDrnd()
    -- oh dear, native only works on 64-bit,
    -- as per ERRE and UCBLogo above on 32-bit...
--  seed = remainder(1103515245 * seed + 12345, #8000_0000)
    -- so, resort to gmp, with the added twist than both
    -- 1103515245 and #8000_0000 are greater than 1GB and
    -- therefore a smidge too big & need some extra help...
    mpz z = mpz_init(seed),
        m9 = mpz_init("1103515245"),
        h8 = mpz_init("0x80000000")
    mpz_mul(z,z,m9)
    mpz_add_si(z,z,12345)
    mpz_fdiv_r(z,z,h8)
    seed = mpz_get_atom(z)
    return seed
end function

function MSrnd()
    seed = and_bits(seed*214013+2531011,#7FFFFFFF)
    return floor(seed/power(2,16))
end function

seed = 0
?"BSDrnd"
for i=1 to 10 do printf(1,"%d\n",BSDrnd()) end for
seed = 0
?"MSrnd"
for i=1 to 10 do printf(1,"%d\n",MSrnd()) end for


from difflib import ndiff

def levenshtein(str1, str2):
    result = ""
    pos, removed = 0, 0
    for x in ndiff(str1, str2):
        if pos<len(str1) and str1[pos] == x[2]:
          pos += 1
          result += x[2]
          if x[0] == "-":
              removed += 1
          continue
        else:
          if removed > 0:
            removed -=1
          else:
            result += "-"
    print(result)

levenshtein("place","palace")
levenshtein("rosettacode","raisethysword")


#lang racket

(define (memoize f)
  (local ([define table (make-hash)])
    (lambda args
      (dict-ref! table args (λ () (apply f args))))))

(define levenshtein
  (memoize
   (lambda (s t)
     (cond
       [(and (empty? s) (empty? t)) 0]
       [(empty? s) (length t)]
       [(empty? t) (length s)]
       [else
        (if (equal? (first s) (first t))
            (levenshtein (rest s) (rest t))
            (min (add1 (levenshtein (rest s) t))
                 (add1 (levenshtein s (rest t)))
                 (add1 (levenshtein (rest s) (rest t)))))]))))


func bagchain(x, n, bb, start=0) {
    n || return [x]

    var out = []
    for i in (start .. bb.end) {
        var (c, s) = bb[i]...
        if (c <= n) {
            out += bagchain([x[0] + c, x[1] + s], n-c, bb, i)
        }
    }

    return out
}

func bags(n) {
    n || return [[0, ""]]
    var upto = []
    for i in (n ^.. 1) { upto += bags(i) }
    bagchain([0, ""], n-1, upto).map{|p| [p[0]+1, '('+p[1]+')'] }
}

func replace_brackets(s) {
    var (depth, out) = (0, [])
    for c in s {
        if (c == '(') {
            out.append(<( [ {>[depth%3])
            ++depth
        }
        else {
            --depth
            out.append(<) ] }>[depth%3])
        }
    }
    return out.join
}

for x in (bags(5)) {
    say replace_brackets(x[1])
}


import "/long" for ULong
import "os" for Process

var treeList = []
var offset = List.filled(32, 0)
offset[1] = 1

var append = Fn.new { |t|
    treeList.add(ULong.one | (t << 1))
}

var show = Fn.new { |t, len|
    while (len > 0) {
        len = len - 1
        System.write(t.isOdd ? "(" : ")")
        t = t >> 1
    }
}

var listTrees = Fn.new { |n|
    for (i in offset[n]...offset[n+1]) {
        show.call(treeList[i], n * 2)
        System.print()
    }
}

/* assemble tree from subtrees
	n:   length of tree we want to make
	t:   assembled parts so far
	sl:  length of subtree we are looking at
	pos: offset of subtree we are looking at
	rem: remaining length to be put together
*/

var assemble // recursive
assemble = Fn.new { |n, t, sl, pos, rem|
    if (rem == 0) {
        append.call(t)
        return
    }
    if (sl > rem) { // need smaller subtrees
        pos = offset[sl = rem]
    } else if (pos >= offset[sl + 1]) {
        // used up sl-trees, try smaller ones
        sl = sl - 1
        if (sl == 0) return
        pos = offset[sl]
    }
    assemble.call(n, (t << (2 * sl)) | treeList[pos], sl, pos, rem - sl)
    assemble.call(n, t, sl, pos + 1, rem)
}

var makeTrees // recursive
makeTrees = Fn.new { |n|
    if (offset[n + 1] != 0) return
    if (n > 0) makeTrees.call(n - 1)
    assemble.call(n, ULong.zero, n - 1, offset[n - 1], n - 1)
    offset[n + 1] = treeList.count
}

var args = Process.arguments
if (args.count != 1) Fiber.abort("There must be exactly 1 command line argument.")
var n = Num.fromString(args[0])
if (!n) Fiber.abort("Argument is not a valid number.")
if (n < 1 || n > 12) Fiber.abort("Argument must be between 1 and 12.")

// init 1-tree
append.call(ULong.zero)
makeTrees.call(n)
System.print("Number of %(n)-trees: %(offset[n + 1] - offset[n])")
listTrees.call(n)


<?php
function bsd_rand($seed) {
    return function() use (&$seed) {
        return $seed = (1103515245 * $seed + 12345) % (1 << 31);
    };
}

function msvcrt_rand($seed) {
    return function() use (&$seed) {
        return ($seed = (214013 * $seed + 2531011) % (1 << 31)) >> 16;
    };
}

$lcg = bsd_rand(0);
echo "BSD ";
for ($i = 0; $i < 10; $i++)
    echo $lcg(), " ";
echo "\n";

$lcg = msvcrt_rand(0);
echo "Microsoft ";
for ($i = 0; $i < 10; $i++)
    echo $lcg(), " ";
echo "\n";
?>


go =>

  % BSD
  println(bsd=[bsd() : _ in 1..10]),
  bsd_seed(1),
  println(bsd2=[bsd() : _ in 1..10]),

  % MS
  println(ms=[ms() : _ in 1..10]),
  ms_seed(1),
  println(ms2=[ms() : _ in 1..10]),

  nl.

% BSD
bsd_seed(Seed) =>
  get_global_map().put(bsd_state, Seed).
bsd = Rand =>
  M = get_global_map(),
  Seed = cond(M.has_key(bsd_state), M.get(bsd_state),0),
  Rand = (1103515245*Seed + 12345) mod 2**31,
  M.put(bsd_state,Rand).

% Microsoft
ms_seed(Seed) =>
  get_global_map().put(ms_state, Seed).
ms = Rand div 2**16 =>
  M = get_global_map(),
  Seed = cond(M.has_key(ms_state),M.get(ms_state),0),
  Rand = ((214013*Seed + 2531011) mod 2**31),
  M.put(ms_state,Rand).


require 'lcs'

def levenshtein_align(a, b)
  apos, bpos = LCS.new(a, b).backtrack2

  c = ""
  d = ""
  x0 = y0 = -1
  dx = dy = 0
  apos.zip(bpos) do |x,y|
    diff = x + dx - y - dy
    if diff < 0
      dx -= diff
      c += "-" * (-diff)
    elsif diff > 0
      dy += diff
      d += "-" * diff
    end
    c += a[x0+1..x]
    x0 = x
    d += b[y0+1..y]
    y0 = y
  end

  c += a[x0+1..-1]
  d += b[y0+1..-1]
  diff = a.length + y0 - b.length - x0
  if diff < 0
    c += "-" * (-diff)
  elsif diff > 0
    d += "-" * diff
  end
  [c, d]
end

puts levenshtein_align("rosettacode", "raisethysword")


import scala.collection.mutable
import scala.collection.parallel.ParSeq

object LevenshteinAlignment extends App {
  val vlad = new Levenshtein("rosettacode", "raisethysword")
  val alignment = vlad.revLevenstein()

  class Levenshtein(s1: String, s2: String) {
    val memoizedCosts = mutable.Map[(Int, Int), Int]()

    def revLevenstein(): (String, String) = {
      def revLev: (Int, Int, String, String) => (String, String) = {
        case (_, 0, revS1, revS2) => (revS1, revS2)
        case (0, _, revS1, revS2) => (revS1, revS2)
        case (i, j, revS1, revS2) =>
          if (memoizedCosts(i, j) == (memoizedCosts(i - 1, j - 1)
                                      + (if (s1(i - 1) != s2(j - 1)) 1 else 0)))
            revLev(i - 1, j - 1, s1(i - 1) + revS1, s2(j - 1) + revS2)
          else if (memoizedCosts(i, j) == 1 + memoizedCosts(i - 1, j))
            revLev(i - 1, j, s1(i - 1) + revS1, "-" + revS2)
          else
            revLev(i, j - 1, "-" + revS1, s2(j - 1) + revS2)
      }

      revLev(s1.length, s2.length, "", "")
    }

    private def levenshtein: Int = {
      def lev: ((Int, Int)) => Int = {
        case (k1, k2) =>
          memoizedCosts.getOrElseUpdate((k1, k2), (k1, k2) match {
            case (i, 0) => i
            case (0, j) => j
            case (i, j) =>
              ParSeq(1 + lev((i - 1, j)),
                1 + lev((i, j - 1)),
                lev((i - 1, j - 1))
                  + (if (s1(i - 1) != s2(j - 1)) 1 else 0)).min
          })
      }

      lev((s1.length, s2.length))
    }

    levenshtein
  }

  println(alignment._1)
  println(alignment._2)

}


fcn bags(n){
   if(not n) return(T(T(0,"")));

   [n-1 .. 1, -1].pump(List,bags).flatten() :
   bagchain(T(0,""), n-1, _).apply(fcn([(c,s)]){ T(c+1,String("(",s,")")) })
}
fcn bagchain(x,n,bb,start=0){
   if(not n) return(T(x));

   out := List();
   foreach i in ([start..bb.len()-1]){
      c,s := bb[i];
      if(c<=n) out.extend(bagchain(L(x[0]+c, x[1]+s), n-c, bb, i));
   }
   out
}
# Maybe this lessens eye strain. Maybe not.
fcn replace_brackets(s){
   depth,out := 0,Sink(String);
   foreach c in (s){
      if(c=="("){
	 out.write("([{"[depth%3]);
	 depth += 1;
      }else{
	 depth -= 1;
	 out.write(")]}"[depth%3]);
      }
   }
   out.close()
}
foreach x in (bags(5)){ println(replace_brackets(x[1])) }
println("or");
b:=bags(5); b.apply("get",1).println(b.len());


(nofixedoverflow, nosize):
LCG: procedure options (main);
   declare i fixed binary;

   put skip list ('BSD', 'MS');
   do i = 1 to 20;
      put skip list (BSD(), MS());
   end;

bsd: procedure returns (fixed binary (31));
    declare const fixed binary static initial (12345);
    declare s fixed binary (31) static initial (123456789);

    s = s * 1103515245 + const;
    s = isrl(isll(s,1), 1);
    return (s);
end bsd;
ms: procedure returns (fixed binary (15));
    declare const fixed binary (31) static initial (2531011);
    declare s     fixed binary (31) static initial (123456789);

    s = s * 214013 + const;
    s = isrl(isll(s,1), 1);
    return (isrl(s,16));

end ms;

end LCG;


Function msstate{
    Param($current_seed)
    Return (214013*$current_seed+2531011)%2147483648}

Function randMS{
    Param($MSState)
    Return [int]($MSState/65536)}

Function randBSD{
    Param($BSDState)
    Return (1103515245*$BSDState+12345)%2147483648}

Write-Host "MS: seed=0"
$seed=0 #initialize seed
For($i=1;$i-le5;$i++){
    $seed = msstate($seed)
    $rand = randMS($seed)
    Write-Host $rand}

Write-Host "BSD: seed=0"
$seed=0 #initialize seed
For($j=1;$j-le5;$j++){
    $seed = randBSD($seed)
    Write-Host $seed}


Procedure ms_LCG(seed.q = -1)
  Static state.q
  If seed >= 0
    state = seed
  Else
    state = (state * 214013 + 2531011) % (1 << 31)
    ProcedureReturn state >> 16
  EndIf
EndProcedure

Procedure.q bsd_LCG(seed.q = -1)
  Static state.q
  If seed >= 0
    state = seed
  Else
    state = (state * 1103515245 + 12345) % (1 << 31)
    ProcedureReturn state
  EndIf
EndProcedure

If OpenConsole()
  Define i
  PrintN("BSD (seed = 1)")
  bsd_LCG(1)
  For i = 1 To 5
    PrintN(Str(bsd_LCG()))
  Next

  PrintN(#CRLF$ + "MS (seed = 1)")
  ms_LCG(1)
  For i = 1 To 5
    PrintN(Str(ms_LCG()))
  Next

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


def bsd_rand(seed):
   def rand():
      rand.seed = (1103515245*rand.seed + 12345) & 0x7fffffff
      return rand.seed
   rand.seed = seed
   return rand

def msvcrt_rand(seed):
   def rand():
      rand.seed = (214013*rand.seed + 2531011) & 0x7fffffff
      return rand.seed >> 16
   rand.seed = seed
   return rand


  [ number$
    10 over size -
    space swap of
    swap join echo$ ]  is echonum  ( n -->   )

  [ stack 0 ]          is BSD-seed (   --> n )

  [ BSD-seed take
    1103515245 *
    12345 +
    hex 7FFFFFFF &
    dup BSD-seed put ] is BSD-rand (   --> n )

  [ stack 0 ]          is MCR-seed (   --> n )

  [ MCR-seed take
    214013 *
    2531011 +
    hex 7FFFFFFF &
    dup MCR-seed put
    16 >> ]            is MCR-rand (   --> n )

  say "  BSD-rand  MCR-rand" cr
  10 times
    [ BSD-rand echonum
      MCR-rand echonum cr ]


#lang racket
(require racket/generator)

(define (bsd-update state_n)
  (modulo (+ (* 1103515245 state_n) 12345)
          (expt 2 31)))

(define (ms-update state_n)
  (modulo (+ (* 214013 state_n) 2531011)
          (expt 2 31)))

(define ((rand update ->rand) seed)
  (generator ()
   (let loop ([state_n seed])
     (define state_n+1 (update state_n))
     (yield (->rand state_n+1))
     (loop state_n+1))))

(define bsd-rand (rand bsd-update identity))
(define ms-rand (rand ms-update (λ (x) (quotient x (expt 2 16)))))


constant modulus = 2**31;
sub bsd  {
    $^seed, ( 1103515245 * * + 12345 ) % modulus ... *
}
sub ms   {
    map * +> 16, (
	$^seed, ( 214013 * * + 2531011 ) % modulus ... *
    )
}

say 'BSD LCG first 10 values (first one is the seed):';
.say for bsd(0)[^10];

say "\nMS LCG first 10 values (first one is the seed):";
.say for ms(0)[^10];


package require struct::list
proc levenshtein/align {a b} {
    lassign [struct::list longestCommonSubsequence [split $a ""] [split $b ""]]\
	    apos bpos
    set c ""
    set d ""
    set x0 [set y0 -1]
    set dx [set dy 0]
    foreach x $apos y $bpos {
	if {$x+$dx < $y+$dy} {
	    set n [expr {($y+$dy)-($x+$dx)}]
	    incr dx $n
	    append c [string repeat "-" $n]
	} elseif {$x+$dx > $y+$dy} {
	    set n [expr {($x+$dx)-($y+$dy)}]
	    incr dy $n
	    append d [string repeat "-" $n]
	}
	append c [string range $a $x0+1 $x]
	set x0 $x
	append d [string range $b $y0+1 $y]
	set y0 $y
    }
    append c [string range $a $x0+1 end]
    append d [string range $b $y0+1 end]
    set al [string length $a]
    set bl [string length $b]
    if {$al+$y0 < $bl+$x0} {
	append c [string repeat "-" [expr {$bl+$x0-$y0-$al}]]
    } elseif {$bl+$x0 < $al+$y0} {
	append d [string repeat "-" [expr {$al+$y0-$x0-$bl}]]
    }
    return $c\n$d
}

puts [levenshtein/align "rosettacode" "raisethysword"]


import "/str" for Str

var levenshteinAlign = Fn.new { |a, b|
    a = Str.lower(a)
    b = Str.lower(b)
    var costs = List.filled(a.count+1, null)
    for (i in 0..a.count) costs[i] = List.filled(b.count+1, 0)
    for (j in 0..b.count) costs[0][j] = j
    for (i in 1..a.count) {
        costs[i][0] = i
        for (j in 1..b.count) {
            var temp = costs[i - 1][j - 1] + ((a[i - 1] == b[j - 1]) ? 0 : 1)
            costs[i][j] = temp.min(1 + costs[i - 1][j].min(costs[i][j - 1]))
        }
    }
    // walk back through matrix to figure out path
    var aPathRev = ""
    var bPathRev = ""
    var i = a.count
    var j = b.count
    while (i != 0 && j != 0) {
        var temp = costs[i - 1][j - 1] + ((a[i - 1] == b[j - 1]) ? 0 : 1)
        var cij = costs[i][j]
        if (cij == temp) {
            i = i - 1
            aPathRev = aPathRev + a[i]
            j = j - 1
            bPathRev = bPathRev + b[j]
        } else if (cij == 1 + costs[i-1][j]) {
            i = i - 1
            aPathRev = aPathRev + a[i]
            bPathRev = bPathRev + "-"
        } else if (cij == 1 + costs[i][j-1]) {
            aPathRev = aPathRev + "-"
            j = j - 1
            bPathRev = bPathRev+ b[j]
        }
    }
    return [aPathRev[-1..0], bPathRev[-1..0]]
}

var result = levenshteinAlign.call("place", "palace")
System.print(result[0])
System.print(result[1])
System.print()
result = levenshteinAlign.call("rosettacode","raisethysword")
System.print(result[0])
System.print(result[1])


/*REXX program uses a linear congruential generator (LCG)  that simulates the old  BSD  */
/*──────── and MS random number generators:    BSD= 0──►(2^31)-1     MS= 0──►(2^16)-1   */
numeric digits 20                                /*use enough dec. digs for the multiply*/
[email protected]@16= 2**16                                   /*use a variable to contain  2^16      */
[email protected]@31= 2**31                                   /* "  "     "     "    "     2^32      */

        do seed=0  for 2;       bsd= seed        /*perform for seed=0  and also  seed=1.*/
                                 ms= seed        /*assign  SEED  to  two REXX variables.*/
        say center(' seed='seed" ", 79, '─')     /*display the seed in a title/separator*/
                                                 /* [↓]  show 20 rand #'s for each seed.*/
            do j=1  for 20                       /*generate & display 20 random numbers.*/

            bsd = (1103515245 * bsd   +     12345)   //    [email protected]@31
            ms  = (    214013 *  ms   +   2531011)   //    [email protected]@31
                                                 /*  ↑                                  */
                                                 /*  └─────◄──── REXX remainder operator*/

            say '  state'   right(j,3)   " BSD"   right(bsd,     11)   left('', 13),
                                         " MS"    right( ms,     11)   left('',  5),
                                         " rand"  right(ms % [email protected]@16,  6)
            end   /*j*/
        end       /*seed*/                       /*stick a fork in it,  we're all done. */


module LCG
  module Common
    # The original seed of this generator.
    attr_reader :seed

    # Creates a linear congruential generator with the given _seed_.
    def initialize(seed)
      @seed = @r = seed
    end
  end

  # LCG::Berkeley generates 31-bit integers using the same formula
  # as BSD rand().
  class Berkeley
    include Common
    def rand
      @r = (1103515245 * @r + 12345) & 0x7fff_ffff
    end
  end

  # LCG::Microsoft generates 15-bit integers using the same formula
  # as rand() from the Microsoft C Runtime.
  class Microsoft
    include Common
    def rand
      @r = (214013 * @r + 2531011) & 0x7fff_ffff
      @r >> 16
    end
  end
end


global bsd
global ms
print "Num  ___Bsd___";chr$(9);"__Ms_"
for i = 1 to 10
    print using("##",i);using("############",bsdRnd());chr$(9);using("#####",msRnd())
next i

function bsdRnd()
    bsdRnd = (1103515245 * bsd + 12345) mod (2 ^ 31)
    bsd = bsdRnd
end function

function msRnd()
    ms = (214013 * ms + 2531011) mod (2 ^ 31)
    msRnd = int(ms / 2 ^ 16)
end function


extern crate rand;

pub use rand::{Rng, SeedableRng};

pub struct BsdLcg {
    state: u32,
}

impl Rng for BsdLcg {
    // Because the output is in the range [0, 2147483647], this should technically be `next_u16`
    // (the largest integer size which is fully covered, as `rand::Rng` assumes).  The `rand`
    // crate does not provide it however.  If serious usage is required, implementing this
    // function as a concatenation of two `next_u16`s (elsewhere defined) should work.
    fn next_u32(&mut self) -> u32 {
        self.state = self.state.wrapping_mul(1_103_515_245).wrapping_add(12_345);
        self.state %= 1 << 31;
        self.state
    }
}

impl SeedableRng<u32> for BsdLcg {
    fn from_seed(seed: u32) -> Self {
        Self { state: seed }
    }
    fn reseed(&mut self, seed: u32) {
        self.state = seed;
    }
}

pub struct MsLcg {
    state: u32,
}

impl Rng for MsLcg {
    // Similarly, this outputs in the range [0, 32767] and should output a `u8`.  Concatenate
    // four `next_u8`s for serious usage.
    fn next_u32(&mut self) -> u32 {
        self.state = self.state.wrapping_mul(214_013).wrapping_add(2_531_011);
        self.state %= 1 << 31;
        self.state >> 16 // rand_n = state_n / 2^16
    }
}

impl SeedableRng<u32> for MsLcg {
    fn from_seed(seed: u32) -> Self {
        Self { state: seed }
    }
    fn reseed(&mut self, seed: u32) {
        self.state = seed;
    }
}

fn main() {
    println!("~~~ BSD ~~~");
    let mut bsd = BsdLcg::from_seed(0);
    for _ in 0..10 {
        println!("{}", bsd.next_u32());
    }

    println!("~~~ MS ~~~");
    let mut ms = MsLcg::from_seed(0);
    for _ in 0..10 {
        println!("{}", ms.next_u32());
    }

    // Because we have implemented the `rand::Rng` trait, we can generate a variety of other types.
    println!("~~~ Others ~~~");
    println!("{:?}", ms.gen::<[u32; 5]>());
    println!("{}", ms.gen::<bool>());
    println!("{}", ms.gen_ascii_chars().take(15).collect::<String>());
}


fcn alignment(a,b){
   a,b = a.toLower(), b.toLower();
   costs := (a.len()+1).pump(List(),'wrap(a){ [1..b.len()].pump(List(a)) });
   foreach i,j in (a.len()+1, [1..b.len()]){
      costs[i][j] = ( 1 + costs[i-1][j].min(costs[i][j-1]) )
         .min(if(a[i-1] == b[j-1]) costs[i-1][j-1] else costs[i-1][j-1] + 1);
   }
   // walk back through matrix to figure out path
   aPathRev,bPathRev := Data(),Data();  // byte buckets
   i,j := a.len(), b.len();
   while(i!=0 and j!= 0){
      if (costs[i][j] ==
          ( if(a[i-1]==b[j-1]) costs[i-1][j-1] else costs[i-1][j-1]+1 )){
         aPathRev.append(a[i-=1]);
	 bPathRev.append(b[j-=1]);
      } else if(costs[i][j] == 1+costs[i-1][j]){
	 aPathRev.append(a[i-=1]);
	 bPathRev.append("-");
      } else if (costs[i][j] == 1+costs[i][j-1]){
	 aPathRev.append("-");
	 bPathRev.append(b[j-=1]);
      }
   }
   return(aPathRev.text.reverse(), bPathRev.text.reverse())
}


object LinearCongruentialGenerator {
  def bsdRandom(rseed:Int):Iterator[Int]=new Iterator[Int]{
    var seed=rseed
    override def hasNext:Boolean=true
    override def next:Int={seed=(seed * 1103515245 + 12345) & Int.MaxValue; seed}
  }

  def msRandom(rseed:Int):Iterator[Int]=new Iterator[Int]{
    var seed=rseed
    override def hasNext:Boolean=true
    override def next:Int={seed=(seed * 214013 + 2531011) & Int.MaxValue; seed >> 16}
  }

  def toString(it:Iterator[Int], n:Int=20)=it take n mkString ", "

  def main(args:Array[String]){
    println("-- seed 0 --")
    println("BSD: "+ toString(bsdRandom(0)))
    println("MS : "+ toString(msRandom(0)))

    println("-- seed 1 --")
    println("BSD: "+ toString(bsdRandom(1)))
    println("MS : "+ toString( msRandom(1)))
  }
}


$ include "seed7_05.s7i";
  include "bigint.s7i";

var bigInteger: bsdSeed is 0_;
var bigInteger: msSeed is 0_;

const func integer: bsdRand is func
  result
    var integer: bsdRand is 0;
  begin
    bsdSeed := (1103515245_ * bsdSeed + 12345_) mod 2147483648_;
    bsdRand := ord(bsdSeed);
  end func;

const func integer: msRand is func
  result
    var integer: msRand is 0;
  begin
    msSeed := (214013_ * msSeed + 2531011_) mod 2147483648_;
    msRand := ord(msSeed) mdiv 65536;
  end func;

const proc: main is func
  local
    var integer: i is 0;
  begin
    writeln("         BSD          MS");
    for i range 1 to 10 do
      writeln(bsdRand lpad 12 <& msRand lpad 12);
    end for;
  end func;


import <Utilities/Random.sl>;

main(args(2)) :=
	let
		bsdRandomGenerator := newRandomGenerator(0, 0, 2147483647, bsdNext);
		msRandomGenerator := newRandomGenerator(0, 0, 32767, msNext);

		// Create a random sequence with each one of the generators
		numbers := getRandomSequence([bsdRandomGenerator, msRandomGenerator], 10).Value;
	in
		"BSD Values: " ++ toString(numbers[1]) ++
		"\nMS Values: " ++ toString(numbers[2]);

bsdNext(RG) :=
	let
		newSeed := ((1103515245 -> int64 * RG.Seed + 12345) mod 2147483648) -> int32;
	in
		(Value : newSeed,
		Generator : (Seed : newSeed, RandomMin : RG.RandomMin, RandomMax : RG.RandomMax, NextFunction : RG.NextFunction));

msNext(RG) :=
	let
		newSeed := ((214013 -> int64 * RG.Seed + 2531011) mod 2147483648) -> int32;
	in
		(Value : newSeed / 65536,
		Generator : (Seed : newSeed, RandomMin : RG.RandomMin, RandomMax : RG.RandomMax, NextFunction : RG.NextFunction));


module LCG {

  # Creates a linear congruential generator and remembers the initial seed.
  class Common(r) {
     has seed = r
  }

  # LCG::Berkeley generates 31-bit integers using the same formula
  # as BSD rand().
  class Berkeley < Common {
    method rand {
      self.r = ((1103515245 * self.r + 12345) & 0x7fff_ffff);
    }
  }

  # LCG::Microsoft generates 15-bit integers using the same formula
  # as rand() from the Microsoft C Runtime.
  class Microsoft < Common {
    method rand {
      self.r = ((214013 * self.r + 2531011) & 0x7fff_ffff);
      self.r >> 16;
    }
  }
}

var lcg1 = LCG::Berkeley(1)
say 5.of { lcg1.rand }

var lcg2 = LCG::Microsoft(1)
say 5.of { lcg2.rand }


var states = {
	"BSD": 0,
	"MS": 0
};

function BSD_seed(n) {
	states.BSD = n;
}

function BSD_rand() {
	return states.BSD = (1103515245 * states.BSD + 12345) % (1 << 31);
}

function Microsoft_seed(n) {
	states.MS = n;
}

function Microsoft_rand() {
	return (states.MS = (214013 * states.MS + 2531011) % (1 << 31)) % (1 << 15);
}


local
  open Word32
in
  fun bsdLcg (seed : int) : int =
    toInt (andb (0w1103515245 * fromInt seed + 0w12345, 0wx7fffffff))
  fun mscLcg (seed : word) : int * word =
    let
      val state = andb (0w214013 * seed + 0w2531011, 0wx7fffffff)
    in
      (toInt (>> (state, 0w16)), state)
    end
end


import Cocoa

class LinearCongruntialGenerator {

    var state = 0 //seed of 0 by default
    let a, c, m, shift: Int

    //we will use microsoft random by default
    init() {
        self.a = 214013
        self.c = 2531011
        self.m = Int(pow(2.0, 31.0)) //2^31 or 2147483648
        self.shift = 16
    }

    init(a: Int, c: Int, m: Int, shift: Int) {
        self.a = a
        self.c = c
        self.m = m //2^31 or 2147483648
        self.shift = shift
    }

    func seed(seed: Int) -> Void {
        state = seed;
    }

    func random() -> Int {
        state = (a * state + c) % m
        return state >> shift
    }
}

let microsoftLinearCongruntialGenerator = LinearCongruntialGenerator()
let BSDLinearCongruntialGenerator = LinearCongruntialGenerator(a: 1103515245, c: 12345, m: 2147483648, shift: 0)

print("Microsft Rand:")
for(var i = 0; i < 10; i++)
{
    print(microsoftLinearCongruntialGenerator.random())
}

print("") //new line for readability
print("BSD Rand:")
for(var i = 0; i < 10; i++)
{
    print(BSDLinearCongruntialGenerator.random())
}


package require Tcl 8.6

# General form of a linear-congruential RNG
oo::class create LCRNG {
    variable seed A B C D
    constructor {init a b c d} {
	if {$init < 1} {set init [clock clicks]}
	variable seed $init A $a B $b C $c D $d
    }
    method rand {} {
	set seed [expr {($A * $seed + $B) % $C}]
	return [expr {$seed / $D}]
    }
    method srand x {
	set seed $x
    }
}
# Subclass to introduce constants
oo::class create BSDRNG {
    superclass LCRNG
    constructor {{initialSeed -1}} {
	next $initialSeed 1103515245 12345 [expr {2**31}] 1
    }
}
oo::class create MSRNG {
    superclass LCRNG
    constructor {{initialSeed -1}} {
	next $initialSeed 214013 2531011 [expr {2**31}] [expr {2**16}]
    }
}


w = 32                                 ' Change for different integer size
b = 0                                  ' Initial BSD seed
m = 0                                  ' Initial MS seed

Print "BSD"                            ' Get the first 10 numbers from BSD
For i = 1 To 10
    GoSub _randBSD
    Print Pop()
Next i

Print

Print "Microsoft"                      ' Get the first 10 numbers from MS
For i = 1 To 10
    GoSub _randMS
    Print Pop()
Next i

End

_randBSD                               ' ( n1 -- n2)
    Push (1103515245 * b + 12345)      ' Compensate for the sign bit
    If Tos() < 0 Then Push (Pop() - (2 ^ (w-1)))
    b = Pop() % (2 ^ 31)               ' Now we got a number less than 2^31
    Push b                             ' So we can complete the operation
Return

_randMS                                ' ( n1 -- n2)
    Push (214013 * m + 2531011)        ' Compensate for the sign bit
    If Tos() < 0 Then Push (Pop() - (2 ^ (w-1)))
    m =  Pop() % (2 ^ 31)              ' Now we got a number less than 2^31
    Push m / (2 ^ 16)                  ' So we can complete the operation
Return


#! /bin/bash

function BSD() {
  SEED=$(((1103515245 * $SEED + 12345) % 2**31))
  echo "  $SEED"
}

function MS() {
  SEED=$(((214013 * $SEED + 2531011) % 2**31))
  echo "  $(($SEED / 2**16))"
}

function output() {
  SEED=0
  echo "$1"

  for i in {1..10}; do
    eval "$1"
  done

  echo ""
}

output BSD
output MS


Public stateBSD As Variant
Public stateMS As Variant
Private Function bsd() As Long
    Dim temp As Variant
    temp = CDec(1103515245 * stateBSD + 12345)
    temp2 = temp / 2 ^ 31
    temp3 = CDec(WorksheetFunction.Floor_Precise(temp2))
    stateBSD = temp - (2 ^ 31) * temp3
    bsd = stateBSD
End Function
Private Function ms() As Integer
    Dim temp As Variant
    temp = CDec(214013 * stateMS + 2531011)
    temp2 = temp / 2 ^ 31
    temp3 = CDec(WorksheetFunction.Floor_Precise(temp2))
    stateMS = temp - (2 ^ 31) * temp3
    ms = stateMS \ 2 ^ 16
End Function
Public Sub main()
    stateBSD = CDec(0)
    stateMS = CDec(0)
    Debug.Print "       BSD", "   MS"
    For i = 1 To 10
        Debug.Print Format(bsd, "@@@@@@@@@@"), Format(ms, "@@@@@")
    Next i
End Sub


import "/big" for BigInt
import "/fmt" for Fmt

// basic linear congruential generator
var lcg = Fn.new { |a, c, m, seed|
    var r = BigInt.new(seed)
    return Fn.new {
        r = (r*a + c) % m
        return r
    }
}

// Microsoft generator has extra division step
var msg = Fn.new { |seed|
    var g = lcg.call(214013, 2531011, 1<<31, seed)
    return Fn.new { g.call()/(1 << 16) }
}

var example = Fn.new { |seed|
    System.print("\nWith seed = %(seed):")
    var bsd = lcg.call(1103515245, 12345, 1<<31, seed)
    var msf = msg.call(seed)
    System.print("       BSD      MSF")
    for (i in 0..4) {
        Fmt.print("$10i    $5i", bsd.call(), msf.call())
    }
}

example.call(0)
example.call(1)


;x86-64 assembly code for Microsoft Windows
;Tested in windows 7 Enterprise Service Pack 1 64 bit
;With the AMD FX(tm)-6300 processor
;Assembled with NASM version 2.11.06
;Linked to C library with gcc version 4.9.2 (x86_64-win32-seh-rev1, Built by MinGW-W64 project)

;Assembled and linked with the following commands:
;nasm -f win64 <filename>.asm -o <filename>.obj
;gcc <filename>.obj -o <filename>

;Takes number of iterations to run RNG loop as command line parameter.

extern printf,puts,atoi,exit,time,malloc

section .data
align 64
errmsg_argnumber: db "There should be no more than one argument.",0
align 64
errmsg_noarg: db "Number of iterations was not specified.",0
align 64
errmsg_zeroiterations: db "Zero iterations of RNG loop specified.",0

align 64
errmsg_timefail: db "Unable to retrieve calender time.",0
align 64
errmsg_mallocfail: db "Unable to allocate memory for array of random numbers.",0

align 64
fmt_random: db "The %u number generated is %d",0xa,0xd,0

section .bss

section .text
global main

main:

;check for argument
cmp rcx,1
jle err_noarg

;ensure that only one argument was entered
cmp rcx,2
jg err_argnumber

;get number of times to iterate get_random
mov rcx,[rdx + 8]
call atoi

;ensure that number of iterations is greater than 0
cmp rax,0
jle err_zeroiterations
mov rcx,rax

;calculate space needed for an array containing the random numbers
shl rcx,2

;move size of array into r14
mov r14,rcx

;reserve memory for array of random numbers with malloc
call malloc

cmp rax,0
jz err_mallocfail

;pointer to array in r15
mov r15,rax

;seed the RNG using time()
xor rcx,rcx
call time

;ensure that time returns valid output
cmp rax,-1
jz err_timefail

;calculate address of end of array in r14
add r14,r15

;pointer to array of random numbers in r15
;address of end of array in r14
;current address in array in rdi
;multiplier in rbx
;seed in rax
;current random number in rcx

;prepare random number generator

mov rdi,r15

mov rbx,214013

get_random:

;multiply by 214013 and add 2561011 to get next state
mul ebx
add eax,2531011

;shr by 16 and AND with 0x7FFF to get current random number
mov ecx,eax
shr ecx,16
and ecx,0x7fff

;store random number in array
mov [rdi],ecx

add rdi,4
cmp rdi,r14
jl get_random

;pointer to array of random numbers in r15
;address of end of array in r14
;current address in array in rdi
;array index in rsi

xor rsi,rsi
mov rdi,r15

print_random:

mov rcx,fmt_random
mov rdx,rsi
mov r8d,[rdi]
call printf

add rsi,1
add rdi,4
cmp rdi,r14
jl print_random

xor rcx,rcx
call exit

;;;;;;;;;;ERROR MESSAGES;;;;;;;;;;;;;;;;

err_argnumber:

mov rcx,errmsg_argnumber
call puts

jmp exit_one

err_noarg:

mov rcx,errmsg_noarg
call puts

jmp exit_one

err_zeroiterations:

mov rcx,errmsg_zeroiterations
call puts

jmp exit_one

err_timefail:

mov rcx,errmsg_timefail
call puts

jmp exit_one

err_mallocfail:

mov rcx,errmsg_mallocfail
call puts

exit_one:

mov rcx,1
call exit


include c:\cxpl\codes;
int R;

func BSD;
[R:= (1103515245*R + 12345) & $7FFF_FFFF;
return R;
]; \BSD

func MSFT;
[R:= (214013*R + 2531011) & $7FFF_FFFF;
return R>>16;
]; \MSFT

int N;
[SetVid(4);             \320x200x2 graphics
R:= 0;                  \initialize seed
for N:= 0 to 5000 do
        Point(rem(BSD/180), rem(BSD/180), 3);
N:= ChIn(1);            \wait for keystoke

SetVid(4);              \320x200x2 graphics
R:= 0;                  \initialize seed
for N:= 0 to 5000 do
        Point(rem(MSFT/180), rem(MSFT/180), 3);
N:= ChIn(1);            \wait for keystoke
SetVid(3);              \restore normal text mode
]


var [private] seed = 0;
fcn srand(s){ seed = s }

const TWO31=(1).shiftLeft(31);

//#define BSD_RAND 1

#ifdef BSD_RAND
   const A=1103515245, C=12345;
   fcn rand{ seed = (seed * A + C) % TWO31 }
#else  // MS rand
   const A=214013, C=2531011, TWO16=(1).shiftLeft(16);
   fcn rand{ (seed = (seed * A + C) % TWO31) / TWO16 }
#endif


#include <cmath>
#include <iostream>
#include <unordered_map>
#include <vector>

std::vector<int> generate_primes(int limit) {
    std::vector<bool> sieve(limit >> 1, true);
    for (int p = 3, s = 9; s < limit; p += 2) {
        if (sieve[p >> 1]) {
            for (int q = s; q < limit; q += p << 1)
                sieve[q >> 1] = false;
        }
        s += (p + 1) << 2;
    }
    std::vector<int> primes;
    if (limit > 2)
        primes.push_back(2);
    for (int i = 1; i < sieve.size(); ++i) {
        if (sieve[i])
            primes.push_back((i << 1) + 1);
    }
    return primes;
}

class legendre_prime_counter {
public:
    explicit legendre_prime_counter(int limit);
    int prime_count(int n);
private:
    int phi(int x, int a);
    std::vector<int> primes;
    std::unordered_map<int, std::unordered_map<int, int>> phi_cache;
};

legendre_prime_counter::legendre_prime_counter(int limit) :
    primes(generate_primes(static_cast<int>(std::sqrt(limit)))) {}

int legendre_prime_counter::prime_count(int n) {
    if (n < 2)
        return 0;
    int a = prime_count(static_cast<int>(std::sqrt(n)));
    return phi(n, a) + a - 1;
}

int legendre_prime_counter::phi(int x, int a) {
    if (a == 0)
        return x;
    auto& map = phi_cache[x];
    auto i = map.find(a);
    if (i != map.end())
        return i->second;
    int result = phi(x, a - 1) - phi(x / primes[a - 1], a - 1);
    map[a] = result;
    return result;
}

int main() {
    legendre_prime_counter counter(1000000000);
    for (int i = 0, n = 1; i < 10; ++i, n *= 10)
        std::cout << "10^" << i << "\t" << counter.prime_count(n) << '\n';
}


sorenson = require('sieve').primes  # Sorenson's extensible sieve from task: Extensible Prime Generator

# put in outer scope to avoid recomputing the cache
memoPhi = {}
primes = []

isqrt = (x) -> Math.floor Math.sqrt x

pi = (n) ->
    phi = (x, a) ->
        y = memoPhi[[x,a]]
        return y unless y is undefined

        memoPhi[[x,a]] =
            if a is 0 then x
            else
                p = primes[a - 1]
                throw "You need to generate at least #{a} primes." if p is undefined
                phi(x, a - 1) - phi(x // p, a - 1)

    if n < 2
        0
    else
        a = pi isqrt n
        phi(n, a) + a - 1

maxPi = 1e9
gen = sorenson()
primes = while (p = gen.next().value) < isqrt maxPi then p

n = 1
for i in [0..9]
    console.log "10^#{i}\t#{pi(n)}"
    n *= 10


-mode(native).

-define(LIMIT, 1000000000).

main(_) ->
    put(primes, array:from_list(primality:sieve(floor(math:sqrt(?LIMIT))))),
    ets:new(memphi, [set, named_table, protected]),
    output(0, 9).

nthprime(N) -> array:get(N - 1, get(primes)).

output(A, B) -> output(A, B, 1).
output(A, B, _) when A > B -> ok;
output(A, B, N) ->
    io:format("10^~b    ~b~n", [A, pi(N)]),
    output(A + 1, B, N * 10).

pi(N) ->
    Primes = get(primes),
    Last = array:get(array:size(Primes) - 1, Primes),
    if
        N =< Last -> small_pi(N);
        true ->
            A = pi(floor(math:sqrt(N))),
            phi(N, A) + A - 1
    end.

phi(X, 0) -> X;
phi(X, A) ->
    case ets:lookup(memphi, {X, A}) of
        [] ->
            Phi = phi(X, A-1) - phi(X div nthprime(A), A-1),
            ets:insert(memphi, {{X, A}, Phi}),
            Phi;

        [{{X, A}, Phi}] -> Phi
    end.

% Use binary search to count primes that we have already listed.
small_pi(N) ->
    Primes = get(primes),
    small_pi(N, Primes, 0, array:size(Primes)).

small_pi(_, _, L, H) when L >= (H - 1) -> L + 1;
small_pi(N, Primes, L, H) ->
    M = (L + H) div 2,
    P = array:get(M, Primes),
    if
        N > P -> small_pi(N, Primes, M, H);
        N < P -> small_pi(N, Primes, 0, M);
        true -> M + 1
    end.


package main

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

var limit = int(math.Sqrt(1e9))
var primes = rcu.Primes(limit)
var memoPhi = make(map[int]int)

func cantorPair(x, y int) int {
    if x < 0 || y < 0 {
        log.Fatal("Arguments must be non-negative integers.")
    }
    return (x*x + 3*x + 2*x*y + y + y*y) / 2
}

func phi(x, a int) int {
    if a == 0 {
        return x
    }
    key := cantorPair(x, a)
    if v, ok := memoPhi[key]; ok {
        return v
    }
    pa := primes[a-1]
    memoPhi[key] = phi(x, a-1) - phi(x/pa, a-1)
    return memoPhi[key]
}

func pi(n int) int {
    if n < 2 {
        return 0
    }
    a := pi(int(math.Sqrt(float64(n))))
    return phi(n, a) + a - 1
}

func main() {
    for i, n := 0, 1; i <= 9; i, n = i+1, n*10 {
        fmt.Printf("10^%d  %d\n", i, pi(n))
    }
}


import java.util.*;

public class LegendrePrimeCounter {
    public static void main(String[] args) {
        LegendrePrimeCounter counter = new LegendrePrimeCounter(1000000000);
        for (int i = 0, n = 1; i < 10; ++i, n *= 10)
            System.out.printf("10^%d\t%d\n", i, counter.primeCount((n)));
    }

    private List<Integer> primes;
    private Map<Integer, Map<Integer, Integer>> phiCache = new HashMap<>();

    public LegendrePrimeCounter(int limit) {
        primes = generatePrimes((int)Math.sqrt((double)limit));
    }

    public int primeCount(int n) {
        if (n < 2)
            return 0;
        int a = primeCount((int)Math.sqrt((double)n));
        return phi(n, a) + a - 1;
    }

    private int phi(int x, int a) {
        if (a == 0)
            return x;
        Map<Integer, Integer> map = phiCache.computeIfAbsent(x, k -> new HashMap<>());
        Integer value = map.get(a);
        if (value != null)
            return value;
        int result = phi(x, a - 1) - phi(x / primes.get(a - 1), a - 1);
        map.put(a, result);
        return result;
    }

    private static List<Integer> generatePrimes(int limit) {
        boolean[] sieve = new boolean[limit >> 1];
        Arrays.fill(sieve, true);
        for (int p = 3, s = 9; s < limit; p += 2) {
            if (sieve[p >> 1]) {
                for (int q = s; q < limit; q += p << 1)
                    sieve[q >> 1] = false;
            }
            s += (p + 1) << 2;
        }
        List<Integer> primes = new ArrayList<>();
        if (limit > 2)
            primes.add(2);
        for (int i = 1; i < sieve.length; ++i) {
            if (sieve[i])
                primes.add((i << 1) + 1);
        }
        return primes;
    }
}


data Memo a = Node a (Memo a) (Memo a)
  deriving Functor

memo :: Integral a => Memo p -> a -> p
memo (Node a l r) n
  | n == 0 = a
  | odd n = memo l (n `div` 2)
  | otherwise = memo r (n `div` 2 - 1)

nats :: Integral a => Memo a
nats = Node 0 ((+1).(*2) <$> nats) ((*2).(+1) <$> nats)

memoize :: Integral a => (a -> b) -> a -> b
memoize f = memo (f <$> nats)

memoize2 :: (Integral a, Integral b) => (a -> b -> c) -> a -> b -> c
memoize2 f = memoize (memoize . f)

memoList :: [b] -> Integer -> b
memoList = memo . mkList
  where
    mkList (x:xs) = Node x (mkList l) (mkList r)
      where (l,r) = split xs
            split [] = ([],[])
            split [x] = ([x],[])
            split (x:y:xs) = let (l,r) = split xs in (x:l, y:r)


# For the sake of the accuracy of integer arithmetic when using gojq:
def power($b): . as $in | reduce range(0;$b) as $i (1; . * $in);

# Input: $n, which is assumed to be positive integer,
# Output: an array of primes less than or equal to $n (e.g. 10|eratosthenes #=> [2,3,5,7]
def eratosthenes:
  # erase(i) sets .[i*j] to false for integral j > 1
  def erase(i):
    if .[i] then
      reduce range(2; (1 + length) / i) as $j (.; .[i * $j] = false)
    else .
    end;

  (. + 1) as $n
  | (($n|sqrt) / 2) as $s
  | [null, null, range(2; $n)]
  | reduce (2, 1 + (2 * range(1; $s))) as $i (.; erase($i))
  | map(select(.)) ;


using Primes

function primepi(N)
    delta = round(Int, N^0.8)
    return sum(i -> count(primesmask(i, min(i + delta - 1, N))), 1:delta:N)
end

@time for power in 0:9
    println("10^", rpad(power, 5), primepi(10^power))
end


ClearAll[Phi,pi]
$RecursionLimit = 10^6;
Phi[x_, 0] := x
Phi[x_, a_] := Phi[x, a] = Phi[x, a - 1] - Phi[Floor[x/Prime[a]], a - 1]
pi[n_] := Module[{a}, If[n < 2, 0, a = pi[Floor[Sqrt[n]]]; Phi[n, a] + a - 1]]
Scan[Print[pi[10^#]] &, Range[0,9]]


import math, strutils, sugar, tables

const
  N = 1_000_000_000
  S = sqrt(N.toFloat).int

var composite: array[3..S, bool]
for n in countup(3, S, 2):
  if n * n > S: break
  if not composite[n]:
    for k in countup(n * n, S, 2 * n):
      composite[k] = true

# Prime list. Add a dummy zero to start at index 1.
let primes = @[0, 2] & collect(newSeq, for n in countup(3, S, 2): (if not composite[n]: n))

var cache: Table[(Natural, Natural), Natural]

proc phi(x, a: Natural): Natural =
  if a == 0: return x
  let pair = (x, a)
  if pair in cache: return cache[pair]
  result = phi(x, a - 1) - phi(x div primes[a], a - 1)
  cache[pair] = result

proc π(n: Natural): Natural =
  if n <= 2: return 0
  let a = π(sqrt(n.toFloat).Natural)
  result = phi(n, a) + a - 1

var n = 1
for i in 0..9:
  echo "π(10^$1) = $2".format(i, π(n))
  n *= 10


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Legendre_prime_counting_function
use warnings;
no warnings qw(recursion);
use ntheory qw( nth_prime prime_count );

my (%cachephi, %cachepi);

sub phi
  {
  return $cachephi{"@_"} //= do {
    my ($x, $aa) = @_;
    $aa <= 0 ? $x : phi($x, $aa - 1) - phi(int $x / nth_prime($aa), $aa - 1) };
  }

sub pi
  {
  return $cachepi{$_[0]} //= do {
    my $n = shift;
    $n < 2 ? 0 : do{ my $aa = pi(int sqrt $n); phi($n, $aa) + $aa - 1 } };
  }

print "e             n   Legendre    ntheory\n",
      "-             -   --------    -------\n";
for (1 .. 9)
  {
  printf "%d  %12d %10d %10d\n", $_, 10**$_, pi(10**$_), prime_count(10**$_);
  }


with javascript_semantics
--
-- While a phix dictionary can handle keys of {x,a}, for this
-- task performance was dreadful (7,612,479 entries, >3mins),
-- so instead memophix maps known x to an index to memophia
-- which holds the full [1..a] for each x, dropping to a much
-- more respectable (albeit not super-fast) 14s
--
constant memophix = new_dict()
sequence memophia = {}  -- 1..a (max 3401) for each x

function phi(integer x, a)
    if a=0 then return x end if
    integer adx = getd(x,memophix), res
    if adx=NULL then
        memophia = append(memophia,repeat(-1,a))
        adx = length(memophia)
        setd(x,adx,memophix)
    else
        object ma = memophia[adx]
        integer l = length(ma)
        if a>l then
            memophia[adx] = 0   -- kill refcount
            memophia[adx] = ma & repeat(-1,a-l)
        else
            res = ma[a]
            if res>=0 then return res end if
        end if
        ma = 0                  -- kill refcount
    end if
    res = phi(x, a-1) - phi(floor(x/get_prime(a)), a-1)
    memophia[adx][a] = res
    return res
end function

function pi(integer n)
    if n<2 then return 0 end if
    integer a = pi(floor(sqrt(n)))
    return phi(n, a) + a - 1
end function

atom t0 = time()
for i=0 to iff(platform()=JS?8:9) do
    printf(1,"10^%d  %d\n",{i,pi(power(10,i))})
--  printf(1,"10^%d  %d\n",{i,length(get_primes_le(power(10,i)))})
end for
?elapsed(time()-t0)


table(+, +, nt)
phi(X, 0, _) = X.
phi(X, A, Primes) = phi(X, A - 1, Primes) - phi(X // Primes[A], A - 1, Primes).

pi(N) = Count, N < 2 => Count = 0.
pi(N) = Count =>
    M = floor(sqrt(N)),
    A = pi(M),
    Count = phi(N, A, math.primes(M)) + A - 1.

main =>
    N = 1,
    foreach (K in 0..9)
        writef("10^%w    %w%n", K, pi(N)),
        N := N * 10.


use Math::Primesieve;

my $sieve = Math::Primesieve.new;

say "10^$_\t" ~ $sieve.count: exp($_,10) for ^10;

say (now - INIT now) ~ ' elapsed seconds';


func legendre_phi(x, a) is cached {
    return x if (a <= 0)
    __FUNC__(x, a-1) - __FUNC__(idiv(x, a.prime), a-1)
}

func legendre_prime_count(n) is cached {
    return 0 if (n < 2)
    var a = __FUNC__(n.isqrt)
    legendre_phi(n, a) + a - 1
}

print("e             n   Legendre    builtin\n",
      "-             -   --------    -------\n")

for n in (1 .. 9) {
    printf("%d  %12d %10d %10d\n", n, 10**n,
        legendre_prime_count(10**n), prime_count(10**n))
    assert_eq(legendre_prime_count(10**n), prime_count(10**n))
}


import Foundation

extension Numeric where Self: Strideable {
  @inlinable
  public func power(_ n: Self) -> Self {
    return stride(from: 0, to: n, by: 1).lazy.map({_ in self }).reduce(1, *)
  }
}

func eratosthenes(limit: Int) -> [Int] {
  guard limit >= 3 else {
    return limit < 2 ? [] : [2]
  }

  let ndxLimit = (limit - 3) / 2 + 1
  let bufSize = ((limit - 3) / 2) / 32 + 1
  let sqrtNdxLimit = (Int(Double(limit).squareRoot()) - 3) / 2 + 1
  var cmpsts = Array(repeating: 0, count: bufSize)

  for ndx in 0..<sqrtNdxLimit where (cmpsts[ndx >> 5] & (1 << (ndx & 31))) == 0 {
    let p = ndx + ndx + 3
    var cullPos = (p * p - 3) / 2

    while cullPos < ndxLimit {
      cmpsts[cullPos >> 5] |= 1 << (cullPos & 31)

      cullPos += p
    }
  }

  return (-1..<ndxLimit).compactMap({i -> Int? in
    if i < 0 {
      return 2
    } else {
      if cmpsts[i >> 5] & (1 << (i & 31)) == 0 {
        return .some(i + i + 3)
      } else {
        return nil
      }
    }
  })
}

let primes = eratosthenes(limit: 1_000_000_000)

func φ(_ x: Int, _ a: Int) -> Int {
  struct Cache {
    static var cache = [String: Int]()
  }

  guard a != 0 else {
    return x
  }

  guard Cache.cache["\(x),\(a)"] == nil else {
    return Cache.cache["\(x),\(a)"]!
  }

  Cache.cache["\(x),\(a)"] = φ(x, a - 1) - φ(x / primes[a - 1], a - 1)

  return Cache.cache["\(x),\(a)"]!
}

func π(n: Int) -> Int {
  guard n > 2 else {
    return 0
  }

  let a = π(n: Int(Double(n).squareRoot()))

  return φ(n, a) + a - 1
}

for i in 0..<10 {
  let n = 10.power(i)

  print("π(10^\(i)) = \(π(n: n))")
}


import "/math" for Int

var limit = 1e9.sqrt.floor
var primes = Int.primeSieve(limit)
var memoPhi = {}

var phi // recursive function
phi = Fn.new { |x, a|
    if (a == 0) return x
    var key = Int.cantorPair(x, a)
    if (memoPhi.containsKey(key)) return memoPhi[key]
    var pa = primes[a-1]
    return memoPhi[key] = phi.call(x, a-1) - phi.call((x/pa).floor, a-1)
}

var pi // recursive function
pi = Fn.new { |n|
    if (n < 2) return 0
    var a = pi.call(n.sqrt.floor)
    return phi.call(n, a) + a - 1
}

var n = 1
for (i in 0..9) {
    System.print("10^%(i)  %(pi.call(n))")
    n = n * 10
}


F add_with_carry(&result, =addend, =addendpos)
   L
      L result.len < addendpos + 1
         result.append(‘0’)
      V addend_result = String(Int(addend) + Int(result[addendpos]))
      V addend_digits = Array(addend_result)
      result[addendpos] = addend_digits.pop()

      I addend_digits.empty
         L.break

      addend = addend_digits.pop()
      addendpos++

F longhand_multiplication(multiplicand, multiplier)
   [Char] result
   L(multiplicand_digit) reversed(multiplicand)
      V multiplicand_offset = L.index
      L(multiplier_digit) reversed(multiplier)
         V multiplier_offset = L.index + multiplicand_offset
         V multiplication_result = String(Int(multiplicand_digit) * Int(multiplier_digit))

         L(result_digit_addend) reversed(multiplication_result)
            V addend_offset = L.index + multiplier_offset
            add_with_carry(&result, result_digit_addend, addend_offset)

   result.reverse()
   R result.join(‘’)

V sixtyfour = ‘18446744073709551616’
print(longhand_multiplication(sixtyfour, sixtyfour))


LONGINT  CSECT
         USING  LONGINT,R13
SAVEAREA B      PROLOG-SAVEAREA(R15)
         DC     17F'0'
         DC     CL8'LONGINT'
PROLOG   STM    R14,R12,12(R13)
         ST     R13,4(R15)
         ST     R15,8(R13)
         LR     R13,R15
         MVC    XX(1),=C'1'
         MVC    LENXX,=H'1'        xx=1
         LA     R2,64
LOOPII   ST     R2,RLOOPII         do for 64
         MVC    X-2(LL+2),XX-2     x=xx
         MVC    Y(1),=C'2'
         MVC    LENY,=H'1'         y=2
         BAL    R14,LONGMULT
         MVC    XX-2(LL+2),Z-2     xx=longmult(xx,2)   xx=xx*2
         L      R2,RLOOPII
ELOOPII  BCT    R2,LOOPII          loop
         MVC    X-2(LL+2),XX-2
         MVC    Y-2(LL+2),XX-2
         BAL    R14,LONGMULT
         MVC    YY-2(LL+2),Z-2     yy=longmult(xx,xx)  yy=xx*xx
         XPRNT  XX,LL              output xx
         XPRNT  YY,LL              output yy
RETURN   L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)
         XR     R15,R15            set return code
         BR     R14                return to caller
RLOOPII  DS     F
*
LONGMULT EQU    *                  function longmult z=(x,y)
         MVC    LENSHIFT,=H'0'     shift=''
         MVC    LENZ,=H'0'         z=''
         LH     R6,LENX
         LA     R6,1(R6)           from lenx
         XR     R8,R8
         BCTR   R8,0               by -1
         LA     R9,0               to 1
LOOPI    BXLE   R6,R8,ELOOPI       do i=lenx to 1 by -1
         LA     R2,X
         AR     R2,R6              +i
         BCTR   R2,0
         MVC    CI,0(R2)           ci=substr(x,i,1)
         IC     R0,CI              ni=integer(ci)
         N      R0,=X'0000000F'
         STH    R0,NI
         MVC    LENT,=H'0'         t=''
         SR     R0,R0
         STH    R0,CARRY           carry=0
         LH     R7,LENY
         LA     R7,1(R7)           from lenx
         XR     R10,R10
         BCTR   R10,0              by -1
         LA     R11,0              to 1
LOOPJ1   BXLE   R7,R10,ELOOPJ1     do j=leny to 1 by -1
         LA     R2,Y
         AR     R2,R7              +j
         BCTR   R2,0
         MVC    CJ,0(R2)           cj=substr(y,j,1)
         IC     R0,CJ
         N      R0,=X'0000000F'
         STH    R0,NJ              nj=integer(cj)
         LH     R2,NI
         MH     R2,NJ
         AH     R2,CARRY
         STH    R2,NKR             nkr=ni*nj+carry
         LH     R2,NKR
         LA     R1,10
         SRDA   R2,32
         DR     R2,R1
         STH    R2,NK              nk=nkr//10
         STH    R3,CARRY           carry=nkr/10
         LH     R2,NK
         O      R2,=X'000000F0'
         STC    R2,CK              ck=string(nk)
         MVC    TEMP,T
         MVC    T(1),CK
         MVC    T+1(LL-1),TEMP
         LH     R2,LENT
         LA     R2,1(R2)
         STH    R2,LENT            t=ck!!t
         B      LOOPJ1             next j
ELOOPJ1  EQU    *
         LH     R2,CARRY
         O      R2,=X'000000F0'
         STC    R2,CK              ck=string(carry)
         MVC    TEMP,T
         MVC    T(1),CK
         MVC    T+1(LL-1),TEMP
         LH     R2,LENT
         LA     R2,1(R2)
         STH    R2,LENT            t=ck!!t
         LA     R2,T
         AH     R2,LENT
         LH     R3,LENSHIFT
         LA     R4,SHIFT
         LH     R5,LENSHIFT
         MVCL   R2,R4
         LH     R2,LENT
         AH     R2,LENSHIFT
         STH    R2,LENT            t=t!!shift
IF1      LH     R4,LENZ
         CH     R4,LENT            if lenz>lent
         BNH    ELSE1
         LH     R2,LENZ            then
         LA     R2,1(R2)
         STH    R2,L               l=lenz+1
         B      EIF1
ELSE1    LH     R2,LENT            else
         LA     R2,1(R2)
         STH    R2,L               l=lent+1
EIF1     EQU    *
         MVI    TEMP,C'0'          to
         MVC    TEMP+1(LL-1),TEMP
         LA     R2,TEMP
         AH     R2,L
         SH     R2,LENZ
         LH     R3,LENZ
         LA     R4,Z
         LH     R5,LENZ
         MVCL   R2,R4
         MVC    LENZ,L
         MVC    Z,TEMP             z=right(z,l,'0')
         MVI    TEMP,C'0'          to
         MVC    TEMP+1(LL-1),TEMP
         LA     R2,TEMP
         AH     R2,L
         SH     R2,LENT
         LH     R3,LENT
         LA     R4,T
         LH     R5,LENT
         MVCL   R2,R4
         MVC    LENT,L
         MVC    T,TEMP             t=right(t,l,'0')
         MVC    LENW,=H'0'         w=''
         SR     R0,R0
         STH    R0,CARRY           carry=0
         LH     R7,L
         LA     R7,1(R7)           from l
         XR     R10,R10
         BCTR   R10,0              by -1
         LA     R11,0              to 1
LOOPJ2   BXLE   R7,R10,ELOOPJ2     do j=l to 1 by -1
         LA     R2,Z
         AR     R2,R7              +j
         BCTR   R2,0
         MVC    CZ,0(R2)           cz=substr(z,j,1)
         IC     R0,CZ
         N      R0,=X'0000000F'
         STH    R0,NZ              nz=integer(cz)
         LA     R2,T
         AR     R2,R7              -j
         BCTR   R2,0
         MVC    CT,0(R2)           ct=substr(t,j,1)
         IC     R0,CT
         N      R0,=X'0000000F'
         STH    R0,NT              nt=integer(ct)
         LH     R2,NZ
         AH     R2,NT
         AH     R2,CARRY
         STH    R2,NKR             nkr=nz+nt+carry
         LH     R2,NKR
         LA     R1,10
         SRDA   R2,32
         DR     R2,R1
         STH    R2,NK
         STH    R3,CARRY           nk=nkr//10; carry=nkr/10
         LH     R2,NK
         O      R2,=X'000000F0'
         STC    R2,CK              ck=string(nk)
         MVC    TEMP,W
         MVC    W(1),CK
         MVC    W+1(LL-1),TEMP
         LH     R2,LENW
         LA     R2,1(R2)
         STH    R2,LENW            w=ck!!w
         B      LOOPJ2             next j
ELOOPJ2  EQU    *
         LH     R2,CARRY
         O      R2,=X'000000F0'
         STC    R2,CK             ck=string(carry)
         MVC    Z(1),CK
         MVC    Z+1(LL-1),W
         LH     R2,LENW
         LA     R2,1(R2)
         STH    R2,LENZ            z=ck!!w
         LA     R7,0               from 1
         LA     R10,1              by 1
         LH     R11,LENZ           to lenz
LOOPJ3   BXH    R7,R10,ELOOPJ3     do j=1 to lenz
         LA     R2,Z
         AR     R2,R7              j
         BCTR   R2,0
         MVC    ZJ(1),0(R2)        zj=substr(z,j,1)
         CLI    ZJ,C'0'            if zj^='0'
         BNE    ELOOPJ3            then leave j
         B      LOOPJ3             next j
ELOOPJ3  EQU    *
IF2      CH     R7,LENZ            if j>lenz
         BNH    EIF2
         LH     R7,LENZ            then j=lenz
EIF2     EQU    *
         LA     R2,TEMP            to
         LH     R3,LENZ
         SR     R3,R7              -j
         LA     R3,1(R3)
         STH    R3,LENTEMP
         LA     R4,Z               from
         AR     R4,R7              +j
         BCTR   R4,0
         LR     R5,R3
         MVCL   R2,R4
         MVC    Z-2(LL+2),TEMP-2   z=substr(z,j)
         LA     R2,SHIFT
         AH     R2,LENSHIFT
         MVI    0(R2),C'0'
         LH     R3,LENSHIFT
         LA     R3,1(R3)
         STH    R3,LENSHIFT        shift=shift!!'0'
         MVC    TEMP,Z
         LA     R2,TEMP
         AH     R2,LENZ
         MVC    0(2,R2),=C'  '
         B      LOOPI              next i
ELOOPI   EQU    *
         MVI    TEMP,C' '
         LA     R2,Z
         AH     R2,LENZ
         LH     R3,=AL2(LL)
         SH     R3,LENZ
         LA     R4,TEMP
         LH     R5,=H'1'
         ICM    R5,8,=C' '
         MVCL   R2,R4              z=clean(z)
         BR     R14                end function longmult
*
L        DS     H
NI       DS     H
NJ       DS     H
NK       DS     H
NZ       DS     H
NT       DS     H
CARRY    DS     H
NKR      DS     H
CI       DS     CL1
CJ       DS     CL1
CZ       DS     CL1
CT       DS     CL1
CK       DS     CL1
ZJ       DS     CL1
LENXX    DS     H
XX       DS     CL94
LENYY    DS     H
YY       DS     CL94
LENX     DS     H
X        DS     CL94
LENY     DS     H
Y        DS     CL94
LENZ     DS     H
Z        DS     CL94
LENT     DS     H
T        DS     CL94
LENW     DS     H
W        DS     CL94
LENSHIFT DS     H
SHIFT    DS     CL94
LENTEMP  DS     H
TEMP     DS     CL94
LL       EQU    94
         YREGS
         END    LONGINT


package Long_Multiplication is
   type Number (<>) is private;

   Zero : constant Number;
   One  : constant Number;

   function Value (Item : in String) return Number;
   function Image (Item : in Number) return String;

   overriding
   function "=" (Left, Right : in Number) return Boolean;

   function "+" (Left, Right : in Number) return Number;
   function "*" (Left, Right : in Number) return Number;

   function Trim (Item : in Number) return Number;
private
   Bits : constant := 16;
   Base : constant := 2 ** Bits;

   type Accumulated_Value is range 0 .. (Base - 1) * Base;
   subtype Digit is Accumulated_Value range 0 .. Base - 1;

   type Number is array (Natural range <>) of Digit;
   for Number'Component_Size use Bits; -- or pragma Pack (Number);

   Zero : constant Number := (1 .. 0 => 0);
   One  : constant Number := (0 => 1);

   procedure Divide (Dividend  : in     Number;
                     Divisor   : in     Digit;
                     Result    :    out Number;
                     Remainder :    out Digit);
end Long_Multiplication;


PRAGMAT precision=200 PRAGMAT
MODE INTEGER = LONG LONG INT;

LONG INT default integer width := 69;
INT width = 69+2;

INT fix w = 1, fix h = 1; # round up #

LONG LONG INT golden ratio w := ENTIER ((long long sqrt(5)-1) / 2 * LENG LENG 10 ** default integer width + fix w),
              golden ratio h := ENTIER ((long long sqrt(5)+1) / 2 * LENG LENG 10 ** default integer width + fix h);

test: (
  print((
    "The approximate golden ratios, width: ",  whole(golden ratio w,width), new line,
    "                              length: ", whole(golden ratio h,width), new line,
    "                product is exactly: ", whole(golden ratio w*golden ratio h,width*2), new line));

  INTEGER two to the power of 64 = LONG 2 ** 64;
  INTEGER neg two to the power of 64 = -(LONG 2 ** 64);
  print(("2 ** 64 * -(2 ** 64) = ", whole(two to the power of 64*neg two to the power of 64,width), new line))
)


begin
    % long multiplication of large integers                                 %
    % large integers are represented by arrays of integers whose absolute   %
    % values are in 0 .. ELEMENT_MAX - 1                                    %
    % negative large integers should have negative values in all non-zero   %
    % elements                                                              %
    % the least significant digits of the large integer are in element 1    %
    integer ELEMENT_DIGITS; % number of digits in an element of a large     %
                            % integer                                       %
    integer ELEMENT_MAX;    % max absolute value of an element of a large   %
                            % integer - must be 10^( ELEMENT_DIGITS + 1 )   %
    integer ELEMENT_COUNT;  % number of elements in each large integer      %
    % implements long multiplication, c is set to a * b                     %
    %     c can be the same array as a or b                                 %
    %     n is the number of elements in the large integers a, b and c      %
    procedure longMultiply( integer array a, b, c ( * )
                          ; integer value n
                          ) ;
    begin
        % multiplies the large integer in b by the integer a, the result    %
        %     is added to c, starting from offset                           %
        %     overflow is ignored                                           %
        procedure multiplyElement( integer value a
                                 ; integer array b, c ( * )
                                 ; integer value offset, n
                                 ) ;
        begin
            integer carry, cPos;
            carry := 0;
            cPos  := offset;
            for bPos := 1 until highestNonZeroElementPosition( b, ( n + 1 ) - offset ) do begin
                integer cElement;
                cElement := c( cPos ) + ( a * b( bPos ) ) + carry;
                if abs cElement < ELEMENT_MAX then carry := 0
                else begin
                    % have digits to carry                                  %
                    carry    := cElement div ELEMENT_MAX;
                    cElement := ( abs cElement ) rem ELEMENT_MAX;
                    if carry < 0 then cElement := - cElement
                end if_no_carry_ ;
                c( cPos ) := cElement;
                cPos := cPos + 1
            end for_aPos ;
            if cPos <= n then c( cPos ) := carry
        end multiplyElement ;
        integer array mResult ( 1 :: n );
        % the result will be computed in mResult, allowing a or b to be c   %
        for rPos := 1 until n do mResult( rPos ) := 0;
        % multiply and add each element to the result                       %
        for aPos := 1 until highestNonZeroElementPosition( a, n ) do begin
            if a( aPos ) not = 0 then multiplyElement( a( aPos ), b, mResult, aPos, n )
        end for_aPos ;
        % return the result in c                                            %
        for rPos := 1 until n do c( rPos ) := mResult( rPos )
    end longMultiply ;
    % writes the decimal value of a large integer a with n elements         %
    procedure writeonLargeInteger( integer array a ( * )
                                 ; integer value n
                                 ) ;
    begin
        integer aMax;
        aMax := highestNonZeroElementPosition( a, n );
        if aMax < 1 then writeon( "0" )
        else begin
            % the large integer is non-zero                                 %
            writeon( i_w := 1, s_w := 0, a( aMax ) ); % highest element     %
            % handle the remaining elements - show leading zeros            %
            for aPos := aMax - 1 step -1 until 1 do begin
                integer v;
                integer array digits ( 1 :: ELEMENT_DIGITS );
                v := abs a( aPos );
                for dPos := ELEMENT_DIGITS step -1 until 1 do begin
                    digits( dPos ) := v rem 10;
                    v              := v div 10
                end for_dPos;
                for dPos := 1 until ELEMENT_DIGITS do writeon( i_w := 1, s_w := 0, digits( dPos ) )
            end for_aPos
        end if_aMax_lt_1_
    end writeonLargeInteger ;
    % returns the position of the highest non-zero element of the large     %
    %     integer a with n elements                                         %
    integer procedure highestNonZeroElementPosition( integer array a ( * )
                                                   ; integer value n
                                                   ) ;
    begin
        integer aMax;
        aMax := n;
        while aMax > 0 and a( aMax ) = 0 do aMax := aMax - 1;
        aMax
    end highestNonZeroElementPosition ;
    % allow each element to contain 4 decimal digits, so element by element %
    % multiplication won't overflow 32-bits                                 %
    ELEMENT_DIGITS :=     4;
    ELEMENT_MAX    := 10000;
    ELEMENT_COUNT  :=    12; % allows up to 48 digits - enough for the task %
    begin
        integer array twoTo64, twoTo128 ( 1 :: ELEMENT_COUNT );
        integer pwr;
        % construct 2^64 in twoTo64                                         %
        for tPos := 2 until ELEMENT_COUNT do twoTo64( tPos ) := 0;
        twoTo64( 1 ) := 2;
        pwr          := 1;
        while pwr < 64 do begin
            longMultiply( twoTo64, twoTo64, twoTo64, ELEMENT_COUNT );
            pwr := pwr * 2
        end while_pwr_lt_64 ;
        % construct 2^128                                                   %
        longMultiply( twoTo64, twoTo64, twoTo128, ELEMENT_COUNT );
        write( "2^128: " );
        writeonLargeInteger( twoTo128, ELEMENT_COUNT )
    end
end.


MsgBox % x := mul(256,256)
MsgBox % x := mul(x,x)
MsgBox % x := mul(x,x) ; 18446744073709551616
MsgBox % x := mul(x,x) ; 340282366920938463463374607431768211456

mul(b,c) { ; <- b*c
   VarSetCapacity(a, n:=StrLen(b)+StrLen(c), 48), NumPut(0,a,n,"char")
   Loop % StrLen(c) {
      i := StrLen(c)+1-A_Index, cy := 0
      Loop % StrLen(b) {
         j := StrLen(b)+1-A_Index,
         t := SubStr(a,i+j,1) + SubStr(b,j,1) * SubStr(c,i,1) + cy
         cy := t // 10
         NumPut(mod(t,10)+48,a,i+j-1,"char")
      }
      NumPut(cy+48,a,i+j-2,"char")
   }
   Return cy ? a : SubStr(a,2)
}


BEGIN {
    DEBUG = 0
    n = 2^64
    nn = sprintf("%.0f", n)
    printf "2^64 * 2^64 = %.0f\n", multiply(nn, nn)
    printf "2^64 * 2^64 = %.0f\n", n*n
    exit
}

function multiply(x, y,     len_x,len_y,ax,ay,j,m,c,i,k,d,v,res,mul,result) {
    len_x = split_reverse(x, ax)
    len_y = split_reverse(y, ay)
    print_array(ax)
    print_array(ay)
    for (j=1; j<=len_y; j++) {
        m = ay[j]
        c = 0
        i = j - 1
        for (k=1; k<=len_x; k++) {
            d = ax[k]
            i++
            v = res[i]
            if (v == "") {
                append_array(res, 0)
                v = 0
            }
            mul = v + c + d*m
            c = int(mul / 10)
            v = mul % 10
            res[i] = v
        }
        append_array(res, c)
    }
    print_array(res)
    result = reverse_join(res)
    sub(/^0+/, "", result)
    return result
}

function split_reverse(x, a,        a_x) {
    split(x, a_x, "")
    return reverse_array(a_x, a)
}

function reverse_array(a,b,         len,i) {
    len = length_array(a)
    for (i in a) {
        b[1+len-i] = a[i]
    }
    return len
}

function length_array(a,        len,i) {
    len = 0
    for (i in a) len++
    return len
}

function append_array(a, value,     len) {
    len = length_array(a)
    a[++len] = value
}

function reverse_join(a,        len,str,i) {
    len = length_array(a)
    str = ""
    for (i=len; i>=1; i--) {
        str = str a[i]
    }
    return str
}

function print_array(a,         len,i) {
    if (DEBUG) {
        len = length_array(a)
        print "length=" len
        for (i=1; i<=len; i++) {
            printf("%s ", i%10)
        }
        print ""
        for (i=1; i<=len; i++) {
            #print i " " a[i]
            printf("%s ", a[i])
        }
        print ""
        print "===="
    }
}