package require TclOO

namespace eval AVL {
    # Class for the overall tree; manages real public API
    oo::class create Tree {
	variable root nil class
	constructor {{nodeClass AVL::Node}} {
	    set class [oo::class create Node [list superclass $nodeClass]]

	    # Create a nil instance to act as a leaf sentinel
	    set nil [my NewNode ""]
	    set root [$nil ref]

	    # Make nil be special
	    oo::objdefine $nil {
		method height {} {return 0}
		method key {} {error "no key possible"}
		method value {} {error "no value possible"}
		method destroy {} {
		    # Do nothing (doesn't prohibit destruction entirely)
		}
		method print {indent increment} {
		    # Do nothing
		}
	    }
	}

	# How to actually manufacture a new node
	method NewNode {key} {
	    if {![info exists nil]} {set nil ""}
	    $class new $key $nil [list [namespace current]::my NewNode]
	}

	# Create a new node in the tree and return it
	method insert {key} {
	    set node [my NewNode $key]
	    if {$root eq $nil} {
		set root $node
	    } else {
		$root insert $node
	    }
	    return $node
	}

	# Find the node for a particular key
	method lookup {key} {
	    for {set node $root} {$node ne $nil} {} {
		if {[$node key] == $key} {
		    return $node
		} elseif {[$node key] > $key} {
		    set node [$node left]
		} else {
		    set node [$node right]
		}
	    }
	    error "no such node"
	}

	# Print a tree out, one node per line
	method print {{indent 0} {increment 1}} {
	    $root print $indent $increment
	    return
	}
    }

    # Class of an individual node; may be subclassed
    oo::class create Node {
	variable key value left right 0 refcount newNode
	constructor {n nil instanceFactory} {
	    set newNode $instanceFactory
	    set 0 [expr {$nil eq "" ? [self] : $nil}]
	    set key $n
	    set value {}
	    set left [set right $0]
	    set refcount 0
	}
	method ref {} {
	    incr refcount
	    return [self]
	}
	method destroy {} {
	    if {[incr refcount -1] < 1} next
	}
	method New {key value} {
	    set n [{*}$newNode $key]
	    $n setValue $value
	    return $n
	}

	# Getters
	method key {} {return $key}
	method value {} {return $value}
	method left {} {return $left}
	method right {args} {return $right}

	# Setters
	method setValue {newValue} {
	    set value $newValue
	}
	method setLeft {node} {
	    # Non-trivial because of reference management
	    $node ref
	    $left destroy
	    set left $node
	    return
	}
	method setRight {node} {
	    # Non-trivial because of reference management
	    $node ref
	    $right destroy
	    set right $node
	    return
	}

	# Print a node and its descendents
	method print {indent increment} {
	    puts [format "%s%s => %s" [string repeat " " $indent] $key $value]
	    incr indent $increment
	    $left print $indent $increment
	    $right print $indent $increment
	}

	method height {} {
	    return [expr {max([$left height], [$right height]) + 1}]
	}
	method balanceFactor {} {
	    expr {[$left height] - [$right height]}
	}

	method insert {node} {
	    # Simple insertion
	    if {$key > [$node key]} {
		if {$left eq $0} {
		    my setLeft $node
		} else {
		    $left insert $node
		}
	    } else {
		if {$right eq $0} {
		    my setRight $node
		} else {
		    $right insert $node
		}
	    }

	    # Rebalance this node
	    if {[my balanceFactor] > 1} {
		if {[$left balanceFactor] < 0} {
		    $left rotateLeft
		}
		my rotateRight
	    } elseif {[my balanceFactor] < -1} {
		if {[$right balanceFactor] > 0} {
		    $right rotateRight
		}
		my rotateLeft
	    }
	}

	# AVL Rotations
	method rotateLeft {} {
	    set new [my New $key $value]
	    set key [$right key]
	    set value [$right value]
	    $new setLeft $left
	    $new setRight [$right left]
	    my setLeft $new
	    my setRight [$right right]
	}

	method rotateRight {} {
	    set new [my New $key $value]
	    set key [$left key]
	    set value [$left value]
	    $new setLeft [$left right]
	    $new setRight $right
	    my setLeft [$left left]
	    my setRight $new
	}
    }
}


begin
    % find the first few squares via the unoptimised door flipping method   %

    integer doorMax;
    doorMax := 100;

    begin
        % need to start a new block so the array can have variable bounds   %

        % array of doors - door( i ) is true if open, false if closed       %
        logical array door( 1 :: doorMax );

        % set all doors to closed                                           %
        for i := 1 until doorMax do door( i ) := false;

        % repeatedly flip the doors                                         %
        for i := 1 until doorMax
        do begin
            for j := i step i until doorMax
            do begin
                door( j ) := not door( j )
            end
        end;

        % display the results                                               %
        i_w := 1; % set integer field width                                 %
        s_w := 1; % and separator width                                     %
        for i := 1 until doorMax do if door( i ) then writeon( i )

    end

end.


(import (scheme base)
        (scheme write)
        (srfi 1 lists)
        (only (srfi 13 strings) string-pad-right)
        (srfi 27 random-bits))

(define (analytical-function n)
  (define (factorial n)
    (fold * 1 (iota n 1)))
  ;
  (fold (lambda (i sum)
          (+ sum
             (/ (factorial n) (expt n i) (factorial (- n i)))))
        0
        (iota n 1)))

