class AVL-Tree {
    has $.root is rw = 0;

    class Node {
        has $.key    is rw = '';
        has $.parent is rw = 0;
        has $.data   is rw = 0;
        has $.left   is rw = 0;
        has $.right  is rw = 0;
        has Int $.balance is rw = 0;
        has Int $.height  is rw = 0;
    }

    #=====================================================
    # public methods
    #=====================================================

    #| returns a node object or 0 if not found
    method find($key) {
        return 0 if !$.root;
        self!find: $key, $.root;
    }

    #| returns a list of tree keys
    method keys() {
        return () if !$.root;
        my @list;
        self!keys: $.root, @list;
        @list;
    }

    #| returns a list of tree nodes
    method nodes() {
        return () if !$.root;
        my @list;
        self!nodes: $.root, @list;
        @list;
    }

    #| insert a node key, optionally add data (the `parent` arg is for
    #| internal use only)
    method insert($key, :$data = 0, :$parent = 0,) {
        return $.root = Node.new: :$key, :$parent, :$data if !$.root;
        my $n = $.root;
        while True {
            return False if $n.key eq $key;
            my $parent = $n;
            my $goLeft = $n.key > $key;
            $n = $goLeft ?? $n.left !! $n.right;
            if !$n {
                if $goLeft {
                    $parent.left = Node.new: :$key, :$parent, :$data;
                }
                else {
                    $parent.right = Node.new: :$key, :$parent, :$data;
                }
                self!rebalance: $parent;
                last
            }
        }
        True
    }

    #| delete one or more nodes by key
    method delete(*@del-key) {
        return if !$.root;
        for @del-key -> $del-key {
            my $child = $.root;
            while $child {
                my $node = $child;
                $child = $del-key >= $node.key ?? $node.right !! $node.left;
                if $del-key eq $node.key {
                    self!delete: $node;
                    next;
                }
            }
        }
    }

    #| show a list of all nodes by key
    method show-keys {
        self!show-keys: $.root;
        say()
    }

    #| show a list of all nodes' balances (not normally needed)
    method show-balances {
        self!show-balances: $.root;
        say()
    }

    #=====================================================
    # private methods
    #=====================================================

    method !delete($node) {
        if !$node.left && !$node.right {
            if !$node.parent {
                $.root = 0;
            }
            else {
                my $parent = $node.parent;
                if $parent.left === $node {
                    $parent.left = 0;
                }
                else {
                    $parent.right = 0;
                }
                self!rebalance: $parent;
            }
            return
        }

        if $node.left {
            my $child = $node.left;
            while $child.right {
                $child = $child.right;
            }
            $node.key = $child.key;
            self!delete: $child;
        }
        else {
            my $child = $node.right;
            while $child.left {
                $child = $child.left;
            }
            $node.key = $child.key;
            self!delete: $child;
        }
    }

    method !rebalance($n is copy) {
        self!set-balance: $n;

        if $n.balance == -2 {
            if self!height($n.left.left) >= self!height($n.left.right) {
                $n = self!rotate-right: $n;
            }
            else {
                $n = self!rotate-left'right: $n;
            }
        }
        elsif $n.balance == 2 {
            if self!height($n.right.right) >= self!height($n.right.left) {
                $n = self!rotate-left: $n;
            }
            else {
                $n = self!rotate-right'left: $n;
            }
        }

        if $n.parent {
            self!rebalance: $n.parent;
        }
        else {
            $.root = $n;
        }
    }

    method !rotate-left($a) {

        my $b     = $a.right;
        $b.parent = $a.parent;

        $a.right = $b.left;

        if $a.right {
            $a.right.parent = $a;
        }

        $b.left   = $a;
        $a.parent = $b;

        if $b.parent {
            if $b.parent.right === $a {
                $b.parent.right = $b;
            }
            else {
                $b.parent.left = $b;
            }
        }

        self!set-balance: $a, $b;
        $b;
    }

    method !rotate-right($a) {

        my $b = $a.left;
        $b.parent = $a.parent;

        $a.left = $b.right;

        if $a.left {
            $a.left.parent = $a;
        }

        $b.right  = $a;
        $a.parent = $b;

        if $b.parent {
            if $b.parent.right === $a {
                $b.parent.right = $b;
            }
            else {
                $b.parent.left = $b;
            }
        }

        self!set-balance: $a, $b;

        $b;
    }

    method !rotate-left'right($n) {
        $n.left = self!rotate-left: $n.left;
        self!rotate-right: $n;
    }

    method !rotate-right'left($n) {
        $n.right = self!rotate-right: $n.right;
        self!rotate-left: $n;
    }

    method !height($n) {
        $n ?? $n.height !! -1;
    }

    method !set-balance(*@n) {
        for @n -> $n {
            self!reheight: $n;
            $n.balance = self!height($n.right) - self!height($n.left);
        }
    }

    method !show-balances($n) {
        if $n {
            self!show-balances: $n.left;
            printf "%s ", $n.balance;
            self!show-balances: $n.right;
        }
    }

    method !reheight($node) {
        if $node {
            $node.height = 1 + max self!height($node.left), self!height($node.right);
        }
    }

    method !show-keys($n) {
        if $n {
            self!show-keys: $n.left;
            printf "%s ", $n.key;
            self!show-keys: $n.right;
        }
    }

    method !nodes($n, @list) {
        if $n {
            self!nodes: $n.left, @list;
            @list.push: $n if $n;
            self!nodes: $n.right, @list;
        }
    }

    method !keys($n, @list) {
        if $n {
            self!keys: $n.left, @list;
            @list.push: $n.key if $n;
            self!keys: $n.right, @list;
        }
    }

    method !find($key, $n) {
        if $n {
            self!find: $key, $n.left;
            return $n if $n.key eq $key;
            self!find: $key, $n.right;
        }
    }
}


Using #HASH-OFF, OPTION OICC ="^" , CICC ="^"


expected(n)=sum(i=1,n,n!/(n-i)!/n^i,0.);
test(n, times)={
  my(ct);
  for(i=1,times,
    my(x=1,bits);
    while(!bitand(bits,x),ct++; bits=bitor(bits,x); x = 1<<random(n))
  );
  ct
};
TIMES=1000000;
{for(n=1,20,
 my(cnt=test(n, TIMES),avg=cnt/TIMES,ex=expected(n),diff=(avg/ex-1)*100.);
 print(n"\t"avg*1."\t"ex*1."\t"diff);
)}


use List::Util qw(sum reduce);

sub find_loop {
    my($n) = @_;
    my($r,@seen);
    while () { $seen[$r] = $seen[($r = int(1+rand $n))] ? return sum @seen : 1 }
}

print " N    empiric      theoric      (error)\n";
print "===  =========  ============  =========\n";

my $MAX    = 20;
my $TRIALS = 1000;

for my $n (1 .. $MAX) {
    my $empiric = ( sum map { find_loop($n) } 1..$TRIALS ) / $TRIALS;
    my $theoric = sum map { (reduce { $a*$b } $_**2, ($n-$_+1)..$n ) / $n ** ($_+1) } 1..$n;

    printf "%3d  %9.4f  %12.4f   (%5.2f%%)\n",
            $n,  $empiric, $theoric, 100 * ($empiric - $theoric) / $theoric;
}


/* Sieve of Eratosthenes */
proc nonrec sieve([*] bool prime) void:
    word p, c, max;
    max := (dim(prime,1)-1)>>1;
    prime[0] := false;
    prime[1] := false;
    for p from 2 upto max do prime[p] := true od;
    for p from 2 upto max>>1 do
        if prime[p] then
            for c from p*2 by p upto max do
                prime[c] := false
            od
        fi
    od
corp

/* Count the prime factors of a number */
proc nonrec n_factors(word n; [*] bool prime) word:
    word count, fac;
    fac := 2;
    count := 0;
    while fac <= n do
        if prime[fac] then
            while n % fac = 0 do
                count := count + 1;
                n := n / fac
            od
        fi;
        fac := fac + 1
    od;
    count
corp

/* Find attractive numbers <= 120 */
proc nonrec main() void:
    word MAX = 120;
    [MAX+1] bool prime;
    unsigned MAX i;
    byte col;
    sieve(prime);
    col := 0;
    for i from 2 upto MAX do
        if prime[n_factors(i, prime)] then
            write(i:4);
            col := col + 1;
            if col % 18 = 0 then writeln() fi
        fi
    od
corp


// attractive_numbers.fsx
// taken from Primality by trial division
let rec primes =
    let next_state s = Some(s, s + 2)
    Seq.cache
        (Seq.append
            (seq[ 2; 3; 5 ])
            (Seq.unfold next_state 7
            |> Seq.filter is_prime))
and is_prime number =
    let rec is_prime_core number current limit =
        let cprime = primes |> Seq.item current
        if cprime >= limit then true
        elif number % cprime = 0 then false
        else is_prime_core number (current + 1) (number/cprime)
    if number = 2 then true
    elif number < 2 then false
    else is_prime_core number 0 number

// taken from Prime decomposition task and modified to add
let count_prime_divisors n =
    let rec loop c n count =
        let p = Seq.item n primes
        if c < (p * p) then count
        elif c % p = 0 then loop (c / p) n (count + 1)
        else loop c (n + 1) count
    loop n 0 1

let is_attractive = count_prime_divisors >> is_prime
let print_iter i n =
    if i % 10 = 9
    then printfn "%d" n
    else printf "%d\t" n

[1..120]
|> List.filter is_attractive
|> List.iteri print_iter


V base = [‘name’ = ‘Rocket Skates’, ‘price’ = ‘12.75’, ‘color’ = ‘yellow’]
V update = [‘price’ = ‘15.25’, ‘color’ = ‘red’, ‘year’ = ‘1974’]

V result = copy(base)
result.update(update)

print(result)


import scala.collection.mutable

class AVLTree[A](implicit val ordering: Ordering[A]) extends mutable.SortedSet[A] {

  if (ordering eq null) throw new NullPointerException("ordering must not be null")

  private var _root: AVLNode = _
  private var _size = 0

  override def size: Int = _size

  override def foreach[U](f: A => U): Unit = {
    val stack = mutable.Stack[AVLNode]()
    var current = root
    var done = false

    while (!done) {
      if (current != null) {
        stack.push(current)
        current = current.left
      } else if (stack.nonEmpty) {
        current = stack.pop()
        f.apply(current.key)

        current = current.right
      } else {
        done = true
      }
    }
  }

  def root: AVLNode = _root

  override def isEmpty: Boolean = root == null

  override def min[B >: A](implicit cmp: Ordering[B]): A = minNode().key

  def minNode(): AVLNode = {
    if (root == null) throw new UnsupportedOperationException("empty tree")
    var node = root
    while (node.left != null) node = node.left
    node
  }

  override def max[B >: A](implicit cmp: Ordering[B]): A = maxNode().key

  def maxNode(): AVLNode = {
    if (root == null) throw new UnsupportedOperationException("empty tree")
    var node = root
    while (node.right != null) node = node.right
    node
  }

  def next(node: AVLNode): Option[AVLNode] = {
    var successor = node
    if (successor != null) {
      if (successor.right != null) {
        successor = successor.right
        while (successor != null && successor.left != null) {
          successor = successor.left
        }
      } else {
        successor = node.parent
        var n = node
        while (successor != null && successor.right == n) {
          n = successor
          successor = successor.parent
        }
      }
    }
    Option(successor)
  }

  def prev(node: AVLNode): Option[AVLNode] = {
    var predecessor = node
    if (predecessor != null) {
      if (predecessor.left != null) {
        predecessor = predecessor.left
        while (predecessor != null && predecessor.right != null) {
          predecessor = predecessor.right
        }
      } else {
        predecessor = node.parent
        var n = node
        while (predecessor != null && predecessor.left == n) {
          n = predecessor
          predecessor = predecessor.parent
        }
      }
    }
    Option(predecessor)
  }

  override def rangeImpl(from: Option[A], until: Option[A]): mutable.SortedSet[A] = ???