(define (simulation n runs)
  (define (single-simulation)
    (random-source-randomize! default-random-source)
    (let ((vec (make-vector n #f)))
      (let loop ((count 0)
                 (num (random-integer n)))
        (if (vector-ref vec num)
          count
          (begin (vector-set! vec num #t)
                 (loop (+ 1 count)
                       (random-integer n)))))))
  ;;
  (let loop ((total 0)
             (run runs))
    (if (zero? run)
      (/ total runs)
      (loop (+ total (single-simulation))
            (- run 1)))))

(display " N   average   formula   (error) \n")
(display "=== ========= ========= =========\n")
(for-each
  (lambda (n)
    (let ((simulation (inexact (simulation n 10000)))
          (formula (inexact (analytical-function n))))
      (display
        (string-append
          " "
          (string-pad-right (number->string n) 3)
          "   "
          (string-pad-right (number->string simulation) 6)
          "   "
          (string-pad-right (number->string formula) 6)
          "   ("
          (string-pad-right
            (number->string (* 100 (/ (- simulation formula) formula)))
            5)
          "%)"))
      (newline)))
  (iota 20 1))


def count(s): reduce s as $x (null; .+1);

def is_attractive:
  count(prime_factors) | is_prime;

def printattractive($m; $n):
  "The attractive numbers from \($m) to \($n) are:\n",
  [range($m; $n+1) | select(is_attractive)];

printattractive(1; 120)


using Primes

# oneliner is println("The attractive numbers from 1 to 120 are:\n", filter(x -> isprime(sum(values(factor(x)))), 1:120))

isattractive(n) = isprime(sum(values(factor(n))))

printattractive(m, n) = println("The attractive numbers from $m to $n are:\n", filter(isattractive, m:n))

printattractive(1, 120)


data Item = Item
  { name :: Maybe String
  , price :: Maybe Float
  , color :: Maybe String
  , year :: Maybe Int
  } deriving (Show)

itemFromMerge :: Item -> Item -> Item
itemFromMerge (Item n p c y) (Item n1 p1 c1 y1) =
  Item (maybe n pure n1) (maybe p pure p1) (maybe c pure c1) (maybe y pure y1)

main :: IO ()
main =
  print $
  itemFromMerge
    (Item (Just "Rocket Skates") (Just 12.75) (Just "yellow") Nothing)
    (Item Nothing (Just 15.25) (Just "red") (Just 1974))


procedure main()
    local base, update, master, f, k

    base := table()
    base["name"] := "Rocket Skates"
    base["price"] := 12.75
    base["color"] := "yellow"

    update := table()
    update["price"] := 15.25
    update["color"] := "red"
    update["year"] := 1974

    master := table()
    every k := key((f := base | update)) do {
        master[k] := f[k]
    }

    every k := key(master) do {
        write(k, " = ", master[k])
    }
end


merge=: ,.    NB. use: update merge original
compress=: #"1~ ~:@:keys
keys=: {.
values=: {:
get=: [: > ((i.~ keys)~ <)~ { [email protected]:]   NB. key get (associative array)
pair=: [: |: <;._2;._2


import java.util.*;

class MergeMaps {
    public static void main(String[] args) {
        Map<String, Object> base = new HashMap<>();
        base.put("name", "Rocket Skates");
        base.put("price", 12.75);
        base.put("color", "yellow");
        Map<String, Object> update = new HashMap<>();
        update.put("price", 15.25);
        update.put("color", "red");
        update.put("year", 1974);

        Map<String, Object> result = new HashMap<>(base);
        result.putAll(update);

        System.out.println(result);
    }
}


/** A single node in an AVL tree */
class AVLnode <T> {
    balance: number
    left: AVLnode<T>
    right: AVLnode<T>

    constructor(public key: T, public parent: AVLnode<T> = null) {
        this.balance = 0
        this.left = null
        this.right = null
    }
}

/** The balanced AVL tree */
class AVLtree <T> {
    // public members organized here
    constructor() {
        this.root = null
    }

    insert(key: T): boolean {
        if (this.root === null) {
            this.root = new AVLnode<T>(key)
        } else {
            let n: AVLnode<T> = this.root,
                parent: AVLnode<T> = null

            while (true) {
                if(n.key === key) {
                    return false
                }

                parent = n

                let goLeft: boolean = n.key > key
                n = goLeft ? n.left : n.right

                if (n === null) {
                    if (goLeft) {
                        parent.left = new AVLnode<T>(key, parent)
                    } else {
                        parent.right = new AVLnode<T>(key, parent)
                    }

                    this.rebalance(parent)
                    break
                }
            }
        }

        return true
    }

    deleteKey(delKey: T): void {
        if (this.root === null) {
            return
        }

        let n: AVLnode<T> = this.root,
            parent: AVLnode<T> = this.root,
            delNode: AVLnode<T> = null,
            child: AVLnode<T> = this.root

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

        if (delNode !== null) {
            delNode.key = n.key

            child = n.left !== null ? n.left : n.right

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

                this.rebalance(parent)
            }
        }
    }

    treeBalanceString(n: AVLnode<T> = this.root): string {
        if (n !== null) {
            return `${this.treeBalanceString(n.left)} ${n.balance} ${this.treeBalanceString(n.right)}`
        }
        return ""
    }

    toString(n: AVLnode<T> = this.root): string {
        if (n !== null) {
            return `${this.toString(n.left)} ${n.key} ${this.toString(n.right)}`
        }
        return ""
    }

    // private members organized here
    private root: AVLnode<T>

    private rotateLeft(a: AVLnode<T>): AVLnode<T> {
        let b: AVLnode<T> = a.right
        b.parent = a.parent
        a.right = b.left

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

        b.left = a
        a.parent = b

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

        this.setBalance(a)
        this.setBalance(b)

        return b
    }

    private rotateRight(a: AVLnode<T>): AVLnode<T> {
        let b: AVLnode<T> = a.left
        b.parent = a.parent
        a.left = b.right

        if (a.left !== null) {
            a.left.parent = a
        }

        b.right = a
        a.parent = b

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

        this.setBalance(a)
        this.setBalance(b)

        return b
    }

    private rotateLeftThenRight(n: AVLnode<T>): AVLnode<T> {
        n.left = this.rotateLeft(n.left)
        return this.rotateRight(n)
    }

    private rotateRightThenLeft(n: AVLnode<T>): AVLnode<T> {
        n.right = this.rotateRight(n.right)
        return this.rotateLeft(n)
    }

    private rebalance(n: AVLnode<T>): void {
        this.setBalance(n)

        if (n.balance === -2) {
            if(this.height(n.left.left) >= this.height(n.left.right)) {
                n = this.rotateRight(n)
            } else {
                n = this.rotateLeftThenRight(n)
            }
        } else if (n.balance === 2) {
            if(this.height(n.right.right) >= this.height(n.right.left)) {
                n = this.rotateLeft(n)
            } else {
                n = this.rotateRightThenLeft(n)
            }
        }

        if (n.parent !== null) {
            this.rebalance(n.parent)
        } else {
            this.root = n
        }
    }

    private height(n: AVLnode<T>): number {
        if (n === null) {
            return -1
        }
        return 1 + Math.max(this.height(n.left), this.height(n.right))
    }

    private setBalance(n: AVLnode<T>): void {
        n.balance = this.height(n.right) - this.height(n.left)
    }

    public showNodeBalance(n: AVLnode<T>): string {
        if (n !== null) {
            return `${this.showNodeBalance(n.left)} ${n.balance} ${this.showNodeBalance(n.right)}`
        }
        return ""
    }
}


BEGIN

INTEGER ARRAY DOORS[1:100];
INTEGER I, J, OPEN, CLOSED;

OPEN := 1;
CLOSED := 0;

% ALL DOORS ARE INITIALLY CLOSED %
FOR I := 1 STEP 1 UNTIL 100 DO
  BEGIN
    DOORS[I] := CLOSED;
  END;

% PASS THROUGH AT INCREASING INTERVALS AND FLIP %
FOR I := 1 STEP 1 UNTIL 100 DO
  BEGIN
     FOR J := I STEP I UNTIL 100 DO
       BEGIN
         DOORS[J] := 1 - DOORS[J];
       END;
  END;

% SHOW RESULTS %
WRITE("THE OPEN DOORS ARE:");
WRITE("");
FOR I := 1 STEP 1 UNTIL 100 DO
  BEGIN
    IF DOORS[I] = OPEN THEN
      WRITEON(I);
  END;

END


$ include "seed7_05.s7i";
  include "float.s7i";

const integer: TESTS is 1000000;

const func float: factorial (in integer: number) is func
  result
    var float: factorial is 1.0;
  local
    var integer: i is 0;
  begin
    for i range 2 to number do
      factorial *:= flt(i);
    end for;
  end func;

const func float: analytical (in integer: number) is func
  result
    var float: sum is 0.0;
  local
    var integer: i is 0;
  begin
    for i range 1 to number do
      sum +:= factorial(number) / factorial(number - i) / flt(number)**i;
    end for;
  end func;

const func float: experimental (in integer: number) is func
  result
    var float: experimental is 0.0;
  local
    var integer: run is 0;
    var set of integer: seen is EMPTY_SET;
    var integer: current is 1;
    var integer: count is 0;
  begin
    for run range 1 to TESTS do
      current := 1;
      seen := EMPTY_SET;
      while current not in seen do
        incr(count);
        incl(seen, current);
        current := rand(1, number);
      end while;
    end for;
    experimental := flt(count) / flt(TESTS);
  end func;

const proc: main is func
  local
    var integer: number is 0;
    var float: analytical is 0.0;
    var float: experimental is 0.0;
    var float: err is 0.0;
  begin
    writeln(" N  avg    calc   %diff");
    for number range 1 to 20 do
      analytical := analytical(number);
      experimental := experimental(number);
      err := abs(experimental - analytical) / analytical * 100.0;
      writeln(number lpad 2 <& experimental digits 4 lpad 7 <&
              analytical digits 4 lpad 7 <& err digits 3 lpad 7);
    end for;
  end func;


func find_loop(n) {
    var seen = Hash()
    loop {
        with (irand(1, n)) { |r|
            seen.has(r) ? (return seen.len) : (seen{r} = true)
        }
    }
}

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

define MAX    = 20
define TRIALS = 1000

for n in (1..MAX) {
    var empiric = (1..TRIALS -> sum { find_loop(n) } / TRIALS)
    var theoric = (1..n -> sum {|k| prod(n - k + 1 .. n) * k**2 / n**(k+1) })

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


BEGIN

   REAL PROCEDURE FACTORIAL(N); INTEGER N;
   BEGIN
      REAL RESULT;
      INTEGER I;
      RESULT := 1.0;
      FOR I := 2 STEP 1 UNTIL N DO
         RESULT := RESULT * I;
      FACTORIAL := RESULT;
   END FACTORIAL;

   REAL PROCEDURE ANALYTICAL (N); INTEGER N;
   BEGIN
      REAL SUM, RN;
      INTEGER I;
      RN := N;
      FOR I := 1 STEP 1 UNTIL N DO
      BEGIN
         SUM := SUM + FACTORIAL(N) / FACTORIAL(N - I) / RN ** I;
      END;
      ANALYTICAL := SUM;
   END ANALYTICAL;

   REAL PROCEDURE EXPERIMENTAL(N); INTEGER N;
   BEGIN
      INTEGER NUM;
      INTEGER COUNT;
      INTEGER RUN;
      FOR RUN := 1 STEP 1 UNTIL TESTS DO
      BEGIN
         BOOLEAN ARRAY BITS(1:N);
         INTEGER I;
         FOR I := 1 STEP 1 UNTIL N DO
         BEGIN
            NUM := RANDINT(1,N,SEED);
            IF BITS(NUM) THEN GOTO L;
            BITS(NUM) := TRUE;
            COUNT := COUNT + 1;
         END FOR I;
      L:
      END FOR RUN;
      EXPERIMENTAL := COUNT / TESTS;
   END EXPERIMENTAL;

   INTEGER SEED, TESTS;
   SEED := ININT;
   TESTS := 1000000;
   BEGIN
      REAL A, E, ERR;
      INTEGER I;
      OUTTEXT(" N  AVG    CALC   %DIFF"); OUTIMAGE;
      FOR I := 1 STEP 1 UNTIL 20 DO
      BEGIN
         A := ANALYTICAL(I);
         E := EXPERIMENTAL(I);
         ERR := (ABS(E-A)/A)*100.0;
         OUTINT(I, 2);
         OUTFIX(E, 4, 7);
         OUTFIX(A, 4, 10);
         OUTFIX(ERR, 4, 10);
         OUTIMAGE;
      END FOR I;
   END;
END


// Version 1.3.21

const val MAX = 120

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

fun countPrimeFactors(n: Int) =
    when {
        n == 1  -> 0
        isPrime(n) -> 1
        else -> {
            var nn = n
            var count = 0
            var f = 2
            while (true) {
                if (nn % f == 0) {
                    count++
                    nn /= f
                    if (nn == 1) break
                    if (isPrime(nn)) f = nn
                } else if (f >= 3) {
                    f += 2
                } else {
                    f = 3
                }
            }
            count
        }
    }

fun main() {
    println("The attractive numbers up to and including $MAX are:")
    var count = 0
    for (i in 1..MAX) {
        val n = countPrimeFactors(i)
        if (isPrime(n)) {
            System.out.printf("%4d", i)
            if (++count % 20 == 0) println()
        }
    }
    println()
}


; This is not strictly LLVM, as it uses the C library function "printf".
; LLVM does not provide a way to print values, so the alternative would be
; to just load the string into memory, and that would be boring.

$"ATTRACTIVE_STR" = comdat any
$"FORMAT_NUMBER" = comdat any
$"NEWLINE_STR" = comdat any

@"ATTRACTIVE_STR" = linkonce_odr unnamed_addr constant [52 x i8] c"The attractive numbers up to and including %d are:\0A\00", comdat, align 1
@"FORMAT_NUMBER" = linkonce_odr unnamed_addr constant [4 x i8] c"%4d\00", comdat, align 1
@"NEWLINE_STR" = linkonce_odr unnamed_addr constant [2 x i8] c"\0A\00", comdat, align 1

;--- The declaration for the external C printf function.
declare i32 @printf(i8*, ...)

; Function Attrs: noinline nounwind optnone uwtable
define zeroext i1 @is_prime(i32) #0 {
  %2 = alloca i1, align 1               ;-- allocate return value
  %3 = alloca i32, align 4              ;-- allocate n
  %4 = alloca i32, align 4              ;-- allocate d
  store i32 %0, i32* %3, align 4        ;-- store local copy of n
  store i32 5, i32* %4, align 4         ;-- store 5 in d
  %5 = load i32, i32* %3, align 4       ;-- load n
  %6 = icmp slt i32 %5, 2               ;-- n < 2
  br i1 %6, label %nlt2, label %niseven

nlt2:
  store i1 false, i1* %2, align 1       ;-- store false in return value
  br label %exit

niseven:
  %7 = load i32, i32* %3, align 4       ;-- load n
  %8 = srem i32 %7, 2                   ;-- n % 2
  %9 = icmp ne i32 %8, 0                ;-- (n % 2) != 0
  br i1 %9, label %odd, label %even

even:
  %10 = load i32, i32* %3, align 4      ;-- load n
  %11 = icmp eq i32 %10, 2              ;-- n == 2
  store i1 %11, i1* %2, align 1         ;-- store (n == 2) in return value
  br label %exit

odd:
  %12 = load i32, i32* %3, align 4      ;-- load n
  %13 = srem i32 %12, 3                 ;-- n % 3
  %14 = icmp ne i32 %13, 0              ;-- (n % 3) != 0
  br i1 %14, label %loop, label %div3

div3:
  %15 = load i32, i32* %3, align 4      ;-- load n
  %16 = icmp eq i32 %15, 3              ;-- n == 3
  store i1 %16, i1* %2, align 1         ;-- store (n == 3) in return value
  br label %exit

loop:
  %17 = load i32, i32* %4, align 4      ;-- load d
  %18 = load i32, i32* %4, align 4      ;-- load d
  %19 = mul nsw i32 %17, %18            ;-- d * d
  %20 = load i32, i32* %3, align 4      ;-- load n
  %21 = icmp sle i32 %19, %20           ;-- (d * d) <= n
  br i1 %21, label %first, label %prime

first:
  %22 = load i32, i32* %3, align 4      ;-- load n
  %23 = load i32, i32* %4, align 4      ;-- load d
  %24 = srem i32 %22, %23               ;-- n % d
  %25 = icmp ne i32 %24, 0              ;-- (n % d) != 0
  br i1 %25, label %second, label %notprime

second:
  %26 = load i32, i32* %4, align 4      ;-- load d
  %27 = add nsw i32 %26, 2              ;-- increment d by 2
  store i32 %27, i32* %4, align 4       ;-- store d
  %28 = load i32, i32* %3, align 4      ;-- load n
  %29 = load i32, i32* %4, align 4      ;-- load d
  %30 = srem i32 %28, %29               ;-- n % d
  %31 = icmp ne i32 %30, 0              ;-- (n % d) != 0
  br i1 %31, label %loop_end, label %notprime

loop_end:
  %32 = load i32, i32* %4, align 4      ;-- load d
  %33 = add nsw i32 %32, 4              ;-- increment d by 4
  store i32 %33, i32* %4, align 4       ;-- store d
  br label %loop

notprime:
  store i1 false, i1* %2, align 1       ;-- store false in return value
  br label %exit

prime:
  store i1 true, i1* %2, align 1        ;-- store true in return value
  br label %exit

exit:
  %34 = load i1, i1* %2, align 1        ;-- load return value
  ret i1 %34
}

; Function Attrs: noinline nounwind optnone uwtable
define i32 @count_prime_factors(i32) #0 {
  %2 = alloca i32, align 4                      ;-- allocate return value
  %3 = alloca i32, align 4                      ;-- allocate n
  %4 = alloca i32, align 4                      ;-- allocate count
  %5 = alloca i32, align 4                      ;-- allocate f
  store i32 %0, i32* %3, align 4                ;-- store local copy of n
  store i32 0, i32* %4, align 4                 ;-- store zero in count
  store i32 2, i32* %5, align 4                 ;-- store 2 in f
  %6 = load i32, i32* %3, align 4               ;-- load n
  %7 = icmp eq i32 %6, 1                        ;-- n == 1
  br i1 %7, label %eq1, label %ne1

eq1:
  store i32 0, i32* %2, align 4                 ;-- store zero in return value
  br label %exit

ne1:
  %8 = load i32, i32* %3, align 4               ;-- load n
  %9 = call zeroext i1 @is_prime(i32 %8)        ;-- is n prime?
  br i1 %9, label %prime, label %loop

prime:
  store i32 1, i32* %2, align 4                 ;-- store a in return value
  br label %exit

loop:
  %10 = load i32, i32* %3, align 4              ;-- load n
  %11 = load i32, i32* %5, align 4              ;-- load f
  %12 = srem i32 %10, %11                       ;-- n % f
  %13 = icmp ne i32 %12, 0                      ;-- (n % f) != 0
  br i1 %13, label %br2, label %br1

br1:
  %14 = load i32, i32* %4, align 4              ;-- load count
  %15 = add nsw i32 %14, 1                      ;-- increment count
  store i32 %15, i32* %4, align 4               ;-- store count
  %16 = load i32, i32* %5, align 4              ;-- load f
  %17 = load i32, i32* %3, align 4              ;-- load n
  %18 = sdiv i32 %17, %16                       ;-- n / f
  store i32 %18, i32* %3, align 4               ;-- n = n / f
  %19 = load i32, i32* %3, align 4              ;-- load n
  %20 = icmp eq i32 %19, 1                      ;-- n == 1
  br i1 %20, label %br1_1, label %br1_2

br1_1:
  %21 = load i32, i32* %4, align 4              ;-- load count
  store i32 %21, i32* %2, align 4               ;-- store the count in the return value
  br label %exit

br1_2:
  %22 = load i32, i32* %3, align 4              ;-- load n
  %23 = call zeroext i1 @is_prime(i32 %22)      ;-- is n prime?
  br i1 %23, label %br1_3, label %loop

br1_3:
  %24 = load i32, i32* %3, align 4              ;-- load n
  store i32 %24, i32* %5, align 4               ;-- f = n
  br label %loop

br2:
  %25 = load i32, i32* %5, align 4              ;-- load f
  %26 = icmp sge i32 %25, 3                     ;-- f >= 3
  br i1 %26, label %br2_1, label %br3

br2_1:
  %27 = load i32, i32* %5, align 4              ;-- load f
  %28 = add nsw i32 %27, 2                      ;-- increment f by 2
  store i32 %28, i32* %5, align 4               ;-- store f
  br label %loop

br3:
  store i32 3, i32* %5, align 4                 ;-- store 3 in f
  br label %loop

exit:
  %29 = load i32, i32* %2, align 4              ;-- load return value
  ret i32 %29
}

; Function Attrs: noinline nounwind optnone uwtable
define i32 @main() #0 {
  %1 = alloca i32, align 4                      ;-- allocate i
  %2 = alloca i32, align 4                      ;-- allocate n
  %3 = alloca i32, align 4                      ;-- count
  store i32 0, i32* %3, align 4                 ;-- store zero in count
  %4 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([52 x i8], [52 x i8]* @"ATTRACTIVE_STR", i32 0, i32 0), i32 120)
  store i32 1, i32* %1, align 4                 ;-- store 1 in i
  br label %loop

loop:
  %5 = load i32, i32* %1, align 4               ;-- load i
  %6 = icmp sle i32 %5, 120                     ;-- i <= 120
  br i1 %6, label %loop_body, label %exit

loop_body:
  %7 = load i32, i32* %1, align 4               ;-- load i
  %8 = call i32 @count_prime_factors(i32 %7)    ;-- count factors of i
  store i32 %8, i32* %2, align 4                ;-- store factors in n
  %9 = call zeroext i1 @is_prime(i32 %8)        ;-- is n prime?
  br i1 %9, label %prime_branch, label %loop_inc

prime_branch:
  %10 = load i32, i32* %1, align 4              ;-- load i
  %11 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([4 x i8], [4 x i8]* @"FORMAT_NUMBER", i32 0, i32 0), i32 %10)
  %12 = load i32, i32* %3, align 4              ;-- load count
  %13 = add nsw i32 %12, 1                      ;-- increment count
  store i32 %13, i32* %3, align 4               ;-- store count
  %14 = srem i32 %13, 20                        ;-- count % 20
  %15 = icmp ne i32 %14, 0                      ;-- (count % 20) != 0
  br i1 %15, label %loop_inc, label %row_end

row_end:
  %16 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([2 x i8], [2 x i8]* @"NEWLINE_STR", i32 0, i32 0))
  br label %loop_inc

loop_inc:
  %17 = load i32, i32* %1, align 4              ;-- load i
  %18 = add nsw i32 %17, 1                      ;-- increment i
  store i32 %18, i32* %1, align 4               ;-- store i
  br label %loop

exit:
  %19 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([2 x i8], [2 x i8]* @"NEWLINE_STR", i32 0, i32 0))
  ret i32 0
}

attributes #0 = { noinline nounwind optnone uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "less-precise-fpmad"="false" "no-frame-pointer-elim"="false" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }


(() => {
    'use strict';

    console.log(JSON.stringify(
        Object.assign({}, // Fresh dictionary.
            { // Base.
                "name": "Rocket Skates",
                "price": 12.75,
                "color": "yellow"
            }, { // Update.
                "price": 15.25,
                "color": "red",
                "year": 1974
            }
        ),
        null, 2
    ))
})();


julia> dict1 = Dict("name" => "Rocket Skates", "price" => 12.75, "color" => "yellow")
Dict{String,Any} with 3 entries:
  "name"  => "Rocket Skates"
  "price" => 12.75
  "color" => "yellow"

julia> dict2 = Dict("price" => 15.25, "color" => "red", "year" => 1974)
Dict{String,Any} with 3 entries:
  "price" => 15.25
  "year"  => 1974
  "color" => "red"

julia> merge(dict1, dict2)
Dict{String,Any} with 4 entries:
  "name"  => "Rocket Skates"
  "price" => 15.25
  "year"  => 1974
  "color" => "red"

julia> merge(dict2, dict1)
Dict{String,Any} with 4 entries:
  "name"  => "Rocket Skates"
  "price" => 12.75
  "year"  => 1974
  "color" => "yellow"

julia> union(dict1, dict2)
6-element Array{Pair{String,Any},1}:
  "name" => "Rocket Skates"
 "price" => 12.75
 "color" => "yellow"
 "price" => 15.25
  "year" => 1974
 "color" => "red"


fun main() {
    val base = HashMap<String,String>()
    val update =  HashMap<String,String>()

    base["name"] = "Rocket Skates"
    base["price"] = "12.75"
    base["color"] = "yellow"

    update["price"] = "15.25"
    update["color"] = "red"
    update["year"] = "1974"

    val merged = HashMap(base)
    merged.putAll(update)

    println("base: $base")
    println("update: $update")
    println("merged: $merged")
}


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

--[[ clone the base data ]]--
result = {}
for key,val in pairs(base) do
    result[key] = val
end

--[[ copy in the update data ]]--
for key,val in pairs(update) do
    result[key] = val
end

--[[ print the result ]]--
for key,val in pairs(result) do
    print(string.format("%s: %s", key, val))
end


class Node {
    construct new(key, parent) {
        _key = key
        _parent = parent
        _balance = 0
        _left = null
        _right = null
    }

    key     { _key     }
    parent  { _parent  }
    balance { _balance }
    left    { _left    }
    right   { _right   }

    key=(k)     { _key = k     }
    parent=(p)  { _parent = p  }
    balance=(v) { _balance = v }
    left=(n)    { _left = n    }
    right= (n)  { _right = n   }
}

class AvlTree {
    construct new() {
        _root = null
    }

    insert(key) {
        if (!_root) {
            _root = Node.new(key, null)
        } else {
            var n = _root
            while (true) {
                if (n.key == key) return false
                var parent = n
                var goLeft = n.key > key
                n = goLeft ? n.left : n.right
                if (!n) {
                    if (goLeft) {
                        parent.left  = Node.new(key, parent)
                    } else {
                        parent.right = Node.new(key, parent)
                    }
                    rebalance(parent)
                    break
                }
            }
       }
       return true
    }

    delete(delKey) {
        if (!_root) return
        var n       = _root
        var parent  = _root
        var delNode = null
        var child   = _root
        while (child) {
            parent = n
            n = child
            child = (delKey >= n.key) ? n.right : n.left
            if (delKey == n.key) delNode = n
        }
        if (delNode) {
            delNode.key = n.key
            child = n.left ? n.left : n.right
            if (_root.key == delKey) {
                _root = child
                if (_root) _root.parent = null
            } else {
                if (parent.left == n) {
                    parent.left = child
                } else {
                    parent.right = child
                }
                if (child) child.parent = parent
                rebalance(parent)
            }
        }
    }

    rebalance(n) {
        setBalance([n])
        var nn = n
        if (nn.balance == -2) {
            if (height(nn.left.left) >= height(nn.left.right)) {
                nn = rotateRight(nn)
            } else {
                nn = rotateLeftThenRight(nn)
            }
        } else if (nn.balance == 2) {
            if (height(nn.right.right) >= height(nn.right.left)) {
                nn = rotateLeft(nn)
            } else {
                nn = rotateRightThenLeft(nn)
            }
        }
        if (nn.parent) rebalance(nn.parent) else _root = nn
    }

    rotateLeft(a) {
        var 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
            }
        }
        setBalance([a, b])
        return b
    }

    rotateRight(a) {
        var 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
            }
        }
        setBalance([a, b])
        return b
    }

    rotateLeftThenRight(n) {
        n.left = rotateLeft(n.left)
        return rotateRight(n)
    }

    rotateRightThenLeft(n) {
        n.right = rotateRight(n.right)
        return rotateLeft(n)
    }

    height(n) {
        if (!n) return -1
        return 1 + height(n.left).max(height(n.right))
    }

    setBalance(nodes) {
        for (n in nodes) n.balance = height(n.right) - height(n.left)
    }

    printKey() {
        printKey(_root)
        System.print()
    }

    printKey(n) {
        if (n) {
            printKey(n.left)
            System.write("%(n.key) ")
            printKey(n.right)
        }
    }

    printBalance() {
        printBalance(_root)
        System.print()
    }

    printBalance(n) {
        if (n) {
            printBalance(n.left)
            System.write("%(n.balance) ")
            printBalance(n.right)
        }
    }
}