  override def +=(key: A): AVLTree.this.type = {
    insert(key)
    this
  }

  def insert(key: A): AVLNode = {
    if (root == null) {
      _root = new AVLNode(key)
      _size += 1
      return root
    }

    var node = root
    var parent: AVLNode = null
    var cmp = 0

    while (node != null) {
      parent = node
      cmp = ordering.compare(key, node.key)
      if (cmp == 0) return node // duplicate
      node = node.matchNextChild(cmp)
    }

    val newNode = new AVLNode(key, parent)
    if (cmp <= 0) parent._left = newNode
    else parent._right = newNode

    while (parent != null) {
      cmp = ordering.compare(parent.key, key)
      if (cmp < 0) parent.balanceFactor -= 1
      else parent.balanceFactor += 1

      parent = parent.balanceFactor match {
        case -1 | 1 => parent.parent
        case x if x < -1 =>
          if (parent.right.balanceFactor == 1) rotateRight(parent.right)
          val newRoot = rotateLeft(parent)
          if (parent == root) _root = newRoot
          null
        case x if x > 1 =>
          if (parent.left.balanceFactor == -1) rotateLeft(parent.left)
          val newRoot = rotateRight(parent)
          if (parent == root) _root = newRoot
          null
        case _ => null
      }
    }

    _size += 1
    newNode
  }

  override def -=(key: A): AVLTree.this.type = {
    remove(key)
    this
  }

  override def remove(key: A): Boolean = {
    var node = findNode(key).orNull
    if (node == null) return false

    if (node.left != null) {
      var max = node.left

      while (max.left != null || max.right != null) {
        while (max.right != null) max = max.right

        node._key = max.key
        if (max.left != null) {
          node = max
          max = max.left
        }
      }
      node._key = max.key
      node = max
    }

    if (node.right != null) {
      var min = node.right

      while (min.left != null || min.right != null) {
        while (min.left != null) min = min.left

        node._key = min.key
        if (min.right != null) {
          node = min
          min = min.right
        }
      }
      node._key = min.key
      node = min
    }

    var current = node
    var parent = node.parent
    while (parent != null) {
      parent.balanceFactor += (if (parent.left == current) -1 else 1)

      current = parent.balanceFactor match {
        case x if x < -1 =>
          if (parent.right.balanceFactor == 1) rotateRight(parent.right)
          val newRoot = rotateLeft(parent)
          if (parent == root) _root = newRoot
          newRoot
        case x if x > 1 =>
          if (parent.left.balanceFactor == -1) rotateLeft(parent.left)
          val newRoot = rotateRight(parent)
          if (parent == root) _root = newRoot
          newRoot
        case _ => parent
      }

      parent = current.balanceFactor match {
        case -1 | 1 => null
        case _ => current.parent
      }
    }

    if (node.parent != null) {
      if (node.parent.left == node) {
        node.parent._left = null
      } else {
        node.parent._right = null
      }
    }

    if (node == root) _root = null

    _size -= 1
    true
  }

  def findNode(key: A): Option[AVLNode] = {
    var node = root
    while (node != null) {
      val cmp = ordering.compare(key, node.key)
      if (cmp == 0) return Some(node)
      node = node.matchNextChild(cmp)
    }
    None
  }

  private def rotateLeft(node: AVLNode): AVLNode = {
    val rightNode = node.right
    node._right = rightNode.left
    if (node.right != null) node.right._parent = node

    rightNode._parent = node.parent
    if (rightNode.parent != null) {
      if (rightNode.parent.left == node) {
        rightNode.parent._left = rightNode
      } else {
        rightNode.parent._right = rightNode
      }
    }

    node._parent = rightNode
    rightNode._left = node

    node.balanceFactor += 1
    if (rightNode.balanceFactor < 0) {
      node.balanceFactor -= rightNode.balanceFactor
    }

    rightNode.balanceFactor += 1
    if (node.balanceFactor > 0) {
      rightNode.balanceFactor += node.balanceFactor
    }
    rightNode
  }

  private def rotateRight(node: AVLNode): AVLNode = {
    val leftNode = node.left
    node._left = leftNode.right
    if (node.left != null) node.left._parent = node

    leftNode._parent = node.parent
    if (leftNode.parent != null) {
      if (leftNode.parent.left == node) {
        leftNode.parent._left = leftNode
      } else {
        leftNode.parent._right = leftNode
      }
    }

    node._parent = leftNode
    leftNode._right = node

    node.balanceFactor -= 1
    if (leftNode.balanceFactor > 0) {
      node.balanceFactor -= leftNode.balanceFactor
    }

    leftNode.balanceFactor -= 1
    if (node.balanceFactor < 0) {
      leftNode.balanceFactor += node.balanceFactor
    }
    leftNode
  }

  override def contains(elem: A): Boolean = findNode(elem).isDefined

  override def iterator: Iterator[A] = ???

  override def keysIteratorFrom(start: A): Iterator[A] = ???

  class AVLNode private[AVLTree](k: A, p: AVLNode = null) {

    private[AVLTree] var _key: A = k
    private[AVLTree] var _parent: AVLNode = p
    private[AVLTree] var _left: AVLNode = _
    private[AVLTree] var _right: AVLNode = _
    private[AVLTree] var balanceFactor: Int = 0

    def parent: AVLNode = _parent

    private[AVLTree] def selectNextChild(key: A): AVLNode = matchNextChild(ordering.compare(key, this.key))

    def key: A = _key

    private[AVLTree] def matchNextChild(cmp: Int): AVLNode = cmp match {
      case x if x < 0 => left
      case x if x > 0 => right
      case _ => null
    }

    def left: AVLNode = _left

    def right: AVLNode = _right
  }

}


with Ada.Text_Io; use Ada.Text_Io;

 procedure Doors is
    type Door_State is (Closed, Open);
    type Door_List is array(Positive range 1..100) of Door_State;
    The_Doors : Door_List := (others => Closed);
 begin
    for I in 1..100 loop
       for J in The_Doors'range loop
          if J mod I = 0 then
             if The_Doors(J) = Closed then
                 The_Doors(J) := Open;
             else
                The_Doors(J) := Closed;
             end if;
          end if;
       end loop;
    end loop;
    for I in The_Doors'range loop
       Put_Line(Integer'Image(I) & " is " & Door_State'Image(The_Doors(I)));
    end loop;
 end Doors;


constant MAX = 20,
         ITER = 1000000

function expected(integer n)
atom sum = 0
    for i=1 to n do
        sum += factorial(n) / power(n,i) / factorial(n-i)
    end for
    return sum
end function

function test(integer n)
integer count = 0, x, bits
    for i=1 to ITER do
        x = 1
        bits = 0
        while not and_bits(bits,x) do
            count += 1
            bits = or_bits(bits,x)
            x = power(2,rand(n)-1)
        end while
    end for
    return count/ITER
end function

atom av, ex
    puts(1," n     avg.     exp.  (error%)\n");
    puts(1,"==   ======   ======  ========\n");
    for n=1 to MAX do
        av = test(n)
        ex = expected(n)
        printf(1,"%2d %8.4f %8.4f  (%5.3f%%)\n", {n,av,ex,abs(1-av/ex)*100})
    end for


include ..\Utilitys.pmt

20 var MAX
100000 var ITER

def factorial 1 swap for * endfor enddef

def expected    /# n -- n #/
    >ps
    0
    tps for var i
        tps factorial tps i power / tps i - factorial / +
    endfor
    ps> drop
enddef

def condition over over bitand not enddef

def test    /# n -- n #/
    0 >ps
    ITER for var i
        0 1
        condition while
            ps> 1 + >ps
            bitor
            over rand * 1 + int 1 - 2 swap power
        condition endwhile
        drop drop
    endfor
    drop ps> ITER /
enddef

def printAll len for get print 9 tochar print endfor enddef

( "n" "avg." "exp." "(error%)" ) printAll drop nl
( "==" "======" "======" "========" ) printAll drop nl

MAX for var n
    n test
    n expected
    n rot rot over over / 1 swap - abs 100 * 4 tolist printAll drop nl
endfor


USING: formatting grouping io math.primes math.primes.factors
math.ranges sequences ;

"The attractive numbers up to and including 120 are:" print
120 [1,b] [ factors length prime? ] filter 20 <groups>
[ [ "%4d" printf ] each nl ] each


program attractive_numbers
    use iso_fortran_env, only: output_unit
    implicit none

    integer, parameter  :: maximum=120, line_break=20
    integer             :: i, counter

    write(output_unit,'(A,x,I0,x,A)') "The attractive numbers up to and including", maximum, "are:"

    counter = 0
    do i = 1, maximum
        if (is_prime(count_prime_factors(i))) then
            write(output_unit,'(I0,x)',advance="no") i
            counter = counter + 1
            if (modulo(counter, line_break) == 0) write(output_unit,*)
        end if
    end do
    write(output_unit,*)
contains
    pure function is_prime(n)
        integer, intent(in) :: n
        logical             :: is_prime
        integer             :: d

        is_prime = .false.

        d = 5
        if (n < 2) return
        if (modulo(n, 2) == 0) then
            is_prime = n==2
            return
        end if
        if (modulo(n, 3) == 0) then
            is_prime = n==3
            return
        end if

        do
            if (d**2 > n) then
                is_prime = .true.
                return
            end if
            if (modulo(n, d) == 0) then
                is_prime = .false.
                return
            end if
            d = d + 2
            if (modulo(n, d) == 0) then
                is_prime = .false.
                return
            end if
            d = d + 4
        end do

        is_prime = .true.
    end function is_prime

    pure function count_prime_factors(n)
        integer, intent(in)     :: n
        integer                 :: count_prime_factors
        integer                 :: i, f

        count_prime_factors = 0
        if (n == 1) return
        if (is_prime(n)) then
            count_prime_factors = 1
            return
        end if
        count_prime_factors = 0
        f = 2
        i = n

        do
            if (modulo(i, f) == 0) then
                count_prime_factors = count_prime_factors + 1
                i = i/f
                if (i == 1) exit
                if (is_prime(i)) f = i
            else if (f >= 3) then
                f = f + 2
            else
                f = 3
            end if
        end do
    end function count_prime_factors
end program attractive_numbers


with Ada.Text_Io;
with Ada.Containers.Indefinite_Ordered_Maps;

procedure Merge_Maps is
   use Ada.Text_Io;

   type Key_Type   is new String;
   type Value_Type is new String;

   package Maps is
     new Ada.Containers.Indefinite_Ordered_Maps (Key_Type     => Key_Type,
                                                 Element_Type => Value_Type);
   use Maps;

   function Merge (Original : Map; Update : Map) return Map is
      Result : Map    := Original;
      Cur    : Cursor := Update.First;
   begin
      while Has_Element (Cur) loop
         if Original.Contains (Key (Cur)) then
            Result.Replace_Element (Result.Find (Key (Cur)),
                                    Element (Cur));
         else
            Result.Insert (Key (Cur), Element (Cur));
         end if;
         Next (Cur);
      end loop;
      return Result;
   end Merge;

   procedure Put_Map (M : Map) is
      Cur : Cursor := M.First;
   begin
      while Has_Element (Cur) loop
         Put (String (Key (Cur)));
         Set_Col (12);
         Put (String (Element (Cur)));
         New_Line;
         Next (Cur);
      end loop;
   end Put_Map;

   Original : Map;
   Update   : Map;
   Result   : Map;
begin
   Original.Insert ("name", "Rocket Skates");
   Original.Insert ("price", "12.75");
   Original.Insert ("color", "yellow");

   Update.Insert ("price", "15.25");
   Update.Insert ("color", "red");
   Update.Insert ("year", "1974");

   Result := Merge (Original, Update);

   Put_Line ("Original:");
   Put_Map (Original);
   New_Line;

   Put_Line ("Update:");
   Put_Map (Update);
   New_Line;

   Put_Line ("Result of merge:");
   Put_Map (Result);
   New_Line;

end Merge_Maps;


# associative array merging                                                  #

# the modes allowed as associative array element values - change to suit     #
MODE AAVALUE = UNION( STRING, INT, REAL );
# the modes allowed as associative array element keys - change to suit       #
MODE AAKEY   = STRING;
# initial value for an array element                                         #
AAVALUE init element value = "";

# include the associative array code                                         #
PR read "aArrayBase.a68" PR

# adds or replaces all elements from b into a                     #
PRIO UPDATE = 9;
OP UPDATE = ( REF AARRAY a, REF AARRAY b )REF AARRAY:
BEGIN
    REF AAELEMENT e := FIRST b;
    WHILE e ISNT nil element DO
        a // key OF e := value OF e;
        e := NEXT b
    OD;
    a
END # UPDATE # ;

# construct the associative arrays for the task                   #
REF AARRAY a := INIT LOC AARRAY;
REF AARRAY b := INIT LOC AARRAY;
a // "name"  := "Rocket Skates";
a // "price" := 12.75;
a // "color" := "yellow";
b // "price" := 15.25;
b // "color" := "red";
b // "year"  := 1974;
# merge the arrays                                                #
REF AARRAY c := INIT LOC AARRAY;
c UPDATE a UPDATE b;
# show the merged array                                           #
REF AAELEMENT e := FIRST c;
WHILE e ISNT nil element DO
    print( ( key OF e
           , ": "
           , CASE value OF e
               IN (STRING s): s
                , (INT    i): whole( i, 0 )
                , (REAL   r): fixed( r, -12, 2 )
              OUT "????"
             ESAC
           , newline
           )
         );
    e := NEXT c
OD


# find the first few squares via the unoptimised door flipping method
scope

    local doorMax := 100;
    local door;
    create register door( doorMax );

    # set all doors to closed
    for i to doorMax do door[ i ] := false od;

    # repeatedly flip the doors
    for i to doorMax do
        for j from i to doorMax by i do door[ j ] := not door[ j ] od
    od;

    # display the results
    for i to doorMax do if door[ i ] then write( " ", i ) fi od; print()

epocs


(scl 4)
(seed (in "/dev/urandom" (rd 8)))

(de fact (N)
   (if (=0 N) 1 (apply * (range 1 N))) )

(de analytical (N)
   (sum
      '((I)
         (/
            (* (fact N) 1.0)
            (** N I)
            (fact (- N I)) ) )
      (range 1 N) ) )