var tree = AvlTree.new()
System.print("Inserting values 1 to 10")
for (i in 1..10) tree.insert(i)
System.write("Printing key     : ")
tree.printKey()
System.write("Printing balance : ")
tree.printBalance()


PROC main()
  DEF t[100]: ARRAY,
      pass, door
  FOR door := 0 TO 99 DO t[door] := FALSE
  FOR pass := 0 TO 99
    door := pass
    WHILE door <= 99
      t[door] := Not(t[door])
      door := door + pass + 1
    ENDWHILE
  ENDFOR
  FOR door := 0 TO 99 DO WriteF('\d is \s\n', door+1,
                                IF t[door] THEN 'open' ELSE 'closed')
ENDPROC


# Generate a list of the numbers increasing from $a to $b
proc range {a b} {
    for {set result {}} {$a <= $b} {incr a} {lappend result $a}
    return $result
}

# Computing the expected value analytically
proc tcl::mathfunc::factorial n {
    ::tcl::mathop::* {*}[range 2 $n]
}
proc Analytical {n} {
    set sum 0.0
    foreach x [range 1 $n] {
	set sum [expr {$sum + factorial($n) / factorial($n-$x) / double($n)**$x}]
    }
    return $sum
}

# Determining an approximation to the value experimentally
proc Experimental {n numTests} {
    set count 0
    set u0 [lrepeat $n 1]
    foreach run [range 1 $numTests] {
	set unseen $u0
	for {set i 0} {[lindex $unseen $i]} {incr count} {
	    lset unseen $i 0
	    set i [expr {int(rand()*$n)}]
	}
    }
    return [expr {$count / double($numTests)}]
}

# Tabulate the results in exactly the original format
puts " N    average    analytical    (error)"
puts "===  =========  ============  ========="
foreach n [range 1 20] {
    set a [Analytical $n]
    set e [Experimental $n 100000]
    puts [format "%3d  %9.4f  %12.4f  (%6.2f%%)" $n $e $a [expr {abs($e-$a)/$a*100.0}]]
}


link printf, factors

$define MAX_N 20
$define TIMES 1000000
$define RAND_MAX 2147483647

procedure expected(n)
    local sum := 0
    every i := 1 to n do
        sum +:= factorial(n) / (n ^ i) / factorial(n - i)
    return sum
end

procedure test(n, times)
    local i, count := 0, x, bits
    every i := 0 to times-1 do {
	x := 1
	bits := 0
	while iand(bits, x)=0 do {
            count +:= 1
            bits := ior(bits, x)
            x := ishift(1 , ?n-1)
        }
    }
    return count
end

procedure main(void)
    local n, cnt, avg, theory, diff
    write(" n\tavg\texp.\tdiff\n", repl("-",29))
    every n := 1 to MAX_N do {
        cnt := test(n, TIMES)
        avg := real(cnt) / TIMES
        theory := expected(n)
        diff := (avg / theory - 1) * 100
        printf("%2d %8.4r %8.4r %6.3r%%\n", n, avg, theory, diff)
    }
    return 0
end


-- Returns true if x is prime, and false otherwise
function isPrime (x)
  if x < 2 then return false end
  if x < 4 then return true end
  if x % 2 == 0 then return false end
  for d = 3, math.sqrt(x), 2 do
    if x % d == 0 then return false end
  end
  return true
end

-- Compute the prime factors of n
function factors (n)
  local facList, divisor, count = {}, 1
  if n < 2 then return facList end
  while not isPrime(n) do
    while not isPrime(divisor) do divisor = divisor + 1 end
    count = 0
    while n % divisor == 0 do
      n = n / divisor
      table.insert(facList, divisor)
    end
    divisor = divisor + 1
    if n == 1 then return facList end
  end
  table.insert(facList, n)
  return facList
end