(de testing (N)
   (let (C 0  N (dec N)  X 0  B 0  I 1000000)
      (do I
         (zero B)
         (one X)
         (while (=0 (& B X))
            (inc 'C)
            (setq
               B (| B X)
               X (** 2 (rand 0 N)) ) ) )
      (*/ C 1.0 I) ) )

(let F (2 8 8 6)
   (tab F "N" "Avg" "Exp" "Diff")
   (for I 20
      (let (A (testing I)  B (analytical I))
         (tab F
            I
            (round A 4)
            (round B 4)
            (round
               (*
                  (abs (- (*/ A 1.0 B) 1.0))
                  100 )
               2 ) ) ) ) )

(bye)


function Get-AnalyticalLoopAverage ( [int]$N )
    {
    #  Expected loop average = sum from i = 1 to N of N! / (N-i)! / N^(N-i+1)
    #  Equivalently, Expected loop average = sum from i = 1 to N of F(i)
    #    where F(N) = 1, and F(i) = F(i+1)*i/N

    $LoopAverage = $Fi = 1

    If ( $N -eq 1 ) { return $LoopAverage }

    ForEach ( $i in ($N-1)..1 )
        {
        $Fi *= $i / $N
        $LoopAverage  += $Fi
        }
    return $LoopAverage
    }

function Get-ExperimentalLoopAverage ( [int]$N, [int]$Tests = 100000 )
    {
    If ( $N -eq 1 ) { return 1 }

    #  Using 0 through N-1 instead of 1 through N for speed and simplicity
    $NMO = $N - 1

    #  Create array to hold mapping function
    $F = New-Object int[] ( $N )

    $Count = 0
    $Random = New-Object System.Random

    ForEach ( $Test in 1..$Tests )
        {
        #  Map each number to a random number
        ForEach ( $i in 0..$NMO )
            {
            $F[$i] = $Random.Next( $N )
            }

        #  For each number...
        ForEach ( $i in 0..$NMO )
            {
            #  Add the number to the list
            $List = @()
            $Count++
            $List += $X = $i

            #  If loop does not yet exist in list...
            While ( $F[$X] -notin $List )
                {
                #  Go to the next mapped number and add it to the list
                $Count++
                $List += $X = $F[$X]
                }
            }
        }
    $LoopAvereage = $Count / $N / $Tests
    return $LoopAvereage
    }


Const limite = 120

Declare Function esPrimo(n As Integer) As Boolean
Declare Function ContandoFactoresPrimos(n As Integer) As Integer

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

Function ContandoFactoresPrimos(n As Integer) As Integer
    If n = 1 Then Return false
    If esPrimo(n) Then Return true
    Dim As Integer f = 2, contar = 0
    While true
        If n Mod f = 0 Then
            contar += 1
            n = n / f
            If n = 1 Then Return contar
            If esPrimo(n) Then f = n
        Elseif f >= 3 Then
            f += 2
        Else
            f = 3
        End If
    Wend
End Function

' Mostrar la sucencia de números atractivos hasta 120.
Dim As Integer i = 1, longlinea = 0

Print "Los numeros atractivos hasta e incluyendo"; limite; " son: "
While i <= limite
    Dim As Integer n = ContandoFactoresPrimos(i)
    If esPrimo(n) Then
        Print Using "####"; i;
        longlinea += 1: If longlinea Mod 20 = 0 Then Print ""
    End If
    i += 1
Wend
End


package main

import "fmt"

func isPrime(n int) bool {
    switch {
    case n < 2:
        return false
    case n%2 == 0:
        return n == 2
    case n%3 == 0:
        return n == 3
    default:
        d := 5
        for d*d <= n {
            if n%d == 0 {
                return false
            }
            d += 2
            if n%d == 0 {
                return false
            }
            d += 4
        }
        return true
    }
}

func countPrimeFactors(n int) int {
    switch {
    case n == 1:
        return 0
    case isPrime(n):
        return 1
    default:
        count, f := 0, 2
        for {
            if n%f == 0 {
                count++
                n /= f
                if n == 1 {
                    return count
                }
                if isPrime(n) {
                    f = n
                }
            } else if f >= 3 {
                f += 2
            } else {
                f = 3
            }
        }
        return count
    }
}

func main() {
    const max = 120
    fmt.Println("The attractive numbers up to and including", max, "are:")
    count := 0
    for i := 1; i <= max; i++ {
        n := countPrimeFactors(i)
        if isPrime(n) {
            fmt.Printf("%4d", i)
            count++
            if count % 20 == 0 {
                fmt.Println()
            }
        }
    }
    fmt.Println()
}


set baseRecord to {|name|:"Rocket Skates", price:12.75, |color|:"yellow"}
set updateRecord to {price:15.25, |color|:"red", |year|:1974}

set mergedRecord to updateRecord & baseRecord
return mergedRecord


details: #[name: "Rocket Skates" price: 12.75 colour: 'yellow]
newDetails: extend details #[price: 15.25 colour: 'red year: 1974]

print newDetails


merge(base, update){
	Merged  := {}
	for k, v in base
		Merged[k] := v
	for k, v in update
		Merged[k] := v
	return Merged
}


# syntax: GAWK -f ASSOCIATIVE_ARRAY_MERGING.AWK
#
# sorting:
#   PROCINFO["sorted_in"] is used by GAWK
#   SORTTYPE is used by Thompson Automation's TAWK
#
BEGIN {
    PROCINFO["sorted_in"] = "@ind_str_asc" ; SORTTYPE = 1
    arr1["name"] = "Rocket Skates"
    arr1["price"] = "12.75"
    arr1["color"] = "yellow"
    show_array(arr1,"base")
    arr2["price"] = "15.25"
    arr2["color"] = "red"
    arr2["year"] = "1974"
    show_array(arr2,"update")
    for (i in arr1) { arr3[i] = arr1[i] }
    for (i in arr2) { arr3[i] = arr2[i] }
    show_array(arr3,"merged")
    exit(0)
}
function show_array(arr,desc,  i) {
    printf("\n%s array\n",desc)
    for (i in arr) {
      printf("%-5s : %s\n",i,arr[i])
    }
}


(cond-expand
  (r7rs)
  (chicken (import r7rs)))

(define-library (avl-trees)

  ;;
  ;; This library implements ‘persistent’ (that is, ‘immutable’) AVL
  ;; trees for R7RS Scheme.
  ;;
  ;; Included are generators of the key-data pairs in a tree. Because
  ;; the trees are persistent (‘immutable’), these generators are safe
  ;; from alterations of the tree.
  ;;
  ;; References:
  ;;
  ;;   * Niklaus Wirth, 1976. Algorithms + Data Structures =
  ;;     Programs. Prentice-Hall, Englewood Cliffs, New Jersey.
  ;;
  ;;   * Niklaus Wirth, 2004. Algorithms and Data Structures. Updated
  ;;     by Fyodor Tkachov, 2014.
  ;;
  ;; Note that the references do not discuss persistent
  ;; implementations. It seems worthwhile to compare the methods of
  ;; implementation.
  ;;

  (export avl)
  (export alist->avl)
  (export avl->alist)
  (export avl?)
  (export avl-empty?)
  (export avl-size)
  (export avl-insert)
  (export avl-delete)
  (export avl-delete-values)
  (export avl-has-key?)
  (export avl-search)
  (export avl-search-values)
  (export avl-make-generator)
  (export avl-pretty-print)
  (export avl-check-avl-condition)
  (export avl-check-usage)

  (import (scheme base))
  (import (scheme case-lambda))
  (import (scheme process-context))
  (import (scheme write))

  (cond-expand
    (chicken
     (import (only (chicken base) define-record-printer))
     (import (only (chicken format) format))) ; For debugging.
    (else))

  (begin

    ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ;;
    ;; Tools for making generators. These use call/cc and so might be
    ;; inefficient in your Scheme. I am using CHICKEN, in which
    ;; call/cc is not so inefficient.
    ;;
    ;; Often I have made &fail a unique object rather than #f, but in
    ;; this case #f will suffice.
    ;;

    (define &fail #f)

    (define *suspend*
      (make-parameter (lambda (x) x)))

    (define (suspend v)
      ((*suspend*) v))

    (define (fail-forever)
      (let loop ()
        (suspend &fail)
        (loop)))

    (define (make-generator-procedure thunk)
      ;; Make a suspendable procedure that takes no arguments. The
      ;; result is a simple generator of values. (This can be
      ;; elaborated upon for generators to take values on resumption,
      ;; in the manner of Icon co-expressions.)
      (define (next-run return)
        (define (my-suspend v)
          (set! return (call/cc (lambda (resumption-point)
                                  (set! next-run resumption-point)
                                  (return v)))))
        (parameterize ((*suspend* my-suspend))
          (suspend (thunk))
          (fail-forever)))
      (lambda () (call/cc next-run)))

    ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    (define-syntax avl-check-usage
      (syntax-rules ()
        ((_ pred msg)
         (or pred (usage-error msg)))))

    ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    (define-record-type <avl>
      (%avl key data bal left right)
      avl?
      (key %key)
      (data %data)
      (bal %bal)
      (left %left)
      (right %right))

    (cond-expand
      (chicken (define-record-printer (<avl> rt out)
                 (display "#<avl " out)
                 (display (%key rt) out)
                 (display " " out)
                 (display (%data rt) out)
                 (display " " out)
                 (display (%bal rt) out)
                 (display " " out)
                 (display (%left rt) out)
                 (display " " out)
                 (display (%right rt) out)
                 (display ">" out)))
      (else))

    ;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    (define avl
      (case-lambda
        (() (%avl #f #f #f #f #f))
        ((pred<? . args) (alist->avl pred<? args))))

    (define (avl-empty? tree)
      (avl-check-usage
       (avl? tree)
       "avl-empty? expects an AVL tree as argument")
      (not (%bal tree)))

    (define (avl-size tree)
      (define (traverse p sz)
        (if (not p)
            sz
            (traverse (%left p) (traverse (%right p) (+ sz 1)))))
      (if (avl-empty? tree)
          0
          (traverse tree 0)))

    (define (avl-has-key? pred<? tree key)
      (define (search p)
        (and p
             (let ((k (%key p)))
               (cond ((pred<? key k) (search (%left p)))
                     ((pred<? k key) (search (%right p)))
                     (else #t)))))
      (avl-check-usage
       (procedure? pred<?)
       "avl-has-key? expects a procedure as first argument")
      (and (not (avl-empty? tree))
           (search tree)))

    (define (avl-search pred<? tree key)
      ;; Return the data matching a key, or #f if the key is not
      ;; found. (Note that the data matching the key might be #f.)
      (define (search p)
        (and p
             (let ((k (%key p)))
               (cond ((pred<? key k) (search (%left p)))
                     ((pred<? k key) (search (%right p)))
                     (else (%data p))))))
      (avl-check-usage
       (procedure? pred<?)
       "avl-search expects a procedure as first argument")
      (and (not (avl-empty? tree))
           (search tree)))

    (define (avl-search-values pred<? tree key)
      ;; Return two values: the data matching the key, or #f is the
      ;; key is not found; and a second value that is either #f or #t,
      ;; depending on whether the key is found.
      (define (search p)
        (if (not p)
            (values #f #f)
            (let ((k (%key p)))
              (cond ((pred<? key k) (search (%left p)))
                    ((pred<? k key) (search (%right p)))
                    (else (values (%data p) #t))))))
      (avl-check-usage
       (procedure? pred<?)
       "avl-search-values expects a procedure as first argument")
      (if (avl-empty? tree)
          (values #f #f)
          (search tree)))

    (define (alist->avl pred<? alst)
      ;; Go from association list to AVL tree.
      (avl-check-usage
       (procedure? pred<?)
       "alist->avl expects a procedure as first argument")
      (let loop ((tree (avl))
                 (lst alst))
        (if (null? lst)
            tree
            (let ((head (car lst)))
              (loop (avl-insert pred<? tree (car head) (cdr head))
                    (cdr lst))))))

    (define (avl->alist tree)
      ;; Go from AVL tree to association list. The output will be in
      ;; order.
      (define (traverse p lst)
        ;; Reverse in-order traversal of the tree, to produce an
        ;; in-order cons-list.
        (if (not p)
            lst
            (traverse (%left p) (cons (cons (%key p) (%data p))
                                      (traverse (%right p) lst)))))
      (if (avl-empty? tree)
          '()
          (traverse tree '())))

    (define (avl-insert pred<? tree key data)

      (define (search p fix-balance?)
        (cond
         ((not p)
          ;; The key was not found. Make a new node and set
          ;; fix-balance?
          (values (%avl key data 0 #f #f) #t))

         ((pred<? key (%key p))
          ;; Continue searching.
          (let-values (((p1 fix-balance?)
                        (search (%left p) fix-balance?)))
            (cond
             ((not fix-balance?)
              (let ((p^ (%avl (%key p) (%data p) (%bal p)
                              p1 (%right p))))
                (values p^ #f)))
             (else
              ;; A new node has been inserted on the left side.
              (case (%bal p)
                ((1)
                 (let ((p^ (%avl (%key p) (%data p) 0
                                 p1 (%right p))))
                   (values p^ #f)))
                ((0)
                 (let ((p^ (%avl (%key p) (%data p) -1
                                 p1 (%right p))))
                   (values p^ fix-balance?)))
                ((-1)
                 ;; Rebalance.
                 (case (%bal p1)
                   ((-1)
                    ;; A single LL rotation.
                    (let* ((p^ (%avl (%key p) (%data p) 0
                                     (%right p1) (%right p)))
                           (p1^ (%avl (%key p1) (%data p1) 0
                                      (%left p1) p^)))
                      (values p1^ #f)))
                   ((0 1)
                    ;; A double LR rotation.
                    (let* ((p2 (%right p1))
                           (bal2 (%bal p2))
                           (p^ (%avl (%key p) (%data p)
                                     (- (min bal2 0))
                                     (%right p2) (%right p)))
                           (p1^ (%avl (%key p1) (%data p1)
                                      (- (max bal2 0))
                                      (%left p1) (%left p2)))
                           (p2^ (%avl (%key p2) (%data p2) 0
                                      p1^ p^)))
                      (values p2^ #f)))
                   (else (internal-error))))
                (else (internal-error)))))))

         ((pred<? (%key p) key)
          ;; Continue searching.
          (let-values (((p1 fix-balance?)
                        (search (%right p) fix-balance?)))
            (cond
             ((not fix-balance?)
              (let ((p^ (%avl (%key p) (%data p) (%bal p)
                              (%left p) p1)))
                (values p^ #f)))
             (else
              ;; A new node has been inserted on the right side.
              (case (%bal p)
                ((-1)
                 (let ((p^ (%avl (%key p) (%data p) 0
                                 (%left p) p1)))
                   (values p^ #f)))
                ((0)
                 (let ((p^ (%avl (%key p) (%data p) 1
                                 (%left p) p1)))
                   (values p^ fix-balance?)))
                ((1)
                 ;; Rebalance.
                 (case (%bal p1)
                   ((1)
                    ;; A single RR rotation.
                    (let* ((p^ (%avl (%key p) (%data p) 0
                                     (%left p) (%left p1)))
                           (p1^ (%avl (%key p1) (%data p1) 0
                                      p^ (%right p1))))
                      (values p1^ #f)))
                   ((-1 0)
                    ;; A double RL rotation.
                    (let* ((p2 (%left p1))
                           (bal2 (%bal p2))
                           (p^ (%avl (%key p) (%data p)
                                     (- (max bal2 0))
                                     (%left p) (%left p2)))
                           (p1^ (%avl (%key p1) (%data p1)
                                      (- (min bal2 0))
                                      (%right p2) (%right p1)))
                           (p2^ (%avl (%key p2) (%data p2) 0
                                      p^ p1^)))
                      (values p2^ #f)))
                   (else (internal-error))))
                (else (internal-error)))))))

         (else
          ;; The key was found; p is an existing node.
          (values (%avl key data (%bal p) (%left p) (%right p))
                  #f))))

      (avl-check-usage
       (procedure? pred<?)
       "avl-insert expects a procedure as first argument")
      (if (avl-empty? tree)
          (%avl key data 0 #f #f)
          (let-values (((p fix-balance?) (search tree #f)))
            p)))

    (define (avl-delete pred<? tree key)
      ;; If one is not interested in whether the key was in the tree,
      ;; then throw away that information.
      (let-values (((tree had-key?)
                    (avl-delete-values pred<? tree key)))
        tree))

    (define (balance-for-shrunken-left p)
      ;; Returns two values: a new p and a new fix-balance?
      (case (%bal p)
        ((-1) (values (%avl (%key p) (%data p) 0
                            (%left p) (%right p))
                      #t))
        ((0) (values (%avl (%key p) (%data p) 1
                           (%left p) (%right p))
                     #f))
        ((1)
         ;; Rebalance.
         (let* ((p1 (%right p))
                (bal1 (%bal p1)))
           (case bal1
             ((0)
              ;; A single RR rotation.
              (let* ((p^ (%avl (%key p) (%data p) 1
                               (%left p) (%left p1)))
                     (p1^ (%avl (%key p1) (%data p1) -1
                                p^ (%right p1))))
                (values p1^ #f)))
             ((1)
              ;; A single RR rotation.
              (let* ((p^ (%avl (%key p) (%data p) 0
                               (%left p) (%left p1)))
                     (p1^ (%avl (%key p1) (%data p1) 0
                                p^ (%right p1))))
                (values p1^ #t)))
             ((-1)
              ;; A double RL rotation.
              (let* ((p2 (%left p1))
                     (bal2 (%bal p2))
                     (p^ (%avl (%key p) (%data p) (- (max bal2 0))
                               (%left p) (%left p2)))
                     (p1^ (%avl (%key p1) (%data p1) (- (min bal2 0))
                                (%right p2) (%right p1)))
                     (p2^ (%avl (%key p2) (%data p2) 0 p^ p1^)))
                (values p2^ #t)))
             (else (internal-error)))))
        (else (internal-error))))

    (define (balance-for-shrunken-right p)
      ;; Returns two values: a new p and a new fix-balance?
      (case (%bal p)
        ((1) (values (%avl (%key p) (%data p) 0
                           (%left p) (%right p))
                     #t))
        ((0) (values (%avl (%key p) (%data p) -1
                           (%left p) (%right p))
                     #f))
        ((-1)
         ;; Rebalance.
         (let* ((p1 (%left p))
                (bal1 (%bal p1)))
           (case bal1
             ((0)
              ;; A single LL rotation.
              (let* ((p^ (%avl (%key p) (%data p) -1
                               (%right p1) (%right p)))
                     (p1^ (%avl (%key p1) (%data p1) 1
                                (%left p1) p^)))
                (values p1^ #f)))
             ((-1)
              ;; A single LL rotation.
              (let* ((p^ (%avl (%key p) (%data p) 0
                               (%right p1) (%right p)))
                     (p1^ (%avl (%key p1) (%data p1) 0
                                (%left p1) p^)))
                (values p1^ #t)))
             ((1)
              ;; A double LR rotation.
              (let* ((p2 (%right p1))
                     (bal2 (%bal p2))
                     (p^ (%avl (%key p) (%data p) (- (min bal2 0))
                               (%right p2) (%right p)))
                     (p1^ (%avl (%key p1) (%data p1) (- (max bal2 0))
                                (%left p1) (%left p2)))
                     (p2^ (%avl (%key p2) (%data p2) 0 p1^ p^)))
                (values p2^ #t)))
             (else (internal-error)))))
        (else (internal-error))))

    (define (avl-delete-values pred<? tree key)

      (define-syntax balance-L
        (syntax-rules ()
          ((_ p fix-balance?)
           (if fix-balance?
               (balance-for-shrunken-left p)
               (values p #f)))))

      (define-syntax balance-R
        (syntax-rules ()
          ((_ p fix-balance?)
           (if fix-balance?
               (balance-for-shrunken-right p)
               (values p #f)))))

      (define (del r fix-balance?)
        ;; Returns a new r, a new fix-balance?, and key and data to be
        ;; ‘moved up the tree’.
        (if (%right r)
            (let*-values
                (((q fix-balance? key^ data^)
                  (del (%right r) fix-balance?))
                 ((r fix-balance?)
                  (balance-R (%avl (%key r) (%data r) (%bal r)
                                   (%left r) q)
                             fix-balance?)))
              (values r fix-balance? key^ data^))
            (values (%left r) #t (%key r) (%data r))))

      (define (search p fix-balance?)
        ;; Return three values: a new p, a new fix-balance, and
        ;; whether the key was found.
        (cond
         ((not p) (values #f #f #f))
         ((pred<? key (%key p))
          ;; Recursive search down the left branch.
          (let*-values
              (((q fix-balance? found?)
                (search (%left p) fix-balance?))
               ((p fix-balance?)
                (balance-L (%avl (%key p) (%data p) (%bal p)
                                 q (%right p))
                           fix-balance?)))
            (values p fix-balance? found?)))
         ((pred<? (%key p) key)
          ;; Recursive search down the right branch.
          (let*-values
              (((q fix-balance? found?)
                (search (%right p) fix-balance?))
               ((p fix-balance?)
                (balance-R (%avl (%key p) (%data p) (%bal p)
                                 (%left p) q)
                           fix-balance?)))
            (values p fix-balance? found?)))
         ((not (%right p))
          ;; Delete p, replace it with its left branch, then
          ;; rebalance.
          (values (%left p) #t #t))
         ((not (%left p))
          ;; Delete p, replace it with its right branch, then
          ;; rebalance.
          (values (%right p) #t #t))
         (else
          ;; Delete p, but it has both left and right branches,
          ;; and therefore may have complicated branch structure.
          (let*-values
              (((q fix-balance? key^ data^)
                (del (%left p) fix-balance?))
               ((p fix-balance?)
                (balance-L (%avl key^ data^ (%bal p) q (%right p))
                           fix-balance?)))
            (values p fix-balance? #t)))))

      (avl-check-usage
       (procedure? pred<?)
       "avl-delete-values expects a procedure as first argument")
      (if (avl-empty? tree)
          (values tree #f)
          (let-values (((tree fix-balance? found?)
                        (search tree #f)))
            (if found?
                (values (or tree (avl)) #t)
                (values tree #f)))))

    (define avl-make-generator
      (case-lambda
        ((tree) (avl-make-generator tree 1))
        ((tree direction)
         (if (negative? direction)
             (make-generator-procedure
              (lambda ()
                (define (traverse p)
                  (unless (or (not p) (avl-empty? p))
                    (traverse (%right p))
                    (suspend (cons (%key p) (%data p)))
                    (traverse (%left p)))
                  &fail)
                (traverse tree)))
             (make-generator-procedure
              (lambda ()
                (define (traverse p)
                  (unless (or (not p) (avl-empty? p))
                    (traverse (%left p))
                    (suspend (cons (%key p) (%data p)))
                    (traverse (%right p)))
                  &fail)
                (traverse tree)))))))

    (define avl-pretty-print
      (case-lambda
        ((tree)
         (avl-pretty-print tree (current-output-port)))
        ((tree port)
         (avl-pretty-print tree port
                           (lambda (port key data)
                             (display "(" port)
                             (write key port)
                             (display ", " port)
                             (write data port)
                             (display ")" port))))
        ((tree port key-data-printer)
         ;; In-order traversal, so the printing is done in
         ;; order. Reflect the display diagonally to get the more
         ;; usual orientation of left-to-right, top-to-bottom.
         (define (pad depth)
           (unless (zero? depth)
             (display "  " port)
             (pad (- depth 1))))
         (define (traverse p depth)
           (when p
             (traverse (%left p) (+ depth 1))
             (pad depth)
             (key-data-printer port (%key p) (%data p))
             (display "\t\tdepth = " port)
             (display depth port)
             (display " bal = " port)
             (display (%bal p) port)
             (display "\n" port)
             (traverse (%right p) (+ depth 1))))
         (unless (avl-empty? tree)
           (traverse (%left tree) 1)
           (key-data-printer port (%key tree) (%data tree))
           (display "\t\tdepth = 0  bal = " port)
           (display (%bal tree) port)
           (display "\n" port)
           (traverse (%right tree) 1)))))

    (define (avl-check-avl-condition tree)
      ;; Check that the AVL condition is satisfied.
      (define (check-heights height-L height-R)
        (when (<= 2 (abs (- height-L height-R)))
          (display "*** AVL condition violated ***"
                   (current-error-port))
          (internal-error)))
      (define (get-heights p)
        (if (not p)
            (values 0 0)
            (let-values (((height-LL height-LR)
                          (get-heights (%left p)))
                         ((height-RL height-RR)
                          (get-heights (%right p))))
              (check-heights height-LL height-LR)
              (check-heights height-RL height-RR)
              (values (+ height-LL height-LR)
                      (+ height-RL height-RR)))))
      (unless (avl-empty? tree)
        (let-values (((height-L height-R) (get-heights tree)))
          (check-heights height-L height-R))))

    (define (internal-error)
      (display "internal error\n" (current-error-port))
      (emergency-exit 123))

    (define (usage-error msg)
      (display "Procedure usage error:\n" (current-error-port))
      (display "  " (current-error-port))
      (display msg (current-error-port))
      (newline (current-error-port))
      (exit 1))

    )) ;; end library (avl-trees)

(cond-expand
  (DEMONSTRATION
   (begin
     (import (avl-trees))
     (import (scheme base))
     (import (scheme time))
     (import (scheme process-context))
     (import (scheme write))

     (cond-expand
       (chicken
        (import (only (chicken format) format))) ; For debugging.
       (else))

     (define 2**64 (expt 2 64))

     (define seed (truncate-remainder (exact (current-second)) 2**64))
     (define random
       ;; A really slow (but presumably highly portable)
       ;; implementation of Donald Knuth’s linear congruential random
       ;; number generator, returning a rational number in [0,1). See
       ;; https://en.wikipedia.org/w/index.php?title=Linear_congruential_generator&oldid=1076681286
       (let ((a 6364136223846793005)
             (c 1442695040888963407))
         (lambda ()
           (let ((result (/ seed 2**64)))
             (set! seed (truncate-remainder (+ (* a seed) c) 2**64))
             result))))
     (do ((i 0 (+ i 1)))
         ((= i 10))
       (random))

     (define (fisher-yates-shuffle keys)
       (let ((n (vector-length keys)))
         (do ((i 1 (+ i 1)))
             ((= i n))
           (let* ((randnum (random))
                  (j (+ i (floor (* randnum (- n i)))))
                  (xi (vector-ref keys i))
                  (xj (vector-ref keys j)))
             (vector-set! keys i xj)
             (vector-set! keys j xi)))))

     (define (display-key-data key data)
       (display "(")
       (write key)
       (display ", ")
       (write data)
       (display ")"))

     (define (display-tree-contents tree)
       (do ((p (avl->alist tree) (cdr p)))
           ((null? p))
         (display-key-data (caar p) (cdar p))
         (newline)))

     (define (error-stop)
       (display "*** ERROR STOP ***\n" (current-error-port))
       (emergency-exit 1))

     (define n 20)
     (define keys (make-vector (+ n 1)))
     (do ((i 0 (+ i 1)))
         ((= i n))
       ;; To keep things more like Fortran, do not use index zero.
       (vector-set! keys (+ i 1) (+ i 1)))

     (fisher-yates-shuffle keys)

     ;; Insert key-data pairs in the shuffled order.
     (define tree (avl))
     (avl-check-avl-condition tree)
     (do ((i 1 (+ i 1)))
         ((= i (+ n 1)))
       (let ((ix (vector-ref keys i)))
         (set! tree (avl-insert < tree ix (inexact ix)))
         (avl-check-avl-condition tree)
         (do ((j 1 (+ j 1)))
             ((= j (+ n 1)))
           (let*-values (((k) (vector-ref keys j))
                         ((has-key?) (avl-has-key? < tree k))
                         ((data) (avl-search < tree k))
                         ((data^ has-key?^)
                          (avl-search-values < tree k)))
             (unless (exact? k) (error-stop))
             (if (<= j i)
                 (unless (and has-key? data data^ has-key?^
                              (inexact? data) (= data k)
                              (inexact? data^) (= data^ k))
                   (error-stop))
                 (when (or has-key? data data^ has-key?^)
                   (error-stop)))))))

     (display "----------------------------------------------------------------------\n")
     (display "keys = ")
     (write (cdr (vector->list keys)))
     (newline)
     (display "----------------------------------------------------------------------\n")
     (avl-pretty-print tree)
     (display "----------------------------------------------------------------------\n")
     (display "tree size = ")
     (display (avl-size tree))
     (newline)
     (display-tree-contents tree)
     (display "----------------------------------------------------------------------\n")

     ;;
     ;; Reshuffle the keys, and change the data from inexact numbers
     ;; to strings.
     ;;

     (fisher-yates-shuffle keys)

     (do ((i 1 (+ i 1)))
         ((= i (+ n 1)))
       (let ((ix (vector-ref keys i)))
         (set! tree (avl-insert < tree ix (number->string ix)))
         (avl-check-avl-condition tree)))

     (avl-pretty-print tree)
     (display "----------------------------------------------------------------------\n")
     (display "tree size = ")
     (display (avl-size tree))
     (newline)
     (display-tree-contents tree)
     (display "----------------------------------------------------------------------\n")

     ;;
     ;; Reshuffle the keys, and delete the contents of the tree, but
     ;; also keep the original tree by saving it in a variable. Check
     ;; persistence of the tree.
     ;;

     (fisher-yates-shuffle keys)

     (define saved-tree tree)

     (do ((i 1 (+ i 1)))
         ((= i (+ n 1)))
       (let ((ix (vector-ref keys i)))
         (set! tree (avl-delete < tree ix))
         (avl-check-avl-condition tree)
         (unless (= (avl-size tree) (- n i)) (error-stop))
         ;; Try deleting a second time.
         (set! tree (avl-delete < tree ix))
         (avl-check-avl-condition tree)
         (unless (= (avl-size tree) (- n i)) (error-stop))
         (do ((j 1 (+ j 1)))
             ((= j (+ n 1)))
           (let ((jx (vector-ref keys j)))
             (unless (eq? (avl-has-key? < tree jx) (< i j))
               (error-stop))
             (let ((data (avl-search < tree jx)))
               (unless (eq? (not (not data)) (< i j))
                 (error-stop))
               (unless (or (not data)
                           (= (string->number data) jx))
                 (error-stop)))
             (let-values (((data found?)
                           (avl-search-values < tree jx)))
               (unless (eq? found? (< i j)) (error-stop))
               (unless (or (and (not data) (<= j i))
                           (and data (= (string->number data) jx)))
                 (error-stop)))))))
     (do ((i 1 (+ i 1)))
         ((= i (+ n 1)))
       ;; Is save-tree the persistent value of the tree we just
       ;; deleted?
       (let ((ix (vector-ref keys i)))
         (unless (equal? (avl-search < saved-tree ix)
                         (number->string ix))
           (error-stop))))

     (display "forwards generator:\n")
     (let ((gen (avl-make-generator saved-tree)))
       (do ((pair (gen) (gen)))
           ((not pair))
         (display-key-data (car pair) (cdr pair))
         (newline)))

     (display "----------------------------------------------------------------------\n")

     (display "backwards generator:\n")
     (let ((gen (avl-make-generator saved-tree -1)))
       (do ((pair (gen) (gen)))
           ((not pair))
         (display-key-data (car pair) (cdr pair))
         (newline)))

     (display "----------------------------------------------------------------------\n")

     ))
  (else))


var doors = new int [100]

foreach pass 100 {
    for (var door = pass ; door < 100 ; door += pass+1) {
        doors[door] = !doors[door]
    }
}

var d = 1
foreach door doors {
    println ("door " + d++ + " is " + (door ? "open" : "closed"))

}


from __future__ import division # Only necessary for Python 2.X
from math import factorial
from random import randrange

MAX_N = 20
TIMES = 1000000

def analytical(n):
	return sum(factorial(n) / pow(n, i) / factorial(n -i) for i in range(1, n+1))

def test(n, times):
    count = 0
    for i in range(times):
        x, bits = 1, 0
        while not (bits & x):
            count += 1
            bits |= x
            x = 1 << randrange(n)
    return count / times

if __name__ == '__main__':
    print(" n\tavg\texp.\tdiff\n-------------------------------")
    for n in range(1, MAX_N+1):
        avg = test(n, TIMES)
        theory = analytical(n)
        diff = (avg / theory - 1) * 100
        print("%2d %8.4f %8.4f %6.3f%%" % (n, avg, theory, diff))


expected <- function(size) {
  result <- 0
  for (i in 1:size) {
    result <- result + factorial(size) / size^i / factorial(size -i)
  }
  result
}

knuth <- function(size) {
  v <- sample(1:size, size, replace = TRUE)

  visit <- vector('logical',size)
  place <- 1
  visit[[1]] <- TRUE
  steps <- 0

  repeat {
    place <- v[[place]]
    steps <- steps + 1
    if (visit[[place]]) break
    visit[[place]] <- TRUE
  }
  steps
}

cat(" N    average    analytical     (error)\n")
cat("===  =========  ============  ==========\n")
for (num in 1:20) {
  average <- mean(replicate(1e6, knuth(num)))
  analytical <- expected(num)
  error <- abs(average/analytical-1)*100

  cat(sprintf("%3d%11.4f%14.4f  ( %4.4f%%)\n", num, round(average,4), round(analytical,4), round(error,2)))
}


#lang racket
(require (only-in math factorial))

(define (analytical n)
  (for/sum ([i (in-range 1 (add1 n))])
    (/ (factorial n) (expt n i) (factorial (- n i)))))

(define (test n times)
  (define (count-times seen times)
    (define x (random n))
    (if (memq x seen) times (count-times (cons x seen) (add1 times))))
  (/ (for/fold ([count 0]) ([i times]) (count-times '() count))
     times))

(define (test-table max-n times)
  (displayln " n avg    theory error\n------------------------")
  (for ([i (in-range 1 (add1 max-n))])
    (define average    (test i times))
    (define theory     (analytical i))
    (define difference (* (abs (sub1 (/ average theory))) 100))
    (displayln (~a (~a i #:width 2 #:align 'right)
                   " " (real->decimal-string average 4)
                   " " (real->decimal-string theory 4)
                   " " (real->decimal-string difference 4)
                   "%"))))

(test-table 20 10000)


class AttractiveNumbers {
    static boolean isPrime(int n) {
        if (n < 2) return false
        if (n % 2 == 0) return n == 2
        if (n % 3 == 0) return n == 3
        int d = 5
        while (d * d <= n) {
            if (n % d == 0) return false
            d += 2
            if (n % d == 0) return false
            d += 4
        }
        return true
    }

    static int countPrimeFactors(int n) {
        if (n == 1) return 0
        if (isPrime(n)) return 1
        int count = 0, f = 2
        while (true) {
            if (n % f == 0) {
                count++
                n /= f
                if (n == 1) return count
                if (isPrime(n)) f = n
            } else if (f >= 3) f += 2
            else f = 3
        }
    }

    static void main(String[] args) {
        final int max = 120
        printf("The attractive numbers up to and including %d are:\n", max)
        int count = 0
        for (int i = 1; i <= max; ++i) {
            int n = countPrimeFactors(i)
            if (isPrime(n)) {
                printf("%4d", i)
                if (++count % 20 == 0) println()
            }
        }
        println()
    }
}


Dim m1 As Map = CreateMap("name": "Rocket Skates", "price": 12.75, "color": "yellow")
Dim m2 As Map = CreateMap("price": 15.25, "color": "red", "year": 1974)
Dim merged As Map
merged.Initialize
For Each m As Map In Array(m1, m2)
	For Each key As Object In m.Keys
		merged.Put(key, m.Get(key))
	Next
Next
Log(merged)


DECLARE base$, update$, merge$ ASSOC STRING

base$("name") = "Rocket Skates"
base$("price") = "12.75"
base$("color") = "yellow"

PRINT "Base array"
FOR x$ IN OBTAIN$(base$)
    PRINT x$, " : ", base$(x$)
NEXT

update$("price") = "15.25"
update$("color") = "red"
update$("year") = "1974"

PRINT NL$, "Update array"
FOR x$ IN OBTAIN$(update$)
    PRINT x$, " : ", update$(x$)
NEXT

merge$() = base$()
merge$() = update$()

PRINT NL$, "Merged array"
FOR x$ IN OBTAIN$(merge$)
    PRINT x$, " : ", merge$(x$)
NEXT


#include <iostream>
#include <string>
#include <map>

template<typename map_type>
map_type merge(const map_type& original, const map_type& update) {
    map_type result(update);
    result.insert(original.begin(), original.end());
    return result;
}

int main() {
    typedef std::map<std::string, std::string> map;
    map original{
        {"name", "Rocket Skates"},
        {"price", "12.75"},
        {"color", "yellow"}
    };
    map update{
        {"price", "15.25"},
        {"color", "red"},
        {"year", "1974"}
    };
    map merged(merge(original, update));
    for (auto&& i : merged)
        std::cout << "key: " << i.first << ", value: " << i.second << '\n';
    return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;

public class Program
{
    public static void Main() {
        var baseData = new Dictionary<string, object> {
            ["name"] = "Rocket Skates",
            ["price"] = 12.75,
            ["color"] = "yellow"
        };
        var updateData = new Dictionary<string, object> {
            ["price"] = 15.25,
            ["color"] = "red",
            ["year"] = 1974
        };
        var mergedData = new Dictionary<string, object>();
        foreach (var entry in baseData.Concat(updateData)) {
            mergedData[entry.Key] = entry.Value;
        }
        foreach (var entry in mergedData) {
            Console.WriteLine(entry);
        }
   }
}


class AVLtree {

    has root = nil

    struct Node {
        Number key,
        Number balance = 0,
        Node left = nil,
        Node right = nil,
        Node parent = nil,
    }

    method insert(key) {
        if (root == nil) {
            root = Node(key)
            return true
        }

        var n = root
        var parent = nil

        loop {
            if (n.key == key) {
                return false
            }
            parent = n
            var goLeft = (n.key > key)
            n = (goLeft ? n.left : n.right)

            if (n == nil) {
                var tn = Node(key, parent: parent)
                if (goLeft) {
                    parent.left = tn
                }
                else {
                    parent.right = tn
                }
                self.rebalance(parent)
                break
            }
        }

        return true
    }

    method delete_key(delKey) {
        if (root == nil) { return nil }

        var n = root
        var parent = root
        var delNode = nil
        var child = root

        while (child != nil) {
            parent = n
            n = child
            child = (delKey >= n.key ? n.right : n.left)
            if (delKey == n.key) {
                delNode = n
            }
        }

        if (delNode != nil) {
            delNode.key = n.key
            child = (n.left != nil ? n.left : n.right)

            if (root.key == delKey) {
                root = child
            }
            else {
                if (parent.left == n) {
                    parent.left = child
                }
                else {
                    parent.right = child
                }
                self.rebalance(parent)
            }
        }
    }

    method rebalance(n) {
        if (n == nil) { return nil }
        self.setBalance(n)

        given (n.balance) {
            when (-2) {
                if (self.height(n.left.left) >= self.height(n.left.right)) {
                    n = self.rotate(n, :right)
                }
                else {
                    n = self.rotate_twice(n, :left, :right)
                }
            }
            when (2) {
                if (self.height(n.right.right) >= self.height(n.right.left)) {
                    n = self.rotate(n, :left)
                }
                else {
                    n = self.rotate_twice(n, :right, :left)
                }
            }
        }

        if (n.parent != nil) {
            self.rebalance(n.parent)
        }
        else {
            root = n
        }
    }

    method rotate(a, dir) {
        var b = (dir == :left ? a.right : a.left)
        b.parent = a.parent

        (dir == :left) ? (a.right = b.left)
                       : (a.left  = b.right)

        if (a.right != nil) {
            a.right.parent = a
        }

        b.$dir = a
        a.parent = b

        if (b.parent != nil) {
            if (b.parent.right == a) {
                b.parent.right = b
            }
            else {
                b.parent.left = b
            }
        }

        self.setBalance(a, b)
        return b
    }

    method rotate_twice(n, dir1, dir2) {
        n.left = self.rotate(n.left, dir1)
        self.rotate(n, dir2)
    }

    method height(n) {
        if (n == nil) { return -1 }
        1 + Math.max(self.height(n.left), self.height(n.right))
    }

    method setBalance(*nodes) {
        nodes.each { |n|
            n.balance = (self.height(n.right) - self.height(n.left))
        }
    }

    method printBalance {
        self.printBalance(root)
    }

    method printBalance(n) {
        if (n != nil) {
            self.printBalance(n.left)
            print(n.balance, ' ')
            self.printBalance(n.right)
        }
    }
}

var tree = AVLtree()

say "Inserting values 1 to 10"
{|i| tree.insert(i) } << 1..10
print "Printing balance: "
tree.printBalance


begin

comment - 100 doors problem in ALGOL-60;

boolean array doors[1:100];
integer i, j;
boolean open, closed;

open := true;
closed := not true;

outstring(1,"100 Doors Problem\n");

comment - all doors are initially closed;
for i := 1 step 1 until 100 do
  doors[i] := closed;

comment
  cycle through at increasing intervals
  and flip each door encountered;
for i := 1 step 1 until 100 do
  for j := i step i until 100 do
    doors[j] := not doors[j];

comment - show which doors are open;
outstring(1,"The open doors are:");
for i := 1 step 1 until 100 do
  if doors[i] then
     outinteger(1,i);

end


constant MAX_N  = 20;
constant TRIALS = 100;

for 1 .. MAX_N -> $N {
    my $empiric = TRIALS R/ [+] find-loop(random-mapping($N)).elems xx TRIALS;
    my $theoric = [+]
        map -> $k { $N ** ($k + 1) R/ [*] flat $k**2, $N - $k + 1 .. $N }, 1 .. $N;

    FIRST say " N    empiric      theoric      (error)";
    FIRST say "===  =========  ============  =========";

    printf "%3d  %9.4f  %12.4f    (%4.2f%%)\n",
            $N,  $empiric,
                        $theoric, 100 * abs($theoric - $empiric) / $theoric;
}

sub random-mapping { hash .list Z=> .roll given ^$^size }
sub find-loop { 0, | %^mapping{*} ...^ { (%){$_}++ } }


/*REXX program computes the average loop length mapping a random field 1···N ───► 1···N */
parse arg runs tests seed .                      /*obtain optional arguments from the CL*/
if  runs =='' |  runs ==","  then runs =      40 /*Not specified?  Then use the default.*/
if tests =='' | tests ==","  then tests= 1000000 /* "      "         "   "   "     "    */
if datatype(seed, 'W')  then call random ,, seed /*Is integer?   For RAND repeatability.*/
!.=0;          !.0=1                             /*used for  factorial (!)  memoization.*/
numeric digits 100000                            /*be able to calculate 25k! if need be.*/
numeric digits max(9, length( !(runs) )   )      /*set the NUMERIC DIGITS for  !(runs). */
say right(     runs, 24)      'runs'             /*display number of runs   we're using.*/
say right(    tests, 24)      'tests'            /*   "       "    " tests    "     "   */
say right( digits(), 24)      'digits'           /*   "       "    " digits   "     "   */
say
say "        N    average     exact     % error "     /* ◄─── title, header ►────────┐  */
hdr="       ═══  ═════════  ═════════  ═════════";       pad=left('',3)  /* ◄────────┘  */
say hdr
         do #=1  for runs;   av=fmtD( exact(#) ) /*use four digits past decimal point.  */
                             xa=fmtD( exper(#) ) /* "    "    "      "     "      "     */
         say right(#,9)  pad xa pad av pad fmtD( abs(xa-av) * 100 / av)   /*show values.*/
         end   /*#*/
say hdr                                          /*display the final header (some bars).*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
!:     procedure expose !.;  parse arg z;                      if !.z\==0  then return !.z
       !=1;       do j=2  for z -1;  !=!*j;  !.j=!;  end; /*compute factorial*/   return !
/*──────────────────────────────────────────────────────────────────────────────────────*/
exact: parse arg x;  s=0;     do j=1  for x;  s=s + !(x) / !(x-j) / x**j;  end;   return s
/*──────────────────────────────────────────────────────────────────────────────────────*/
exper: parse arg n;  k=0;     do tests;   $.=0                      /*do it TESTS times.*/
                                 do n;    r=random(1, n);      if $.r  then leave
                                 $.r=1;   k=k + 1                   /*bump the counter. */
                                 end   /*n*/
                              end      /*tests*/
       return k/tests
/*──────────────────────────────────────────────────────────────────────────────────────*/
fmtD:  parse arg y,d;     d=word(d 4, 1);    y=format(y, , d);     parse var  y  w  '.'  f
       if f=0  then return  w || left('', d +1);                                  return y


import Data.Numbers.Primes
import Data.Bool (bool)

attractiveNumbers :: [Integer]
attractiveNumbers =
  [1 ..] >>= (bool [] . return) <*> (isPrime . length . primeFactors)

main :: IO ()
main = print $ takeWhile (<= 120) attractiveNumbers


(() => {
    'use strict';

    // attractiveNumbers :: () -> Gen [Int]
    const attractiveNumbers = () =>
        // An infinite series of attractive numbers.
        filter(
            compose(isPrime, length, primeFactors)
        )(enumFrom(1));

    // ----------------------- TEST -----------------------
    // main :: IO ()
    const main = () =>
        showCols(10)(
            takeWhile(ge(120))(
                attractiveNumbers()
            )
        );

    // ---------------------- PRIMES ----------------------

    // isPrime :: Int -> Bool
    const isPrime = n => {
        // True if n is prime.
        if (2 === n || 3 === n) {
            return true
        }
        if (2 > n || 0 === n % 2) {
            return false
        }
        if (9 > n) {
            return true
        }
        if (0 === n % 3) {
            return false
        }
        return !enumFromThenTo(5)(11)(
            1 + Math.floor(Math.pow(n, 0.5))
        ).some(x => 0 === n % x || 0 === n % (2 + x));
    };

    // primeFactors :: Int -> [Int]
    const primeFactors = n => {
        // A list of the prime factors of n.
        const
            go = x => {
                const
                    root = Math.floor(Math.sqrt(x)),
                    m = until(
                        ([q, _]) => (root < q) || (0 === (x % q))
                    )(
                        ([_, r]) => [step(r), 1 + r]
                    )([
                        0 === x % 2 ? (
                            2
                        ) : 3,
                        1
                    ])[0];
                return m > root ? (
                    [x]
                ) : ([m].concat(go(Math.floor(x / m))));
            },
            step = x => 1 + (x << 2) - ((x >> 1) << 1);
        return go(n);
    };

    // ---------------- GENERIC FUNCTIONS -----------------

    // chunksOf :: Int -> [a] -> [[a]]
    const chunksOf = n =>
        xs => enumFromThenTo(0)(n)(
            xs.length - 1
        ).reduce(
            (a, i) => a.concat([xs.slice(i, (n + i))]),
            []
        );

    // compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
    const compose = (...fs) =>
        fs.reduce(
            (f, g) => x => f(g(x)),
            x => x
        );

    // enumFrom :: Enum a => a -> [a]
    function* enumFrom(x) {
        // A non-finite succession of enumerable
        // values, starting with the value x.
        let v = x;
        while (true) {
            yield v;
            v = 1 + v;
        }
    }

    // enumFromThenTo :: Int -> Int -> Int -> [Int]
    const enumFromThenTo = x1 =>
        x2 => y => {
            const d = x2 - x1;
            return Array.from({
                length: Math.floor(y - x2) / d + 2
            }, (_, i) => x1 + (d * i));
        };

    // filter :: (a -> Bool) -> Gen [a] -> [a]
    const filter = p => xs => {
        function* go() {
            let x = xs.next();
            while (!x.done) {
                let v = x.value;
                if (p(v)) {
                    yield v
                }
                x = xs.next();
            }
        }
        return go(xs);
    };

    // ge :: Ord a => a -> a -> Bool
    const ge = x =>
        // True if x >= y
        y => x >= y;

    // justifyRight :: Int -> Char -> String -> String
    const justifyRight = n =>
        // The string s, preceded by enough padding (with
        // the character c) to reach the string length n.
        c => s => n > s.length ? (
            s.padStart(n, c)
        ) : s;

    // last :: [a] -> a
    const last = xs =>
        // The last item of a list.
        0 < xs.length ? xs.slice(-1)[0] : undefined;

    // length :: [a] -> Int
    const length = xs =>
        // Returns Infinity over objects without finite
        // length. This enables zip and zipWith to choose
        // the shorter argument when one is non-finite,
        // like cycle, repeat etc
        (Array.isArray(xs) || 'string' === typeof xs) ? (
            xs.length
        ) : Infinity;

    // map :: (a -> b) -> [a] -> [b]
    const map = f =>
        // The list obtained by applying f
        // to each element of xs.
        // (The image of xs under f).
        xs => (
            Array.isArray(xs) ? (
                xs
            ) : xs.split('')
        ).map(f);

    // showCols :: Int -> [a] -> String
    const showCols = w => xs => {
        const
            ys = xs.map(str),
            mx = last(ys).length;
        return unlines(chunksOf(w)(ys).map(
            row => row.map(justifyRight(mx)(' ')).join(' ')
        ))
    };

    // str :: a -> String
    const str = x =>
        x.toString();

    // takeWhile :: (a -> Bool) -> Gen [a] -> [a]
    const takeWhile = p => xs => {
        const ys = [];
        let
            nxt = xs.next(),
            v = nxt.value;
        while (!nxt.done && p(v)) {
            ys.push(v);
            nxt = xs.next();
            v = nxt.value
        }
        return ys;
    };

    // unlines :: [String] -> String
    const unlines = xs =>
        // A single string formed by the intercalation
        // of a list of strings with the newline character.
        xs.join('\n');

    // until :: (a -> Bool) -> (a -> a) -> a -> a
    const until = p => f => x => {
        let v = x;
        while (!p(v)) v = f(v);
        return v;
    };

    // MAIN ---
    return main();
})();


(defn update-map [base update]
  (merge base update))

  (update-map {"name"  "Rocket Skates"
               "price" "12.75"
               "color" "yellow"}
              {"price" "15.25"
               "color" "red"
               "year"  "1974"})


base = {"name" => "Rocket Skates", "price" => 12.75, "color" => "yellow"}
update = { "price" => 15.25, "color" => "red", "year" => 1974 }

puts base.merge(update)


main() {
	var base = {
		'name':   'Rocket Skates',
		'price':  12.75,
		'color':  'yellow'
	};

	var newData = {
		'price': 15.25,
		'color': 'red',
		'year':  1974
	};

	var updated = Map.from( base ) // create new Map from base
		..addAll( newData ); // use cascade operator to add all new data

	assert( base.toString()    == '{name: Rocket Skates, price: 12.75, color: yellow}' );
	assert( updated.toString() == '{name: Rocket Skates, price: 15.25, color: red, year: 1974}');

}


program Associative_arrayMerging;

{$APPTYPE CONSOLE}

uses
  System.Generics.Collections;

type
  TData = TDictionary<string, Variant>;

var
  baseData, updateData, mergedData: TData;
  entry: string;

begin
  baseData := TData.Create();
  baseData.Add('name', 'Rocket Skates');
  baseData.Add('price', 12.75);
  baseData.Add('color', 'yellow');

  updateData := TData.Create();
  updateData.Add('price', 15.25);
  updateData.Add('color', 'red');
  updateData.Add('year', 1974);

  mergedData := TData.Create();
  for entry in baseData.Keys do
    mergedData.AddOrSetValue(entry, baseData[entry]);

  for entry in updateData.Keys do
    mergedData.AddOrSetValue(entry, updateData[entry]);

  for entry in mergedData.Keys do
    Writeln(entry, ' ', mergedData[entry]);

  mergedData.Free;
  updateData.Free;
  baseData.Free;

  Readln;
end.


CLASS AVL;
BEGIN

    ! AVL TREE ADAPTED FROM JULIENNE WALKER'S PRESENTATION AT ;
    ! HTTP://ETERNALLYCONFUZZLED.COM/TUTS/DATASTRUCTURES/JSW_TUT_AVL.ASPX. ;
    ! THIS PORT USES SIMILAR INDENTIFIER NAMES. ;

    ! THE KEY INTERFACE MUST BE SUPPORTED BY DATA STORED IN THE AVL TREE. ;
    CLASS KEY;
    VIRTUAL:
        PROCEDURE LESS  IS BOOLEAN PROCEDURE LESS (K); REF(KEY) K;;
        PROCEDURE EQUAL IS BOOLEAN PROCEDURE EQUAL(K); REF(KEY) K;;
    BEGIN
    END KEY;

    ! NODE IS A NODE IN AN AVL TREE. ;
    CLASS NODE(DATA); REF(KEY) DATA;  ! ANYTHING COMPARABLE WITH LESS AND EQUAL. ;
    BEGIN
        INTEGER  BALANCE;             ! BALANCE FACTOR ;
        REF(NODE) ARRAY LINK(0:1);    ! CHILDREN, INDEXED BY "DIRECTION", 0 OR 1. ;
    END NODE;

    ! A LITTLE READABILITY FUNCTION FOR RETURNING THE OPPOSITE OF A DIRECTION, ;
    ! WHERE A DIRECTION IS 0 OR 1. ;
    ! WHERE JW WRITES !DIR, THIS CODE HAS OPP(DIR). ;
    INTEGER PROCEDURE OPP(DIR); INTEGER DIR;
    BEGIN
        OPP := 1 - DIR;
    END OPP;

    ! SINGLE ROTATION ;
    REF(NODE) PROCEDURE SINGLE(ROOT, DIR); REF(NODE) ROOT; INTEGER DIR;
    BEGIN
        REF(NODE) SAVE;
        SAVE :- ROOT.LINK(OPP(DIR));
        ROOT.LINK(OPP(DIR)) :- SAVE.LINK(DIR);
        SAVE.LINK(DIR) :- ROOT;
        SINGLE :- SAVE;
    END SINGLE;

    ! DOUBLE ROTATION ;
    REF(NODE) PROCEDURE DOUBLE(ROOT, DIR); REF(NODE) ROOT; INTEGER DIR;
    BEGIN
        REF(NODE) SAVE;
        SAVE :- ROOT.LINK(OPP(DIR)).LINK(DIR);

        ROOT.LINK(OPP(DIR)).LINK(DIR) :- SAVE.LINK(OPP(DIR));
        SAVE.LINK(OPP(DIR)) :- ROOT.LINK(OPP(DIR));
        ROOT.LINK(OPP(DIR)) :- SAVE;

        SAVE :- ROOT.LINK(OPP(DIR));
        ROOT.LINK(OPP(DIR)) :- SAVE.LINK(DIR);
        SAVE.LINK(DIR) :- ROOT;
        DOUBLE :- SAVE;
    END DOUBLE;

    ! ADJUST BALANCE FACTORS AFTER DOUBLE ROTATION ;
    PROCEDURE ADJUSTBALANCE(ROOT, DIR, BAL); REF(NODE) ROOT; INTEGER DIR, BAL;
    BEGIN
        REF(NODE) N, NN;
        N :- ROOT.LINK(DIR);
        NN :- N.LINK(OPP(DIR));
        IF NN.BALANCE = 0   THEN BEGIN ROOT.BALANCE := 0;    N.BALANCE := 0;   END ELSE
        IF NN.BALANCE = BAL THEN BEGIN ROOT.BALANCE := -BAL; N.BALANCE := 0;   END
                            ELSE BEGIN ROOT.BALANCE := 0;    N.BALANCE := BAL; END;
        NN.BALANCE := 0;
    END ADJUSTBALANCE;

    REF(NODE) PROCEDURE INSERTBALANCE(ROOT, DIR); REF(NODE) ROOT; INTEGER DIR;
    BEGIN REF(NODE) N;  INTEGER BAL;
        N :- ROOT.LINK(DIR);
        BAL := 2*DIR - 1;
        IF N.BALANCE = BAL THEN
        BEGIN
            ROOT.BALANCE := 0;
            N.BALANCE := 0;
            INSERTBALANCE :- SINGLE(ROOT, OPP(DIR));
        END ELSE
        BEGIN
            ADJUSTBALANCE(ROOT, DIR, BAL);
            INSERTBALANCE :- DOUBLE(ROOT, OPP(DIR));
        END;
    END INSERTBALANCE;

    CLASS TUPLE(N,B); REF(NODE) N; BOOLEAN B;;

    REF(TUPLE) PROCEDURE INSERTR(ROOT, DATA); REF(NODE) ROOT; REF(KEY) DATA;
    BEGIN
        IF ROOT == NONE THEN
            INSERTR :- NEW TUPLE(NEW NODE(DATA), FALSE)
        ELSE
        BEGIN
            REF(TUPLE) T;  BOOLEAN DONE;  INTEGER DIR;
            DIR := 0;
            IF ROOT.DATA.LESS(DATA) THEN
                DIR := 1;
            T :- INSERTR(ROOT.LINK(DIR), DATA);
            ROOT.LINK(DIR) :- T.N;
            DONE := T.B;
            IF DONE THEN INSERTR :- NEW TUPLE(ROOT, TRUE) ELSE
            BEGIN
                ROOT.BALANCE := ROOT.BALANCE + 2*DIR - 1;
                IF ROOT.BALANCE = 0 THEN
                    INSERTR :- NEW TUPLE(ROOT, TRUE) ELSE
                IF ROOT.BALANCE = 1 OR ROOT.BALANCE = -1 THEN
                    INSERTR :- NEW TUPLE(ROOT, FALSE)
                ELSE
                    INSERTR :- NEW TUPLE(INSERTBALANCE(ROOT, DIR), TRUE);
            END;
        END;
    END INSERTR;

    ! INSERT A NODE INTO THE AVL TREE. ;
    ! DATA IS INSERTED EVEN IF OTHER DATA WITH THE SAME KEY ALREADY EXISTS. ;
    PROCEDURE INSERT(TREE, DATA); NAME TREE; REF(NODE) TREE; REF(KEY) DATA;
    BEGIN
        REF(TUPLE) T;
        T :- INSERTR(TREE, DATA);
        TREE :- T.N;
    END INSERT;

    REF(TUPLE) PROCEDURE REMOVEBALANCE(ROOT, DIR); REF(NODE) ROOT; INTEGER DIR;
    BEGIN REF(NODE) N;  INTEGER BAL;
        N :- ROOT.LINK(OPP(DIR));
        BAL := 2*DIR - 1;

        IF N.BALANCE = -BAL THEN
        BEGIN ROOT.BALANCE := 0; N.BALANCE := 0;
            REMOVEBALANCE :- NEW TUPLE(SINGLE(ROOT, DIR), FALSE);
        END ELSE

        IF N.BALANCE = BAL THEN
        BEGIN ADJUSTBALANCE(ROOT, OPP(DIR), -BAL);
            REMOVEBALANCE :- NEW TUPLE(DOUBLE(ROOT, DIR), FALSE);
        END ELSE

        BEGIN ROOT.BALANCE := -BAL; N.BALANCE := BAL;
            REMOVEBALANCE :- NEW TUPLE(SINGLE(ROOT, DIR), TRUE);
        END
    END REMOVEBALANCE;

    REF(TUPLE) PROCEDURE REMOVER(ROOT, DATA); REF(NODE) ROOT; REF(KEY) DATA;
    BEGIN INTEGER DIR; BOOLEAN DONE; REF(TUPLE) T;

        IF ROOT == NONE THEN
            REMOVER :- NEW TUPLE(NONE, FALSE)
        ELSE
        IF ROOT.DATA.EQUAL(DATA) THEN
        BEGIN
            IF ROOT.LINK(0) == NONE THEN
            BEGIN
                REMOVER :- NEW TUPLE(ROOT.LINK(1), FALSE);
                GOTO L;
            END

            ELSE IF ROOT.LINK(1) == NONE THEN
            BEGIN
                REMOVER :- NEW TUPLE(ROOT.LINK(0), FALSE);
                GOTO L;
            END

            ELSE
            BEGIN REF(NODE) HEIR;
                HEIR :- ROOT.LINK(0);
                WHILE HEIR.LINK(1) =/= NONE DO
                    HEIR :- HEIR.LINK(1);
                ROOT.DATA :- HEIR.DATA;
                DATA :- HEIR.DATA;
            END;
        END;
        DIR := 0;
        IF ROOT.DATA.LESS(DATA) THEN
            DIR := 1;
        T :- REMOVER(ROOT.LINK(DIR), DATA); ROOT.LINK(DIR) :- T.N; DONE := T.B;
        IF DONE THEN
        BEGIN
            REMOVER :- NEW TUPLE(ROOT, TRUE);
            GOTO L;
        END;
        ROOT.BALANCE := ROOT.BALANCE + 1 - 2*DIR;
        IF ROOT.BALANCE = 1 OR ROOT.BALANCE = -1 THEN
            REMOVER :- NEW TUPLE(ROOT, TRUE)

        ELSE IF ROOT.BALANCE = 0 THEN
            REMOVER :- NEW TUPLE(ROOT, FALSE)

        ELSE
            REMOVER :- REMOVEBALANCE(ROOT, DIR);
    L:
    END REMOVER;

    ! REMOVE A SINGLE ITEM FROM AN AVL TREE. ;
    ! IF KEY DOES NOT EXIST, FUNCTION HAS NO EFFECT. ;
    PROCEDURE REMOVE(TREE, DATA); NAME TREE; REF(NODE) TREE; REF(KEY) DATA;
    BEGIN REF(TUPLE) T;
        T :- REMOVER(TREE, DATA);
        TREE :- T.N;
    END REMOVEM;

END.


# declare some constants #
INT limit = 100;

PROC doors = VOID:
(
  MODE DOORSTATE = BOOL;
  BOOL closed = FALSE;
  BOOL open = NOT closed;
  MODE DOORLIST = [limit]DOORSTATE;

  DOORLIST the doors;
  FOR i FROM LWB the doors TO UPB the doors DO the doors[i]:=closed OD;

  FOR i FROM LWB the doors TO UPB the doors DO
    FOR j FROM LWB the doors TO UPB the doors DO
      IF j MOD i = 0 THEN
        the doors[j] :=  NOT the doors[j]
      FI
    OD
  OD;
  FOR i FROM LWB the doors TO UPB the doors DO
    printf(($g" is "gl$,i,(the doors[i]|"opened"|"closed")))
  OD
);
doors;


class Integer
  def factorial
    self == 0 ? 1 : (1..self).inject(:*)
  end
end

def rand_until_rep(n)
  rands = {}
  loop do
    r = rand(1..n)
    return rands.size if rands[r]
    rands[r] = true
  end
end

runs = 1_000_000

puts " N    average    exp.        diff   ",
     "===  ========  ========  ==========="
(1..20).each do |n|
  sum_of_runs = runs.times.inject(0){|sum, _| sum += rand_until_rep(n)}
  avg = sum_of_runs / runs.to_f
  analytical = (1..n).inject(0){|sum, i| sum += (n.factorial / (n**i).to_f / (n-i).factorial)}
  puts "%3d  %8.4f  %8.4f  (%8.4f%%)" % [n, avg, analytical, (avg/analytical - 1)*100]
end


extern crate rand;

use rand::{ThreadRng, thread_rng};
use rand::distributions::{IndependentSample, Range};
use std::collections::HashSet;
use std::env;
use std::process;

fn help() {
    println!("usage: average_loop_length <max_N> <trials>");
}

fn main() {
    let args: Vec<String> = env::args().collect();
    let mut max_n: u32 = 20;
    let mut trials: u32 = 1000;

    match args.len() {
        1 => {}
        3 => {
            max_n = args[1].parse::<u32>().unwrap();
            trials = args[2].parse::<u32>().unwrap();
        }
        _ => {
            help();
            process::exit(0);
        }
    }

    let mut rng = thread_rng();

    println!(" N    average    analytical    (error)");
    println!("===  =========  ============  =========");
    for n in 1..(max_n + 1) {
        let the_analytical = analytical(n);
        let the_empirical = empirical(n, trials, &mut rng);
        println!(" {:>2}     {:3.4}        {:3.4}  ( {:>+1.2}%)",
                 n,
                 the_empirical,
                 the_analytical,
                 100f64 * (the_empirical / the_analytical - 1f64));
    }
}

fn factorial(n: u32) -> f64 {
    (1..n + 1).fold(1f64, |p, n| p * n as f64)
}

fn analytical(n: u32) -> f64 {
    let sum: f64 = (1..(n + 1))
                       .map(|i| factorial(n) / (n as f64).powi(i as i32) / factorial(n - i))
                       .fold(0f64, |a, v| a + v);
    sum
}

fn empirical(n: u32, trials: u32, rng: &mut ThreadRng) -> f64 {
    let sum: f64 = (0..trials)
                       .map(|_t| {
                           let mut item = 1u32;
                           let mut seen = HashSet::new();
                           let range = Range::new(1u32, n + 1);

                           for step in 0..n {
                               if seen.contains(&item) {
                                   return step as f64;
                               }
                               seen.insert(item);
                               item = range.ind_sample(rng);
                           }
                           n as f64
                       })
                       .fold(0f64, |a, v| a + v);
    sum / trials as f64
}


import scala.util.Random

object AverageLoopLength extends App {

  val factorial: LazyList[Double] = 1 #:: factorial.zip(LazyList.from(1)).map(n => n._2 * factorial(n._2 - 1))
  val results = for (n <- 1 to 20;
                     avg = tested(n, 1000000);
                     theory = expected(n)
                     ) yield (n, avg, theory, (avg / theory - 1) * 100)

  def expected(n: Int): Double = (for (i <- 1 to n) yield factorial(n) / Math.pow(n, i) / factorial(n - i)).sum

  def tested(n: Int, times: Int): Double = (for (i <- 1 to times) yield trial(n)).sum / times

  def trial(n: Int): Double = {
    var count = 0
    var x = 1
    var bits = 0

    while ((bits & x) == 0) {
      count = count + 1
      bits = bits | x
      x = 1 << Random.nextInt(n)
    }
    count
  }

  println("n          avg         exp      diff")
  println("------------------------------------")
  results foreach { n => {
    println(f"${n._1}%2d    ${n._2}%2.6f    ${n._3}%2.6f    ${n._4}%2.3f%%")
  }
  }

}


public class Attractive {

    static boolean is_prime(int n) {
        if (n < 2) return false;
        if (n % 2 == 0) return n == 2;
        if (n % 3 == 0) return n == 3;
        int d = 5;
        while (d *d <= n) {
            if (n % d == 0) return false;
            d += 2;
            if (n % d == 0) return false;
            d += 4;
        }
        return true;
    }

    static int count_prime_factors(int n) {
        if (n == 1) return 0;
        if (is_prime(n)) return 1;
        int count = 0, f = 2;
        while (true) {
            if (n % f == 0) {
                count++;
                n /= f;
                if (n == 1) return count;
                if (is_prime(n)) f = n;
            }
            else if (f >= 3) f += 2;
            else f = 3;
        }
    }

    public static void main(String[] args) {
        final int max = 120;
        System.out.printf("The attractive numbers up to and including %d are:\n", max);
        for (int i = 1, count = 0; i <= max; ++i) {
            int n = count_prime_factors(i);
            if (is_prime(n)) {
                System.out.printf("%4d", i);
                if (++count % 20 == 0) System.out.println();
            }
        }
        System.out.println();
    }
}


base = %{name: "Rocket Skates", price: 12.75, color: "yellow"}
update = %{price: 15.25, color: "red", year: 1974}
result = Map.merge(base, update)
IO.inspect(result)


type N = |Price of float|Name of string|Year of int|Colour of string
let n=Map<string,N>[("name",Name("Rocket Skates"));("price",Price(12.75));("colour",Colour("yellow"))]
let g=Map<string,N>[("price",Price(15.25));("colour",Colour("red"));("year",Year(1974))]
let ng=(Map.toList n)@(Map.toList g)|>Map.ofList
printfn "%A" ng


USING: assocs prettyprint ;

{ { "name" "Rocket Skates" } { "price" 12.75 } { "color" "yellow" } }
{ { "price" 15.25 } { "color" "red" } { "year" 1974 } }
assoc-union .


package main

import "fmt"

type assoc map[string]interface{}

func merge(base, update assoc) assoc {
    result := make(assoc)
    for k, v := range base {
        result[k] = v
    }
    for k, v := range update {
        result[k] = v
    }
    return result
}

func main() {
    base := assoc{"name": "Rocket Skates", "price": 12.75, "color": "yellow"}
    update := assoc{"price": 15.25, "color": "red", "year": 1974}
    result := merge(base, update)
    fmt.Println(result)
}