-- Main procedure
for i = 1, 120 do
  if isPrime(#factors(i)) then io.write(i .. "\t") end
end


attractivenumbers := proc(n::posint)
local an, i;
an :=[]:
for i from 1 to n do
    if isprime(NumberTheory:-NumberOfPrimeFactors(i)) then
        an := [op(an), i]:
    end if:
end do:
end proc:
attractivenumbers(120);


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

result = base + update

print result


import tables

let t1 = {"name": "Rocket Skates", "price": "12.75", "color": "yellow"}.toTable
let t2 = {"price": "15.25", "color": "red", "year": "1974"}.toTable

var t3 = t1   # Makes a copy.
for key, value in t2.pairs:
  t3[key] = value

echo t3


#import <Foundation/Foundation.h>

int main(void) {
  @autoreleasepool {
    NSDictionary *base = @{@"name": @"Rocket Skates", @"price": @12.75, @"color": @"yellow"};
    NSDictionary *update = @{@"price": @15.25, @"color": @"red", @"year": @1974};

    NSMutableDictionary *result = [[NSMutableDictionary alloc] initWithDictionary:base];
    [result addEntriesFromDictionary:update];

    NSLog(@"%@", result);
  }
  return 0;
}


type ty =
    | TFloat of float
    | TInt of int
    | TString of string

type key = string
type assoc = string * ty

let string_of_ty : ty -> string = function
    | TFloat x -> string_of_float x
    | TInt i -> string_of_int i
    | TString s -> s

let print_pair key el =
    Printf.printf "%s: %s\n" key (string_of_ty el)
;;


Const MAX = 20
Const ITER = 1000000

Function expected(n As Long) As Double
    Dim sum As Double
    For i = 1 To n
        sum = sum + WorksheetFunction.Fact(n) / n ^ i / WorksheetFunction.Fact(n - i)
    Next i
    expected = sum
End Function

Function test(n As Long) As Double
    Dim count As Long
    Dim x As Long, bits As Long
    For i = 1 To ITER
        x = 1
        bits = 0
        Do While Not bits And x
            count = count + 1
            bits = bits Or x
            x = 2 ^ (Int(n * Rnd()))
        Loop
    Next i
    test = count / ITER
End Function

Public Sub main()
    Dim n As Long
    Debug.Print " n     avg.     exp.  (error%)"
    Debug.Print "==   ======   ======  ========"
    For n = 1 To MAX
        av = test(n)
        ex = expected(n)
        Debug.Print Format(n, "@@"); "  "; Format(av, "0.0000"); "   ";
        Debug.Print Format(ex, "0.0000"); "  ("; Format(Abs(1 - av / ex), "0.000%"); ")"
    Next n
End Sub


Const MAX = 20
Const ITER = 100000

Function expected(n)
  Dim sum
  ni=n
  For i = 1 To n
    sum = sum + fact(n) / ni / fact(n-i)
    ni=ni*n
  Next
  expected = sum
End Function

Function test(n )
  Dim coun,x,bits
  For i = 1 To ITER
    x = 1
    bits = 0
    Do While Not bits And x
      count = count + 1
      bits = bits Or x
      x =shift(Int(n * Rnd()))
    Loop
  Next
  test = count / ITER
End Function

'VBScript formats numbers but does'nt align them!
function rf(v,n,s) rf=right(string(n,s)& v,n):end function

'some precalculations to speed things up...
dim fact(20),shift(20)
fact(0)=1:shift(0)=1
for i=1 to 20
  fact(i)=i*fact(i-1)
  shift(i)=2*shift(i-1)
next

Dim n
Wscript.echo "For " & ITER &" iterations"
Wscript.Echo " n     avg.     exp.   (error%)"
Wscript.Echo "==   ======   ======  =========="
For n = 1 To MAX
  av = test(n)
  ex = expected(n)
  Wscript.Echo rf(n,2," ")& "  "& rf(formatnumber(av, 4),7," ") & "   "& _
  rf(formatnumber(ex,4),6," ")& "  ("& rf(Formatpercent(1 - av / ex,4),8," ") & ")"
Next


import rand
import math

const nmax = 20

fn main() {
    println(" N    average    analytical    (error)")
    println("===  =========  ============  =========")
    for n := 1; n <= nmax; n++ {
        a := avg(n)
        b := ana(n)
        println("${n:3}  ${a:9.4f}  ${b:12.4f}  (${math.abs(a-b)/b*100:6.2f}%)" )
    }
}

fn avg(n int) f64 {
    tests := int(1e4)
    mut sum := 0
    for _ in 0..tests {
        mut v := [nmax]bool{}
        for x := 0; !v[x];  {
            v[x] = true
            sum++
            x = rand.intn(n) or {0}
        }
    }
    return f64(sum) / tests
}

fn ana(n int) f64 {
    nn := f64(n)
    mut term := 1.0
    mut sum := 1.0
    for i := nn - 1; i >= 1; i-- {
        term *= i / nn
        sum += term
    }
    return sum
}


ClearAll[AttractiveNumberQ]
AttractiveNumberQ[n_Integer] := FactorInteger[n][[All, 2]] // Total // PrimeQ
Reap[Do[If[AttractiveNumberQ[i], Sow[i]], {i, 120}]][[2, 1]]


MODULE AttractiveNumbers;
FROM InOut IMPORT WriteCard, WriteLn;

CONST
    Max = 120;

VAR
    n, col: CARDINAL;
    Prime: ARRAY [1..Max] OF BOOLEAN;

PROCEDURE Sieve;
VAR i, j: CARDINAL;
BEGIN
    Prime[1] := FALSE;
    FOR i := 2 TO Max DO
        Prime[i] := TRUE;
    END;

    FOR i := 2 TO Max DIV 2 DO
        IF Prime[i] THEN
            j := i*2;
            WHILE j <= Max DO
                Prime[j] := FALSE;
                j := j + i;
            END;
        END;
    END;
END Sieve;

PROCEDURE Factors(n: CARDINAL): CARDINAL;
VAR i, factors: CARDINAL;
BEGIN
    factors := 0;
    FOR i := 2 TO Max DO
        IF i > n THEN
            RETURN factors;
        END;
        IF Prime[i] THEN
            WHILE n MOD i = 0 DO
                n := n DIV i;
                factors := factors + 1;
            END;
        END;
     END;
     RETURN factors;
END Factors;

BEGIN
    Sieve();
    col := 0;
    FOR n := 2 TO Max DO
        IF Prime[Factors(n)] THEN
            WriteCard(n, 4);
            col := col + 1;
            IF col MOD 15 = 0 THEN
                WriteLn();
            END;
        END;
    END;
    WriteLn();
END AttractiveNumbers.


(define a1 {
   'name    "Rocket Skates"
   'price   12.75
   'color   "yellow"
})

(define a2 {
   'price   15.25
   'color   "red"
   'year    1974
})

(print "a1: " a1)
(print "a2: " a2)

(define (collide a b) b) ; will use new key value
(print "merged a1 a2: " (ff-union collide a1 a2))


use strict;
use warnings;

my %base = ("name" => "Rocket Skates", "price" => 12.75, "color" => "yellow");
my %more = ("price" => 15.25, "color" => "red", "year" => 1974);

print "Update\n";
my %update = (%base, %more);
printf "%-7s %s\n", $_, $update{$_} for sort keys %update;

print "\nMerge\n";
my %merge;
$merge{$_} = [$base{$_}] for keys %base;
push @{$merge{$_}}, $more{$_} for keys %more;
printf "%-7s %s\n", $_, join ', ', @{$merge{$_}} for sort keys %merge;


with javascript_semantics
integer d1 = new_dict({{"name","Rocket Skates"},{"price",12.75},{"color","yellow"}}),
        d2 = new_dict({{"price",15.25},{"color","red"},{"year",1974}}),
        d3 = new_dict(d1)
function merger(object key, data, /*user_data*/) setd(key,data,d3) return 1 end function
traverse_dict(merger,NULL,d2)
include builtins/map.e
?pairs(d3)


set is_open to {}
repeat 100 times
   set end of is_open to false
end
repeat with pass from 1 to 100
  repeat with door from pass to 100 by pass
    set item door of is_open to not item door of is_open
  end
end
set open_doors to {}
repeat with door from 1 to 100
   if item door of is_open then
     set end of open_doors to door
   end
end
set text item delimiters to ", "
display dialog "Open doors: " & open_doors


import "random" for Random
import "/fmt" for Fmt

var nmax = 20
var rand = Random.new()

var avg = Fn.new { |n|
    var tests = 1e4
    var sum = 0
    for (t in 0...tests) {
        var v = List.filled(nmax, false)
        var x = 0
        while (!v[x]) {
            v[x] = true
            sum = sum + 1
            x = rand.int(n)
        }
    }
    return sum/tests
}

var ana = Fn.new { |n|
    if (n < 2) return 1
    var term = 1
    var sum = 1
    for (i in n-1..1) {
        term = term * i / n
        sum = sum + term
    }
    return sum
}

System.print(" N    average    analytical    (error)")
System.print("===  =========  ============  =========")
for (n in 1..nmax) {
    var a = avg.call(n)
    var b = ana.call(n)
    var ns = Fmt.d(3, n)
    var as = Fmt.f(9, a, 4)
    var bs = Fmt.f(12, b, 4)
    var e = (a - b).abs/ b * 100
    var es = Fmt.f(6, e, 2)
    System.print("%(ns) %(as)  %(bs)   (%(es)\%)")
}


const N=20;

(" N    average    analytical    (error)").println();
("===  =========  ============  =========").println();
foreach n in ([1..N]){
   a := avg(n);
   b := ana(n);
   "%3d  %9.4f  %12.4f  (%6.2f%%)".fmt(
            n, a, b, ((a-b)/b*100)).println();
}

fcn f(n){ (0).random(n) }

fcn avg(n){
   tests := 0d10_000;
   sum := 0;
   do(tests){
      v:=(0).pump(n,List,T(Void,False)).copy();
      while(1){
         z := f(n);
         if(v[z]) break;
	 v[z] = True;
	 sum += 1;
      }
   }
   return(sum.toFloat() / tests);
}

fcn fact(n) { (1).reduce(n,fcn(N,n){N*n},1.0) } //-->Float
fcn ana(n){
   n=n.toFloat();
   (1).reduce(n,'wrap(sum,i){ sum+fact(n)/n.pow(i)/fact(n-i) },0.0);
}


MAX = 120

def is_prime(n)
	d = 5
	if (n < 2)
		return false
	end
	if (n % 2) = 0
		return n = 2
	end
	if (n % 3) = 0
		return n = 3
	end

	while (d * d) <= n
		if n % d = 0
			return false
		end
		d += 2
		if n % d = 0
			return false
		end
		d += 4
	end

	return true
end

def count_prime_factors(n)
	count = 0; f = 2
	if n = 1
		return 0
	end
	if is_prime(n)
		return 1
	end

	while true
		if (n % f) = 0
			count += 1
			n /= f
			if n = 1
				return count
			end
			if is_prime(n)
				f = n
			end
		else if f >= 3
			f += 2
		else
			f = 3
		end
	end
end

i = 0; n = 0; count = 0
println format("The attractive numbers up to and including %d are:\n", MAX)
for i in range(1, MAX)
	n = count_prime_factors(i)
	if is_prime(n)
		print format("%4d", i)
		count += 1
		if (count % 20) = 0
			println
		end
	end
end
println


(define (prime? n)
	(= (length (factor n)) 1))
(define (attractive? n)
	(prime? (length (factor n))))
;
(filter attractive? (sequence 2 120))


import strformat

const MAX = 120

proc isPrime(n: int): bool =
  var d = 5
  if n < 2:
    return false
  if n mod 2 == 0:
    return n == 2
  if n mod 3 == 0:
    return n == 3
  while d * d <= n:
    if n mod d == 0:
      return false
    inc d, 2
    if n mod d == 0:
      return false
    inc d, 4
  return true

proc countPrimeFactors(n_in: int): int =
  var count = 0
  var f = 2
  var n = n_in
  if n == 1:
    return 0
  if isPrime(n):
    return 1
  while true:
    if n mod f == 0:
      inc count
      n = n div f
      if n == 1:
        return count
      if isPrime(n):
        f = n
    elif (f >= 3):
      inc f, 2
    else:
      f = 3

proc main() =
  var n, count: int = 0
  echo fmt"The attractive numbers up to and including {MAX} are:"
  for i in 1..MAX:
    n = countPrimeFactors(i)
    if isPrime(n):
      write(stdout, fmt"{i:4d}")
      inc count
      if count mod 20 == 0:
        write(stdout, "\n")
  write(stdout, "\n")

main()


class AttractiveNumber {
  function : Main(args : String[]) ~ Nil {
    max := 120;
    "The attractive numbers up to and including {$max} are:"->PrintLine();

    count := 0;
    for(i := 1; i <= max; i += 1;) {
      n := CountPrimeFactors(i);
      if(IsPrime(n)) {
        " {$i}"->Print();
        if(++count % 20 = 0) {
          ""->PrintLine();
        };
      };
    };

    ""->PrintLine();
  }

  function : IsPrime(n : Int) ~ Bool {
    if(n < 2) {
      return false;
    };

    if(n % 2 = 0) {
      return n = 2;
    };

    if(n % 3 = 0) {
      return n = 3;
    };

    d := 5;
    while(d *d <= n) {
      if(n % d = 0) {
        return false;
      };
      d += 2;

      if(n % d = 0) {
        return false;
      };
      d += 4;
    };

    return true;
  }

  function : CountPrimeFactors(n : Int) ~ Int {
    if(n = 1) {
      return 0;
    };

    if(IsPrime(n)) {
      return 1;
    };

    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;
      };
    };

    return -1;
  }
}


include ..\Utilitys.pmt

def scand   /# dict key -- dict n #/
    0 var flag
    var ikey
    len for
        var i
        i 1 2 tolist sget
        ikey == if i var flag exitfor endif
    endfor
    flag
enddef

def getd    /# dict key -- dict data #/
    scand
    dup if get 2 get nip else drop "Unfound" endif
enddef

def setd    /# dict ( key data ) -- dict #/
    1 get rot swap
    scand
    rot swap
    dup if set else put endif
enddef

/# ---------- MAIN ---------- #/

( ( "name" "Rocket Skates" )
  ( "price" 12.75 )
  ( "color" "yellow" ) )

dup

( ( "price" 15.25 )
  ( "color" "red" )
  ( "year" 1974 ) )

len for
    get rot swap setd swap
endfor

swap

pstack


<?
$base = array("name" => "Rocket Skates", "price" => 12.75, "color" => "yellow");
$update = array("price" => 15.25, "color" => "red", "year" => 1974);

$result = $update + $base; // Notice that the order is reversed
print_r($result);
?>


NewMap m1.s()
NewMap m2.s()
NewMap m3.s()

m1("name")="Rocket Skates"
m1("price")="12.75"
m1("color")="yellow"

m2("price")="15.25"
m2("color")="red"
m2("year")="1974"

CopyMap(m1(),m3())

ForEach m2()
  m3(MapKey(m2()))=m2()
Next

ForEach m3()
  Debug MapKey(m3())+" : "+m3()
Next


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

result = {**base, **update}

print(result)


#lang racket/base

(require racket/hash)

(module+ test
  (require rackunit)

  (define base-data (hash "name"	"Rocket Skates"
                          "price"	12.75
                          "color"	"yellow"))

  (define update-data (hash "price"	15.25
                            "color"	"red"
                            "year"	1974))

  (hash-union base-data update-data #:combine (λ (a b) b)))


openshut(n):
  for x in [1..n]
    x%n==0

pass(n):
  if n==100
    openshut(n)
  else
    openshut(n) xor pass(n+1)

100doors():
  pass(1) -> io


program AttractiveNumbers;
{ numbers with count of factors = prime
* using modified sieve of erathosthes
* by adding the power of the prime to multiples
* of the composite number }
{$IFDEF FPC}
  {$MODE DELPHI}
{$ELSE}
   {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils;//timing
const
  cTextMany = ' with many factors     ';
  cText2    = ' with only two factors ';
  cText1    = ' with only one factor  ';
type
  tValue = LongWord;
  tpValue = ^tValue;
  tPower = array[0..63] of tValue;//2^64

var
  power : tPower;
  sieve : array of byte;

function NextPotCnt(p: tValue):tValue;
//return the first power <> 0
//power == n to base prim
var
  i : NativeUint;
begin
  result := 0;
  repeat
    i := power[result];
    Inc(i);
    IF i < p then
      BREAK
    else
    begin
      i := 0;
      power[result]  := 0;
      inc(result);
    end;
  until false;
  power[result] := i;
  inc(result);
end;

procedure InitSieveWith2;
//the prime 2, because its the first one, is the one,
//which can can be speed up tremendously, by moving
var
  pSieve : pByte;
  CopyWidth,lmt : NativeInt;
Begin
  pSieve := @sieve[0];
  Lmt := High(sieve);
  sieve[1] := 0;
  sieve[2] := 1; // aka 2^1 -> one factor
  CopyWidth := 2;

  while CopyWidth*2 <= Lmt do
  Begin
    // copy idx 1,2 to 3,4 | 1..4 to 5..8 | 1..8 to 9..16
    move(pSieve[1],pSieve[CopyWidth+1],CopyWidth);
    // 01 -> 0101 -> 01020102-> 0102010301020103
    inc(CopyWidth,CopyWidth);//*2
    //increment the factor of last element by one.
    inc(pSieve[CopyWidth]);
    //idx    12    1234    12345678
    //value  01 -> 0102 -> 01020103-> 0102010301020104
  end;
  //copy the rest
  move(pSieve[1],pSieve[CopyWidth+1],Lmt-CopyWidth);

  //mark 0,1 not prime, 255 factors are today not possible 2^255 >> Uint64
  sieve[0]:= 255;
  sieve[1]:= 255;
  sieve[2]:= 0;   // make prime again
end;

procedure OutCntTime(T:TDateTime;txt:String;cnt:NativeInt);
Begin
   writeln(cnt:12,txt,T*86400:10:3,' s');
end;

procedure sievefactors;
var
  T0 : TDateTime;
  pSieve : pByte;
  i,j,i2,k,lmt,cnt : NativeUInt;
Begin
  InitSieveWith2;
  pSieve := @sieve[0];
  Lmt := High(sieve);

//Divide into 3 section

//first i*i*i<= lmt with time expensive NextPotCnt
  T0 := now;
  cnt := 0;
  //third root of limit calculate only once, no comparison ala while i*i*i<= lmt do
  k := trunc(exp(ln(Lmt)/3));
  For i := 3 to k do
    if pSieve[i] = 0 then
    Begin
      inc(cnt);
      j := 2*i;
      fillChar(Power,Sizeof(Power),#0);
      Power[0] := 1;
      repeat
        inc(pSieve[j],NextPotCnt(i));
        inc(j,i);
      until j > lmt;
    end;
  OutCntTime(now-T0,cTextMany,cnt);
  T0 := now;

//second i*i <= lmt
  cnt := 0;
  i := k+1;
  k := trunc(sqrt(Lmt));
  For i := i to k do
    if pSieve[i] = 0 then
    Begin
      //first increment all multiples of prime by one
      inc(cnt);
      j := 2*i;
      repeat
        inc(pSieve[j]);
        inc(j,i);
      until j>lmt;
      //second increment all multiples prime*prime by one
      i2 := i*i;
      j := i2;
      repeat
        inc(pSieve[j]);
        inc(j,i2);
      until j>lmt;
    end;
  OutCntTime(now-T0,cText2,cnt);
  T0 := now;

//third i*i > lmt -> only one new factor
  cnt := 0;
  inc(k);
  For i := k to Lmt shr 1 do
    if pSieve[i] = 0 then
    Begin
      inc(cnt);
      j := 2*i;
      repeat
        inc(pSieve[j]);
        inc(j,i);
      until j>lmt;
    end;
   OutCntTime(now-T0,cText1,cnt);
end;

const
  smallLmt = 120;
  //needs 1e10 Byte = 10 Gb maybe someone got 128 Gb :-) nearly linear time
  BigLimit = 10*1000*1000*1000;
var
  T0,T : TDateTime;
  i,cnt,lmt : NativeInt;
Begin
  setlength(sieve,smallLmt+1);

  sievefactors;
  cnt := 0;
  For i := 2 to smallLmt do
  Begin
    if sieve[sieve[i]] = 0 then
    Begin
      write(i:4);
      inc(cnt);
      if cnt>19 then
      Begin
        writeln;
        cnt := 0;
      end;
    end;
  end;
  writeln;
  writeln;
  T0 := now;
  setlength(sieve,BigLimit+1);
  T := now;
  writeln('time allocating  : ',(T-T0) *86400 :8:3,' s');
  sievefactors;
  T := now-T;
  writeln('time sieving : ',T*86400 :8:3,' s');
  T:= now;
  cnt := 0;
  i := 0;
  lmt := 10;
  repeat
    repeat
      inc(i);
      {IF sieve[sieve[i]] = 0 then inc(cnt); takes double time is not relevant}
      inc(cnt,ORD(sieve[sieve[i]] = 0));
    until i = lmt;
    writeln(lmt:11,cnt:12);
    lmt := 10*lmt;
  until lmt >High(sieve);
  T := now-T;
  writeln('time counting : ',T*86400 :8:3,' s');
  writeln('time total    : ',(now-T0)*86400 :8:3,' s');
end.


# Show original hashes
say my %base   = :name('Rocket Skates'), :price<12.75>, :color<yellow>;
say my %update = :price<15.25>, :color<red>, :year<1974>;

# Need to assign to anonymous hash to get the desired results and avoid mutating
# TIMTOWTDI
say "\nUpdate:\n", join "\n", sort %=%base, %update;
# Same
say "\nUpdate:\n", {%base, %update}.sort.join: "\n";

say "\nMerge:\n", join "\n", sort ((%=%base).push: %update)».join: ', ';
# Same
say "\nMerge:\n", ({%base}.push: %update)».join(', ').sort.join: "\n";

# Demonstrate unmutated hashes
say "\n", %base, "\n", %update;


/*REXX program merges two associative arrays  (requiring an external list of indices).  */
$.=                                              /*define default value(s) for arrays.  */
@.wAAn= 21;      @.wKey= 7;       @.wVal= 7      /*max widths of:  AAname, keys, values.*/
call defAA  'base',     "name Rocket Skates",   'price 12.75',   "color yellow"
call defAA  'update',   "price 15.25",          "color red",     'year 1974'
call show   'base'
call show   'update'
call show   'new'
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
defAA: procedure expose $. @.;  parse arg AAn;      new= 'new'   /*get AA name; set NEW.*/
         do j=2  to arg();   parse value arg(j)  with  key val   /*obtain key and value.*/
         $.AAn.key= val                          /*assign a  value  to a  key for AAn.  */
         if wordpos(key, $.AAN.?keys)==0  then $.AAn.?keys= $.AAn.?keys key
                                                 /* [↑]  add to key list if not in list.*/
         $.new.key= val                          /*assign a  value  to a  key for "new".*/
         if wordpos(key, $.new.?keys)==0  then $.new.?keys= $.new.?keys key
                                                 /* [↑]  add to key list if not in list.*/
         @.wKey= max(@.wKey, length(key) )       /*find max width of a name of a  key.  */
         @.wVal= max(@.wVal, length(val) )       /*  "   "    "    " "   "   " "  value.*/
         @.wAA = max(@.wAAn, length(AAn) )       /*  "   "    "    " "   "   "    array.*/
         end   /*j*/
       return
/*──────────────────────────────────────────────────────────────────────────────────────*/
show:  procedure expose $. @.;  parse arg AAn;      say;     _= '═'    /*set title char.*/
         do j=1  for words($.AAn.?keys)                                /*process keys.  */
         if j==1  then say  center('associate array', @.wAAn,     _)  ,
                            center("key"            , @.wKey,     _)  ,
                            center('value'          , @.wVal + 2, _)
         key= word($.AAn.?keys, j)                              /*get the name of a key.*/
         say center(AAn, @.wAAn)  right(key, @.wKey)  $.AAn.key /*show some information.*/
         end   /*j*/
       return


var bucket
var bucket-size

\ The 'bucket' will be a simple array of some values:
: genbucket \ n --
  a:new swap
  (
    \ make a random int up to 1000
    rand-pcg n:abs 1000 n:mod
    a:push
  ) swap times
  bucket ! ;

\ display bucket and its total:
: .bucket
  bucket lock @
    dup . space
    ' n:+ 0 a:reduce . cr
  bucket unlock drop ;

\ Get current value of bucket #x
: [email protected] \ n -- bucket[n]
  bucket @
  swap a:@ nip ;

\ Transfer x from bucket n to bucket m
: bucket-xfer \ m n x --
  >r bucket @
  \ m n bucket
  over a:@ [email protected] n:-
  rot swap a:!
  \ m bucket
  over a:@ r> n:+
  rot swap a:!
  drop ;

\ Get two random indices to check (ensure they're not the same):
: pick2
  rand-pcg n:abs bucket-size @ n:mod dup >r
  repeat
    drop
    rand-pcg n:abs bucket-size @ n:mod
    [email protected] over n:=
  while!
  r> ;

\ Pick two buckets and make them more equal (by a quarter of their difference):
: make-equal
  repeat
    pick2
    bucket lock @
    third a:@ >r
    over a:@ r> n:-
    \ if they are equal, do nothing
    dup not if
      \ equal, so do nothing
      drop -rot 2drop
    else
      4 n:/ n:int
      >r -rot r>
      bucket-xfer
    then
    drop
    bucket unlock drop
  again ;

\ Moves a quarter of the smaller value from one (random) bucket to another:
: make-redist
  repeat
    pick2 bucket lock @
      \ n m bucket
      over a:@ >r \ n m b b[m]
      third a:@ r>  \ n m b b[n]
      n:min 4 n:/ n:int
      nip bucket-xfer

    bucket unlock drop
  again ;

: app:main
  \ create 10 buckets with random positive integer values:
  10 genbucket bucket @ a:len bucket-size ! drop

  \ print the bucket
  .bucket

  \ the problem's tasks:
  ' make-equal t:task
  ' make-redist t:task

  \ the print-the-bucket task. We'll do it just 10 times and then quit:
  ( 1 sleep .bucket ) 10 times
  bye ;


use std, array

close all doors
for each pass from 1 to 100
  for (door = pass) (door <= 100) (door += pass)
    toggle door

let int pass, door.

.: close all doors :. {memset doors 0 size of doors}
.:toggle <int door>:. {    !!(doors[door - 1])     }

let doors be an array of 100 bool

for each door from 1 to 100
  printf "#%.3d %s\n" door (doors[door - 1]) ? "[ ]", "[X]"


use ntheory <is_prime factor>;

is_prime +factor $_ and print "$_ " for 1..120;


function attractive(integer lim)
    sequence s = {}
    for i=1 to lim do
        integer n = length(prime_factors(i,true))
        if is_prime(n) then s &= i end if
    end for
    return s
end function
sequence s = attractive(120)
printf(1,"There are %d attractive numbers up to and including %d:\n",{length(s),120})
pp(s,{pp_IntCh,false})
for i=3 to 6 do
    atom t0 = time()
    integer p = power(10,i),
            l = length(attractive(p))
    string e = elapsed(time()-t0)
    printf(1,"There are %,d attractive numbers up to %,d (%s)\n",{l,p,e})
end for


load "stdlib.ring"

list1 = [:name = "Rocket Skates", :price = 12.75, :color = "yellow"]
list2 = [:price = 15.25, :color = "red", :year = 1974]

for n = 1 to len(list2)
    flag = 0
    for m = 1 to len(list1)
        if list2[n][1] = list1[m][1]
           flag = 1
           del(list1,m)
           add(list1,[list2[n][1],list2[n][2]])
           exit
        ok
    next
    if flag = 0
       add(list1,[list2[n][1],list2[n][2]])
    ok
next

for n = 1 to len(list1)
    see list1[n][1] + " = " + list1[n][2] + nl
next


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

result = base.merge(update)
p result


use std::collections::HashMap;

fn main() {
    let mut original = HashMap::new();
    original.insert("name", "Rocket Skates");
    original.insert("price", "12.75");
    original.insert("color", "yellow");

    let mut update = HashMap::new();
    update.insert("price", "15.25");
    update.insert("color", "red");
    update.insert("year", "1974");

    original.extend(&update);

    println!("{:#?}", original);
}


set base to {name:"Rocket Skates", price:12.75, color:"yellow"}

set update to {price:15.25, color:"red", year:1974}

put "Base data: " & base
put "Update data: " & update

// replacing as an operator, to generate merged data on the fly:
put "Merged data: " & base replacing properties in update

// replace as a command, to modify base data in place:
replace properties of update in base
put "Base after update: " & base


base := Dictionary withAssociations:{
         'name'-> 'Rocket Skates' .
         'price' -> 12.75 .
         'color' -> 'yellow' }.

update := Dictionary withAssociations:{
         'price' -> 15.25 .
         'color' -> 'red' .
         'year' -> 1974 }.

result := Dictionary new
             declareAllFrom:base;
             declareAllFrom:update.

Transcript showCR: result.


let base : [String: Any] = ["name": "Rocket Skates", "price": 12.75, "color": "yellow"]
let update : [String: Any] = ["price": 15.25, "color": "red", "year": 1974]

let result = base.merging(update) { (_, new) in new }

print(result)


set dict1 [dict create name "Rocket Skates" price 12.75 color yellow]
set dict2 [dict create price 15.25 color red year 1974]
dict for {key val} [dict merge $dict1 $dict2] {
    puts "$key: $val"
}


with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Numerics.Discrete_Random;

procedure Test_Updates is

   type Bucket_Index is range 1..13;
   package Random_Index is new Ada.Numerics.Discrete_Random (Bucket_Index);
   use Random_Index;
   type Buckets is array (Bucket_Index) of Natural;

   protected type Safe_Buckets is
      procedure Initialize (Value : Buckets);
      function Get (I : Bucket_Index) return Natural;
      procedure Transfer (I, J : Bucket_Index; Amount : Integer);
      function Snapshot return Buckets;
   private
      Data : Buckets := (others => 0);
   end Safe_Buckets;

   protected body Safe_Buckets is
      procedure Initialize (Value : Buckets) is
      begin
         Data := Value;
      end Initialize;

      function Get (I : Bucket_Index) return Natural is
      begin
         return Data (I);
      end Get;

      procedure Transfer (I, J : Bucket_Index; Amount : Integer) is
         Increment : constant Integer :=
            Integer'Max (-Data (J), Integer'Min (Data (I), Amount));
      begin
         Data (I) := Data (I) - Increment;
         Data (J) := Data (J) + Increment;
      end Transfer;

      function Snapshot return Buckets is
      begin
         return Data;
      end Snapshot;
   end Safe_Buckets;

   Data : Safe_Buckets;

   task Equalize;
   task Mess_Up;

   task body Equalize is
      Dice : Generator;
      I, J : Bucket_Index;
   begin
      loop
         I := Random (Dice);
         J := Random (Dice);
         Data.Transfer (I, J, (Data.Get (I) - Data.Get (J)) / 2);
      end loop;
   end Equalize;

   task body Mess_Up is
      Dice : Generator;
   begin
      loop
         Data.Transfer (Random (Dice), Random (Dice), 100);
      end loop;
   end Mess_Up;

begin
   Data.Initialize ((1,2,3,4,5,6,7,8,9,10,11,12,13));
   loop
      delay 1.0;
      declare
         State : Buckets := Data.Snapshot;
         Sum   : Natural := 0;
      begin
         for Index in State'Range loop
            Sum := Sum + State (Index);
            Put (Integer'Image (State (Index)));
         end loop;
         Put (" =" & Integer'Image (Sum));
         New_Line;
      end;
   end loop;
end Test_Updates;


Bucket := [],	Buckets := 10,	Originaltotal = 0
loop, %Buckets% {
	Random, rnd, 0,50
	Bucket[A_Index] := rnd,		Originaltotal += rnd
}

loop 100
{
	total := 0
	Randomize(B1, B2, Buckets)
	temp := (Bucket[B1] + Bucket[B2]) /2
	Bucket[B1] := floor(temp),	Bucket[B2] := Ceil(temp)	; values closer to equal

	Randomize(B1, B2, Buckets)
	temp := Bucket[B1] + Bucket[B2]
	Random, value, 0, %temp%
	Bucket[B1] := value,	Bucket[B2] := temp-value		; redistribute values arbitrarily

	VisualTip := "Original Total = " Originaltotal "`n"
	loop, %Buckets%
		VisualTip .= SubStr("0" Bucket[A_Index], -1) " : " x(Bucket[A_Index]) "`n" , total += Bucket[A_Index]

	ToolTip % VisualTip "Current Total = " total
	if (total <> Originaltotal)
		MsgBox "Error"
	Sleep, 100
}
return

Randomize(ByRef B1, ByRef B2, Buckets){
	Random, B1, 1, %Buckets%
	Loop
		Random, B2, 1, %Buckets%
	until (B1<>B2)
}

x(n){
	loop, % n
		Res.= ">"
	return Res
}


/* ARM assembly Raspberry PI  */
/*  program 100doors.s   */

/************************************/
/* Constantes                       */
/************************************/
.equ STDOUT, 1                                 @ Linux output console
.equ EXIT,   1                                 @ Linux syscall
.equ WRITE,  4                                 @ Linux syscall
.equ NBDOORS,   100
/*********************************/
/* Initialized data              */
/*********************************/
.data
sMessResult:       .ascii "The door "
sMessValeur:       .fill 11, 1, ' '            @ size => 11
                      .asciz "is open.\n"

/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
stTableDoors:	.skip   4 * NBDOORS
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                                         @ entry of program
    push {fp,lr}                              @ saves 2 registers
    @ display first line
    ldr r3,iAdrstTableDoors                   @ table address
    mov r5,#1
1:
    mov r4,r5
2:                                            @ begin loop
    ldr r2,[r3,r4,lsl #2]                     @ read doors index r4
    cmp r2,#0
    moveq r2,#1                               @ if r2 = 0   1 -> r2
    movne r2,#0                               @ if r2 = 1   0 -> r2
    str r2,[r3,r4,lsl #2]                     @ store value of doors
    add r4,r5                                 @ increment r4 with  r5 value
    cmp r4,#NBDOORS                           @ number of doors ?
    ble 2b                                    @ no -> loop
    add r5,#1                                 @ increment the increment !!
    cmp r5,#NBDOORS                           @ number of doors ?
    ble 1b                                    @ no -> loop

                                              @ loop display state doors
    mov r4,#0
3:
    ldr r2,[r3,r4,lsl #2]                     @ read state doors r4 index
    cmp r2,#0
    beq 4f
    mov r0,r4                                 @ open -> display message
    ldr r1,iAdrsMessValeur                    @ display value index
    bl conversion10                           @ call function
    ldr r0,iAdrsMessResult
    bl affichageMess                          @ display message
4:
    add r4,#1
    cmp r4,#NBDOORS
    ble 3b                                    @ loop

100:                                          @ standard end of the program
    mov r0, #0                                @ return code
    pop {fp,lr}                               @restaur 2 registers
    mov r7, #EXIT                             @ request to exit program
    svc #0                                    @ perform the system call

iAdrsMessValeur:                .int sMessValeur
iAdrstTableDoors:		.int stTableDoors
iAdrsMessResult:		.int sMessResult

/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {r0,r1,r2,r7,lr}                     @ save  registres
    mov r2,#0                                 @ counter length
1:                                            @ loop length calculation
    ldrb r1,[r0,r2]                           @ read octet start position + index
    cmp r1,#0                                 @ if 0 its over
    addne r2,r2,#1                            @ else add 1 in the length
    bne 1b                                    @ and loop
                                              @ so here r2 contains the length of the message
    mov r1,r0        			      @ address message in r1
    mov r0,#STDOUT      		      @ code to write to the standard output Linux
    mov r7, #WRITE                            @ code call system "write"
    svc #0                                    @ call systeme
    pop {r0,r1,r2,r7,lr}                      @ restaur des  2 registres */
    bx lr                                     @ return
/******************************************************************/
/*     Converting a register to a decimal unsigned                */
/******************************************************************/
/* r0 contains value and r1 address area   */
/* r0 return size of result (no zero final in area) */
/* area size => 11 bytes          */
.equ LGZONECAL,   10
conversion10:
    push {r1-r4,lr}                            @ save registers
    mov r3,r1
    mov r2,#LGZONECAL

1:	                                       @ start loop
    bl divisionpar10U                          @unsigned  r0 <- dividende. quotient ->r0 reste -> r1
    add r1,#48                                 @ digit
    strb r1,[r3,r2]                            @ store digit on area
    cmp r0,#0                                  @ stop if quotient = 0
    subne r2,#1                                @ else previous position
    bne 1b	                               @ and loop
    // and move digit from left of area
    mov r4,#0
2:
    ldrb r1,[r3,r2]
    strb r1,[r3,r4]
    add r2,#1
    add r4,#1
    cmp r2,#LGZONECAL
    ble 2b
    // and move spaces in end on area
    mov r0,r4                                 @ result length
    mov r1,#' '                               @ space
3:
    strb r1,[r3,r4]                           @ store space in area
    add r4,#1                                 @ next position
    cmp r4,#LGZONECAL
    ble 3b                                    @ loop if r4 <= area size

100:
    pop {r1-r4,lr}                            @ restaur registres
    bx lr                                     @return

/***************************************************/
/*   division par 10   unsigned                    */
/***************************************************/
/* r0 dividende   */
/* r0 quotient */
/* r1 remainder  */
divisionpar10U:
    push {r2,r3,r4, lr}
    mov r4,r0                                        @ save value
    //mov r3,#0xCCCD                                 @ r3 <- magic_number  lower   @ for Raspberry pi 3
    //movt r3,#0xCCCC                                @ r3 <- magic_number  upper   @ for Raspberry pi 3
    ldr r3,iMagicNumber                              @ for Raspberry pi 1 2
    umull r1, r2, r3, r0                             @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
    mov r0, r2, LSR #3                               @ r2 <- r2 >> shift 3
    add r2,r0,r0, lsl #2                             @ r2 <- r0 * 5
    sub r1,r4,r2, lsl #1                             @ r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10)
    pop {r2,r3,r4,lr}
    bx lr                                            @ leave function
iMagicNumber:            .int 0xCCCCCCCD


<?php
  function isPrime ($x) {
    if ($x < 2) return false;
    if ($x < 4) return true;
    if ($x % 2 == 0) return false;
    for ($d = 3; $d < sqrt($x); $d++) {
      if ($x % $d == 0) return false;
    }
    return true;
  }

  function countFacs ($n) {
    $count = 0;
    $divisor = 1;
    if ($n < 2) return 0;
    while (!isPrime($n)) {
      while (!isPrime($divisor)) $divisor++;
      while ($n % $divisor == 0) {
        $n /= $divisor;
        $count++;
      }
      $divisor++;
      if ($n == 1) return $count;
    }
  return $count + 1;
  }

  for ($i = 1; $i <= 120; $i++) {
    if (isPrime(countFacs($i))) echo $i." ";
  }
?>


attractive: procedure options(main);
    %replace MAX by 120;
    declare prime(1:MAX) bit(1);

    sieve: procedure;
        declare (i, j, sqm) fixed;
        prime(1) = 0;
        do i=2 to MAX; prime(i) = '1'b; end;

        sqm = sqrt(MAX);
        do i=2 to sqm;
            if prime(i) then do j=i*2 to MAX by i;
                prime(j) = '0'b;
            end;
        end;
    end sieve;

    factors: procedure(nn) returns(fixed);
        declare (f, i, n, nn) fixed;
        n = nn;
        f = 0;
        do i=2 to n;
            if prime(i) then do while(mod(n,i) = 0);
                f = f+1;
                n = n/i;
            end;
        end;
        return(f);
    end factors;

    attractive: procedure(n) returns(bit(1));
        declare n fixed;
        return(prime(factors(n)));
    end attractive;

    declare (i, col) fixed;
    i = 0;
    col = 0;
    call sieve();
    do i=2 to MAX;
        if attractive(i) then do;
            put edit(i) (F(4));
            col = col + 1;
            if mod(col,18) = 0 then put skip;
        end;
    end;
end attractive;


Private Type Associative
    Key As String
    Value As Variant
End Type
Sub Main_Array_Associative()
Dim BaseArray(2) As Associative, UpdateArray(2) As Associative
    FillArrays BaseArray, UpdateArray
    ReDim Result(UBound(BaseArray)) As Associative
    MergeArray Result, BaseArray, UpdateArray
    PrintOut Result
End Sub
Private Sub MergeArray(Res() As Associative, Base() As Associative, Update() As Associative)
Dim i As Long, Respons As Long
    Res = Base
    For i = LBound(Update) To UBound(Update)
        If Exist(Respons, Base, Update(i).Key) Then
            Res(Respons).Value = Update(i).Value
        Else
            ReDim Preserve Res(UBound(Res) + 1)
            Res(UBound(Res)).Key = Update(i).Key
            Res(UBound(Res)).Value = Update(i).Value
        End If
    Next
End Sub
Private Function Exist(R As Long, B() As Associative, K As String) As Boolean
Dim i As Long
    Do
        If B(i).Key = K Then
            Exist = True
            R = i
        End If
        i = i + 1
    Loop While i <= UBound(B) And Not Exist
End Function
Private Sub FillArrays(B() As Associative, U() As Associative)
    B(0).Key = "name"
    B(0).Value = "Rocket Skates"
    B(1).Key = "price"
    B(1).Value = 12.75
    B(2).Key = "color"
    B(2).Value = "yellow"
    U(0).Key = "price"
    U(0).Value = 15.25
    U(1).Key = "color"
    U(1).Value = "red"
    U(2).Key = "year"
    U(2).Value = 1974
End Sub
Private Sub PrintOut(A() As Associative)
Dim i As Long
    Debug.Print "Key", "Value"
    For i = LBound(A) To UBound(A)
        Debug.Print A(i).Key, A(i).Value
    Next i
    Debug.Print "-----------------------------"
End Sub


var mergeMaps = Fn.new { |m1, m2|
    var m3 = {}
    for (key in m1.keys) m3[key] = m1[key]
    for (key in m2.keys) m3[key] = m2[key]
    return m3
}

var base = { "name": "Rocket Skates" , "price": 12.75, "color": "yellow" }
var update = { "price": 15.25, "color": "red", "year": 1974 }
var merged = mergeMaps.call(base, update)
System.print(merged)


type Generic = int|string|f64
type Assoc = map[string]Generic

fn merge(base Assoc, update Assoc) Assoc {
    mut result := Assoc(map[string]Generic{})
    for k, v in base {
        result[k] = v
    }
    for k, v in update {
        result[k] = v
    }
    return result
}

fn main() {
    base := Assoc({"name": Generic("Rocket Skates"), "price": 12.75, "color": "yellow"})
    update := Assoc({"price": Generic(15.25), "color": "red", "year": 1974})
    result := merge(base, update)
    for k,v in result {
        println('$k: $v')
    }
}


      INSTALL @lib$+"TIMERLIB"

      DIM Buckets%(100)
      FOR i% = 1 TO 100 : Buckets%(i%) = RND(10) : NEXT

      tid0% = FN_ontimer(10, PROCdisplay, 1)
      tid1% = FN_ontimer(11, PROCflatten, 1)
      tid2% = FN_ontimer(12, PROCroughen, 1)

      ON ERROR PROCcleanup : REPORT : PRINT : END
      ON CLOSE PROCcleanup : QUIT

      REPEAT
        WAIT 0
      UNTIL FALSE
      END

      DEF PROCdisplay
      PRINT SUM(Buckets%()) " ", MOD(Buckets%())
      ENDPROC

      DEF PROCflatten
      LOCAL d%, i%, j%
      REPEAT
        i% = RND(100)
        j% = RND(100)
      UNTIL i%<>j%
      d% = Buckets%(i%) - Buckets%(j%)
      PROCatomicupdate(Buckets%(i%), Buckets%(j%), d% DIV 4)
      ENDPROC

      DEF PROCroughen
      LOCAL i%, j%
      REPEAT
        i% = RND(100)
        j% = RND(100)
      UNTIL i%<>j%
      PROCatomicupdate(Buckets%(i%), Buckets%(j%), RND(10))
      ENDPROC

      DEF PROCatomicupdate(RETURN src%, RETURN dst%, amt%)
      IF amt% > src% amt% = src%
      IF amt% < -dst% amt% = -dst%
      src% -= amt%
      dst% += amt%
      ENDPROC

      DEF PROCcleanup
      PROC_killtimer(tid0%)
      PROC_killtimer(tid1%)
      PROC_killtimer(tid2%)
      ENDPROC


#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <unistd.h>
#include <time.h>
#include <pthread.h>

#define N_BUCKETS 15

pthread_mutex_t bucket_mutex[N_BUCKETS];
int buckets[N_BUCKETS];

pthread_t equalizer;
pthread_t randomizer;

void transfer_value(int from, int to, int howmuch)
{
  bool swapped = false;

  if ( (from == to) || ( howmuch < 0 ) ||
       (from < 0 ) || (to < 0) || (from >= N_BUCKETS) || (to >= N_BUCKETS) ) return;

  if ( from > to ) {
    int temp1 = from;
    from = to;
    to = temp1;
    swapped = true;
    howmuch = -howmuch;
  }

  pthread_mutex_lock(&bucket_mutex[from]);
  pthread_mutex_lock(&bucket_mutex[to]);

  if ( howmuch > buckets[from] && !swapped )
    howmuch = buckets[from];
  if ( -howmuch > buckets[to] && swapped )
    howmuch = -buckets[to];

  buckets[from] -= howmuch;
  buckets[to] += howmuch;

  pthread_mutex_unlock(&bucket_mutex[from]);
  pthread_mutex_unlock(&bucket_mutex[to]);
}

void print_buckets()
{
  int i;
  int sum=0;

  for(i=0; i < N_BUCKETS; i++) pthread_mutex_lock(&bucket_mutex[i]);
  for(i=0; i < N_BUCKETS; i++) {
    printf("%3d ", buckets[i]);
    sum += buckets[i];
  }
  printf("= %d\n", sum);
  for(i=0; i < N_BUCKETS; i++) pthread_mutex_unlock(&bucket_mutex[i]);
}

void *equalizer_start(void *t)
{
  for(;;) {
    int b1 = rand()%N_BUCKETS;
    int b2 = rand()%N_BUCKETS;
    int diff = buckets[b1] - buckets[b2];
    if ( diff < 0 )
      transfer_value(b2, b1, -diff/2);
    else
      transfer_value(b1, b2, diff/2);
  }
  return NULL;
}

void *randomizer_start(void *t)
{
  for(;;) {
    int b1 = rand()%N_BUCKETS;
    int b2 = rand()%N_BUCKETS;
    int diff = rand()%(buckets[b1]+1);
    transfer_value(b1, b2, diff);
  }
  return NULL;
}

int main()
{
  int i, total=0;

  for(i=0; i < N_BUCKETS; i++) pthread_mutex_init(&bucket_mutex[i], NULL);

  for(i=0; i < N_BUCKETS; i++) {
    buckets[i] = rand() % 100;
    total += buckets[i];
    printf("%3d ", buckets[i]);
  }
  printf("= %d\n", total);

  // we should check if these succeeded
  pthread_create(&equalizer, NULL, equalizer_start, NULL);
  pthread_create(&randomizer, NULL, randomizer_start, NULL);

  for(;;) {
    sleep(1);
    print_buckets();
  }

  // we do not provide a "good" way to stop this run, so the following
  // is never reached indeed...
  for(i=0; i < N_BUCKETS; i++) pthread_mutex_destroy(bucket_mutex+i);
  return EXIT_SUCCESS;
}


isOpen: map 1..101 => false

loop 1..100 'pass ->
	loop (range.step:pass pass 100) 'door [
		isOpen\[door]: not? isOpen\[door]
	]

loop 1..100 'x ->
	if isOpen\[x] [
		print ["Door" x "is open."]
	]


100H:
BDOS: PROCEDURE (F, ARG); DECLARE F BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PUT$CHAR: PROCEDURE (CH); DECLARE CH BYTE; CALL BDOS(2,CH); END PUT$CHAR;

DECLARE MAXIMUM LITERALLY '120';

PRINT4: PROCEDURE (N);
    DECLARE (N, MAGN, Z) BYTE;
    CALL PUT$CHAR(' ');
    MAGN = 100;
    Z = 0;
    DO WHILE MAGN > 0;
        IF NOT Z AND N < MAGN THEN
            CALL PUT$CHAR(' ');
        ELSE DO;
            CALL PUT$CHAR('0' + N/MAGN);
            N = N MOD MAGN;
            Z = 1;
        END;
        MAGN = MAGN/10;
    END;
END PRINT4;

NEW$LINE: PROCEDURE;
    CALL PUT$CHAR(13);
    CALL PUT$CHAR(10);
END NEW$LINE;

SIEVE: PROCEDURE (MAX, PRIME);
    DECLARE PRIME ADDRESS;
    DECLARE (I, J, MAX, P BASED PRIME) BYTE;

    P(0)=0;
    P(1)=0;
    DO I=2 TO MAX; P(I)=1; END;
    DO I=2 TO SHR(MAX,1);
        IF P(I) THEN DO J=SHL(I,1) TO MAX BY I;
            P(J) = 0;
        END;
    END;
END SIEVE;

FACTORS: PROCEDURE (N, MAX, PRIME) BYTE;
    DECLARE PRIME ADDRESS;
    DECLARE (I, J, N, MAX, F, P BASED PRIME) BYTE;
    F = 0;
    DO I=2 TO MAX;
        IF P(I) THEN DO WHILE N MOD I = 0;
            F = F + 1;
            N = N / I;
        END;
    END;
    RETURN F;
END FACTORS;

ATTRACTIVE: PROCEDURE(N, MAX, PRIME) BYTE;
    DECLARE PRIME ADDRESS;
    DECLARE (N, MAX, P BASED PRIME) BYTE;
    RETURN P(FACTORS(N, MAX, PRIME));
END ATTRACTIVE;

DECLARE (I, COL) BYTE INITIAL (0, 0);
CALL SIEVE(MAXIMUM, .MEMORY);
DO I=2 TO MAXIMUM;
    IF ATTRACTIVE(I, MAXIMUM, .MEMORY) THEN DO;
        CALL PRINT4(I);
        COL = COL + 1;
        IF COL MOD 18 = 0 THEN CALL NEW$LINE;
    END;
END;
CALL EXIT;
EOF


base:=Dictionary(
   "name", 	"Rocket Skates",
   "price", 	12.75,
   "color", 	"yellow",);
update:=Dictionary(
   "price", 	15.25,
   "color", 	"red",
   "year", 	1974,);

update.pump( new:=base.copy() );

new.pump(Void,fcn([(k,v)]){ println("%s\t%s".fmt(k,v)) });


- Changed to using object locks and Montor.Enter rather than Mutexes.  This allows use of the cleaner "lock" statement, and also has lower runtime overhead for in process locks
- The previous implementation tracked a "swapped" state - which seems a harder way to tackle the problem.   You need to acquire the locks in the correct order, not swap i and j


#include <algorithm>
#include <array>
#include <chrono>
#include <iomanip>
#include <iostream>
#include <mutex>
#include <random>
#include <thread>

using namespace std;

constexpr int bucket_count = 15;

void equalizer(array<int, bucket_count>& buckets,
               array<mutex, bucket_count>& bucket_mutex) {
    random_device rd;
    mt19937 gen(rd());
    uniform_int_distribution<> dist_bucket(0, bucket_count - 1);

    while (true) {
        int from = dist_bucket(gen);
        int to = dist_bucket(gen);
        if (from != to) {
            lock_guard<mutex> lock_first(bucket_mutex[min(from, to)]);
            lock_guard<mutex> lock_second(bucket_mutex[max(from, to)]);
            int diff = buckets[from] - buckets[to];
            int amount = abs(diff / 2);
            if (diff < 0) {
                swap(from, to);
            }
            buckets[from] -= amount;
            buckets[to] += amount;
        }
    }
}

void randomizer(array<int, bucket_count>& buckets,
                array<mutex, bucket_count>& bucket_mutex) {
    random_device rd;
    mt19937 gen(rd());
    uniform_int_distribution<> dist_bucket(0, bucket_count - 1);

    while (true) {
        int from = dist_bucket(gen);
        int to = dist_bucket(gen);
        if (from != to) {
            lock_guard<mutex> lock_first(bucket_mutex[min(from, to)]);
            lock_guard<mutex> lock_second(bucket_mutex[max(from, to)]);
            uniform_int_distribution<> dist_amount(0, buckets[from]);
            int amount = dist_amount(gen);
            buckets[from] -= amount;
            buckets[to] += amount;
        }
    }
}

void print_buckets(const array<int, bucket_count>& buckets) {
    int total = 0;
    for (const int& bucket : buckets) {
        total += bucket;
        cout << setw(3) << bucket << ' ';
    }
    cout << "= " << setw(3) << total << endl;
}

int main() {
    random_device rd;
    mt19937 gen(rd());
    uniform_int_distribution<> dist(0, 99);

    array<int, bucket_count> buckets;
    array<mutex, bucket_count> bucket_mutex;
    for (int& bucket : buckets) {
        bucket = dist(gen);
    }
    print_buckets(buckets);

    thread t_eq(equalizer, ref(buckets), ref(bucket_mutex));
    thread t_rd(randomizer, ref(buckets), ref(bucket_mutex));

    while (true) {
        this_thread::sleep_for(chrono::seconds(1));
        for (mutex& mutex : bucket_mutex) {
            mutex.lock();
        }
        print_buckets(buckets);
        for (mutex& mutex : bucket_mutex) {
            mutex.unlock();
        }
    }
    return 0;
}


var doors = falses(100)

for a in 1..100: for b in a..a..100:
    doors[b] = not doors[b]

for a in 1..100:
    print "Door $a is ${(doors[a]) ? 'open.': 'closed.'}"


prime_factors(N, Factors):-
    S is sqrt(N),
    prime_factors(N, Factors, S, 2).

prime_factors(1, [], _, _):-!.
prime_factors(N, [P|Factors], S, P):-
    P =< S,
    0 is N mod P,
    !,
    M is N // P,
    prime_factors(M, Factors, S, P).
prime_factors(N, Factors, S, P):-
    Q is P + 1,
    Q =< S,
    !,
    prime_factors(N, Factors, S, Q).
prime_factors(N, [N], _, _).

is_prime(2):-!.
is_prime(N):-
    0 is N mod 2,
    !,
    fail.
is_prime(N):-
    N > 2,
    S is sqrt(N),
    \+is_composite(N, S, 3).

is_composite(N, S, P):-
    P =< S,
    0 is N mod P,
    !.
is_composite(N, S, P):-
    Q is P + 2,
    Q =< S,
    is_composite(N, S, Q).

attractive_number(N):-
    prime_factors(N, Factors),
    length(Factors, Len),
    is_prime(Len).

print_attractive_numbers(From, To, _):-
    From > To,
    !.
print_attractive_numbers(From, To, C):-
    (attractive_number(From) ->
        writef('%4r', [From]),
        (0 is C mod 20 -> nl ; true),
        C1 is C + 1
        ;
        C1 = C
    ),
    Next is From + 1,
    print_attractive_numbers(Next, To, C1).

main:-
    print_attractive_numbers(1, 120, 1).


(defn xfer [m from to amt]
  (let [{f-bal from t-bal to} m
        f-bal (- f-bal amt)
        t-bal (+ t-bal amt)]
    (if (or (neg? f-bal) (neg? t-bal))
      (throw (IllegalArgumentException. "Call results in negative balance."))
      (assoc m from f-bal to t-bal))))


(ql:quickload '(:alexandria :stmx :bordeaux-threads))

(defpackage :atomic-updates
  (:use :cl))

(in-package :atomic-updates)

(defvar *buckets* nil)
(defvar *running* nil)

(defun distribute (ratio a b)
  "Atomically redistribute the values of buckets A and B by RATIO."
  (stmx:atomic
   (let* ((sum (+ (stmx:$ a) (stmx:$ b)))
          (a2 (truncate (* ratio sum))))
     (setf (stmx:$ a) a2)
     (setf (stmx:$ b) (- sum a2)))))

(defun runner (ratio-func)
  "Continously distribute to two different elements in *BUCKETS* with the
value returned from RATIO-FUNC."
  (loop while *running*
     do (let ((a (alexandria:random-elt *buckets*))
              (b (alexandria:random-elt *buckets*)))
          (unless (eq a b)
            (distribute (funcall ratio-func) a b)))))

(defun print-buckets ()
  "Atomically get the bucket values and print out their metrics."
  (let ((buckets (stmx:atomic (map 'vector 'stmx:$ *buckets*))))
    (format t "Buckets: ~a~%Sum: ~a~%" buckets (reduce '+ buckets))))

(defun scenario ()
  (setf *buckets* (coerce (loop repeat 20 collect (stmx:tvar 10)) 'vector))
  (setf *running* t)
  (bt:make-thread (lambda () (runner (constantly 0.5))))
  (bt:make-thread (lambda () (runner (lambda () (random 1.0))))))


for(int i = 1; i < 100; ++i) {
    if (i % i^2 < 11)  {
      write("Door ", i^2, suffix=none);
      write(" is open");
    }
  }


#MAX=120
Dim prime.b(#MAX)
FillMemory(@prime(),#MAX,#True,#PB_Byte) : FillMemory(@prime(),2,#False,#PB_Byte)
For i=2 To Int(Sqr(#MAX)) : n=i*i : While n<#MAX : prime(n)=#False : n+i : Wend : Next

Procedure.i pfCount(n.i)
  Shared prime()
  If n=1          : ProcedureReturn 0     : EndIf
  If prime(n)     : ProcedureReturn 1     : EndIf
  count=0 : f=2
  Repeat
    If n%f=0      : count+1               : n/f
      If n=1      : ProcedureReturn count : EndIf
      If prime(n) : f=n                   : EndIf
    ElseIf f>=3   : f+2
    Else          : f=3
    EndIf
  ForEver
EndProcedure

OpenConsole()
PrintN("The attractive numbers up to and including "+Str(#MAX)+" are:")
For i=1 To #MAX
  If prime(pfCount(i))
    Print(RSet(Str(i),4)) : count+1 : If count%20=0 : PrintN("") : EndIf
  EndIf
Next
PrintN("") : Input()


from sympy import sieve # library for primes

def get_pfct(n):
	i = 2; factors = []
	while i * i <= n:
		if n % i:
			i += 1
		else:
			n //= i
			factors.append(i)
	if n > 1:
		factors.append(n)
	return len(factors)

sieve.extend(110) # first 110 primes...
primes=sieve._list

pool=[]

for each in xrange(0,121):
	pool.append(get_pfct(each))

for i,each in enumerate(pool):
	if each in primes:
		print i,


import std.stdio: writeln;
import std.conv: text;
import std.random: uniform, Xorshift;
import std.algorithm: min, max;
import std.parallelism: task;
import core.thread: Thread;
import core.sync.mutex: Mutex;
import core.time: seconds;

__gshared uint transfersCount;

final class Buckets(size_t nBuckets) if (nBuckets > 0) {
    alias TBucketValue = uint;

    // The trailing padding avoids cache line contention
    // when run with two or more cores.
    align(128) private static struct Bucket {
        TBucketValue value;
        Mutex mtx;
        alias value this;
    }

    private Bucket[nBuckets] buckets;
    private bool running;

    public this() {
        this.running = true;
        foreach (ref b; buckets)
            b = Bucket(uniform(0, 100), new Mutex);
    }

    public TBucketValue opIndex(in size_t index) const pure nothrow {
        return buckets[index];
    }

    public void transfer(in size_t from, in size_t to,
                         in TBucketValue amount) {
        immutable low  = min(from, to);
        immutable high = max(from, to);
        buckets[low].mtx.lock();
        buckets[high].mtx.lock();

        scope(exit) {
            buckets[low].mtx.unlock();
            buckets[high].mtx.unlock();
        }

        immutable realAmount = min(buckets[from].value, amount);
        buckets[from] -= realAmount;
        buckets[to  ] += realAmount;
        transfersCount++;
    }

    @property size_t length() const pure nothrow {
        return this.buckets.length;
    }

    void toString(in void delegate(const(char)[]) sink) {
        TBucketValue total = 0;
        foreach (ref b; buckets) {
            b.mtx.lock();
            total += b;
        }

        scope(exit)
            foreach (ref b; buckets)
                b.mtx.unlock();

        sink(text(buckets));
        sink(" ");
        sink(text(total));
    }
}

void randomize(size_t N)(Buckets!N data) {
    auto rng = Xorshift(1);

    while (data.running) {
        immutable i = uniform(0, data.length, rng);
        immutable j = uniform(0, data.length, rng);
        immutable amount = uniform!"[]"(0, 20, rng);
        data.transfer(i, j, amount);
    }
}

void equalize(size_t N)(Buckets!N data) {
    auto rng = Xorshift(1);

    while (data.running) {
        immutable i = uniform(0, data.length, rng);
        immutable j = uniform(0, data.length, rng);
        immutable a = data[i];
        immutable b = data[j];
        if (a > b)
            data.transfer(i, j, (a - b) / 2);
        else
            data.transfer(j, i, (b - a) / 2);
    }
}

void display(size_t N)(Buckets!N data) {
    foreach (immutable _; 0 .. 10) {
        writeln(transfersCount, " ", data);
        transfersCount = 0;
        Thread.sleep(1.seconds);
    }
    data.running = false;
}

void main() {
    writeln("N. transfers, buckets, buckets sum:");
    auto data = new Buckets!20();
    task!randomize(data).executeInNewThread();
    task!equalize(data).executeInNewThread();
    task!display(data).executeInNewThread();
}


#include "share/atspre_staload.hats"

implement
main0((*void*)) = let
//
var A = @[bool][100](false)
val A = $UNSAFE.cast{arrayref(bool,100)}([email protected])
//
fnx
loop
(
  pass: intGte(0)
) : void =
  if pass < 100
    then loop2 (pass, pass)
  // end of [if]
and
loop2
(
  pass: natLt(100), door: intGte(0)
) : void =
  if door < 100
    then (A[door] := ~A[door]; loop2(pass, door+pass+1))
    else loop(pass+1)
  // end of [if]
//
fun
loop3
(
  door: intGte(0)
) : void =
  if door < 100
    then (
      println!("door #", door+1, " is ", (if A[door] then "open" else "closed"): string, ".");
      loop3(door+1)
    ) (* end of [then] *)
  // end of [if]
//
in
  loop(0); loop3 (0)
end // end of [main0]


 [ primefactors size
   primefactors size 1 = ] is attractive ( n --> b )

120 times
  [ i^ 1+ attractive if
      [ i^ 1+ echo sp ] ]


is_prime <- function(num) {
  if (num < 2) return(FALSE)
  if (num %% 2 == 0) return(num == 2)
  if (num %% 3 == 0) return(num == 3)

  d <- 5
  while (d*d <= num) {
    if (num %% d == 0) return(FALSE)
    d <- d + 2
    if (num %% d == 0) return(FALSE)
    d <- d + 4
  }
  TRUE
}

count_prime_factors <- function(num) {
  if (num == 1) return(0)
  if (is_prime(num)) return(1)
  count <- 0
  f <- 2
  while (TRUE) {
    if (num %% f == 0) {
      count <- count + 1
      num <- num / f
      if (num == 1) return(count)
      if (is_prime(num)) f <- num
    }
    else if (f >= 3) f <- f + 2
    else f <- 3
  }
}

max <- 120
cat("The attractive numbers up to and including",max,"are:\n")
count <- 0
for (i in 1:max) {
  n <- count_prime_factors(i);
  if (is_prime(n)) {
    cat(i," ", sep = "")
    count <- count + 1
  }
}