Data update

Task/100-doors/ANSI-BASIC/100-doors.basic

@@ -0,0 +1,21 @@
+100 REM 100 doors
+110 REM The unoptimised door flipping method
+120 REM which simulates the process
+130 DIM IsDoorOpen(1 TO 100)
+140 LET DoorMax = UBOUND(IsDoorOpen)
+150 REM Set all doors to closed
+160 FOR I = 1 TO DoorMax
+170    LET IsDoorOpen(I) = 0
+180 NEXT I
+190 REM Repeatedly flip the doors
+200 FOR I = 1 TO DoorMax
+210    FOR J = I TO DoorMax STEP I
+220       LET IsDoorOpen(J) = 1 - IsDoorOpen(J)
+230    NEXT J
+240 NEXT I
+250 REM Display the results
+260 FOR I = 1 TO DoorMax
+270    IF IsDoorOpen(I) <> 0 THEN PRINT I;
+280 NEXT I
+290 PRINT
+300 END

Task/100-doors/Ada/100-doors-1.adb

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

Task/100-doors/Ada/100-doors-2.adb

@@ -0,0 +1,16 @@
+with Ada.Text_Io; use Ada.Text_Io;
+ with Ada.Numerics.Elementary_Functions; use Ada.Numerics.Elementary_Functions;
+
+ procedure Doors_Optimized is
+    Num : Float;
+ begin
+    for I in 1..100 loop
+       Num := Sqrt(Float(I));
+       Put(Integer'Image(I) & " is ");
+       if Float'Floor(Num) = Num then
+          Put_Line("Opened");
+       else
+          Put_Line("Closed");
+       end if;
+    end loop;
+ end Doors_Optimized;

Task/100-doors/AutoIt/100-doors.au3

@@ -0,0 +1,17 @@
+#include <array.au3>
+$doors = 100
+
+;door array, 0 = closed, 1 = open
+Local $door[$doors +1]
+
+For $ii = 1 To $doors
+	For $i = $ii To $doors Step $ii
+		$door[$i] = Not $door[$i]
+	next
+Next
+
+;display to screen
+For $i = 1 To $doors
+	ConsoleWrite (Number($door[$i])& " ")
+	If Mod($i,10) = 0 Then ConsoleWrite(@CRLF)
+Next

Task/100-doors/AutoLISP/100-doors.lsp

@@ -0,0 +1,18 @@
+(defun CreateDoors (n / doors)
+  (repeat n
+    (setq doors (cons nil doors))
+  )
+)
+
+(defun Doors (doors / cnt)
+  (setq cnt 0)
+  (mapcar
+   '(lambda (d)
+      (zerop (rem (sqrt (setq cnt (1+ cnt))) 1))
+    )
+    doors
+  )
+)
+
+> (Doors (CreateDoors 100))
+(T nil nil T nil nil nil nil T nil nil nil nil nil nil T nil nil nil nil nil nil nil nil T nil nil nil nil nil nil nil nil nil nil T nil nil nil nil nil nil nil nil nil nil nil nil T nil nil nil nil nil nil nil nil nil nil nil nil nil nil T nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil T nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil T nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil T nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil T nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil T nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil T nil nil nil nil)

Task/100-doors/Ballerina/100-doors.ballerina

@@ -0,0 +1,16 @@
+// https://rosettacode.org/wiki/100_doors
+import ballerina/io;
+
+public function main() {
+    boolean[100] doors = [];
+    foreach int i in int:range(0,100,1) {
+        foreach int j in int:range(i, 100, i+1) {
+            doors[j] = ! doors[j];
+        }
+    }
+    foreach int i in int:range(0,doors.length(),1) {
+        if doors[i] {
+            io:println("Door #",i+1," is ","open");
+        }
+    }
+}

Task/100-doors/COBOL/100-doors.cob

@@ -0,0 +1,33 @@
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. 100Doors.
+
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01 Current-n      PIC 9(3).
+       01 StepSize       PIC 9(3).
+       01 DoorTable.
+          02 Doors       PIC 9(1)   OCCURS 100 TIMES.
+             88 ClosedDoor          VALUE ZERO.
+       01 Idx            PIC 9(3).
+
+       PROCEDURE DIVISION.
+       Begin.
+           INITIALIZE DoorTable
+           PERFORM VARYING StepSize FROM 1 BY 1 UNTIL StepSize > 100
+             PERFORM VARYING Current-n FROM StepSize BY StepSize
+                     UNTIL Current-n > 100
+               SUBTRACT Doors (Current-n) FROM 1 GIVING Doors (Current-n)
+             END-PERFORM
+           END-PERFORM
+
+           PERFORM VARYING Idx FROM 1 BY 1
+                   UNTIL Idx > 100
+             IF ClosedDoor (Idx)
+               DISPLAY Idx " is closed."
+             ELSE
+               DISPLAY Idx " is open."
+             END-IF
+           END-PERFORM
+
+           STOP RUN
+           .

Task/100-doors/EMal/100-doors.emal

@@ -13,7 +13,7 @@ type Main
 List doors ← Door[].with(100, <int i|Door(i + 1, Door:State.CLOSED))
 ^|You make 100 passes by the doors.|^
 for int pass ← 0; pass < 100; ++pass
-  for int i ← pass; i < 100; i += pass + 1
+  for int i ← pass; i < 100; i +← pass + 1
     doors[i].toggle()
   end
 end

Task/100-doors/Emacs-Lisp/100-doors-1.el

@@ -0,0 +1,83 @@
+(defun create-doors ()
+  "Returns a list of closed doors
+
+Each door only has two status: open or closed.
+If a door is closed it has the value 0, if it's open it has the value 1."
+  (let ((return_value '(0))
+         ;; There is already a door in the return_value, so k starts at 1
+         ;; otherwise we would need to compare k against 99 and not 100 in
+         ;; the while loop
+         (k 1))
+    (while (< k 100)
+      (setq return_value (cons 0 return_value))
+      (setq k (+ 1 k)))
+    return_value))
+
+(defun toggle-single-door (doors)
+  "Toggle the stat of the door at the `car' position of the DOORS list
+
+DOORS is a list of integers with either the value 0 or 1 and it represents
+a row of doors.
+
+Returns a list where the `car' of the list has it's value toggled (if open
+it becomes closed, if closed it becomes open)."
+  (if (= (car doors) 1)
+    (cons 0 (cdr doors))
+    (cons 1 (cdr doors))))
+
+(defun toggle-doors (doors step original-step)
+  "Step through all elements of the doors' list and toggle a door when step is 1
+
+DOORS is a list of integers with either the value 0 or 1 and it represents
+a row of doors.
+STEP is the number of doors we still need to transverse before we arrive
+at a door that has to be toggled.
+ORIGINAL-STEP is the value of the argument step when this function is
+called for the first time.
+
+Returns a list of doors"
+  (cond ((null doors)
+          '())
+    ((= step 1)
+      (cons (car (toggle-single-door doors))
+        (toggle-doors (cdr doors) original-step original-step)))
+    (t
+      (cons (car doors)
+        (toggle-doors (cdr doors) (- step 1) original-step)))))
+
+(defun main-program ()
+  "The main loop for the program"
+  (let ((doors_list (create-doors))
+         (k 1)
+         ;; We need to define max-specpdl-size and max-specpdl-size to big
+         ;; numbers otherwise the loop reaches the max recursion depth and
+         ;; throws an error.
+         ;; If you want more information about these variables, press Ctrl
+         ;; and h at the same time and then press v and then type the name
+         ;; of the variable that you want to read the documentation.
+         (max-specpdl-size 5000)
+         (max-lisp-eval-depth 2000))
+    (while (< k 101)
+      (setq doors_list (toggle-doors doors_list k k))
+      (setq k (+ 1 k)))
+    doors_list))
+
+(defun print-doors (doors)
+  "This function prints the values of the doors into the current buffer.
+
+DOORS is a list of integers with either the value 0 or 1 and it represents
+a row of doors.
+"
+  ;; As in the main-program function, we need to set the variable
+  ;; max-lisp-eval-depth to a big number so it doesn't reach max recursion
+  ;; depth.
+  (let ((max-lisp-eval-depth 5000))
+    (unless (null doors)
+      (insert (int-to-string (car doors)))
+      (print-doors (cdr doors)))))
+
+;; Returns a list with the final solution
+(main-program)
+
+;; Print the final solution on the buffer
+(print-doors (main-program))

Task/100-doors/Emacs-Lisp/100-doors-2.el

@@ -0,0 +1,16 @@
+(defun one-hundred-doors(initial-state)
+  "Turn doors in INITIAL-STATE according to 100 Doors problem."
+  (interactive "nEnter initial doors' state (as a number): ")
+  (cl-loop for x from 1 to 100
+           do (cl-loop for y from (1- x) to 99 by x
+                       do (setq initial-state (logxor initial-state (ash 1 y)))))
+  (let ((counter 1)
+        (open-doors nil))
+    (while (> initial-state 0)
+      (when (eq (mod initial-state 2) 1)
+        (push counter open-doors))
+      (cl-incf counter)
+      (setq initial-state (/ initial-state 2)))
+    (message "Open doors are %s" (reverse open-doors))))
+
+(one-hundred-doors 0)

Task/100-doors/Euphoria/100-doors.eu

@@ -0,0 +1,23 @@
+-- doors.ex
+include std/console.e
+sequence doors
+doors = repeat( 0, 100 ) -- 1 to 100, initialised to false
+
+for pass = 1 to 100 do
+	for door = pass to 100 by pass do
+		--printf( 1, "%d", doors[door] )
+		--printf( 1, "%d", not doors[door] )
+		doors[door] = not doors[door]
+	end for
+end for
+
+sequence oc
+
+for i = 1 to 100 do
+	if doors[i] then
+		oc = "open"
+	else
+		oc = "closed"
+	end if
+ 	printf( 1, "door %d is %s\n", { i, oc } )
+end for

Task/100-doors/F-Sharp/100-doors-2.fs

@@ -1,6 +1 @@
-open System
-let answer2 =
-    let PerfectSquare n =
-        let sqrt = int(Math.Sqrt(float n))
-        n = sqrt * sqrt
-    [| for i in 1..100 do yield PerfectSquare i |]
+[1..100] |> List.fold (fun doors pass->List.mapi (fun i x->if ((i + 1) % pass)=0 then not x else x) doors) (List.init 100 (fun _->false))

Task/100-doors/F-Sharp/100-doors-3.fs

@@ -1 +1,8 @@
-[1..100] |> List.fold (fun doors pass->List.mapi (fun i x->if ((i + 1) % pass)=0 then not x else x) doors) (List.init 100 (fun _->false))
+let X q=not q
+let mutable q = false
+let mutable doors = []
+for n in 1..100 do
+  for g in 1..n do if n%g=0 then q<-X(q)
+  if q then doors<-n::doors
+  q<-false
+printfn "%A" (doors|>List.rev)

Task/100-doors/Fennel/100-doors.fennel

@@ -0,0 +1,15 @@
+(do ;;; find the first few squares via the unoptimised door flipping method
+
+    (local door-max 100)
+
+    ; repeatedly flip the doors and show the ones that are left open
+    (var door {})
+    (for [i 1 door-max]
+         (for [j i door-max i]
+              (tset door j (not (. door j)))
+         )
+         (when (. door i)
+               (io.write (.. " " i))
+         )
+    )
+)

Task/100-doors/Fortran/100-doors-3.f

@@ -0,0 +1,73 @@
+! =============================================================================
+! DOORS PROBLEM
+! =============================================================================
+!
+! PROBLEM STATEMENT:
+!   100 doors are all initially closed.  We make 100 passes.
+!   Pass 1 toggles every door  (1, 2, 3, ..., 100).
+!   Pass 2 toggles every 2nd   (2, 4, 6, ..., 100).
+!   Pass k toggles every k-th  (k, 2k, 3k, ...).
+!   Pass 100 toggles only door 100.
+!   What state is each door in after all 100 passes?
+!
+! ALGORITHM -- DIVISOR COUNTING:
+!   Door number D is toggled on pass k if and only if k divides D evenly,
+!   i.e. mod(D, k) == 0.  So the total number of toggles that door D receives
+!   equals the number of divisors of D (including 1 and D itself).
+!
+!   Example: door 6
+!     Divisors of 6 are 1, 2, 3, 6  =>  4 toggles  =>  even  =>  CLOSED
+!
+!   Example: door 9
+!     Divisors of 9 are 1, 3, 9     =>  3 toggles  =>  odd   =>  OPEN
+!
+!   A door ends up OPEN  when its divisor count is ODD.
+!   A door ends up CLOSED when its divisor count is EVEN.
+!
+! KEY MATHEMATICAL INSIGHT (why the pattern is perfect squares):
+!   Divisors normally come in pairs: if j divides D then (D/j) also divides D,
+!   giving an even count.  The only exception is when j == D/j, i.e. j*j == D.
+!   That "pairing trick" breaks at the square root, leaving one unpaired divisor
+!   and making the total ODD.  This happens exactly when D is a perfect square.
+!   So doors 1, 4, 9, 16, 25, 36, 49, 64, 81, 100 are open; all others closed.
+!
+!   This program proves the result by brute-force divisor counting, rather than
+!   assuming the mathematical conclusion up front.
+! =============================================================================
+
+program doors
+    implicit none
+
+    integer, parameter :: n = 100   ! total number of doors (and passes)
+    integer :: door                 ! current door being evaluated (1..n)
+    integer :: pass                 ! current pass number being tested (1..n)
+    integer :: toggles              ! number of times this door was toggled
+    character(6) :: state           ! final state label: 'open' or 'closed'
+
+    ! --- outer loop: consider each door in turn ---
+    do door = 1, n
+
+        toggles = 0   ! reset the toggle counter for this door
+
+        ! --- inner loop: check every pass to see if it touches this door ---
+        ! Pass number 'pass' visits door 'door' only when 'pass' is a divisor
+        ! of 'door'.  mod(door, pass) == 0 means pass divides door exactly.
+        do pass = 1, n
+            if (mod(door, pass) == 0) toggles = toggles + 1
+        end do
+
+        ! --- determine final state from parity of toggle count ---
+        ! Starting closed, an odd number of toggles leaves the door open;
+        ! an even number returns it to closed.
+        if (mod(toggles, 2) == 1) then
+            state = 'open'
+        else
+            state = 'closed'
+        end if
+
+        ! --- report result for this door ---
+        write(*, '(A, I3, A, A)') 'Door', door, ' is ', trim(state)
+
+    end do
+
+end program doors

Task/100-doors/Goboscript/100-doors.gobo

@@ -0,0 +1,37 @@
+costumes "assets/blank.svg";
+
+list doors;
+
+proc do_100_doors {
+    delete doors;
+    repeat 100 {add false to doors;}
+
+    local pass_i = 1;
+    repeat 100 {
+        local i = 0;
+        repeat length doors / pass_i {
+            i += pass_i;
+            doors[i] = not doors[i];
+        }
+
+        pass_i++;
+    }
+}
+
+onflag{main;}
+proc main {
+    do_100_doors;
+
+    show doors;
+    local i = 1;
+    repeat length doors {
+        if doors[i] {
+            local state = "open";
+        } else {
+            local state = "closed";
+        }
+
+        log "Door " & i & " is " & state;
+        i++;
+    }
+}

Task/100-doors/Haxe/100-doors-1.hx

@@ -0,0 +1,23 @@
+class Main
+{
+    static public function main()
+    {
+        findOpenDoors( 100 );
+    }
+
+    static function findOpenDoors( n : Int )
+    {
+        var door = [];
+        for( i in 0...n + 1 ){ door[ i ] = false; }
+        for( i in 1...n + 1 ){
+            var j = i;
+            while( j <= n ){
+                door[ j ] = ! door[ j ];
+                j += i;
+            }
+        }
+        for( i in 1...n + 1 ){
+            if( door[ i ] ){ Sys.print( ' $i' ); }
+        }
+    }
+}

Task/100-doors/Haxe/100-doors-2.hx

@@ -0,0 +1,18 @@
+class RosettaDemo
+{
+    static public function main()
+    {
+        findOpenLockers(100);
+    }
+
+    static function findOpenLockers(n : Int)
+    {
+        var i = 1;
+
+        while((i*i) <= n)
+        {
+            Sys.println(i*i);
+            i++;
+        }
+    }
+}

Task/100-doors/Langur/100-doors-2.langur

@@ -1 +1 @@
-writeln fold(doors, series(1..len(doors)), by=fn a, b, c: if(b: a~[c]; a), init=[])
+writeln fold(doors, series(1..len(doors)), by=fn(a, b, c) { if(b: a~[c]; a) }, init=[])

Task/100-doors/MoonRock/100-doors.moonrock

@@ -0,0 +1,35 @@
+' 100 doors
+
+BEGIN DEF
+%DoorMax = 100
+%LastI = %DoorMax - 1
+DIM DoorOpen%[%DoorMax]
+
+BEGIN CODE
+' The unoptimised door flipping method
+' which simulates the process
+' Set all doors to closed
+FOR I% = 0 TO %LastI
+  DoorOpen%[I%] = FALSE
+NEXT
+' Repeatedly flip the doors
+FOR I% = 1 TO %DoorMax
+  J% = I% - 1
+  WHILE J% < %DoorMax
+    IF DoorOpen%[J%] = TRUE THEN
+      DoorOpen%[J%] = FALSE
+    ELSE
+      DoorOpen%[J%] = TRUE
+    ENDIF
+    J% = J% + I%
+  WEND
+NEXT
+' Display the results
+FOR I% = 0 TO %LastI
+  IF DoorOpen%[I%] = TRUE THEN
+    IPl1% = I% + 1
+    PRINT " " + IPl1%
+  ENDIF
+NEXT
+PRINT "\n"
+END

Task/100-doors/Odin/100-doors-3.odin

@@ -0,0 +1,22 @@
+package main
+
+import "core:fmt"
+import "core:math"
+
+main :: proc() {
+ using fmt
+
+  Door_State :: enum {Closed, Open}
+
+  doors := [?]Door_State { 0..<100 = .Closed }
+
+  for i in  1..=100 {
+     res := math.sqrt_f64( f64(i) )
+     if math.mod_f64( res, 1) == 0 {
+        doors[i-1] = .Open
+     } else {
+        doors[i-1] = .Closed
+     }
+     println("Door: ", i, " -> ", doors[i-1])
+  }
+}

Task/100-doors/PowerShell/100-doors-1.ps1

@@ -0,0 +1,14 @@
+$doors = @(0..99)
+for($i=0; $i -lt 100; $i++) {
+  $doors[$i] = 0  # start with all doors closed
+}
+for($i=0; $i -lt 100; $i++) {
+  $step = $i + 1
+  for($j=$i; $j -lt 100; $j = $j + $step) {
+    $doors[$j] = $doors[$j] -bxor 1
+  }
+}
+foreach($doornum in 1..100) {
+  if($doors[($doornum-1)] -eq $true) {"$doornum open"}
+  else {"$doornum closed"}
+}

Task/100-doors/PowerShell/100-doors-2.ps1

@@ -0,0 +1,37 @@
+function Get-DoorState($NumberOfDoors)
+{
+   begin
+   {
+      $Doors = @()
+      $Multiple = 1
+   }
+
+   process
+   {
+      for ($i = 1; $i -le $NumberOfDoors; $i++)
+      {
+         $Door = [pscustomobject]@{
+                    Name = $i
+                    Open = $false
+                 }
+
+         $Doors += $Door
+      }
+
+      While ($Multiple -le $NumberOfDoors)
+      {
+	 Foreach ($Door in $Doors)
+	 {
+	    if ($Door.name % $Multiple -eq 0)
+               {
+	          If ($Door.open -eq $False){$Door.open = $True}
+	          Else {$Door.open = $False}
+	       }
+	 }
+			
+         $Multiple++
+      }
+    }
+
+    end {$Doors}
+}

Task/100-doors/PowerShell/100-doors-3.ps1

@@ -0,0 +1,2 @@
+$doors = 1..100 | ForEach-Object {0}
+1..100 | ForEach-Object { $a=$_;1..100 | Where-Object { -not ( $_ % $a )  } | ForEach-Object { $doors[$_-1] = $doors[$_-1] -bxor 1 }; if ( $doors[$a-1] ) { "door opened" } else { "door closed" } }

Task/100-doors/PowerShell/100-doors-4.ps1

@@ -0,0 +1,3 @@
+$doors = 1..100 | ForEach-Object {0}
+$visited = 1..100
+1..100 | ForEach-Object { $a=$_;$visited[0..([math]::floor(100/$a)-1)] | Where-Object { -not ( $_ % $a )  } | ForEach-Object { $doors[$_-1] = $doors[$_-1] -bxor 1;$visited[$_/$a-1]+=($_/$a) }; if ( $doors[$a-1] ) { "door opened" } else { "door closed" } }

Task/100-doors/PowerShell/100-doors-5.ps1

@@ -0,0 +1,3 @@
+1..100|foreach-object {$pipe += "toggle $_ |"} -begin {$pipe=""}
+filter toggle($pass) {$_.door = $_.door -xor !($_.index % $pass);$_}
+invoke-expression "1..100| foreach-object {@{index=`$_;door=`$false}} | $pipe  out-host"

Task/100-doors/PowerShell/100-doors-6.ps1

@@ -0,0 +1,6 @@
+Workflow Calc-Doors {
+    Foreach –parallel ($number in 1..100) {
+        "Door " + $number.ToString("0000") + ": " + @{$true="Closed";$false="Open"}[([Math]::pow($number, 0.5)%1) -ne 0]
+    }
+}
+Calc-Doors | sort

Task/100-doors/PowerShell/100-doors-7.ps1

@@ -0,0 +1 @@
+1..10|%{"Door "+ $_*$_ + " is open"}

Task/100-doors/Rebol/100-doors-1.rebol

@@ -0,0 +1,5 @@
+doors: array/initial 100 'closed
+repeat i 100 [
+    door: at doors i
+    forskip door i [change door either 'open = first door ['closed] ['open]]
+]

Task/100-doors/Rebol/100-doors-2.rebol

@@ -0,0 +1,26 @@
+;; Create a bitset with capacity for 100 bits (representing 100 doors)
+;; Each bit represents a door state: 0 = closed, 1 = open
+doors: make bitset! 100
+
+;; Outer loop: Make 100 passes (i = 1 to 100)
+repeat i 100 [
+    ;; Inner loop: Check each door position (j = 1 to 100)
+    repeat j 100 [
+        ;; If door j index is divisible by pass number i (no remainder)
+        if zero? (j // i) [
+            ;; Toggle the door's bit:
+            ;; doors/:j accesses door j in the bitset
+            ;; 'not' flips the bit value (0 -> 1, 1 -> 0)
+            doors/:j: not doors/:j
+        ]
+    ]
+]
+
+;; Final loop: Check which doors are open, print their numbers
+repeat i 100 [
+    ;; If door i's bit is set (open)
+    if doors/:i [
+        ;; Print the door's number and that it is open
+        print ["door" i "is open"]
+    ]
+]

Task/100-doors/Rebol/100-doors-3.rebol

@@ -0,0 +1,6 @@
+;; Loop variable i from 1 to 10 (since 10^2 = 100, covers doors 1 to 100)
+repeat i 10 [
+    ;; Print that door number (i squared) is open
+    ;; These are exactly the doors with perfect square numbers: 1, 4, 9, ..., 100
+    print ["door" (i * i) "is open"]
+]

Task/100-doors/Rocq/100-doors-1.rocq

@@ -0,0 +1,26 @@
+Require Import List.
+
+Fixpoint rep {A} (a : A) n :=
+  match n with
+    | O => nil
+    | S n' => a::(rep a n')
+  end.
+
+Fixpoint flip (l : list bool) (n k : nat) : list bool :=
+  match l with
+    | nil => nil
+    | cons h t => match k with
+                | O => (negb h) :: (flip t n n)
+                | S k' => h :: (flip t n k')
+              end
+  end.
+
+Definition flipeach l n := flip l n n.
+
+Fixpoint flipwhile l n :=
+  match n with
+    | O => flipeach l 0
+    | S n' => flipwhile (flipeach l (S n')) n'
+  end.
+
+Definition prison cells := flipwhile (rep false cells) cells.

Task/100-doors/Rocq/100-doors-2.rocq

@@ -0,0 +1,13 @@
+Require Import List.
+
+Fixpoint prisoo' nd n k accu :=
+  match nd with
+    | O => rev accu
+    | S nd' => let ra := match k with
+                 | O => (true, S n, (n + n))
+                 | S k' => (false, n, k')
+               end in
+               prisoo' nd' (snd (fst ra)) (snd ra) ((fst (fst ra))::accu)
+  end.
+
+Definition prisoo cells := prisoo' cells 1 0 nil.

Task/100-doors/Rocq/100-doors-3.rocq

@@ -0,0 +1 @@
+Goal prison 100 = prisoo 100. compute. reflexivity. Qed.

Task/100-doors/Rocq/100-doors-4.rocq

@@ -0,0 +1 @@
+Goal forall n, prison n = prisoo n. Abort.

Task/100-doors/Rye/100-doors.rye

@@ -0,0 +1,8 @@
+replicate 100 { false }
+|walk\pos 'p {
+	.map\pos 'r { ::d ,
+		either r .is-multiple-of p { not d } { d } }
+	|at p }
+|map\pos 'p { .either { p } { false } }
+|filter { .is-integer }
+|for { .embed "Door {} is open." |print }

Task/100-doors/Scheme/100-doors-4.scm

@@ -0,0 +1,17 @@
+(define (doors-toggle door-state)
+  (define (doors-toggle-helper door-state num-doors step counter)
+    (cond ((> step num-doors) door-state)
+          ((> counter (1- num-doors))
+           (doors-toggle-helper door-state num-doors (1+ step) step))
+          (else (vector-set! door-state
+                             counter
+                             (not (array-ref door-state counter)))
+                (doors-toggle-helper door-state
+                                     num-doors
+                                     step
+                                     (+ step counter)))))
+  (let ((step 1)
+        (num-doors (vector-length door-state)))
+    (doors-toggle-helper door-state num-doors step (1- step))))
+
+(doors-toggle (make-vector 100 #f)) ;; #t is an open door, #f a closed one

Task/100-doors/Uiua/100-doors-1.uiua

@@ -0,0 +1,6 @@
+◿2/+=0⊞◿.+1⇡100
+         +1⇡100 # 1-100
+      ⊞◿.       # Mod each with 1-100
+    =0          # Find where mod = 0, aka the divisors
+  /+            # Sum to get num of divisors
+◿2              # Num divisors is odd

Task/100-doors/Uiua/100-doors-2.uiua

@@ -0,0 +1 @@
+⊜∘/≠±⊞◿..+1⇡100

Task/100-doors/Uiua/100-doors-3.uiua

@@ -0,0 +1 @@
+×.+1⇡⌊√ 100

Task/100-doors/VBScript/100-doors.vbs

@@ -0,0 +1,21 @@
+Dim doorIsOpen(100), pass, currentDoor, text
+
+For currentDoor = 0 To 99
+	doorIsOpen(currentDoor) = False
+Next
+
+For pass = 0 To 99
+	For currentDoor = pass To 99 Step pass + 1
+		doorIsOpen(currentDoor) = Not doorIsOpen(currentDoor)
+	Next
+Next
+
+For currentDoor = 0 To 99
+	text = "Door #" & currentDoor + 1 & " is "
+	If doorIsOpen(currentDoor) Then
+		text = text & "open."
+	Else
+		text = text & "closed."
+	End If
+	WScript.Echo(text)
+Next

Task/100-doors/VHDL/100-doors-1.vhd

@@ -0,0 +1,28 @@
+library IEEE;
+use IEEE.STD_LOGIC_1164.ALL;
+
+entity DOORS is
+	port (CLK: in std_logic; OUTPUT: out std_logic_vector(1 to 100));
+end DOORS;
+
+architecture Behavioral of DOORS is
+begin
+	process (CLK)
+	variable TEMP: std_logic_vector(1 to 100);
+	begin
+		--setup closed doors
+		TEMP := (others => '0');
+		
+		--looping through
+		for i in 1 to TEMP'length loop
+			for j in i to TEMP'length loop
+				if (j mod i) = 0 then
+					TEMP(j) := not TEMP(j);
+				end if;
+			end loop;
+		end loop;
+		
+		--assign output
+		OUTPUT <= TEMP;
+	end process;
+end Behavioral;

Task/100-doors/VHDL/100-doors-2.vhd

@@ -0,0 +1,34 @@
+LIBRARY ieee;
+USE ieee.std_logic_1164.all;
+
+
+entity doors is
+  port (
+        clk   : in std_logic;
+        reset : in std_logic;
+        door  : buffer std_logic_vector(1 to 100)
+        );
+end entity doors;
+
+
+architecture rtl of doors is
+  signal step : integer range 1 to 101;
+  signal addr : integer range 1 to 201;
+begin
+  proc_step: process(clk, reset)
+  begin
+    if reset = '1' then
+      step  <= 1;
+      addr  <= 1;
+      door <= (others => '0');
+    elsif rising_edge(clk) then
+      if addr <= 100 then
+        door(addr) <= not door(addr);
+        addr <= addr + step;
+      elsif step <= 100 then
+        addr <= step + 1;
+        step <= step + 1;
+      end if;
+    end if;
+  end process;
+end;

Task/100-prisoners/Ada/100-prisoners-1.adb

@@ -0,0 +1,23 @@
+package Prisoners is
+
+   type Win_Percentage is digits 2 range 0.0 .. 100.0;
+   type Drawers is array (1 .. 100) of Positive;
+
+   function Play_Game
+     (Repetitions : in Positive;
+      Strategy    :    not null access function
+        (Cupboard     : in Drawers; Max_Prisoners : Integer;
+         Max_Attempts :    Integer; Prisoner_Number : Integer) return Boolean)
+      return Win_Percentage;
+   -- Play the game with a specified number of repetitions, the chosen strategy
+   -- is passed to this function
+
+   function Optimal_Strategy
+     (Cupboard : in Drawers; Max_Prisoners : Integer; Max_Attempts : Integer;
+      Prisoner_Number :    Integer) return Boolean;
+
+   function Random_Strategy
+     (Cupboard : in Drawers; Max_Prisoners : Integer; Max_Attempts : Integer;
+      Prisoner_Number :    Integer) return Boolean;
+
+end Prisoners;

Task/100-prisoners/Ada/100-prisoners-2.adb

@@ -0,0 +1,128 @@
+pragma Ada_2012;
+with Ada.Numerics.Discrete_Random;
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body Prisoners is
+
+   subtype Drawer_Range is Positive range 1 .. 100;
+   package Random_Drawer is new Ada.Numerics.Discrete_Random (Drawer_Range);
+   use Random_Drawer;
+
+   -- Helper procedures to initialise and shuffle the drawers
+
+   procedure Swap (A, B : Positive; Cupboard : in out Drawers) is
+      Temp : Positive;
+   begin
+      Temp         := Cupboard (B);
+      Cupboard (B) := Cupboard (A);
+      Cupboard (A) := Temp;
+   end Swap;
+
+   procedure Shuffle (Cupboard : in out Drawers) is
+      G : Generator;
+   begin
+      Reset (G);
+      for I in Cupboard'Range loop
+         Swap (I, Random (G), Cupboard);
+      end loop;
+   end Shuffle;
+
+   procedure Initialise_Drawers (Cupboard : in out Drawers) is
+   begin
+      for I in Cupboard'Range loop
+         Cupboard (I) := I;
+      end loop;
+      Shuffle (Cupboard);
+   end Initialise_Drawers;
+
+   -- The two strategies for playing the game
+
+   function Optimal_Strategy
+     (Cupboard : in Drawers; Max_Prisoners : Integer; Max_Attempts : Integer;
+      Prisoner_Number :    Integer) return Boolean
+   is
+      Current_Card : Positive;
+   begin
+      Current_Card := Cupboard (Prisoner_Number);
+      if Current_Card = Prisoner_Number then
+         return True;
+      else
+         for I in Integer range 1 .. Max_Attempts loop
+            Current_Card := Cupboard (Current_Card);
+            if Current_Card = Prisoner_Number then
+               return True;
+            end if;
+         end loop;
+      end if;
+      return False;
+   end Optimal_Strategy;
+
+   function Random_Strategy
+     (Cupboard : in Drawers; Max_Prisoners : Integer; Max_Attempts : Integer;
+      Prisoner_Number :    Integer) return Boolean
+   is
+      Current_Card : Positive;
+      G            : Generator;
+   begin
+      Reset (G);
+      Current_Card := Cupboard (Prisoner_Number);
+      if Current_Card = Prisoner_Number then
+         return True;
+      else
+         for I in Integer range 1 .. Max_Attempts loop
+            Current_Card := Cupboard (Random (G));
+            if Current_Card = Prisoner_Number then
+               return True;
+            end if;
+         end loop;
+      end if;
+      return False;
+   end Random_Strategy;
+
+   function Prisoners_Attempts
+     (Cupboard : in Drawers; Max_Prisoners : Integer; Max_Attempts : Integer;
+      Strategy :    not null access function
+        (Cupboard     : in Drawers; Max_Prisoners : Integer;
+         Max_Attempts :    Integer; Prisoner_Number : Integer) return Boolean)
+      return Boolean
+   is
+   begin
+      for Prisoner_Number in Integer range 1 .. Max_Prisoners loop
+         if not Strategy
+             (Cupboard, Max_Prisoners, Max_Attempts, Prisoner_Number)
+         then
+            return False;
+         end if;
+      end loop;
+      return True;
+   end Prisoners_Attempts;
+
+   -- The function to play the game itself
+
+   function Play_Game
+     (Repetitions : in Positive;
+      Strategy    :    not null access function
+        (Cupboard     : in Drawers; Max_Prisoners : Integer;
+         Max_Attempts :    Integer; Prisoner_Number : Integer) return Boolean)
+      return Win_Percentage
+   is
+      Cupboard            : Drawers;
+      Win, Game_Count     : Natural          := 0;
+      Number_Of_Prisoners : constant Integer := 100;
+      Max_Attempts        : constant Integer := 50;
+   begin
+      loop
+         Initialise_Drawers (Cupboard);
+         if Prisoners_Attempts
+             (Cupboard     => Cupboard, Max_Prisoners => Number_Of_Prisoners,
+              Max_Attempts => Max_Attempts, Strategy => Strategy)
+         then
+            Win := Win + 1;
+         end if;
+         Game_Count := Game_Count + 1;
+         exit when Game_Count = Repetitions;
+      end loop;
+      return Win_Percentage ((Float (Win) / Float (Repetitions)) * 100.0);
+   end Play_Game;
+
+end Prisoners;

Task/100-prisoners/Ada/100-prisoners-3.adb

@@ -0,0 +1,17 @@
+with Prisoners;   use Prisoners;
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Main is
+   Wins : Win_Percentage;
+   package Win_Percentage_IO is new Float_IO (Win_Percentage);
+begin
+   Wins := Play_Game (100_000, Optimal_Strategy'Access);
+   Put ("Optimal Strategy = ");
+   Win_Percentage_IO.Put (Wins, 2, 2, 0);
+   Put ("%");
+   New_Line;
+   Wins := Play_Game (100_000, Random_Strategy'Access);
+   Put ("Random Strategy = ");
+   Win_Percentage_IO.Put (Wins, 2, 2, 0);
+   Put ("%");
+end Main;

Task/100-prisoners/C++/100-prisoners-2.cpp

@@ -0,0 +1,89 @@
+(ns clips-sandbox.prisoners)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 100 Prisoners Problem — CLIPS Implementation
+;; Implements the classical "loop strategy" and estimates success
+;; probability by simulation.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconstant NUM-PRISONERS 100)
+(defconstant NUM-BOXES 100)
+(defconstant MAX-OPENS 50)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Utility: shuffle a list (Fisher–Yates)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deffunction shuffle (?lst)
+  (bind ?n (length$ ?lst))
+  (while (> ?n 1) do
+    (bind ?k (+ 1 (random ?n)))
+    (bind ?tmp (nth$ ?n ?lst))
+    (bind ?lst (replace$ ?lst ?n ?n (nth$ ?k ?lst)))
+    (bind ?lst (replace$ ?lst ?k ?k ?tmp))
+    (bind ?n (- ?n 1)))
+  ?lst)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Create a random permutation of 1..100 representing box contents
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deffunction random-permutation ()
+  (shuffle (create$ 1 2 3 4 5 6 7 8 9 10
+                    11 12 13 14 15 16 17 18 19 20
+                    21 22 23 24 25 26 27 28 29 30
+                    31 32 33 34 35 36 37 38 39 40
+                    41 42 43 44 45 46 47 48 49 50
+                    51 52 53 54 55 56 57 58 59 60
+                    61 62 63 64 65 66 67 68 69 70
+                    71 72 73 74 75 76 77 78 79 80
+                    81 82 83 84 85 86 87 88 89 90
+                    91 92 93 94 95 96 97 98 99 100)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Prisoner loop strategy:
+;; Start at your own number, open that box, then follow the chain.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deffunction prisoner-succeeds (?id ?perm)
+  (bind ?next ?id)
+  (bind ?opens 0)
+  (while (< ?opens MAX-OPENS) do
+    (bind ?opens (+ ?opens 1))
+    (bind ?found (nth$ ?next ?perm))
+    (if (= ?found ?id) then
+      (return TRUE))
+    (bind ?next ?found))
+  FALSE)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Run one full trial: all prisoners must succeed
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deffunction run-trial ()
+  (bind ?perm (random-permutation))
+  (foreach ?p (create$ 1 to NUM-PRISONERS) do
+    (if (not (prisoner-succeeds ?p ?perm)) then
+      (return FALSE)))
+  TRUE)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Run many trials to estimate probability
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(deffunction simulate (?trials)
+  (bind ?wins 0)
+  (loop-for-count (?i 1 ?trials) do
+    (if (run-trial) then
+      (bind ?wins (+ ?wins 1))))
+  (printout t "Trials: " ?trials crlf)
+  (printout t "Successful trials: " ?wins crlf)
+  (printout t "Estimated probability: "
+               (/ (float ?wins) (float ?trials)) crlf))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Entry point
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(reset)
+(simulate 1000)

Task/100-prisoners/EasyLang/100-prisoners.easy

@@ -8,7 +8,7 @@ proc init .
 init
 proc shuffle_drawer .
    for i = len drawer[] downto 2
-      r = random i
+      r = random 1 i
       swap drawer[r] drawer[i]
    .
 .
@@ -16,7 +16,7 @@ func play_random .
    shuffle_drawer
    for prisoner = 1 to 100
       for i = 1 to 50
-         r = random (100 - i + 1)
+         r = random 1 (100 - i + 1)
          card = drawer[sampler[r]]
          swap sampler[r] sampler[100 - i + 1]
          if card = prisoner : break 1

Task/100-prisoners/Icon/100-prisoners.icon

@@ -0,0 +1,40 @@
+link "numbers"
+global lp	# lucky prisoner list
+global p        # starting prisoner list
+global pardoned # Count of trials with all prisoners pardoned
+
+procedure main(A)
+   n := \A[1] | 100
+   runs := \A[2] | 3000
+
+   write(runs," runs using ",n," prisoners.")
+   every (pardoned := 0, 1 to runs) do
+      runTrial(simplePrisoner, n)
+   write("Simple: ",fix(100*pardoned,runs,6,2),"%")
+   every (pardoned := 0, 1 to runs) do
+      runTrial(smartPrisoner, n)
+   write("Smart:  ",fix(100*pardoned,runs,6,2),"%")
+end
+
+procedure runTrial(pCode,n)
+   d := mkDrawers(n)
+   p := set([: 1 to n :])
+   lp := set()
+   every pCode(d, !p)
+   if *lp = n then pardoned +:= 1
+end
+
+procedure mkDrawers(n)
+   d := [: 1 to n :]
+   every !d :=: ?d
+   return d
+end
+
+procedure simplePrisoner(d, n)
+   every 1 to *d/2 do if n = (i := ?d) then break (insert(lp,n))
+end
+
+procedure smartPrisoner(d, n)
+   i := n
+   every 1 to *d/2 do if n = (i := d[i]) then break (insert(lp,n))
+end

Task/100-prisoners/Pluto/100-prisoners.pluto

@@ -0,0 +1,55 @@
+local fmt = require "fmt"
+require "table2"
+
+local function do_trials(trials, np, strategy)
+    local pardoned = 0
+    for _ = 1, trials do
+        local drawers = table.create(100)
+        for i = 1, 100 do drawers[i] = i end
+        drawers:shuffle()
+        local next_trial = false
+        for p = 1, np do
+            local next_prisoner = false
+            if strategy == "optimal" then
+                local prev = p
+                for __ = 1, 50 do
+                    local curr = drawers[prev]
+                    if curr == p then
+                        next_prisoner = true
+                        break
+                    end
+                    prev = curr
+                end
+            else
+                local opened = table.rep(100, false)
+                for ___ = 1, 50 do
+                    local n
+                    while true do
+                        n = math.random(100)
+                        if !opened[n] then
+                            opened[n] = true
+                            break
+                        end
+                    end
+                    if drawers[n] == p then
+                        next_prisoner = true
+                        break
+                    end
+                end
+            end
+            if !next_prisoner then
+                next_trial = true
+                break
+            end
+        end
+        if !next_trial then pardoned += 1 end
+    end
+    local rf = pardoned / trials * 100
+    fmt.print("  strategy = %-7s  pardoned = %,6s relative frequency = %5.2f%%\n", strategy, pardoned, rf)
+end
+
+local trials = 1e5
+for {10, 100} as np do
+    fmt.print("Results from %,s trials with %d prisoners:\n", trials, np)
+    for {"random", "optimal"} as strategy do do_trials(trials, np, strategy) end
+end

Task/100-prisoners/PowerShell/100-prisoners.ps1

@@ -0,0 +1,121 @@
+### Clear Screen from old Output
+Clear-Host
+
+Function RandomOpening ()
+  {
+    $Prisoners = 1..100 | Sort-Object {Get-Random}
+    $Cupboard = 1..100 | Sort-Object {Get-Random}
+    ## Loop for the Prisoners
+    $Survived = $true
+    for ($I=1;$I -le 100;$i++)
+      {
+          $OpeningListe = 1..100 | Sort-Object {Get-Random}
+          $Gefunden = $false
+          ## Loop for the trys of every prisoner
+          for ($X=1;$X -le 50;$X++)
+            {
+                $OpenNumber = $OpeningListe[$X]
+                IF ($Cupboard[$OpenNumber] -eq $Prisoners[$I])
+                  {
+                      $Gefunden = $true
+                  }
+                ## Cancel loop if prisoner found his number (yeah i know, dirty way ^^ )
+                IF ($Gefunden)
+                  {
+                    $X = 55
+                  }
+            }
+          IF ($Gefunden -eq $false)
+            {
+              $I = 120
+              $Survived = $false
+            }
+      }
+    Return $Survived
+  }
+
+  Function StrategyOpening ()
+  {
+    $Prisoners = 1..100 | Sort-Object {Get-Random}
+    $Cupboard = 1..100 | Sort-Object {Get-Random}
+    $Survived = $true
+    for ($I=1;$I -le 100;$i++)
+      {
+          $Gefunden = $false
+          $OpeningNumber = $Prisoners[$I-1]
+          for ($X=1;$X -le 50;$X++)
+            {
+                IF ($Cupboard[$OpeningNumber-1] -eq $Prisoners[$I-1])
+                  {
+                      $Gefunden = $true
+                  }
+                else
+                  {
+                    $OpeningNumber = $Cupboard[$OpeningNumber-1]
+                  }
+                IF ($Gefunden)
+                  {
+                    $X = 55
+                  }
+            }
+          IF ($Gefunden -eq $false)
+            {
+              $I = 120
+              $Survived = $false
+            }
+      }
+    Return $Survived
+  }
+
+$MaxRounds = 10000
+
+Function TestRandom
+  {
+    $WinnerRandom = 0
+    for ($Round = 1; $Round -le $MaxRounds;$Round++)
+      {
+        IF (($Round%1000) -eq 0)
+          {
+            $Time = Get-Date
+            Write-Host "Currently we are at rount $Round at $Time"
+          }
+        $Rueckgabewert = RandomOpening
+        IF ($Rueckgabewert)
+          {
+            $WinnerRandom++
+          }
+      }
+
+    $Prozent = (100/$MaxRounds)*$WinnerRandom
+    Write-Host "There are $WinnerRandom survivors whit random opening. This is $Prozent percent"
+  }
+
+Function TestStrategy
+  {
+    $WinnersStrategy = 0
+      for ($Round = 1; $Round -le $MaxRounds;$Round++)
+        {
+          IF (($Round%1000) -eq 0)
+            {
+              $Time = Get-Date
+              Write-Host "Currently we are at $Round at $Time"
+            }
+          $Rueckgabewert = StrategyOpening
+          IF ($Rueckgabewert)
+            {
+              $WinnersStrategy++
+            }
+        }
+
+    $Prozent = (100/$MaxRounds)*$WinnersStrategy
+    Write-Host "There are $WinnersStrategy survivors whit strategic opening. This is $Prozent percent"
+  }
+
+Function Main ()
+  {
+    Clear-Host
+    TestRandom
+    TestStrategy
+  }
+
+Main

Task/100-prisoners/Rebol/100-prisoners.rebol

@@ -0,0 +1,77 @@
+Rebol [
+	title: "Rosetta code: 100 prisoners"
+	file: %100_prisoners.r3
+	url: https://rosettacode.org/wiki/100_prisoners
+	needs: 3.0.0
+    note: "Based on Red language implementation!"
+]
+
+random/seed 1
+prisoners: 100                     ;; Total number of prisoners in the puzzle
+K_runs: 10000                      ;; Number of simulation runs to perform
+
+rand_arr: make block! prisoners         ;; Will hold the numbers 1..100
+repeat n prisoners [append rand_arr n]  ;; Fill rand_arr with [1 2 3 ... 100]
+
+;; --------------------------------------------------
+;; strat_optimal: "optimal" strategy from the puzzle
+;; Each prisoner starts at the locker with their own number,
+;; then follows the chain inside the lockers until they find their number
+;; or until they have opened 50 lockers.
+;; Returns TRUE if the prisoner finds their own number, FALSE otherwise.
+;; --------------------------------------------------
+strat_optimal: func [pris /local locker][
+    locker: pris                                    ;; Start at 'own-numbered' locker
+    loop 50 [
+        if Board/:locker = pris [ return true ]     ;; Found prisoner's number? -> success
+        locker: Board/:locker                       ;; Move to the locker whose number was inside
+    ]
+    false                                           ;; Not found within 50 tries -> fail
+]
+
+;; --------------------------------------------------
+;; strat_rand: "random" strategy
+;; Each prisoner picks a random permutation of lockers,
+;; then opens the first 50 in that random order, checking for their number.
+;; Returns TRUE if found, FALSE if not.
+;; --------------------------------------------------
+strat_rand: func [pris][
+    random rand_arr                                 ;; Randomize the locker opening order
+    repeat n 50 [
+        if Board/(rand_arr/:n) = pris [ return true ];; Check the nth randomly chosen locker
+    ]                                                ;; If found -> success
+    false                                            ;; Not found in 50 tries -> fail
+]
+
+;; --------------------------------------------------
+;; check_board: Runs a strategy for the entire set of prisoners
+;; Returns TRUE if *every prisoner* finds their number, FALSE if any fail.
+;; Argument 'strat' is the symbol 'optimal or 'rand
+;; --------------------------------------------------
+check_board: func [strat][
+    ;; Choose which strategy function to run
+    strat: either strat = 'optimal [:strat_optimal] [:strat_rand]
+
+    ;; Test each prisoner with the chosen strategy
+    repeat pris prisoners [
+        unless strat pris [return false]            ;; If any fail, run ends -> false
+    ]
+    true                                            ;; All prisoners succeeded -> true
+]
+
+saved: saved_rand: 0                                ;; Counters for the number of successful runs per strategy
+
+;; --------------------------------------------------
+;; Run the given number of simulations
+;; --------------------------------------------------
+loop K_runs [
+    Board: random copy rand_arr                     ;; Create a random locker arrangement for this run
+    if check_board 'optimal [saved: saved + 1]      ;; Attempt "optimal" strategy, count full successes
+    if check_board 'rand    [saved_rand: saved_rand + 1]  ;; Attempt "random" strategy, count full successes
+]
+
+;; At this point:
+;; - 'saved'       = number of runs where *all prisoners* survived using optimal strategy
+;; - 'saved_rand'  = number of runs where *all prisoners* survived using random strategy
+print ["runs" k_runs newline  "Percent saved opt.strategy:" saved * 100.0 / k_runs ]
+print ["Percent saved random strategy:" saved_rand * 100.0 / k_runs ]

Task/100-prisoners/VBScript/100-prisoners.vbs

@@ -0,0 +1,62 @@
+option explicit
+const npris=100
+const ntries=50
+const ntests=1000.
+dim drawer(100),opened(100),i
+for i=1 to npris: drawer(i)=i:next
+shuffle drawer
+wscript.echo rf(tests(false)/ntests*100,10," ")  &" % success for random"
+wscript.echo rf(tests(true) /ntests*100,10," ")  &" % success for optimal strategy"
+
+function rf(v,n,s) rf=right(string(n,s)& v,n):end function
+
+sub shuffle(d) 'knut's shuffle
+dim i,j,t
+randomize timer
+for i=1 to npris
+   j=int(rnd()*i+1)
+   t=d(i):d(i)=d(j):d(j)=t
+next
+end sub
+
+function tests(strat)
+dim cntp,i,j
+tests=0
+for i=1 to ntests
+  shuffle drawer
+  cntp=0
+  if strat then
+      for j=1 to npris
+	if not trystrat(j) then exit for
+      next
+  else		
+     for j=1 to npris
+       if not tryrand(j) then exit for
+     next
+  end if
+  if j>=npris then tests=tests+1
+next
+end function
+	
+function tryrand(pris)
+  dim i,r
+	erase opened
+  for i=1 to ntries
+    do
+      r=int(rnd*npris+1)
+    loop until opened(r)=false
+    opened(r)=true
+    if drawer(r)= pris then tryrand=true : exit function
+  next
+  tryrand=false
+end function
+
+function trystrat(pris)
+  dim i,r
+  r=pris
+  for i=1 to ntries
+    if drawer(r)= pris then trystrat=true	:exit function
+    r=drawer(r)
+  next
+  trystrat=false
+end function	

Task/15-puzzle-game/Ada/15-puzzle-game-1.adb

@@ -0,0 +1,16 @@
+generic
+   Rows, Cols: Positive;
+   with function Name(N: Natural) return String; -- with Pre => (N < Rows*Cols);
+   -- Name(0) shall return the name for the empty tile
+package Generic_Puzzle is
+
+   subtype Row_Type is Positive range 1 .. Rows;
+   subtype Col_Type is Positive range 1 .. Cols;
+   type Moves is (Up, Down, Left, Right);
+   type Move_Arr is array(Moves) of Boolean;
+
+   function Get_Point(Row: Row_Type; Col: Col_Type) return String;
+   function Possible return Move_Arr;
+   procedure Move(The_Move: Moves);
+
+end Generic_Puzzle;

Task/15-puzzle-game/Ada/15-puzzle-game-2.adb

@@ -0,0 +1,57 @@
+package body Generic_Puzzle is
+
+   Field: array(Row_Type, Col_Type) of Natural;
+   Current_R: Row_Type := Rows;
+   Current_C: Col_Type := Cols;
+   -- invariant: Field(Current_R, Current_C=0)
+   -- and for all R, C: Field(R, C) < R*C
+   -- and for all (R, C) /= (RR, CC): Field(R, C) /= Field(RR, CC)
+
+   function Get_Point(Row: Row_Type; Col: Col_Type) return String is
+      (Name(Field(Row, Col)));
+
+   function Possible return Move_Arr is
+      (Up => Current_R > 1, Down => Current_R < Rows,
+       Left => Current_C > 1, Right => Current_C < Cols);
+
+   procedure Move(The_Move: Moves) is
+      Old_R: Row_Type; Old_C: Col_Type; N: Natural;
+   begin
+      if not Possible(The_Move) then
+	 raise Constraint_Error with "attempt to make impossible move";
+      else
+	 -- remember current row and column
+	 Old_R := Current_R;
+	 Old_C := Current_C;
+	
+	 -- move the virtual cursor to a new position
+	 case The_Move is
+	   when Up    => Current_R := Current_R - 1;
+	   when Down  => Current_R := Current_R + 1;
+	   when Left  => Current_C := Current_C - 1;
+	   when Right => Current_C := Current_C + 1;
+	 end case;
+	
+	 -- swap the tiles on the board
+	 N := Field(Old_R, Old_C);
+	 Field(Old_R, Old_C) := Field(Current_R, Current_C);
+	 Field(Current_R, Current_C) := N;
+      end if;
+   end Move;
+
+begin
+   declare   -- set field to its basic setting
+      N: Positive := 1;
+   begin
+      for R in Row_Type loop
+	 for C in Col_Type loop
+	    if (R /= Current_R) or else (C /= Current_C) then
+	       Field(R, C) := N;
+	       N := N + 1;
+	    else
+	       Field(R, C) := 0;
+	    end if;
+	 end loop;
+      end loop;
+   end;
+end Generic_Puzzle;

Task/15-puzzle-game/Ada/15-puzzle-game-3.adb

@@ -0,0 +1,72 @@
+with Generic_Puzzle, Ada.Text_IO,
+     Ada.Numerics.Discrete_Random, Ada.Command_Line;
+
+procedure Puzzle_15 is
+
+   function Image(N: Natural) return String is
+      (if N=0 then "   " elsif N < 10 then " " & Integer'Image(N)
+	else Integer'Image(N));
+	
+   package Puzzle is new Generic_Puzzle(Rows => 4, Cols => 4, Name => Image);
+
+   package Rnd is new Ada.Numerics.Discrete_Random(Puzzle.Moves);
+   Rand_Gen: Rnd.Generator;
+
+   Level: Natural := (if Ada.Command_Line.Argument_Count = 0 then 10
+                      else Natural'Value(Ada.Command_Line.Argument(1)));
+   Initial_Moves: Natural := (2**(Level/2) + 2**((1+Level)/2))/2;
+   Texts: constant array(Puzzle.Moves) of String(1..9) :=
+       ("u,U,^,8: ", "d,D,v,2: ", "l,L,<,4: ", "r,R,>,6: ");
+   Move_Counter: Natural := 0;
+   Command: Character;
+
+ begin
+    -- randomize board
+    for I in 1 .. Initial_Moves loop
+       declare
+	  M: Puzzle.Moves := Rnd.Random(Rand_Gen);
+       begin
+	  if Puzzle.Possible(M) then
+	     Puzzle.Move(M);
+	  end if;
+       end;
+    end loop;
+
+    -- read command and perform move	
+    loop
+      -- Print board
+      for R in Puzzle.Row_Type loop
+	 for C in Puzzle.Col_Type loop
+	    Ada.Text_IO.Put(Puzzle.Get_Point(R, C));
+	 end loop;
+	 Ada.Text_IO.New_Line;
+      end loop;
+      Ada.Text_IO.Get(Command);
+      begin
+	 case Command is
+	    when 'u' | 'U' | '^' | '8' =>
+	       Ada.Text_IO.Put_Line("Up!"); Puzzle.Move(Puzzle.Up);
+	    when 'd' | 'D' | 'v' | '2' =>
+	       Ada.Text_IO.Put_Line("Down!"); Puzzle.Move(Puzzle.Down);
+	    when 'l' | 'L' | '<' | '4' =>
+	       Ada.Text_IO.Put_Line("Left!"); Puzzle.Move(Puzzle.Left);
+	    when 'r' | 'R' | '>' | '6' =>
+	       Ada.Text_IO.Put_Line("Right!"); Puzzle.Move(Puzzle.Right);
+	    when '!' =>
+	       Ada.Text_IO.Put_Line(Natural'Image(Move_Counter) & " moves!");
+	       exit;
+	    when others =>
+	       raise Constraint_Error with "wrong input";
+	 end case;
+	 Move_Counter := Move_Counter + 1;
+      exception when Constraint_Error =>
+	 Ada.Text_IO.Put_Line("Possible Moves and Commands:");
+	 for M in Puzzle.Moves loop
+	    if Puzzle.Possible(M) then
+	       Ada.Text_IO.Put(Texts(M) & Puzzle.Moves'Image(M) & "   ");
+	    end if;
+	 end loop;
+	 Ada.Text_IO.Put_Line("!: Quit");
+      end;
+   end loop;
+end Puzzle_15;

Task/15-puzzle-game/Ada/15-puzzle-game-4.adb

@@ -0,0 +1 @@
+   package Puzzle is new Generic_Puzzle(Rows => 3, Cols => 3, Name => Image);

Task/15-puzzle-game/COBOL/15-puzzle-game.cob

@@ -0,0 +1,151 @@
+         >>SOURCE FORMAT FREE
+*> This code is dedicated to the public domain
+*> This is GNUCOBOL 2.0
+identification division.
+program-id. fifteen.
+environment division.
+configuration section.
+repository. function all intrinsic.
+data division.
+working-storage section.
+
+01  r pic 9.
+01  r-empty pic 9.
+01  r-to pic 9.
+01  r-from pic 9.
+
+01  c pic 9.
+01  c-empty pic 9.
+01  c-to pic 9.
+01  c-from pic 9.
+
+01  display-table.
+    03  display-row occurs 4.
+        05  display-cell occurs 4 pic 99.
+
+01  tile-number pic 99.
+01  tile-flags pic x(16).
+
+01  display-move value spaces.
+    03  tile-id pic 99.
+
+01  row-separator pic x(21) value all '.'.
+01  column-separator pic x(3) value ' . '.
+
+01  inversions pic 99.
+01  current-tile pic 99.
+
+01  winning-display pic x(32) value
+        '01020304'
+    &   '05060708'
+    &   '09101112'
+    &   '13141500'.
+
+procedure division.
+start-fifteen.
+    display 'start fifteen puzzle'
+    display '    enter a two-digit tile number and press <enter> to move'
+    display '    press <enter> only to exit'
+
+    *> tables with an odd number of inversions are not solvable
+    perform initialize-table with test after until inversions = 0
+    perform show-table
+    accept display-move
+    perform until display-move = spaces
+        perform move-tile
+        perform show-table
+        move spaces to display-move
+        accept display-move
+    end-perform
+    stop run
+    .
+initialize-table.
+    compute tile-number = random(seconds-past-midnight) *> seed only
+    move spaces to tile-flags
+    move 0 to current-tile inversions
+    perform varying r from 1 by 1 until r > 4
+    after c from 1 by 1 until c > 4
+        perform with test after
+        until tile-flags(tile-number + 1:1) = space
+            compute tile-number = random() * 100
+            compute tile-number = mod(tile-number, 16)
+        end-perform
+        move 'x' to tile-flags(tile-number + 1:1)
+        if tile-number > 0 and < current-tile
+            add 1 to inversions
+        end-if
+        move tile-number to display-cell(r,c) current-tile
+    end-perform
+    compute inversions = mod(inversions,2)
+    .
+show-table.
+    if display-table = winning-display
+        display 'winning'
+    end-if
+    display space row-separator
+    perform varying r from 1 by 1 until r > 4
+        perform varying c from 1 by 1 until c > 4
+            display column-separator with no advancing
+            if display-cell(r,c) = 00
+                display '  ' with no advancing
+                move r to r-empty
+                move c to c-empty
+            else
+                display display-cell(r,c) with no advancing
+            end-if
+        end-perform
+        display column-separator
+    end-perform
+    display space row-separator
+    .
+move-tile.
+    if not (tile-id numeric and tile-id >= 01 and <= 15)
+        display 'invalid tile number'
+        exit paragraph
+    end-if
+
+    *> find the entered tile-id row and column (r,c)
+    perform varying r from 1 by 1 until r > 4
+    after c from 1 by 1 until c > 4
+        if display-cell(r,c) = tile-id
+            exit perform
+        end-if
+    end-perform
+
+    *> show-table filled (r-empty,c-empty)
+    evaluate true
+    when r = r-empty
+        if c-empty < c
+            *> shift left
+            perform varying c-to from c-empty by 1 until c-to > c
+                compute c-from = c-to + 1
+                move display-cell(r-empty,c-from) to display-cell(r-empty,c-to)
+            end-perform
+        else
+           *> shift right
+           perform varying c-to from c-empty by -1 until c-to < c
+               compute c-from = c-to - 1
+               move display-cell(r-empty,c-from) to display-cell(r-empty,c-to)
+           end-perform
+       end-if
+       move 00 to display-cell(r,c)
+    when c = c-empty
+        if r-empty < r
+            *>shift up
+            perform varying r-to from r-empty by 1 until r-to > r
+                compute r-from = r-to + 1
+                move display-cell(r-from,c-empty) to display-cell(r-to,c-empty)
+            end-perform
+        else
+            *> shift down
+            perform varying r-to from r-empty by -1 until r-to < r
+                compute r-from = r-to - 1
+                move display-cell(r-from,c-empty) to display-cell(r-to,c-empty)
+            end-perform
+        end-if
+        move 00 to display-cell(r,c)
+    when other
+         display 'invalid move'
+    end-evaluate
+    .
+end program fifteen.

Task/15-puzzle-game/EasyLang/15-puzzle-game.easy

@@ -35,7 +35,7 @@ proc init .
    for i = 1 to 16 : f[i] = i
    # shuffle
    for i = 15 downto 2
-      r = random i
+      r = random 1 i
       swap f[r] f[i]
    .
    # make it solvable

Task/15-puzzle-game/FuncSug/15-puzzle-game-1.funcsug

@@ -0,0 +1,33 @@
+#---------------
+# Prepare game
+#---------------
+# 'import' imports from JavaScript code
+var buttonList := import('buttonList')
+var emptyButton := import('emptyButton')
+
+#---------------
+# Shuffle cards
+#---------------
+repeat 100:
+	var adj := calljs getAdjacentButtons(emptyButton)
+	var button := calljs randomChoose(adj)
+	waitSeconds(0)
+	calljs exchange(button, emptyButton)
+	emptyButton := button
+
+#---------------
+# Play
+#---------------
+while not (calljs isOrdered(buttonList)):
+	var adj := listToPar(calljs getAdjacentButtons(emptyButton))
+	parallel(for button in adj, select 1):
+		select:
+			awaitClickBeep(button)
+		do:
+			calljs exchange(button, emptyButton)
+			emptyButton := button
+
+#----------
+# Success
+#----------
+displayNewMessage('Congratulations! You succeeded!')

Task/15-puzzle-game/FuncSug/15-puzzle-game-2.funcsug

@@ -0,0 +1,53 @@
+const $ = document.getElementById.bind(document)
+
+// Parameters
+//------------
+const width = 4
+const height = 4
+const size = width*height-1
+
+// Make cards
+//------------
+const gameTable = $('gameTable')
+gameTable.style.gridTemplateColumns = 'repeat(' + width + ', 60px)'
+for (let i=0; i<size; i++) {
+	gameTable.innerHTML += '<button id="' + i + '" disabled>' + (i+1) + '</button>'
+}
+gameTable.innerHTML += '<button id="' + size + '" disabled></button>'
+const buttonList = document.querySelectorAll('#gameTable > button')
+const emptyButton = $(''+size)
+
+// Utils functions
+//-----------------
+function idToXy(id) {
+	return [id%width, Math.floor(id/width)]
+}
+
+function xyToId(x,y) {
+	return '' + (width*y + x)
+}
+
+function getAdjacentButtons(button) {
+	const [x,y] = idToXy(button.id)
+	const inTheXFrame = n=>(0<=n && n <width)
+	const inTheYFrame = n=>(0<=n && n <height)
+	const coordToButton = coord => $(xyToId(coord[0],coord[1]))
+	const horizAdj = [x-1,x+1].filter(inTheXFrame).map(e=>[e,y])
+	const verticAdj = [y-1,y+1].filter(inTheYFrame).map(e=>[x,e])
+	return [...horizAdj, ...verticAdj].map( coordToButton )
+}
+
+function exchange(button, empty) {
+	empty.innerHTML = button.innerHTML
+	button.innerHTML = ''
+}
+
+function randomChoose(array) {
+	const index = Math.floor(Math.random()*array.length)
+	return array[index]
+}
+
+function isOrdered(buttonList) {
+	const isAtRightPlace = button=>(button.innerHTML=='' || button.innerHTML==(1*button.id+1))
+	return Array.from(buttonList).every(isAtRightPlace)
+}

Task/15-puzzle-game/FuncSug/15-puzzle-game-3.funcsug

@@ -0,0 +1,13 @@
+#gameTable {
+	display: inline-grid;
+	row-gap: 10px;
+}
+
+#gameTable > button {
+	width: 50px;
+	height: 50px;
+}
+
+#gameTable > button:empty {
+	visibility: hidden;
+}

Task/15-puzzle-game/PowerShell/15-puzzle-game.ps1

@@ -0,0 +1,259 @@
+#15 Puzzle Game
+$Script:Neighbours = @{
+    "1" = @("2","5")
+    "2" = @("1","3","6")
+    "3" = @("2","4","7")
+    "4" = @("3","8")
+    "5" = @("1","6","9")
+    "6" = @("2","5","7","10")
+    "7" = @("3","6","8","11")
+    "8" = @("4","7","12")
+    "9" = @("5","10","13")
+    "10" = @("6","9","11","14")
+    "11" = @("7","10","12","15")
+    "12" = @("8","11","0")
+    "13" = @("9","14")
+    "14" = @("10","13","15")
+    "15" = @("11","14","0")
+    "0" = @("12","15")
+}
+$script:blank = ''
+#region XAML window definition
+$xaml = @'
+<Window
+   xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
+   xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
+   xmlns:d="http://schemas.microsoft.com/expression/blend/2008" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="d"
+   MinWidth="200"
+   Width ="333.333"
+   Title="15 Game"
+   Topmost="True" Height="398.001" VerticalAlignment="Center" HorizontalAlignment="Center">
+    <Grid HorizontalAlignment="Center" Height="285" Margin="0" VerticalAlignment="Center" Width="300">
+        <Grid.ColumnDefinitions>
+            <ColumnDefinition/>
+            <ColumnDefinition/>
+            <ColumnDefinition/>
+            <ColumnDefinition/>
+        </Grid.ColumnDefinitions>
+        <Grid.RowDefinitions>
+            <RowDefinition/>
+            <RowDefinition/>
+            <RowDefinition/>
+            <RowDefinition/>
+        </Grid.RowDefinitions>
+        <Button x:Name="B_1" Content="01" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24"/>
+        <Button x:Name="B_2" Content="02" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="1"/>
+        <Button x:Name="B_3" Content="03" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="2"/>
+        <Button x:Name="B_4" Content="04" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="3"/>
+        <Button x:Name="B_5" Content="05" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Row="1"/>
+        <Button x:Name="B_6" Content="06" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="1" Grid.Row="1"/>
+        <Button x:Name="B_7" Content="07" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="2" Grid.Row="1"/>
+        <Button x:Name="B_8" Content="08" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="3" Grid.Row="1"/>
+        <Button x:Name="B_9" Content="09" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Margin="0,71,0,0" Grid.Row="1" Grid.RowSpan="2"/>
+        <Button x:Name="B_10" Content="10" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="1" Grid.Row="1" Margin="0,71,0,0" Grid.RowSpan="2"/>
+        <Button x:Name="B_11" Content="11" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="2" Grid.Row="1" Margin="0,71,0,0" Grid.RowSpan="2"/>
+        <Button x:Name="B_12" Content="12" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="3" Grid.Row="1" Margin="0,71,0,0" Grid.RowSpan="2"/>
+        <Button x:Name="B_13" Content="13" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Margin="0,71,0,0" Grid.Row="2" Grid.RowSpan="2"/>
+        <Button x:Name="B_14" Content="14" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="1" Grid.Row="2" Margin="0,71,0,0" Grid.RowSpan="2"/>
+        <Button x:Name="B_15" Content="15" HorizontalAlignment="Center" VerticalAlignment="Center" Width="75" Height="72" FontSize="24" Grid.Column="2" Grid.Row="2" Margin="0,71,0,0" Grid.RowSpan="2"/>
+        <Button x:Name="B_0" Content="00" HorizontalAlignment="Left" VerticalAlignment="Top" Width="75" Height="72" FontSize="24" Grid.Column="3" Grid.Row="2" Margin="0,71,0,0" Grid.RowSpan="2"/>
+        <Button x:Name="B_Jumble" Grid.ColumnSpan="2" Content="Jumble Tiles" Grid.Column="1" HorizontalAlignment="Left" Height="23" Margin="0,81,0,-33" Grid.Row="3" VerticalAlignment="Top" Width="150"/>
+    </Grid>
+</Window>
+'@
+#endregion
+
+#region Code Behind
+function Convert-XAMLtoWindow
+{
+    param
+    (
+        [Parameter(Mandatory=$true)]
+        [string]
+        $XAML
+    )
+
+    Add-Type -AssemblyName PresentationFramework
+
+    $reader = [XML.XMLReader]::Create([IO.StringReader]$XAML)
+    $result = [Windows.Markup.XAMLReader]::Load($reader)
+    $reader.Close()
+    $reader = [XML.XMLReader]::Create([IO.StringReader]$XAML)
+    while ($reader.Read())
+    {
+        $name=$reader.GetAttribute('Name')
+        if (!$name) { $name=$reader.GetAttribute('x:Name') }
+        if($name)
+        {$result | Add-Member NoteProperty -Name $name -Value $result.FindName($name) -Force}
+    }
+    $reader.Close()
+    $result
+}
+function Show-WPFWindow
+{
+    param
+    (
+        [Parameter(Mandatory=$true)]
+        [Windows.Window]
+        $Window
+    )
+
+    $result = $null
+    $null = $window.Dispatcher.InvokeAsync{
+        $result = $window.ShowDialog()
+        Set-Variable -Name result -Value $result -Scope 1
+    }.Wait()
+    $result
+}
+#endregion Code Behind
+
+#region Convert XAML to Window
+$window = Convert-XAMLtoWindow -XAML $xaml
+
+#endregion
+
+#region Define Event Handlers
+function Test-Victory{
+    #Evaluate if all the labels are in the correct position
+    $victory = $true
+    foreach($num in 1..15){
+        if([int]$window."b_$num".Content -ne $num){$victory = $false;break}
+    }
+    return($victory)
+}
+function Test-Move($Number){
+    #Number is a string of the pressed button number.
+    if($Script:Neighbours[$Number] -contains $script:blank){
+        return($true)
+    } else {
+        return($false)
+    }
+}
+Function Move-Tile($Number,$Bypass){
+    if((!(Test-Victory)) -or $Bypass){
+        if(Test-Move $Number){
+            #Set the new window label
+            $window."B_$script:blank".content = $window."B_$Number".content
+            $window."B_$script:blank".background = $window."B_$Number".background
+            $window."B_$Number".background = "#FFDDDDDD"
+            #Set the new blank window label
+            $window."B_$Number".content = ''
+            #Enable the old blank tile
+            $window."B_$script:blank".isenabled = $true
+            #disable the new blank tile
+            $window."B_$Number".isenabled = $false
+            #set the new blank
+            $script:blank = $Number
+        }
+    }
+}
+function Move-TileRandom{
+    $lastmove = "1"
+    for($i=0;$i -lt 500;$i++){
+        $move = $Script:Neighbours[$script:blank] | Where-Object {$_ -ne $lastmove} | Get-Random
+        $lastmove = $move
+        Move-Tile $move $true
+    }
+}
+function Set-TileColour($Tile){
+    #I was curious about setting tiles to a checkerboard pattern at this stage. It's probably far better to just define it in the xaml
+    #Ignore the blank tile
+    if($Tile -ne 0){
+        #check if the row of the tile is odd or even
+        if((([math]::floor(($Tile - 1)/4)) % 2 -eq 0)){
+            #check if the tile is odd or even
+            if($Tile % 2 -eq 0){
+                $window."B_$Tile".Background = "#FFFF7878"
+            } else {
+                $window."B_$Tile".Background = "#FF9696FF"
+            }
+        }else{
+            if($Tile % 2 -eq 0){
+                $window."B_$Tile".Background = "#FF9696FF"
+            } else {
+                $window."B_$Tile".Background = "#FFFF7878"
+            }
+        }
+    } else {
+        $window.B_0.Background = "#FFDDDDDD"
+    }
+}
+$window.B_1.add_Click{
+    $n = "1"
+    move-tile $n
+}
+$window.B_2.add_Click{
+    $n = "2"
+    move-tile $n
+}
+$window.B_3.add_Click{
+    $n = "3"
+    move-tile $n
+}
+$window.B_4.add_Click{
+    $n = "4"
+    move-tile $n
+}
+$window.B_5.add_Click{
+    $n = "5"
+    move-tile $n
+}
+$window.B_6.add_Click{
+    $n = "6"
+    move-tile $n
+}
+$window.B_7.add_Click{
+    $n = "7"
+    move-tile $n
+}
+$window.B_8.add_Click{
+    $n = "8"
+    move-tile $n
+}
+$window.B_9.add_Click{
+    $n = "9"
+    move-tile $n
+}
+$window.B_10.add_Click{
+    $n = "10"
+    move-tile $n
+}
+$window.B_11.add_Click{
+    $n = "11"
+    move-tile $n
+}
+$window.B_12.add_Click{
+    $n = "12"
+    move-tile $n
+}
+$window.B_13.add_Click{
+    $n = "13"
+    move-tile $n
+}
+$window.B_14.add_Click{
+    $n = "14"
+    move-tile $n
+}
+$window.B_15.add_Click{
+    $n = "15"
+    move-tile $n
+}
+$window.B_0.add_Click{
+    $n = "0"
+    move-tile $n
+}
+
+$window.B_Jumble.add_Click{
+    Move-TileRandom
+}
+#endregion Event Handlers
+(([math]::floor(("9" - 1)/4)) % 2 -eq 0)
+#region Manipulate Window Content
+#initial processing of tiles
+$array = 0..15 | ForEach-Object {"{0:00}" -f $_}
+0..15 | ForEach-Object {if($array[$_] -ne '00'){$window."B_$_".content = $array[$_]} else {$window."B_$_".content = '';$script:blank = "$_";$window."B_$_".isenabled = $false};Set-TileColour $_}
+#Shove them around a bit
+Move-TileRandom
+#endregion
+# Show Window
+$result = Show-WPFWindow -Window $window

Task/15-puzzle-game/Rebol/15-puzzle-game.rebol

@@ -0,0 +1,6 @@
+rebol []  random/seed now  g: [style t box red [
+  if not find [0x108 108x0 0x-108 -108x0] face/offset - e/offset [exit]
+  x: face/offset face/offset: e/offset e/offset: x] across
+] x: random repeat i 15 [append x:[] i]  repeat i 15 [
+  repend g ['t mold x/:i random white] if find [4 8 12] i [append g 'return]
+] append g [e: box]  view layout g

Task/15-puzzle-game/VBScript/15-puzzle-game.vbs

@@ -0,0 +1,108 @@
+'----------------15 game-------------------------------------
+'WARNING: this script uses ANSI escape codes to position items on console so
+'it won't work in Windows from XP to 8.1 where Microsoft removed ANSI support...
+'Windows 10, 11 or 98 are ok!!!
+
+option explicit
+const maxshuffle=100 'level
+
+dim ans0:ans0=chr(27)&"["
+dim anscls:anscls=ans0 & "2J"
+
+dim dirs:dirs=array(6,-1,-6,1)
+dim a:a=array(-1,-1,-1,-1,-1,-1,_
+              -1, 1, 2, 3, 4,-1,_
+              -1, 5, 6, 7, 8,-1,_
+              -1, 9,10,11,12,-1,_
+              -1,13,14,15, 0,-1,_
+              -1,-1,-1,-1,-1,-1)
+dim b(35)
+dim pos0
+dim s:s=Array("W+Enter: up   Z+Enter: down  A+Enter: left   S+Enter right ",_
+              "Bad move!!                                                 ",_
+	      "You did it! Another game? [y/n]+Enter                      ",_
+	      "Bye!                                                       ")
+
+
+do
+  shuffle
+  draw
+  toxy 10,1,s(0)
+  do
+   if usr(wait()) then
+     draw
+     toxy 10,1,s(0)
+   else 	
+     toxy 10,1,s(1)
+   end if
+  loop until checkend
+  toxy 10,1,s(2)
+loop until wait()="n"
+toxy 10,1,s(3)
+
+function wait():
+ toxy 11,1,"":
+ wait=left(lcase(wscript.stdin.readline),1):	
+end function
+
+sub toxy(x,y,s)
+ wscript.StdOut.Write ans0 & x & ";" & y & "H"& " "& s
+end sub
+
+sub draw
+  dim i,j
+  wscript.stdout.write anscls
+  for i=0 to 3 'row
+    for j=0 to 3  'col
+      toxy (j*2)+2,(i*3)+3,iif(b(j*6+i+7)<>0,b(j*6+i+7)," ")
+    next
+  next
+  toxy 10,1,""
+end sub
+
+
+function checkend
+  dim i
+  for i=0 to ubound(a)
+   if (b(i)<>a(i)) then checkend=false : exit function
+  next
+  checkend=true
+end function	
+
+function move(d)
+ dim p1
+ p1=pos0+d
+ if b(p1) <>-1 then
+    b(pos0)=b(p1):
+    b(p1)=0:
+    pos0=p1:
+    move=true
+ else
+   move=false
+ end if
+end function
+
+sub shuffle
+  dim cnt,r,i
+   randomize timer
+   for i=0 to ubound(a):b(i)=a(i):next
+   pos0=28
+   cnt=0
+   do
+     r=int(rnd*4)
+     if move(dirs(r))=true then cnt=cnt+1
+   loop until cnt=maxshuffle
+end sub	
+
+function iif(a,b,c): if a then iif=b else iif=c end if:end function			
+
+function usr(a)
+  dim d
+  select case lcase(a)
+  case "w" :d=-6
+  case "z" :d=6
+  case "a" :d=-1
+  case "s" :d=1
+  end select
+  usr= move(d)
+end function	

Task/15-puzzle-solver/Ada/15-puzzle-solver.adb

@@ -0,0 +1,192 @@
+with Ada.Text_IO;
+
+procedure Puzzle_15 is
+
+   type Direction is (Up, Down, Left, Right);
+   type Row_Type is range 0 .. 3;
+   type Col_Type is range 0 .. 3;
+   type Tile_Type is range 0 .. 15;
+
+   To_Col : constant array (Tile_Type) of Col_Type :=
+     (3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2);
+   To_Row : constant array (Tile_Type) of Row_Type :=
+     (3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3);
+
+   type Board_Type is array (Row_Type, Col_Type) of Tile_Type;
+
+   Solved_Board : constant Board_Type :=
+     ((1,   2,  3,  4),
+      (5,   6,  7,  8),
+      (9,  10, 11, 12),
+      (13, 14, 15, 0));
+
+   type Try_Type is
+      record
+         Board : Board_Type;
+         Move  : Direction;
+         Cost  : Integer;
+         Row   : Row_Type;
+         Col   : Col_Type;
+      end record;
+
+   Stack : array (0 .. 100) of Try_Type;
+   Top             : Natural := 0;
+   Iteration_Count : Natural := 0;
+
+   procedure Move_Down is
+      Board   : Board_Type         := Stack (Top).Board;
+      Row     : constant Row_Type  := Stack (Top).Row;
+      Col     : constant Col_Type  := Stack (Top).Col;
+      Tile    : constant Tile_Type := Board (Row + 1, Col);
+      Penalty : constant Integer   :=
+        (if To_Row (Tile) <= Row then 0 else 1);
+   begin
+      Board (Row,     Col) := Tile;
+      Board (Row + 1, Col) := 0;
+      Stack (Top + 1) := (Board => Board,
+                          Move  => Down,
+                          Row   => Row + 1,
+                          Col   => Col,
+                          Cost  => Stack (Top).Cost + Penalty);
+   end Move_Down;
+
+   procedure Move_Up is
+      Board   : Board_Type         := Stack (Top).Board;
+      Row     : constant Row_Type  := Stack (Top).Row;
+      Col     : constant Col_Type  := Stack (Top).Col;
+      Tile    : constant Tile_Type := Board (Row - 1, Col);
+      Penalty : constant Integer   :=
+        (if To_Row (Tile) >= Row then 0 else 1);
+   begin
+      Board (Row,     Col) := Tile;
+      Board (Row - 1, Col) := 0;
+      Stack (Top + 1) := (Board => Board,
+                          Move  => Up,
+                          Row   => Row - 1,
+                          Col   => Col,
+                          Cost  => Stack (Top).Cost + Penalty);
+   end Move_Up;
+
+   procedure Move_Left is
+      Board   : Board_Type         := Stack (Top).Board;
+      Row     : constant Row_Type  := Stack (Top).Row;
+      Col     : constant Col_Type  := Stack (Top).Col;
+      Tile    : constant Tile_Type := Board (Row, Col - 1);
+      Penalty : constant Integer :=
+        (if To_Col (Tile) >= Col then 0 else 1);
+   begin
+      Board (Row, Col)     := Tile;
+      Board (Row, Col - 1) := 0;
+      Stack (Top + 1) := (Board => Board,
+                          Move  => Left,
+                          Row   => Row,
+                          Col   => Col - 1,
+                          Cost  => Stack (Top).Cost + Penalty);
+   end Move_Left;
+
+   procedure Move_Right is
+      Board   : Board_Type         := Stack (Top).Board;
+      Row     : constant Row_Type  := Stack (Top).Row;
+      Col     : constant Col_Type  := Stack (Top).Col;
+      Tile    : constant Tile_Type := Board (Row, Col + 1);
+      Penalty : constant Integer :=
+        (if To_Col (Tile) <= Col then 0 else 1);
+   begin
+      Board (Row, Col)     := Tile;
+      Board (Row, Col + 1) := 0;
+      Stack (Top + 1) := (Board => Board,
+                          Move  => Right,
+                          Row   => Row,
+                          Col   => Col + 1,
+                          Cost  => Stack (Top).Cost + Penalty);
+   end Move_Right;
+
+   function Is_Solution return Boolean;
+
+   function Test_Moves return Boolean is
+   begin
+      if
+        Stack (Top).Move /= Down and then
+        Stack (Top).Row  /= Row_Type'First
+      then
+         Move_Up;
+         Top := Top + 1;
+         if Is_Solution then return True; end if;
+         Top := Top - 1;
+      end if;
+
+      if
+        Stack (Top).Move /= Up and then
+        Stack (Top).Row  /= Row_Type'Last
+      then
+         Move_Down;
+         Top := Top + 1;
+         if Is_Solution then return True; end if;
+         Top := Top - 1;
+      end if;
+
+      if
+        Stack (Top).Move /= Right and then
+        Stack (Top).Col  /= Col_Type'First
+      then
+         Move_Left;
+         Top := Top + 1;
+         if Is_Solution then return True; end if;
+         Top := Top - 1;
+      end if;
+
+      if
+        Stack (Top).Move /= Left and then
+        Stack (Top).Col  /= Col_Type'Last
+      then
+         Move_Right;
+         Top := Top + 1;
+         if Is_Solution then return True; end if;
+         Top := Top - 1;
+      end if;
+
+      return False;
+   end Test_Moves;
+
+   function Is_Solution return Boolean is
+      use Ada.Text_IO;
+   begin
+      if Stack (Top).Board = Solved_Board then
+         Put ("Solved in " & Top'Image & " moves: ");
+         for R in 1 .. Top loop
+            Put (String'(Stack (R).Move'Image) (1));
+         end loop;
+         New_Line;
+         return True;
+      end if;
+      if Stack (Top).Cost <= Iteration_Count then
+         return Test_Moves;
+      end if;
+      return False;
+   end Is_Solution;
+
+   procedure Solve (Row   : in Row_Type;
+                    Col   : in Col_Type;
+                    Board : in Board_Type) is
+   begin
+      pragma Assert (Board (Row, Col) = 0);
+      Top := 0;
+      Iteration_Count := 0;
+      Stack (Top) := (Board => Board,
+                      Row   => Row,
+                      Col   => Col,
+                      Move  => Down,
+                      Cost  => 0);
+      while not Is_Solution loop
+         Iteration_Count := Iteration_Count + 1;
+      end loop;
+   end Solve;
+
+begin
+   Solve (Row   => 2,
+          Col   => 0,
+          Board => ((15, 14, 1, 6),
+                    (9, 11, 4, 12),
+                    (0, 10, 7, 3),
+                    (13, 8, 5, 2)));
+end Puzzle_15;

Task/15-puzzle-solver/R/15-puzzle-solver.r

@@ -0,0 +1,239 @@
+## ----- Constants (match Julia) -----
+Nr <- c(3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3)
+Nc <- c(3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2)
+
+N0 <- integer(85)
+# N2 is a list of nibble vectors (each length 16, values 0..15, LSB-first)
+N2 <- vector("list", 85)
+N3 <- rep("", 85)      # chars 'd','u','r','l'
+N4 <- integer(85)
+
+i  <- 1L
+g  <- 8L
+ee <- 2L
+l  <- 4L
+.n <- 1L  # scalar (Julia used a 1-element Vector{Int32})
+
+## ----- Helpers for nibble representation -----
+# Convert a 16-hex string like "fe169b4c0a73d852" to nibble vector (LSB first)
+hex_to_nibbles <- function(hexstr) {
+  hexstr <- gsub("^0x", "", tolower(hexstr))
+  stopifnot(nchar(hexstr) == 16)
+  chars <- strsplit(hexstr, "")[[1]]
+  lookup <- c(as.character(0:9), letters[1:6])
+  to_val <- function(ch) match(ch, lookup) - 1L
+  nibs_msbf <- vapply(chars, to_val, integer(1))
+  rev(nibs_msbf)
+}
+
+
+# Compare two nibble vectors for equality
+nibbles_equal <- function(a, b) {
+  if (is.null(a) || is.null(b)) return(FALSE)
+  length(a) == length(b) && all(a == b)
+}
+
+# Extract nibble value at bit-offset gg (multiple of 4)
+# LSB-first indexing: position = gg/4, R index = pos+1
+get_nibble_at <- function(nibs, gg) {
+  pos <- as.integer(gg / 4L)
+  nibs[pos + 1L]
+}
+
+# Move nibble at position pos by delta positions (delta can be +/-1, +/-4)
+# Clears original pos (sets to 0), and adds the nibble to new position.
+move_nibble <- function(nibs, pos, delta) {
+  src <- pos
+  dst <- pos + delta
+  if (dst < 0L || dst > 15L) stop("Nibble move out of bounds")
+  v <- nibs[src + 1L]
+  if (v == 0L) return(nibs)  # nothing to move
+  nibs[src + 1L] <- 0L
+  nibs[dst + 1L] <- nibs[dst + 1L] + v  # original code “-a + (a << …)” effectively relocates the nibble
+  nibs
+}
+
+# (a >> gg) when a is a single-nibble mask at gg just yields that nibble value.
+# In our model we already read that nibble directly.
+
+## ----- Target and initial states (as nibbles) -----
+# Goal: 0x123456789abcdef0  => nibbles MSB→LSB: 1 2 3 4 5 6 7 8 9 a b c d e f 0
+GOAL <- hex_to_nibbles("123456789abcdef0")
+
+# Initial: 0xfe169b4c0a73d852 => nibbles MSB→LSB: f e 1 6 9 b 4 c 0 a 7 3 d 8 5 2
+INIT <- hex_to_nibbles("fe169b4c0a73d852")
+
+## ----- Core functions (translated) -----
+fY <- function(n) {
+  if (nibbles_equal(N2[[n + 1L]], GOAL)) {
+    return(list(ans = TRUE, n = n))
+  }
+  if (N4[n + 1L] <= .n) {
+    return(fN(n))
+  }
+  list(ans = FALSE, n = n)
+}
+
+fZ <- function(w, n) {
+  if (bitwAnd(w, i) > 0L) {
+    n <- fI(n)
+    tmp <- fY(n)
+    if (tmp$ans) return(tmp)
+    n <- n - 1L
+  }
+  if (bitwAnd(w, g) > 0L) {
+    n <- fG(n)
+    tmp <- fY(n)
+    if (tmp$ans) return(tmp)
+    n <- n - 1L
+  }
+  if (bitwAnd(w, ee) > 0L) {
+    n <- fE(n)
+    tmp <- fY(n)
+    if (tmp$ans) return(tmp)
+    n <- n - 1L
+  }
+  if (bitwAnd(w, l) > 0L) {
+    n <- fL(n)
+    tmp <- fY(n)
+    if (tmp$ans) return(tmp)
+    n <- n - 1L
+  }
+  list(ans = FALSE, n = n)
+}
+
+fN <- function(n) {
+  x <- N0[n + 1L]
+  y <- N3[n + 1L]  # "d","u","r","l"
+  if (x == 0L) {
+    if (y == "l")      return(fZ(i, n))
+    else if (y == "u") return(fZ(ee, n))
+    else               return(fZ(i + ee, n))
+  } else if (x == 3L) {
+    if (y == "r")      return(fZ(i, n))
+    else if (y == "u") return(fZ(l, n))
+    else               return(fZ(i + l, n))
+  } else if (x == 1L || x == 2L) {
+    if      (y == "l") return(fZ(i + l, n))
+    else if (y == "r") return(fZ(i + ee, n))
+    else if (y == "u") return(fZ(ee + l, n))
+    else               return(fZ(l + ee + i, n))
+  } else if (x == 12L) {
+    if      (y == "l") return(fZ(g, n))
+    else if (y == "d") return(fZ(ee, n))
+    else               return(fZ(ee + g, n))
+  } else if (x == 15L) {
+    if      (y == "r") return(fZ(g, n))
+    else if (y == "d") return(fZ(l, n))
+    else               return(fZ(g + l, n))
+  } else if (x == 13L || x == 14L) {
+    if      (y == "l") return(fZ(g + l, n))
+    else if (y == "r") return(fZ(ee + g, n))
+    else if (y == "d") return(fZ(ee + l, n))
+    else               return(fZ(g + ee + l, n))
+  } else if (x == 4L || x == 8L) {
+    if      (y == "l") return(fZ(i + g, n))
+    else if (y == "u") return(fZ(g + ee, n))
+    else if (y == "d") return(fZ(i + ee, n))
+    else               return(fZ(i + g + ee, n))
+  } else if (x == 7L || x == 11L) {
+    if      (y == "d") return(fZ(i + l, n))
+    else if (y == "u") return(fZ(g + l, n))
+    else if (y == "r") return(fZ(i + g, n))
+    else               return(fZ(i + g + l, n))
+  } else {
+    if      (y == "d") return(fZ(i + ee + l, n))
+    else if (y == "l") return(fZ(i + g + l, n))
+    else if (y == "r") return(fZ(i + g + ee, n))
+    else if (y == "u") return(fZ(g + ee + l, n))
+    else               return(fZ(i + g + ee + l, n))
+  }
+}
+
+# Down: take nibble at gg=(11-N0)*4 and move it left by 16 bits => +4 nibbles
+fI <- function(n) {
+  gg  <- (11L - N0[n + 1L]) * 4L
+  pos <- as.integer(gg / 4L)
+  a   <- get_nibble_at(N2[[n + 1L]], gg)
+  N0[n + 2L] <<- N0[n + 1L] + 4L
+  N2[[n + 2L]] <<- move_nibble(N2[[n + 1L]], pos, +4L)
+  N3[n + 2L] <<- "d"
+  N4[n + 2L] <<- N4[n + 1L]
+  cond <- Nr[a + 1L] <= (N0[n + 1L] %/% 4L)
+  if (!cond) N4[n + 2L] <<- N4[n + 2L] + 1L
+  n + 1L
+}
+
+# Up: gg=(19-N0)*4, move right by 16 bits => -4 nibbles
+fG <- function(n) {
+  gg  <- (19L - N0[n + 1L]) * 4L
+  pos <- as.integer(gg / 4L)
+  a   <- get_nibble_at(N2[[n + 1L]], gg)
+  N0[n + 2L] <<- N0[n + 1L] - 4L
+  N2[[n + 2L]] <<- move_nibble(N2[[n + 1L]], pos, -4L)
+  N3[n + 2L] <<- "u"
+  N4[n + 2L] <<- N4[n + 1L]
+  cond <- Nr[a + 1L] >= (N0[n + 1L] %/% 4L)
+  if (!cond) N4[n + 2L] <<- N4[n + 2L] + 1L
+  n + 1L
+}
+
+# Right: gg=(14-N0)*4, shift by +4 bits => +1 nibble
+fE <- function(n) {
+  gg  <- (14L - N0[n + 1L]) * 4L
+  pos <- as.integer(gg / 4L)
+  a   <- get_nibble_at(N2[[n + 1L]], gg)
+  N0[n + 2L] <<- N0[n + 1L] + 1L
+  N2[[n + 2L]] <<- move_nibble(N2[[n + 1L]], pos, +1L)
+  N3[n + 2L] <<- "r"
+  N4[n + 2L] <<- N4[n + 1L]
+  cond <- Nc[a + 1L] <= (N0[n + 1L] %% 4L)
+  if (!cond) N4[n + 2L] <<- N4[n + 2L] + 1L
+  n + 1L
+}
+
+# Left: gg=(16-N0)*4, shift by -4 bits => -1 nibble
+fL <- function(n) {
+  gg  <- (16L - N0[n + 1L]) * 4L
+  pos <- as.integer(gg / 4L)
+  a   <- get_nibble_at(N2[[n + 1L]], gg)
+  N0[n + 2L] <<- N0[n + 1L] - 1L
+  N2[[n + 2L]] <<- move_nibble(N2[[n + 1L]], pos, -1L)
+  N3[n + 2L] <<- "l"
+  N4[n + 2L] <<- N4[n + 1L]
+  cond <- Nc[a + 1L] >= (N0[n + 1L] %% 4L)
+  if (!cond) N4[n + 2L] <<- N4[n + 2L] + 1L
+  n + 1L
+}
+
+solve_fn <- function(n) {
+  tmp <- fN(n)
+  ans <- tmp$ans
+  n   <- tmp$n
+  if (ans) {
+    cat(sprintf("Solution found in %d moves:\n", n))
+    if (n >= 1L) {
+      cat(paste0(N3[2:(n + 1L)], collapse = ""), "\n")
+    } else {
+      cat("\n")
+    }
+  } else {
+    cat(sprintf("next iteration, .n will be %d...\n", .n + 1L))
+    n  <<- 0L
+    .n <<- .n + 1L
+    solve_fn(n)
+  }
+}
+
+run <- function() {
+  N0[1L] <<- 8L
+  .n      <<- 1L
+  N2[[1L]] <<- INIT
+  # carry forward initial defaults
+  N3[1L]  <<- ""
+  N4[1L]  <<- 0L
+  solve_fn(0L)
+}
+
+# Execute
+run()

Task/15-puzzle-solver/V-(Vlang)/15-puzzle-solver.v

@@ -0,0 +1,194 @@
+import strconv
+
+struct FifteenSolver {
+	mut:
+    n      int
+    n1     int
+    n0     []int
+    n2     []u64
+    n3     []rune
+    n4     []int
+    xx     u64
+}
+
+const nr      = [3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3]
+const nc      = [3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2]
+const i_flag  = 1
+const g_flag  = 8
+const e_flag  = 2
+const l_flag  = 4
+const fifteen = u64(15)
+
+fn u64_from_hex(s string) u64 {
+    return strconv.parse_uint(s, 16, 64) or { 0 }
+}
+
+fn (mut fs FifteenSolver) f_y() bool {
+    if fs.n2[fs.n] == fs.xx { return true }
+    if fs.n4[fs.n] <= fs.n1 { return fs.f_n() }
+    return false
+}
+
+fn (mut fs FifteenSolver) f_i() {
+    g := (11 - fs.n0[fs.n]) * 4
+    a := fs.n2[fs.n] & (fifteen << g)
+    fs.n0[fs.n + 1] = fs.n0[fs.n] + 4
+    fs.n2[fs.n + 1] = fs.n2[fs.n] - a + (a << 16)
+    fs.n3[fs.n + 1] = `d`
+    fs.n4[fs.n + 1] = fs.n4[fs.n]
+    cond := nr[(a >> g) & 0xF] <= (fs.n0[fs.n] >> 2)
+    if !cond { fs.n4[fs.n + 1] = fs.n4[fs.n + 1] + 1 }
+    fs.n++
+}
+
+fn (mut fs FifteenSolver) f_g() {
+    g := (19 - fs.n0[fs.n]) * 4
+    a := fs.n2[fs.n] & (fifteen << g)
+    fs.n0[fs.n + 1] = fs.n0[fs.n] - 4
+    fs.n2[fs.n + 1] = fs.n2[fs.n] - a + (a >> 16)
+    fs.n3[fs.n + 1] = `u`
+    fs.n4[fs.n + 1] = fs.n4[fs.n]
+    cond := nr[(a >> g) & 0xF] >= (fs.n0[fs.n] >> 2)
+    if !cond { fs.n4[fs.n + 1] = fs.n4[fs.n + 1] + 1 }
+    fs.n++
+}
+
+fn (mut fs FifteenSolver) f_e() {
+    g := (14 - fs.n0[fs.n]) * 4
+    a := fs.n2[fs.n] & (fifteen << g)
+    fs.n0[fs.n + 1] = fs.n0[fs.n] + 1
+    fs.n2[fs.n + 1] = fs.n2[fs.n] - a + (a << 4)
+    fs.n3[fs.n + 1] = `r`
+    fs.n4[fs.n + 1] = fs.n4[fs.n]
+    cond := nc[(a >> g) & 0xF] <= fs.n0[fs.n] % 4
+    if !cond { fs.n4[fs.n + 1] = fs.n4[fs.n + 1] + 1 }
+    fs.n++
+}
+
+fn (mut fs FifteenSolver) f_l() {
+    g := (16 - fs.n0[fs.n]) * 4
+    a := fs.n2[fs.n] & (fifteen << g)
+    fs.n0[fs.n + 1] = fs.n0[fs.n] - 1
+    fs.n2[fs.n + 1] = fs.n2[fs.n] - a + (a >> 4)
+    fs.n3[fs.n + 1] = `l`
+    fs.n4[fs.n + 1] = fs.n4[fs.n]
+    cond := nc[(a >> g) & 0xF] >= fs.n0[fs.n] % 4
+    if !cond { fs.n4[fs.n + 1] = fs.n4[fs.n + 1] + 1 }
+    fs.n++
+}
+
+fn (mut fs FifteenSolver) f_z(w int) bool {
+    if w & i_flag > 0 {
+        fs.f_i()
+        if fs.f_y() { return true }
+        fs.n--
+    }
+    if w & g_flag > 0 {
+        fs.f_g()
+        if fs.f_y() { return true }
+        fs.n--
+    }
+    if w & e_flag > 0 {
+        fs.f_e()
+        if fs.f_y() { return true }
+        fs.n--
+    }
+    if w & l_flag > 0 {
+        fs.f_l()
+        if fs.f_y() { return true }
+        fs.n--
+    }
+    return false
+}
+
+fn (mut fs FifteenSolver) f_n() bool {
+    p0 := fs.n0[fs.n]
+    p3 := fs.n3[fs.n]
+    return match p0 {
+        0 {
+            if p3 == `l` { fs.f_z(i_flag) }
+			else if p3 == `u` { fs.f_z(e_flag) }
+			else { fs.f_z(i_flag + e_flag) }
+        }
+        3 {
+            if p3 == `r` { fs.f_z(i_flag) }
+			else if p3 == `u` { fs.f_z(l_flag) }
+			else { fs.f_z(i_flag + l_flag) }
+        }
+        1, 2 {
+            if p3 == `l` { fs.f_z(i_flag + l_flag) }
+			else if p3 == `r` { fs.f_z(i_flag + e_flag) }
+			else if p3 == `u` { fs.f_z(e_flag + l_flag) }
+			else { fs.f_z(l_flag + e_flag + i_flag) }
+        }
+        12 {
+            if p3 == `l` { fs.f_z(g_flag) }
+			else if p3 == `d` { fs.f_z(e_flag) }
+			else { fs.f_z(e_flag + g_flag) }
+        }
+        15 {
+            if p3 == `r` { fs.f_z(g_flag) }
+			else if p3 == `d` { fs.f_z(l_flag) }
+			else { fs.f_z(g_flag + l_flag) }
+        }
+        13, 14 {
+            if p3 == `l` { fs.f_z(g_flag + l_flag) }
+			else if p3 == `r` { fs.f_z(e_flag + g_flag) }
+			else if p3 == `d` { fs.f_z(e_flag + l_flag) }
+			else { fs.f_z(g_flag + e_flag + l_flag) }
+        }
+        4, 8 {
+            if p3 == `l` { fs.f_z(i_flag + g_flag) }
+			else if p3 == `u` { fs.f_z(g_flag + e_flag) }
+			else if p3 == `d` { fs.f_z(i_flag + e_flag) }
+			else { fs.f_z(i_flag + g_flag + e_flag) }
+        }
+        7, 11 {
+            if p3 == `d` { fs.f_z(i_flag + l_flag) }
+			else if p3 == `u` { fs.f_z(g_flag + l_flag) }
+			else if p3 == `r` { fs.f_z(i_flag + g_flag) }
+			else { fs.f_z(i_flag + g_flag + l_flag) }
+        }
+        else {
+            if p3 == `d` { fs.f_z(i_flag + e_flag + l_flag) }
+			else if p3 == `l` { fs.f_z(i_flag + g_flag + l_flag) }
+			else if p3 == `r` { fs.f_z(i_flag + g_flag + e_flag) }
+			else if p3 == `u` { fs.f_z(g_flag + e_flag + l_flag) }
+			else { fs.f_z(i_flag + g_flag + e_flag + l_flag) }
+        }
+    }
+}
+
+fn (mut fs FifteenSolver) fifteen_solver(n_val int, g_val u64) {
+    fs.n0[0] = n_val
+    fs.n2[0] = g_val
+    fs.n4[0] = 0
+}
+
+fn (mut fs FifteenSolver) solve() {
+    if fs.f_n() {
+        println("Solution found in $fs.n moves: ")
+        for g in 1 .. fs.n + 1 {
+            print(fs.n3[g].str())
+        }
+        println("")
+    } else {
+        fs.n = 0
+        fs.n1++
+        fs.solve()
+    }
+}
+
+fn main() {
+    mut fs := FifteenSolver{
+        n0: []int{len: 85, init: 0}
+        n2: []u64{len: 85, init: 0}
+        n3: []rune{len: 85, init: ` `}
+        n4: []int{len: 85, init: 0}
+        n: 0
+        n1: 0
+        xx: u64_from_hex("123456789abcdef0")
+    }
+    fs.fifteen_solver(8, u64_from_hex("fe169b4c0a73d852"))
+    fs.solve()
+}

Task/2048/Ada/2048.adb

@@ -0,0 +1,177 @@
+with Ada.Text_IO; use Ada.Text_IO;
+with System.Random_Numbers;
+procedure Play_2048 is
+   -- ----- Keyboard management
+   type t_Keystroke is (Up, Down, Right, Left, Quit, Restart, Invalid);
+   -- Redefining this standard procedure as function to allow Get_Keystroke as an expression function
+   function Get_Immediate return Character is
+   begin
+      return Answer : Character do Ada.Text_IO.Get_Immediate(Answer);
+      end return;
+   end Get_Immediate;
+   Arrow_Prefix : constant Character := Character'Val(224); -- works for windows
+   function Get_Keystroke return t_Keystroke is
+     (case Get_Immediate is
+         when 'Q' | 'q' => Quit,
+         when 'R' | 'r' => Restart,
+         when 'W' | 'w' => Left,
+         when 'A' | 'a' => Up,
+         when 'S' | 's' => Down,
+         when 'D' | 'd' => Right,
+         -- Windows terminal
+         when Arrow_Prefix => (case Character'Pos(Get_Immediate) is
+                                  when 72 => Up,
+                                  when 75 => Left,
+                                  when 77 => Right,
+                                  when 80 => Down,
+                                  when others => Invalid),
+         -- Unix escape sequences
+         when ASCII.ESC => (case Get_Immediate is
+                               when '[' => (case Get_Immediate is
+                                               when 'A' => Up,
+                                               when 'B' => Down,
+                                               when 'C' => Right,
+                                               when 'D' => Left,
+                                               when others => Invalid),
+                               when others => Invalid),
+         when others => Invalid);
+
+   -- ----- Game data
+   function Random_Int is new System.Random_Numbers.Random_Discrete(Integer);
+   type    t_List  is array (Positive range <>) of Natural;
+   subtype t_Row   is t_List (1..4);
+   type    t_Board is array  (1..4) of t_Row;
+   Board     : t_Board;
+   New_Board : t_Board;
+   Blanks    : Natural;
+   Score     : Natural;
+   Generator : System.Random_Numbers.Generator;
+
+   -- ----- Displaying the board
+   procedure Display_Board is
+      Horizontal_Rule : constant String := "+----+----+----+----+";
+      function Center (Value : in String) return String is
+        ((1..(2-(Value'Length-1)/2) => ' ') & -- Add leading spaces
+         Value(Value'First+1..Value'Last)   & -- Trim the leading space of the raw number image
+         (1..(2-Value'Length/2) => ' '));     -- Add trailing spaces
+   begin
+      Put_Line (Horizontal_Rule);
+      for Row of Board loop
+         for Cell of Row loop
+            Put('|' & (if Cell = 0 then "    " else Center(Cell'Img)));
+         end loop;
+         Put_Line("|");
+         Put_Line (Horizontal_Rule);
+      end loop;
+      Put_Line("Score =" & Score'Img);
+   end Display_Board;
+
+   -- ----- Game mechanics
+   procedure Add_Block is
+      Block_Offset : Positive := Random_Int(Generator, 1, Blanks);
+   begin
+      Blanks := Blanks-1;
+      for Row of Board loop
+         for Cell of Row loop
+            if Cell = 0 then
+               if Block_Offset = 1 then
+                  Cell := (if Random_Int(Generator,1,10) = 1 then 4 else 2);
+                  return;
+               else
+                  Block_Offset := Block_Offset-1;
+               end if;
+            end if;
+         end loop;
+      end loop;
+   end Add_Block;
+
+   procedure Reset_Game is
+   begin
+      Board  := (others => (others => 0));
+      Blanks := 16;
+      Score  := 0;
+      Add_Block;
+      Add_Block;
+   end Reset_Game;
+
+   -- Moving and merging will always be performed leftward, hence the following transforms
+   function HFlip (What : in t_Row) return t_Row is
+     (What(4),What(3),What(2),What(1));
+   function VFlip (What : in t_Board) return t_Board is
+     (HFlip(What(1)),HFlip(What(2)),HFlip(What(3)),HFlip(What(4)));
+   function Transpose (What : in t_Board) return t_Board is
+   begin
+      return Answer : t_Board do
+         for Row in t_Board'Range loop
+            for Column in t_Row'Range loop
+               Answer(Column)(Row) := What(Row)(Column);
+            end loop;
+         end loop;
+      end return;
+   end Transpose;
+
+   -- For moving/merging, recursive expression functions will be used, but they
+   -- can't contain statements, hence the following sub-function used by Merge
+   function Add_Blank (Delta_Score : in Natural) return t_List is
+   begin
+      Blanks := Blanks+1;
+      Score  := Score+Delta_Score;
+      return (1 => 0);
+   end Add_Blank;
+
+   function Move_Row (What : in t_List) return t_List is
+     (if What'Length = 1 then What
+      elsif What(What'First) = 0
+      then Move_Row(What(What'First+1..What'Last)) & (1 => 0)
+      else (1 => What(What'First)) & Move_Row(What(What'First+1..What'Last)));
+
+   function Merge (What : in t_List) return t_List is
+     (if What'Length <= 1 or else What(What'First) = 0 then What
+      elsif What(What'First) = What(What'First+1)
+      then (1 => 2*What(What'First)) & Merge(What(What'First+2..What'Last)) & Add_Blank(What(What'First))
+      else (1 => What(What'First)) & Merge(What(What'First+1..What'Last)));
+
+   function Move (What : in t_Board) return t_Board is
+     (Merge(Move_Row(What(1))),Merge(Move_Row(What(2))),Merge(Move_Row(What(3))),Merge(Move_Row(What(4))));
+
+begin
+   System.Random_Numbers.Reset(Generator);
+
+   Main_Loop: loop
+      Reset_Game;
+      Game_Loop: loop
+         Display_Board;
+         case Get_Keystroke is
+            when Restart => exit Game_Loop;
+            when Quit    => exit Main_Loop;
+            when Left    => New_Board := Move(Board);
+            when Right   => New_Board := VFlip(Move(VFlip(Board)));
+            when Up      => New_Board := Transpose(Move(Transpose(Board)));
+            when Down    => New_Board := Transpose(VFlip(Move(VFlip(Transpose(Board)))));
+            when others  => null;
+         end case;
+
+         if New_Board = Board then
+            Put_Line ("Invalid move...");
+         elsif (for some Row of New_Board => (for some Cell of Row => Cell = 2048)) then
+            Display_Board;
+            Put_Line ("Win !");
+            exit Main_Loop;
+         else
+            Board := New_Board;
+            Add_Block; -- OK since the board has changed
+            if Blanks = 0
+               and then (for all Row in 1..4 =>
+                           (for all Column in 1..3 =>
+                                (Board(Row)(Column) /= Board(Row)(Column+1))))
+               and then (for all Row in 1..3 =>
+                           (for all Column in 1..4 =>
+                                (Board(Row)(Column) /= Board(Row+1)(Column)))) then
+               Display_Board;
+               Put_Line ("Lost !");
+               exit Main_Loop;
+            end if;
+         end if;
+      end loop Game_Loop;
+   end loop Main_Loop;
+end Play_2048;

Task/2048/EasyLang/2048.easy

@@ -6,7 +6,7 @@ proc newtile .
    v = 2
    if randomf < 0.1 : v = 4
    repeat
-      ind = random 16
+      ind = random 1 16
       until brd[ind] = 0
    .
    brd[ind] = v

Task/21-game/00-TASK.txt

@@ -9,6 +9,7 @@ One player will be the computer.
  
 Players alternate supplying a number to be added to the ''running total''. 
 
+This game is a variant of [https://en.wikipedia.org/wiki/Nim#The_21_game Nim].
 
 ;Task:
 Write a computer program that will:
@@ -19,4 +20,7 @@ Write a computer program that will:
 ::* provide a mechanism for the player to quit/exit/halt/stop/close the program,
 ::* issue a notification when there is a winner, and
 ::* determine who goes first (maybe a random or user choice, or can be specified when the game begins). 
+
+;Related tasks:
+::* [[Nim game]]
 <br><br>

Task/21-game/ALGOL-68/21-game.alg

@@ -0,0 +1,41 @@
+IF  print( ( "Player who reaches 21, wins", newline ) );    # 21 game - based on the EasyLang sample #
+    INT      human   = 1, computer = 2;
+    []STRING name    = ( "Human   ", "Computer" );
+    INT      player := human, sum := 0;
+    STRING   a      := "?";
+    WHILE a /= "y" AND a /= "n" AND a /= "q" DO
+        print( ( "Do you want to go first (y/n/q) " ) );
+        read( ( a, newline ) );
+        IF a = "n" THEN player := computer FI
+    OD;
+    a /= "q"
+THEN
+    WHILE
+        INT add := IF player = human THEN
+                       a := "?";
+                       WHILE a /= "q" AND a /= "1" AND a /= "2" AND a /= "3" DO
+                           print( ( newline, "Add 1, 2 or 3 (q to quit) " ) );
+                           read( ( a, newline ) )
+                       OD;
+                       IF a = "1" THEN 1 ELIF a = "2" THEN 2 ELSE 3 FI
+                   ELIF sum MOD 4 = 1 THEN
+                       # player = computer, optimal move not possible #
+                       ENTIER ( random * 3 ) + 1
+                   ELSE
+                       # player = computer, can make the optimal move #
+                       4 - ( sum + 3 ) MOD 4
+                   FI;
+        sum +:= add;
+        IF a /= "q" THEN
+            print( ( name[ player ], ": ", whole( add, 0 ), " --> ", whole( sum, 0 ), newline ) )
+        FI;
+        a /= "q" AND sum < 21
+    DO
+        player := IF player = human THEN computer ELSE human FI
+    OD;
+    IF a /= "q" THEN
+        print( ( newline ) );
+        print( ( IF player = human THEN "Congratulations, you won" ELSE "Sorry, you lost" FI ) );
+        print( ( newline ) )
+    FI
+FI

Task/21-game/Ada/21-game.adb

@@ -0,0 +1,108 @@
+with Ada.Text_IO;
+with Ada.Numerics.Discrete_Random;
+
+procedure Game_21 is
+
+   procedure Put (Item : String) is
+   begin
+      for Char of Item loop
+         Ada.Text_IO.Put (Char);
+         delay 0.010;
+      end loop;
+   end Put;
+
+   procedure New_Line is
+   begin
+      Ada.Text_IO.New_Line;
+   end New_Line;
+
+   procedure Put_Line (Item : String) is
+   begin
+      Put (Item);
+      New_Line;
+   end Put_LIne;
+
+   type Player_Kind is (Human, Computer);
+   type Score_Type  is range 0 .. 21;
+   subtype Amount_Range is Score_Type range 1 .. 3;
+
+   package Amount_Generators is
+     new Ada.Numerics.Discrete_Random (Amount_Range);
+
+   Gen    : Amount_Generators.Generator;
+   Total  : Score_Type := 0;
+   Choice : Character;
+   Player : Player_Kind;
+   Amount : Amount_Range;
+begin
+   Amount_Generators.Reset (Gen);
+
+   Put_Line ("--- The 21 Game ---"); New_Line;
+
+   Put ("Who is starting human or computer (h/c) ? ");
+   Ada.Text_IO.Get_Immediate (Choice);
+   New_Line;
+
+   case Choice is
+      when 'c' | 'C' =>  Player := Computer;
+      when 'h' | 'H' =>  Player := Human;
+      when others => return;
+   end case;
+
+   Play_Loop : loop
+      New_Line;
+      Put ("Runing total is "); Put (Total'Image); New_Line;
+      New_Line;
+
+      case Player is
+
+         when Human =>
+            Put_Line ("It is your turn !");
+            Input_Loop : loop
+               Put ("Enter choice 1 .. 3 (0 to end) : ");
+               Ada.Text_IO.Get_Immediate (Choice);
+
+               case Choice is
+                  when '1' .. '3' =>
+                     Amount := Amount_Range'Value ("" & Choice);
+                     exit Input_Loop;
+
+                  when '0' =>
+                     exit Play_Loop;
+
+                  when others =>
+                     Put_Line ("Choice must be in 1 .. 3");
+               end case;
+            end loop Input_Loop;
+            New_Line;
+
+         when Computer =>
+            delay 1.500;
+            Amount := Amount_Generators.Random (Gen);
+            Put ("Computer chooses: "); Put (Amount'Image); New_Line;
+            delay 0.800;
+
+      end case;
+
+      New_Line;
+      Amount := Score_Type'Min (Amount, Score_Type'Last - Total);
+      Put ("  "); Put (Total'Image); Put (" + ");  Put (Amount'Image); Put (" = ");
+      Total := Total + Amount;
+      Put (Total'Image);
+      New_Line;
+
+      if Total = 21 then
+         New_Line;
+         Put ("... and we have a WINNER !!"); New_Line;
+         delay 0.500;
+         Put_Line ("   ... and the winner is ...");
+         delay 1.000;
+         Put_Line ("      " & Player'Image);
+         exit;
+      end if;
+
+      Player := (case Player is
+                 when Computer => Human,
+                 when Human    => Computer);
+   end loop Play_Loop;
+end Game_21;

Task/21-game/AppleScript/21-game.applescript

@@ -0,0 +1,44 @@
+repeat
+	set pstart to some item of {true, false}
+	if pstart then
+		display alert "You go first!"
+		set score to 0
+	else
+		display alert "The computer goes first!"
+		log "The computer chose 1"
+		log "The score is now 1"
+		set score to 1
+	end if
+	repeat
+		repeat
+			set input to display alert "Choose a number:" buttons {1, 2, 3}
+			set pmove to button returned of input
+			set score to score + pmove
+			if score > 21 then
+				display alert "You can't go above 21! Try again."
+				set score to score - pmove
+			else
+				exit repeat
+			end if
+		end repeat
+		log "You chose " & pmove
+		log "The score is now " & score
+		if score = 21 then
+			log "You win!"
+			exit repeat
+		else if score mod 4 is not 1 then
+			set cmove to (5 - (score mod 4)) mod 4
+		else
+			set cmove to random number from 1 to 3
+		end if
+		set score to score + cmove
+		log "The computer chose " & cmove
+		log "The score is now " & score
+		if score = 21 then
+			log "Too bad! The computer wins."
+			exit repeat
+		end if
+	end repeat
+	set again to display alert "Play again?" buttons {"Yes", "No"}
+	if button returned of again = "No" then exit repeat
+end repeat

Task/21-game/EasyLang/21-game.easy

@@ -2,36 +2,36 @@ print "Who reaches 21, wins"
 print "Do you want to begin (y/n)"
 who = 1
 if input = "n"
-  who = 2
+   who = 2
 .
 who$[] = [ "Human" "Computer" ]
 repeat
-  if who = 1
-    repeat
-      print ""
-      print "Choose 1,2 or 3 (q for quit)"
-      a$ = input
-      n = number a$
-      until a$ = "q" or (n >= 1 and n <= 3)
-    .
-  else
-    sleep 1
-    if sum mod 4 = 1
-      n = random 3
-    else
-      n = 4 - (sum + 3) mod 4
-    .
-  .
-  sum += n
-  print who$[who] & ": " & n & " --> " & sum
-  until sum >= 21 or a$ = "q"
-  who = who mod 2 + 1
+   if who = 1
+      repeat
+         print ""
+         print "Choose 1,2 or 3 (q for quit)"
+         a$ = input
+         n = number a$
+         until a$ = "q" or (n >= 1 and n <= 3)
+      .
+   else
+      sleep 1
+      if sum mod 4 = 1
+         n = random 1 3
+      else
+         n = 4 - (sum + 3) mod 4
+      .
+   .
+   sum += n
+   print who$[who] & ": " & n & " --> " & sum
+   until sum >= 21 or a$ = "q"
+   who = who mod 2 + 1
 .
 if a$ <> "q"
-  print ""
-  if who = 0
-    print "Congratulation, you won"
-  else
-    print "Sorry, you lost"
-  .
+   print ""
+   if who = 0
+      print "Congratulation, you won"
+   else
+      print "Sorry, you lost"
+   .
 .

Task/21-game/Rebol/21-game.rebol

@@ -0,0 +1,26 @@
+Rebol [
+    title: "Rosetta code: 21 game"
+    file:  %21_game.r3
+    url:   https://rosettacode.org/wiki/21_game
+]
+
+game-21: function[][
+    total: 0
+    human?: true
+    while [total <> 21][
+        either human? [
+            n: ask "Enter a number between 1 and 3 (CTRL+C to quit): "
+            if none? n [quit]
+            unless parse n [#"1" | #"2" | #"3"][ continue ]
+            n: to integer! n
+        ][  ;computer
+            if 3 < n: 21 - total [ n: random 3 ]
+            print ["Computer picks:" as-yellow n]
+        ]
+        total: total + n
+        print ["Total:" as-green total]
+        human?: not human?
+    ]
+    print as-green pick ["Computer wins!" "You win!"] human?
+]
+game-21

Task/21-game/Uiua/21-game.uiua

@@ -0,0 +1,6 @@
+T        ← 21
+P        ← &p$"_ played: _\tTotal: _"
+Play‼    ← ⍥(&p$"_ won." ^0)⊸=T⊸P ^0 ⟜+ ^1
+Computer ← Play‼"Computer" ⍥+₁⊸=0◿4⊸˜-T # Aim for Rem mod 4 = 0
+Random   ← Play‼"Random"+1⌊×3⚂          # Random play.
+◌⍢(⍥Computer⊸<T Random|<T) 0

Task/21-game/YAMLScript/21-game.ys

@@ -0,0 +1,31 @@
+!YS-v0
+
+players =: qw(A B):cycle.drop(rand-int(2))
+
+defn main():
+  say: |
+    --------------------
+    Welcome to 21 Game
+    --------------------
+
+  loop turn 0 total 0:
+    say: "Running total: $total"
+    say: "Player $(players.$turn)'s turn"
+    total +=: get-num(total)
+    say:
+    when total == 21:
+      say: |
+        Running total is 21. Player $(players.$turn) won!
+      exit: 0
+    recur: turn.++ total
+
+defn get-num(total):
+  print: 'Enter a number (1,2,3): '
+  val =: read-line()
+  condf val:
+    nil?: exit()
+    \(/[1-3]/):
+      if (total + val:N) > 21:
+        recur()
+        val
+    else: recur()

Task/24-game-Solve/Ada/24-game-solve.adb

@@ -0,0 +1,245 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Game24_Solver is
+   subtype Index is Positive range 1 .. 4;
+   subtype Digit is Integer range 1 .. 9;
+   type Digit_Array_Type is array (Index) of Digit;
+
+   Success_Exception : exception;
+
+   Digit_Array : Digit_Array_Type;
+
+   procedure Swap (A, B : Index) is
+      Tmp : Digit;
+   begin
+      if A /= B then
+         Tmp := Digit_Array (A);
+         Digit_Array (A) := Digit_Array (B);
+         Digit_Array (B) := Tmp;
+      end if;
+   end Swap;
+
+   procedure Do_Operation_Options is
+      type Operation_Character is ('+', '-', '*', '/');
+      type Operation_Access is
+        access function (Left, Right : Float) return Float;
+      type Allowed_Operation_Array_Type is
+        array (Operation_Character) of Operation_Access;
+
+      function Operation_Character_To_String
+        (C : in Operation_Character) return String is
+      begin
+         case C is
+            when '+' =>
+               return "+";
+
+            when '-' =>
+               return "-";
+
+            when '*' =>
+               return "*";
+
+            when '/' =>
+               return "/";
+         end case;
+      end Operation_Character_To_String;
+
+      function Add_Floats (Left, Right : Float) return Float is
+      begin
+         return Left + Right;
+      end Add_Floats;
+
+      function Subtract_Floats (Left, Right : Float) return Float is
+      begin
+         return Left - Right;
+      end Subtract_Floats;
+
+      function Multiply_Floats (Left, Right : Float) return Float is
+      begin
+         return Left * Right;
+      end Multiply_Floats;
+
+      function Divide_Floats (Left, Right : Float) return Float is
+      begin
+         return Left / Right;
+      end Divide_Floats;
+
+      Allowed_Operation_Array : constant Allowed_Operation_Array_Type :=
+        ('+' => Add_Floats'Access,
+         '-' => Subtract_Floats'Access,
+         '*' => Multiply_Floats'Access,
+         '/' => Divide_Floats'Access);
+
+      A : Digit renames Digit_Array (1);
+      B : Digit renames Digit_Array (2);
+      C : Digit renames Digit_Array (3);
+      D : Digit renames Digit_Array (4);
+   begin
+      for Op1 in Operation_Character loop
+         for Op2 in Operation_Character loop
+            for Op3 in Operation_Character loop
+               if (Allowed_Operation_Array (Op3)
+                     (Allowed_Operation_Array (Op2)
+                        (Allowed_Operation_Array (Op1) (Float (A), Float (B)),
+                         Float (C)),
+                      Float (D)))
+                 = 24.0
+               then
+                  Put_Line
+                    ("(("
+                     & Digit'Image (A)
+                     & " "
+                     & Operation_Character_To_String (Op1)
+                     & " "
+                     & Digit'Image (B)
+                     & ") "
+                     & Operation_Character_To_String (Op2)
+                     & " "
+                     & Digit'Image (C)
+                     & ") "
+                     & Operation_Character_To_String (Op3)
+                     & " "
+                     & Digit'Image (D));
+                  raise Success_Exception;
+               end if;
+               if (Allowed_Operation_Array (Op2)
+                     (Allowed_Operation_Array (Op1) (Float (A), Float (B)),
+                      Allowed_Operation_Array (Op3) (Float (C), Float (D))))
+                 = 24.0
+               then
+                  Put_Line
+                    ("("
+                     & Digit'Image (A)
+                     & " "
+                     & Operation_Character_To_String (Op1)
+                     & " "
+                     & Digit'Image (B)
+                     & ") "
+                     & Operation_Character_To_String (Op2)
+                     & " ("
+                     & Digit'Image (C)
+                     & " "
+                     & Operation_Character_To_String (Op3)
+                     & " "
+                     & Digit'Image (D)
+                     & ")");
+                  raise Success_Exception;
+               end if;
+               if (Allowed_Operation_Array (Op1)
+                     (Float (A),
+                      Allowed_Operation_Array (Op2)
+                        (Float (B),
+                         Allowed_Operation_Array (Op3)
+                           (Float (C), Float (D)))))
+                 = 24.0
+               then
+                  Put_Line
+                    (Digit'Image (A)
+                     & " "
+                     & Operation_Character_To_String (Op1)
+                     & " ("
+                     & Digit'Image (B)
+                     & " "
+                     & Operation_Character_To_String (Op2)
+                     & " ("
+                     & Digit'Image (C)
+                     & " "
+                     & Operation_Character_To_String (Op3)
+                     & " "
+                     & Digit'Image (D)
+                     & "))");
+                  raise Success_Exception;
+               end if;
+               if (Allowed_Operation_Array (Op1)
+                     (Float (A),
+                      Allowed_Operation_Array (Op3)
+                        (Allowed_Operation_Array (Op2) (Float (B), Float (C)),
+                         Float (D))))
+                 = 24.0
+               then
+                  Put_Line
+                    (Digit'Image (A)
+                     & " "
+                     & Operation_Character_To_String (Op1)
+                     & " (("
+                     & Digit'Image (B)
+                     & " "
+                     & Operation_Character_To_String (Op2)
+                     & " "
+                     & Digit'Image (C)
+                     & ") "
+                     & Operation_Character_To_String (Op3)
+                     & " "
+                     & Digit'Image (D)
+                     & ")");
+                  raise Success_Exception;
+               end if;
+               if (Allowed_Operation_Array (Op3)
+                     (Allowed_Operation_Array (Op1)
+                        (Float (A),
+                         Allowed_Operation_Array (Op2) (Float (B), Float (C))),
+                      Float (D)))
+                 = 24.0
+               then
+                  Put_Line
+                    ("("
+                     & Digit'Image (A)
+                     & " "
+                     & Operation_Character_To_String (Op1)
+                     & " ("
+                     & Digit'Image (B)
+                     & " "
+                     & Operation_Character_To_String (Op2)
+                     & " "
+                     & Digit'Image (C)
+                     & ")) "
+                     & Operation_Character_To_String (Op3)
+                     & " "
+                     & Digit'Image (D));
+                  raise Success_Exception;
+               end if;
+            end loop;
+         end loop;
+      end loop;
+   end Do_Operation_Options;
+
+   procedure Do_Permutations (Start_Index : Index := Index'First) is
+   begin
+      if Start_Index = Index'Last then
+         Do_Operation_Options;
+         return;
+      end if;
+
+      for I in Start_Index .. Index'Last loop
+         Swap (Start_Index, I);
+         Do_Permutations (Start_Index + 1);
+         Swap (Start_Index, I);
+      end loop;
+   end Do_Permutations;
+begin
+   Put ("Enter 4 digits: ");
+   declare
+      Zero_Pos : constant Integer := Character'Pos ('0');
+      Input    : String := Get_Line;
+   begin
+      if Input'Length = 4 then
+         for I in Index'Range loop
+            if Input (I) in '1' .. '9' then
+               Digit_Array (I) := Character'Pos (Input (I)) - Zero_Pos;
+            else
+               Put_Line
+                 ("Invalid input: all characters must be non-zero digits");
+               return;
+            end if;
+         end loop;
+      else
+         Put_Line ("Invalid input: it must have length of 4");
+         return;
+      end if;
+   end;
+   Do_Permutations;
+   Put_Line ("Solution not found");
+exception
+   when Success_Exception =>
+      null;
+end Game24_Solver;

Task/24-game-Solve/COBOL/24-game-solve.cob

@@ -0,0 +1,446 @@
+        >>SOURCE FORMAT FREE
+*> This code is dedicated to the public domain
+*> This is GNUCobol 2.0
+identification division.
+program-id. twentyfoursolve.
+environment division.
+configuration section.
+repository. function all intrinsic.
+input-output section.
+file-control.
+    select count-file
+        assign to count-file-name
+        file status count-file-status
+        organization line sequential.
+data division.
+file section.
+fd  count-file.
+01  count-record pic x(7).
+
+working-storage section.
+01  count-file-name pic x(64) value 'solutioncounts'.
+01  count-file-status pic xx.
+
+01  command-area.
+    03  nd pic 9.
+    03  number-definition.
+        05  n occurs 4 pic 9.
+    03  number-definition-9 redefines number-definition
+        pic 9(4).
+    03  command-input pic x(16).
+    03  command pic x(5).
+    03  number-count pic 9999.
+    03  l1 pic 99.
+    03  l2 pic 99.
+    03  expressions pic zzz,zzz,zz9.
+
+01  number-validation.
+    03  px pic 99.
+    03  permutations value
+          '1234'
+        & '1243'
+        & '1324'
+        & '1342'
+        & '1423'
+        & '1432'
+
+        & '2134'
+        & '2143'
+        & '2314'
+        & '2341'
+        & '2413'
+        & '2431'
+
+        & '3124'
+        & '3142'
+        & '3214'
+        & '3241'
+        & '3423'
+        & '3432'
+
+        & '4123'
+        & '4132'
+        & '4213'
+        & '4231'
+        & '4312'
+        & '4321'.
+        05  permutation occurs 24 pic x(4).
+    03  cpx pic 9.
+    03  current-permutation pic x(4).
+    03  od1 pic 9.
+    03  od2 pic 9.
+    03  od3 pic 9.
+    03  operator-definitions pic x(4) value '+-*/'.
+    03  cox pic 9.
+    03  current-operators pic x(3).
+    03  rpn-forms value
+          'nnonono'
+        & 'nnonnoo'
+        & 'nnnonoo'
+        & 'nnnoono'
+        & 'nnnnooo'.
+        05  rpn-form occurs 5 pic x(7).
+    03  rpx pic 9.
+    03  current-rpn-form pic x(7).
+
+01  calculation-area.
+    03  oqx pic 99.
+    03  output-queue pic x(7).
+    03  work-number pic s9999.
+    03  top-numerator pic s9999 sign leading separate.
+    03  top-denominator pic s9999 sign leading separate.
+    03  rsx pic 9.
+    03  result-stack occurs 8.
+        05  numerator pic s9999.
+        05  denominator pic s9999.
+    03  divide-by-zero-error pic x.
+
+01  totals.
+    03  s pic 999.
+    03  s-lim pic 999 value 600.
+    03  s-max pic 999 value 0.
+    03  solution occurs 600 pic x(7).
+    03  sc pic 999.
+    03  sc1 pic 999.
+    03  sc2 pic 9.
+    03  sc-max pic 999 value 0.
+    03  sc-lim pic 999 value 600.
+    03  solution-counts value zeros.
+        05  solution-count occurs 600 pic 999.
+    03  ns pic 9999.
+    03  ns-max pic 9999 value 0.
+    03  ns-lim pic 9999 value 6561.
+    03  number-solutions occurs 6561.
+        05 ns-number pic x(4).
+        05 ns-count pic 999.
+    03  record-counts pic 9999.
+    03  total-solutions pic 9999.
+
+01  infix-area.
+    03  i pic 9.
+    03  i-s pic 9.
+    03  i-s1 pic 9.
+    03  i-work pic x(16).
+    03  i-stack occurs 7 pic x(13).
+
+procedure division.
+start-twentyfoursolve.
+    display 'start twentyfoursolve'
+    perform display-instructions
+    perform get-command
+    perform until command-input = spaces
+        display space
+        initialize command number-count
+        unstring command-input delimited by all space
+            into command number-count
+        move command-input to number-definition
+        move spaces to command-input
+        evaluate command
+        when 'h'
+        when 'help'
+            perform display-instructions
+        when 'list'
+            if ns-max = 0
+                perform load-solution-counts
+            end-if
+            perform list-counts
+        when 'show'
+            if ns-max = 0
+                perform load-solution-counts
+            end-if
+            perform show-numbers
+        when other
+            if number-definition-9 not numeric
+                display 'invalid number'
+            else
+                perform get-solutions
+                perform display-solutions
+            end-if
+        end-evaluate
+        if command-input = spaces
+            perform get-command
+        end-if
+    end-perform
+    display 'exit twentyfoursolve'
+    stop run
+    .
+display-instructions.
+    display space
+    display 'enter a number <n> as four integers from 1-9 to see its solutions'
+    display 'enter list to see counts of solutions for all numbers'
+    display 'enter show <n> to see numbers having <n> solutions'
+    display '<enter> ends the program'
+    .
+get-command.
+    display space
+    move spaces to command-input
+    display '(h for help)?' with no advancing
+    accept command-input
+    .
+ask-for-more.
+    display space
+    move 0 to l1
+    add 1 to l2
+    if l2 = 10
+        display 'more (<enter>)?' with no advancing
+        accept command-input
+        move 0 to l2
+    end-if
+    .
+list-counts.
+    add 1 to sc-max giving sc
+    display 'there are ' sc ' solution counts'
+    display space
+    display 'solutions/numbers'
+    move 0 to l1
+    move 0 to l2
+    perform varying sc from 1 by 1 until sc > sc-max
+    or command-input <> spaces
+        if solution-count(sc) > 0
+            subtract 1 from sc giving sc1 *> offset to capture zero counts
+            display sc1 '/' solution-count(sc) space with no advancing
+            add 1 to l1
+            if l1 = 8
+                perform ask-for-more
+            end-if
+        end-if
+    end-perform
+    if l1 > 0
+        display space
+    end-if
+    .
+show-numbers. *> with number-count solutions
+    add 1 to number-count giving sc1 *> offset for zero count
+    evaluate true
+    when number-count >= sc-max
+        display 'no number has ' number-count ' solutions'
+        exit paragraph
+    when solution-count(sc1) = 1 and number-count = 1
+        display '1 number has 1 solution'
+    when solution-count(sc1) = 1
+        display '1 number has ' number-count ' solutions'
+    when number-count = 1
+        display solution-count(sc1) ' numbers have 1 solution'
+    when other
+        display solution-count(sc1) ' numbers have ' number-count ' solutions'
+    end-evaluate
+    display space
+    move 0 to l1
+    move 0 to l2
+    perform varying ns from 1 by 1 until ns > ns-max
+    or command-input <> spaces
+        if ns-count(ns) = number-count
+            display ns-number(ns) space with no advancing
+            add 1 to l1
+            if l1 = 14
+                perform ask-for-more
+            end-if
+        end-if
+    end-perform
+    if l1 > 0
+        display space
+    end-if
+    .
+display-solutions.
+    evaluate s-max
+    when 0 display number-definition ' has no solutions'
+    when 1 display number-definition ' has 1 solution'
+    when other display number-definition ' has ' s-max ' solutions'
+    end-evaluate
+    display space
+    move 0 to l1
+    move 0 to l2
+    perform varying s from 1 by 1 until s > s-max
+    or command-input <> spaces
+        *> convert rpn solution(s) to infix
+        move 0 to i-s
+        perform varying i from 1 by 1 until i > 7
+            if solution(s)(i:1) >= '1' and <= '9'
+                add 1 to i-s
+                move solution(s)(i:1) to i-stack(i-s)
+            else
+                subtract 1 from i-s giving i-s1
+                move spaces to i-work
+                string '(' i-stack(i-s1) solution(s)(i:1) i-stack(i-s) ')'
+                    delimited by space into i-work
+                move i-work to i-stack(i-s1)
+                subtract 1 from i-s
+            end-if
+        end-perform
+        display solution(s) space i-stack(1) space space with no advancing
+        add 1 to l1
+        if l1 = 3
+            perform ask-for-more
+        end-if
+    end-perform
+    if l1 > 0
+        display space
+    end-if
+    .
+load-solution-counts.
+    move 0 to ns-max *> numbers and their solution count
+    move 0 to sc-max *> solution counts
+    move spaces to count-file-status
+    open input count-file
+    if count-file-status <> '00'
+        perform create-count-file
+        move 0 to ns-max *> numbers and their solution count
+        move 0 to sc-max *> solution counts
+        open input count-file
+    end-if
+    read count-file
+    move 0 to record-counts
+    move zeros to solution-counts
+    perform until count-file-status <> '00'
+        add 1 to record-counts
+        perform increment-ns-max
+        move count-record to number-solutions(ns-max)
+        add 1 to ns-count(ns-max) giving sc *> offset 1 for zero counts
+        if sc > sc-lim
+            display 'sc ' sc ' exceeds sc-lim ' sc-lim
+            stop run
+        end-if
+        if sc > sc-max
+            move sc to sc-max
+        end-if
+        add 1 to solution-count(sc)
+        read count-file
+    end-perform
+    close count-file
+    .
+create-count-file.
+    open output count-file
+    display 'Counting solutions for all numbers'
+    display 'We will examine 9*9*9*9 numbers'
+    display 'For each number we will examine 4! permutations of the digits'
+    display 'For each permutation we will examine 4*4*4 combinations of operators'
+    display 'For each permutation and combination we will examine 5 rpn forms'
+    display 'We will count the number of unique solutions for the given number'
+    display 'Each number and its counts will be written to file ' trim(count-file-name)
+    compute expressions = 9*9*9*9*factorial(4)*4*4*4*5
+    display 'So we will evaluate ' trim(expressions) ' statements'
+    display 'This will take a few minutes'
+    display 'In the future if ' trim(count-file-name) ' exists, this step will be bypassed'
+    move 0 to record-counts
+    move 0 to total-solutions
+    perform varying n(1) from 1 by 1 until n(1) = 0
+        perform varying n(2) from 1 by 1 until n(2) = 0
+            display n(1) n(2) '..' *> show progress
+            perform varying n(3) from 1 by 1 until n(3) = 0
+                perform varying n(4) from 1 by 1 until n(4) = 0
+                    perform get-solutions
+                    perform increment-ns-max
+                    move number-definition to ns-number(ns-max)
+                    move s-max to ns-count(ns-max)
+                    move number-solutions(ns-max) to count-record
+                    write count-record
+                    add s-max to total-solutions
+                    add 1 to record-counts
+                    add 1 to ns-count(ns-max) giving sc *> offset by 1 for zero counts
+                    if sc > sc-lim
+                        display 'error: ' sc ' solution count exceeds ' sc-lim
+                        stop run
+                    end-if
+                    add 1 to solution-count(sc)
+                end-perform
+            end-perform
+        end-perform
+    end-perform
+    close count-file
+    display record-counts ' numbers and counts written to ' trim(count-file-name)
+    display total-solutions ' total solutions'
+    display space
+    .
+increment-ns-max.
+    if ns-max >= ns-lim
+        display 'error: numbers exceeds ' ns-lim
+        stop run
+    end-if
+    add 1 to ns-max
+    .
+get-solutions.
+    move 0 to s-max
+    perform varying px from 1 by 1 until px > 24
+        move permutation(px) to current-permutation
+        perform varying od1 from 1 by 1 until od1 > 4
+            move operator-definitions(od1:1) to current-operators(1:1)
+            perform varying od2 from 1 by 1 until od2 > 4
+                move operator-definitions(od2:1) to current-operators(2:1)
+                perform varying od3 from 1 by 1 until od3 > 4
+                    move operator-definitions(od3:1) to current-operators(3:1)
+                    perform varying rpx from 1 by 1 until rpx > 5
+                        move rpn-form(rpx) to current-rpn-form
+                        move 0 to cpx cox
+                        move spaces to output-queue
+                        perform varying oqx from 1 by 1 until oqx > 7
+                            if current-rpn-form(oqx:1) = 'n'
+                                add 1 to cpx
+                                move current-permutation(cpx:1) to nd
+                                move n(nd) to output-queue(oqx:1)
+                            else
+                                add 1 to cox
+                                move current-operators(cox:1) to output-queue(oqx:1)
+                            end-if
+                        end-perform
+                        perform evaluate-rpn
+                        if divide-by-zero-error = space
+                        and 24 * top-denominator = top-numerator
+                            perform varying s from 1 by 1 until s > s-max
+                            or solution(s) = output-queue
+                                continue
+                            end-perform
+                            if s > s-max
+                                if s >= s-lim
+                                    display 'error: solutions ' s ' for ' number-definition ' exceeds ' s-lim
+                                    stop run
+                                end-if
+                                move s to s-max
+                                move output-queue to solution(s-max)
+                            end-if
+                        end-if
+                    end-perform
+                end-perform
+            end-perform
+        end-perform
+    end-perform
+    .
+evaluate-rpn.
+    move space to divide-by-zero-error
+    move 0 to rsx *> stack depth
+    perform varying oqx from 1 by 1 until oqx > 7
+        if output-queue(oqx:1) >= '1' and <= '9'
+            *> push the digit onto the stack
+            add 1 to rsx
+            move top-numerator to numerator(rsx)
+            move top-denominator to denominator(rsx)
+            move output-queue(oqx:1) to top-numerator
+            move 1 to top-denominator
+        else
+            *> apply the operation
+            evaluate output-queue(oqx:1)
+            when '+'
+                compute top-numerator = top-numerator * denominator(rsx)
+                    + top-denominator * numerator(rsx)
+                compute top-denominator = top-denominator * denominator(rsx)
+            when '-'
+                compute top-numerator = top-denominator * numerator(rsx)
+                    - top-numerator * denominator(rsx)
+                compute top-denominator = top-denominator * denominator(rsx)
+            when '*'
+                compute top-numerator = top-numerator * numerator(rsx)
+                compute top-denominator = top-denominator * denominator(rsx)
+            when '/'
+                compute work-number = numerator(rsx) * top-denominator
+                compute top-denominator = denominator(rsx) * top-numerator
+                if top-denominator = 0
+                    move 'y' to divide-by-zero-error
+                    exit paragraph
+                end-if
+                move work-number to top-numerator
+            end-evaluate
+            *> pop the stack
+            subtract 1 from rsx
+        end-if
+    end-perform
+    .
+end program twentyfoursolve.

Task/24-game/Ada/24-game.adb

@@ -0,0 +1,172 @@
+with Ada.Float_Text_IO;
+with Ada.Text_IO;
+with Ada.Numerics.Discrete_Random;
+procedure Game_24 is
+   subtype Digit is Character range '1' .. '9';
+   package Random_Digit is new Ada.Numerics.Discrete_Random (Digit);
+   Exp_Error : exception;
+   Digit_Generator : Random_Digit.Generator;
+   Given_Digits : array (1 .. 4) of Digit;
+   Float_Value : constant array (Digit) of Float :=
+      (1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0);
+   function Apply_Op (L, R : Float; Op : Character) return Float is
+   begin
+      case Op is
+         when '+' =>
+            return L + R;
+         when '-' =>
+            return L - R;
+         when '*' =>
+            return L * R;
+         when '/' =>
+            return L / R;
+         when others =>
+            Ada.Text_IO.Put_Line ("Unexpected operator: " & Op);
+            raise Exp_Error;
+      end case;
+   end Apply_Op;
+   function Eval_Exp (E : String) return Float is
+      Flt : Float;
+      First : Positive := E'First;
+      Last : Positive;
+      function Match_Paren (Start : Positive) return Positive is
+         Pos : Positive := Start + 1;
+         Level : Natural := 1;
+      begin
+         loop
+            if Pos > E'Last then
+               Ada.Text_IO.Put_Line ("Unclosed parentheses.");
+               raise Exp_Error;
+            elsif E (Pos) = '(' then
+               Level := Level + 1;
+            elsif E (Pos) = ')' then
+               Level := Level - 1;
+               exit when Level = 0;
+            end if;
+            Pos := Pos + 1;
+         end loop;
+         return Pos;
+      end Match_Paren;
+   begin
+      if E (First) = '(' then
+         Last := Match_Paren (First);
+         Flt := Eval_Exp (E (First + 1 .. Last - 1));
+      elsif E (First) in Digit then
+         Last := First;
+         Flt := Float_Value (E (First));
+      else
+         Ada.Text_IO.Put_Line ("Unexpected character: " & E (First));
+         raise Exp_Error;
+      end if;
+      loop
+         if Last = E'Last then
+            return Flt;
+         elsif Last = E'Last - 1 then
+            Ada.Text_IO.Put_Line ("Unexpected end of expression.");
+            raise Exp_Error;
+         end if;
+         First := Last + 2;
+         if E (First) = '(' then
+            Last := Match_Paren (First);
+            Flt := Apply_Op (Flt, Eval_Exp (E (First + 1 .. Last - 1)),
+                             Op => E (First - 1));
+         elsif E (First) in Digit then
+            Last := First;
+            Flt := Apply_Op (Flt, Float_Value (E (First)),
+                             Op => E (First - 1));
+         else
+            Ada.Text_IO.Put_Line ("Unexpected character: " & E (First));
+            raise Exp_Error;
+         end if;
+      end loop;
+   end Eval_Exp;
+begin
+   Ada.Text_IO.Put_Line ("24 Game");
+   Ada.Text_IO.Put_Line ("- Enter Q to Quit");
+   Ada.Text_IO.Put_Line ("- Enter N for New digits");
+   Ada.Text_IO.Put_Line ("Note: Operators are evaluated left-to-right");
+   Ada.Text_IO.Put_Line ("      (use parentheses to override)");
+   Random_Digit.Reset (Digit_Generator);
+   <<GEN_DIGITS>>
+   Ada.Text_IO.Put_Line ("Generating 4 digits...");
+   for I in Given_Digits'Range loop
+      Given_Digits (I) := Random_Digit.Random (Digit_Generator);
+   end loop;
+   <<GET_EXP>>
+   Ada.Text_IO.Put ("Your Digits:");
+   for I in Given_Digits'Range loop
+      Ada.Text_IO.Put (" " & Given_Digits (I));
+   end loop;
+   Ada.Text_IO.New_Line;
+   Ada.Text_IO.Put ("Enter your Expression: ");
+   declare
+      Value : Float;
+      Response : constant String := Ada.Text_IO.Get_Line;
+      Prev_Ch : Character := ' ';
+      Unused_Digits : array (Given_Digits'Range) of Boolean :=
+        (others => True);
+   begin
+      if Response = "n" or Response = "N" then
+         goto GEN_DIGITS;
+      end if;
+      if Response = "q" or Response = "Q" then
+         return;
+      end if;
+      -- check input
+      for I in Response'Range loop
+         declare
+            Ch : constant Character := Response (I);
+            Found : Boolean;
+         begin
+            if Ch in Digit then
+               if Prev_Ch in Digit then
+                  Ada.Text_IO.Put_Line ("Illegal multi-digit number used.");
+                  goto GET_EXP;
+               end if;
+               Found := False;
+               for J in Given_Digits'Range loop
+                  if Unused_Digits (J) and then
+                        Given_Digits (J) = Ch then
+                     Unused_Digits (J) := False;
+                     Found := True;
+                     exit;
+                  end if;
+               end loop;
+               if not Found then
+                  Ada.Text_IO.Put_Line ("Illegal number used: " & Ch);
+                  goto GET_EXP;
+               end if;
+            elsif Ch /= '(' and Ch /= ')' and Ch /= '+' and
+                  Ch /= '-' and Ch /= '*' and Ch /= '/' then
+               Ada.Text_IO.Put_Line ("Illegal character used: " & Ch);
+               goto GET_EXP;
+            end if;
+            Prev_Ch := Ch;
+         end;
+      end loop;
+      -- check all digits used
+      for I in Given_Digits'Range loop
+         if Unused_Digits (I) then
+            Ada.Text_IO.Put_Line ("Digit not used: " & Given_Digits (I));
+            goto GET_EXP;
+         end if;
+      end loop;
+      -- check value
+      begin
+         Value := Eval_Exp (Response);
+      exception
+         when Exp_Error =>
+            goto GET_EXP; -- Message displayed by Eval_Exp;
+      end;
+      if abs (Value - 24.0) > 0.001 then
+         Ada.Text_IO.Put ("Value ");
+         Ada.Float_Text_IO.Put (Value, Fore => 0, Aft => 3, Exp => 0);
+         Ada.Text_IO.Put_Line (" is not 24!");
+         goto GET_EXP;
+      else
+         Ada.Text_IO.Put_Line ("You won!");
+         Ada.Text_IO.Put_Line ("Enter N for a new game, or try another solution.");
+         goto GET_EXP;
+      end if;
+   end;
+end Game_24;

Task/24-game/AutoIt/24-game.au3

@@ -0,0 +1,74 @@
+;AutoIt Script Example
+;by Daniel Barnes
+;spam me at djbarnes at orcon dot net dot en zed
+;13/08/2012
+
+;Choose four random digits (1-9) with repetitions allowed:
+global $digits
+FOR $i = 1 TO 4
+	$digits &= Random(1,9,1)
+NEXT
+
+While 1
+	main()
+WEnd
+
+Func main()
+	$text  = "Enter an equation (using all of, and only, the single digits "&$digits &")"&@CRLF
+	$text &= "which evaluates to exactly 24. Only multiplication (*) division (/)"&@CRLF
+	$text &= "addition (+) and subtraction (-) operations and parentheses are allowed:"
+	$input = InputBox ("24 Game",$text,"","",400,150)
+	If @error Then exit
+
+	;remove any spaces in input
+	$input = StringReplace($input," ","")
+
+	;check correct characters were used
+	For $i = 1 To StringLen($input)
+		$chr = StringMid($input,$i,1)
+		If Not StringInStr("123456789*/+-()",$chr) Then
+			MsgBox (0, "ERROR","Invalid character used: '"&$chr&"'")
+			return
+		endif
+	Next
+
+	;validate the equation uses all of the 4 characters, and nothing else
+	$test = $input
+	$test = StringReplace($test,"(","")
+	$test = StringReplace($test,")","")
+
+	;validate the length of the input - if its not 7 characters long then the user has done something wrong
+	If StringLen ($test) <> 7 Then
+		MsgBox (0,"ERROR","The equation "&$test&" is invalid")
+		return
+	endif
+
+	$test = StringReplace($test,"/","")
+	$test = StringReplace($test,"*","")
+	$test = StringReplace($test,"-","")
+	$test = StringReplace($test,"+","")
+
+	For $i = 1 To StringLen($digits)
+		$digit = StringMid($digits,$i,1)
+		For $ii = 1 To StringLen($test)
+			If  StringMid($test,$ii,1) = $digit Then
+				$test = StringLeft($test,$ii-1) & StringRight($test,StringLen($test)-$ii)
+				ExitLoop
+			endif
+		Next
+	Next
+	If $test <> "" Then
+		MsgBox (0, "ERROR", "The equation didn't use all 4 characters, and nothing else!")
+		return
+	endif
+
+	$try = Execute($input)
+
+	If $try = 24 Then
+		MsgBox (0, "24 Game","Well done. Your equation ("&$input&") = 24!")
+		Exit
+	Else
+		MsgBox (0, "24 Game","Fail. Your equation ("&$input&") = "&$try&"!")
+		return
+	endif
+EndFunc

Task/24-game/COBOL/24-game.cob

@@ -0,0 +1,843 @@
+        >>SOURCE FORMAT FREE
+*> This code is dedicated to the public domain
+*> This is GNUCobol 2.0
+identification division.
+program-id. twentyfour.
+environment division.
+configuration section.
+repository. function all intrinsic.
+data division.
+working-storage section.
+01  p pic 999.
+01  p1 pic 999.
+01  p-max pic 999 value 38.
+01  program-syntax pic x(494) value
+*>statement = expression;
+        '001 001 000 n'
+    &   '002 000 004 ='
+    &   '003 005 000 n'
+    &   '004 000 002 ;'
+*>expression = term, {('+'|'-') term,};
+    &   '005 005 000 n'
+    &   '006 000 016 ='
+    &   '007 017 000 n'
+    &   '008 000 015 {'
+    &   '009 011 013 ('
+    &   '010 001 000 t'
+    &   '011 013 000 |'
+    &   '012 002 000 t'
+    &   '013 000 009 )'
+    &   '014 017 000 n'
+    &   '015 000 008 }'
+    &   '016 000 006 ;'
+*>term = factor, {('*'|'/') factor,};
+    &   '017 017 000 n'
+    &   '018 000 028 ='
+    &   '019 029 000 n'
+    &   '020 000 027 {'
+    &   '021 023 025 ('
+    &   '022 003 000 t'
+    &   '023 025 000 |'
+    &   '024 004 000 t'
+    &   '025 000 021 )'
+    &   '026 029 000 n'
+    &   '027 000 020 }'
+    &   '028 000 018 ;'
+*>factor = ('(' expression, ')' | digit,);
+    &   '029 029 000 n'
+    &   '030 000 038 ='
+    &   '031 035 037 ('
+    &   '032 005 000 t'
+    &   '033 005 000 n'
+    &   '034 006 000 t'
+    &   '035 037 000 |'
+    &   '036 000 000 n'
+    &   '037 000 031 )'
+    &   '038 000 030 ;'.
+01  filler redefines program-syntax.
+    03  p-entry occurs 038.
+        05  p-address pic 999.
+        05  filler pic x.
+        05  p-definition pic 999.
+        05  p-alternate redefines p-definition pic 999.
+        05  filler pic x.
+        05  p-matching pic 999.
+        05  filler pic x.
+        05  p-symbol pic x.
+
+01  t pic 999.
+01  t-len pic 99 value 6.
+01  terminal-symbols
+    pic x(210) value
+        '01 +                               '
+    &   '01 -                               '
+    &   '01 *                               '
+    &   '01 /                               '
+    &   '01 (                               '
+    &   '01 )                               '.
+01  filler redefines terminal-symbols.
+    03  terminal-symbol-entry occurs 6.
+        05  terminal-symbol-len pic 99.
+        05  filler pic x.
+        05  terminal-symbol pic x(32).
+
+01  nt pic 999.
+01  nt-lim pic 99 value 5.
+01  nonterminal-statements pic x(294) value
+        "000 ....,....,....,....,....,....,....,....,....,"
+    &   "001 statement = expression;                      "
+    &   "005 expression = term, {('+'|'-') term,};        "
+    &   "017 term = factor, {('*'|'/') factor,};          "
+    &   "029 factor = ('(' expression, ')' | digit,);     "
+    &   "036 digit;                                       ".
+01  filler redefines nonterminal-statements.
+    03  nonterminal-statement-entry occurs 5.
+        05  nonterminal-statement-number pic 999.
+        05  filler pic x.
+        05  nonterminal-statement pic x(45).
+
+01  indent pic x(64) value all '|  '.
+01  interpreter-stack.
+    03  r pic 99. *> previous top of stack
+    03  s pic 99. *> current top of stack
+    03  s-max pic 99 value 32.
+    03  s-entry occurs 32.
+        05  filler pic x(2) value 'p='.
+        05  s-p pic 999. *> callers return address
+        05  filler pic x(4) value ' sc='.
+        05  s-start-control pic 999. *> sequence start address
+        05  filler pic x(4) value ' ec='.
+        05  s-end-control pic 999. *> sequence end address
+        05  filler pic x(4) value ' al='.
+        05  s-alternate pic 999. *> the next alternate
+        05  filler pic x(3) value ' r='.
+        05  s-result pic x. *> S success, F failure, N no result
+        05  filler pic x(3) value ' c='.
+        05  s-count pic 99. *> successes in a sequence
+        05  filler pic x(3) value ' x='.
+        05  s-repeat pic 99. *> repeats in a {} sequence
+        05  filler pic x(4) value ' nt='.
+        05  s-nt pic 99. *> current nonterminal
+
+01  language-area.
+    03  l pic 99.
+    03  l-lim pic 99.
+    03  l-len pic 99 value 1.
+    03  nd pic 9.
+    03  number-definitions.
+        05  n occurs 4 pic 9.
+    03  nu pic 9.
+    03  number-use.
+        05  u occurs 4 pic x.
+    03  statement.
+        05  c occurs 32.
+            07  c9 pic 9.
+
+01  number-validation.
+    03  p4 pic 99.
+    03  p4-lim pic 99 value 24.
+    03  permutations-4 pic x(96) value
+          '1234'
+        & '1243'
+        & '1324'
+        & '1342'
+        & '1423'
+        & '1432'
+        & '2134'
+        & '2143'
+        & '2314'
+        & '2341'
+        & '2413'
+        & '2431'
+        & '3124'
+        & '3142'
+        & '3214'
+        & '3241'
+        & '3423'
+        & '3432'
+        & '4123'
+        & '4132'
+        & '4213'
+        & '4231'
+        & '4312'
+        & '4321'.
+     03  filler redefines permutations-4.
+         05  permutation-4 occurs 24 pic x(4).
+     03  current-permutation-4 pic x(4).
+     03  cpx pic 9.
+     03  od1 pic 9.
+     03  od2 pic 9.
+     03  odx pic 9.
+     03  od-lim pic 9 value 4.
+     03  operator-definitions pic x(4) value '+-*/'.
+     03  current-operators pic x(3).
+     03  co3 pic 9.
+     03  rpx pic 9.
+     03  rpx-lim pic 9 value 4.
+     03  valid-rpn-forms pic x(28) value
+          'nnonono'
+        & 'nnnonoo'
+        & 'nnnoono'
+        & 'nnnnooo'.
+    03  filler redefines valid-rpn-forms.
+        05  rpn-form occurs 4 pic x(7).
+    03  current-rpn-form pic x(7).
+
+01  calculation-area.
+    03  osx pic 99.
+    03  operator-stack pic x(32).
+    03  oqx pic 99.
+    03  oqx1 pic 99.
+    03  output-queue pic x(32).
+    03  work-number pic s9999.
+    03  top-numerator pic s9999 sign leading separate.
+    03  top-denominator pic s9999 sign leading separate.
+    03  rsx pic 9.
+    03  result-stack occurs 8.
+        05  numerator pic s9999.
+        05  denominator pic s9999.
+
+01  error-found pic x.
+01  divide-by-zero-error pic x.
+
+*>  diagnostics
+01  NL pic x value x'0A'.
+01  NL-flag pic x value space.
+01  display-level pic x value '0'.
+01  loop-lim pic 9999 value 1500.
+01  loop-count pic 9999 value 0.
+01  message-area value spaces.
+    03  message-level pic x.
+    03  message-value pic x(128).
+
+*>  input and examples
+01  instruction pic x(32) value spaces.
+01  tsx pic 99.
+01  tsx-lim pic 99 value 14.
+01  test-statements.
+    03  filler pic x(32) value '1234;1 + 2 + 3 + 4'.
+    03  filler pic x(32) value '1234;1 * 2 * 3 * 4'.
+    03  filler pic x(32) value '1234;((1)) * (((2 * 3))) * 4'.
+    03  filler pic x(32) value '1234;((1)) * ((2 * 3))) * 4'.
+    03  filler pic x(32) value '1234;(1 + 2 + 3 + 4'.
+    03  filler pic x(32) value '1234;)1 + 2 + 3 + 4'.
+    03  filler pic x(32) value '1234;1 * * 2 * 3 * 4'.
+    03  filler pic x(32) value '5679;6 - (5 - 7) * 9'.
+    03  filler pic x(32) value '1268;((1 * (8 * 6) / 2))'.
+    03  filler pic x(32) value '4583;-5-3+(8*4)'.
+    03  filler pic x(32) value '4583;8 * 4 - 5 - 3'.
+    03  filler pic x(32) value '4583;8 * 4 - (5 + 3)'.
+    03  filler pic x(32) value '1223;1 * 3 / (2 - 2)'.
+    03  filler pic x(32) value '2468;(6 * 8) / 4 / 2'.
+01  filler redefines test-statements.
+    03  filler occurs 14.
+        05  test-numbers pic x(4).
+        05  filler pic x.
+        05  test-statement pic x(27).
+
+procedure division.
+start-twentyfour.
+    display 'start twentyfour'
+    perform generate-numbers
+    display 'type h <enter> to see instructions'
+    accept instruction
+    perform until instruction = spaces or 'q'
+        evaluate true
+        when instruction = 'h'
+            perform display-instructions
+        when instruction = 'n'
+            perform generate-numbers
+        when instruction(1:1) = 'm'
+            move instruction(2:4) to number-definitions
+            perform validate-number
+            if divide-by-zero-error = space
+            and 24 * top-denominator = top-numerator
+                display number-definitions ' is solved by ' output-queue(1:oqx)
+            else
+                display number-definitions ' is not solvable'
+            end-if
+        when instruction = 'd0' or 'd1' or 'd2' or 'd3'
+            move instruction(2:1) to display-level
+        when instruction = 'e'
+            display 'examples:'
+            perform varying tsx from 1 by 1
+            until tsx > tsx-lim
+                move spaces to statement
+                move test-numbers(tsx) to number-definitions
+                move test-statement(tsx) to statement
+                perform evaluate-statement
+                perform show-result
+            end-perform
+        when other
+            move instruction to statement
+            perform evaluate-statement
+            perform show-result
+        end-evaluate
+        move spaces to instruction
+        display 'instruction? ' with no advancing
+        accept instruction
+    end-perform
+
+    display 'exit twentyfour'
+    stop run
+    .
+generate-numbers.
+    perform with test after until divide-by-zero-error = space
+    and 24 * top-denominator = top-numerator
+        compute n(1) = random(seconds-past-midnight) * 10 *> seed
+        perform varying nd from 1 by 1 until nd > 4
+            compute n(nd) = random() * 10
+            perform until n(nd) <> 0
+                compute n(nd) = random() * 10
+            end-perform
+        end-perform
+        perform validate-number
+    end-perform
+    display NL 'numbers:' with no advancing
+    perform varying nd from 1 by 1 until nd > 4
+        display space n(nd) with no advancing
+    end-perform
+    display space
+    .
+validate-number.
+    perform varying p4 from 1 by 1 until p4 > p4-lim
+        move permutation-4(p4) to current-permutation-4
+        perform varying od1 from 1 by 1 until od1 > od-lim
+            move operator-definitions(od1:1) to current-operators(1:1)
+            perform varying od2 from 1 by 1 until od2 > od-lim
+                move operator-definitions(od2:1) to current-operators(2:1)
+                perform varying odx from 1 by 1 until odx > od-lim
+                    move operator-definitions(odx:1) to current-operators(3:1)
+                    perform varying rpx from 1 by 1 until rpx > rpx-lim
+                        move rpn-form(rpx) to current-rpn-form
+                        move 0 to cpx co3
+                        move spaces to output-queue
+                        move 7 to oqx
+                        perform varying oqx1 from 1 by 1 until oqx1 > oqx
+                            if current-rpn-form(oqx1:1) = 'n'
+                                add 1 to cpx
+                                move current-permutation-4(cpx:1) to nd
+                                move n(nd) to output-queue(oqx1:1)
+                            else
+                                add 1 to co3
+                                move current-operators(co3:1) to output-queue(oqx1:1)
+                            end-if
+                        end-perform
+                    end-perform
+                    perform evaluate-rpn
+                    if divide-by-zero-error = space
+                    and 24 * top-denominator = top-numerator
+                        exit paragraph
+                    end-if
+                end-perform
+            end-perform
+        end-perform
+    end-perform
+    .
+display-instructions.
+    display '1)  Type h <enter> to repeat these instructions.'
+    display '2)  The program will display four randomly-generated'
+    display '    single-digit numbers and will then prompt you to enter'
+    display '    an arithmetic expression followed by <enter> to sum'
+    display '    the given numbers to 24.'
+    display '    The four numbers may contain duplicates and the entered'
+    display '    expression must reference all the generated numbers and duplicates.'
+    display '    Warning:  the program converts the entered infix expression'
+    display '    to a reverse polish notation (rpn) expression'
+    display '    which is then interpreted from RIGHT to LEFT.'
+    display '    So, for instance, 8*4 - 5 - 3 will not sum to 24.'
+    display '3)  Type n <enter> to generate a new set of four numbers.'
+    display '    The program will ensure the generated numbers are solvable.'
+    display '4)  Type m#### <enter> (e.g. m1234) to create a fixed set of numbers'
+    display '    for testing purposes.'
+    display '    The program will test the solvability of the entered numbers.'
+    display '    For example, m1234 is solvable and m9999 is not solvable.'
+    display '5)  Type d0, d1, d2 or d3 followed by <enter> to display none or'
+    display '    increasingly detailed diagnostic information as the program evaluates'
+    display '    the entered expression.'
+    display '6)  Type e <enter> to see a list of example expressions and results'
+    display '7)  Type <enter> or q <enter> to exit the program'
+    .
+show-result.
+    if error-found = 'y'
+    or divide-by-zero-error = 'y'
+        exit paragraph
+    end-if
+    display 'statement in RPN is' space output-queue
+    evaluate true
+    when top-numerator = 0
+    when top-denominator = 0
+    when 24 * top-denominator <> top-numerator
+        display 'result (' top-numerator '/' top-denominator ') is not 24'
+    when other
+        display 'result is 24'
+    end-evaluate
+    .
+evaluate-statement.
+    compute l-lim = length(trim(statement))
+
+    display NL 'numbers:' space n(1) space n(2) space n(3) space n(4)
+    move number-definitions to number-use
+    display 'statement is' space statement
+
+    move 1 to l
+    move 0 to loop-count
+    move space to error-found
+
+    move 0 to osx oqx
+    move spaces to output-queue
+
+    move 1 to p
+    move 1 to nt
+    move 0 to s
+    perform increment-s
+    perform display-start-nonterminal
+    perform increment-p
+
+    *>===================================
+    *> interpret ebnf
+    *>===================================
+    perform until s = 0
+    or error-found = 'y'
+
+        evaluate true
+
+        when p-symbol(p) = 'n'
+        and p-definition(p) = 000 *> a variable
+           perform test-variable
+       if s-result(s) = 'S'
+               perform increment-l
+           end-if
+           perform increment-p
+
+       when p-symbol(p) = 'n'
+       and p-address(p) <> p-definition(p) *> nonterminal reference
+           move p to s-p(s)
+           move p-definition(p) to p
+
+       when p-symbol(p) = 'n'
+       and p-address(p) = p-definition(p) *> nonterminal definition
+           perform increment-s
+           perform display-start-nonterminal
+           perform increment-p
+
+        when p-symbol(p) = '=' *> nonterminal control
+            move p to s-start-control(s)
+            move p-matching(p) to s-end-control(s)
+            perform increment-p
+
+        when p-symbol(p) = ';' *> end nonterminal
+            perform display-end-control
+            perform display-end-nonterminal
+            perform decrement-s
+            if s > 0
+                evaluate true
+                when s-result(r) = 'S'
+                    perform set-success
+                when s-result(r) = 'F'
+                    perform set-failure
+                end-evaluate
+                move s-p(s) to p
+                perform increment-p
+                perform display-continue-nonterminal
+            end-if
+
+    when p-symbol(p) = '{' *> start repeat sequence
+            perform increment-s
+            perform display-start-control
+            move p to s-start-control(s)
+            move p-alternate(p) to s-alternate(s)
+            move p-matching(p) to s-end-control(s)
+            move 0 to s-count(s)
+            perform increment-p
+
+        when p-symbol(p) = '}' *> end repeat sequence
+            perform display-end-control
+            evaluate true
+            when s-result(s) = 'S' *> repeat the sequence
+                perform display-repeat-control
+                perform set-nothing
+                add 1 to s-repeat(s)
+                move s-start-control(s) to p
+                perform increment-p
+           when other
+               perform decrement-s
+               evaluate true
+               when s-result(r) = 'N'
+               and s-repeat(r) = 0 *> no result
+                   perform increment-p
+               when s-result(r) = 'N'
+               and s-repeat(r) > 0 *> no result after success
+                   perform set-success
+                   perform increment-p
+               when other *> fail the sequence
+                   perform increment-p
+               end-evaluate
+           end-evaluate
+
+        when p-symbol(p) = '(' *> start sequence
+            perform increment-s
+            perform display-start-control
+            move p to s-start-control(s)
+            move p-alternate(p) to s-alternate(s)
+            move p-matching(p) to s-end-control(s)
+            move 0 to s-count(s)
+            perform increment-p
+
+       when p-symbol(p) = ')' *> end sequence
+           perform display-end-control
+           perform decrement-s
+           evaluate true
+           when s-result(r) = 'S' *> success
+               perform set-success
+               perform increment-p
+           when s-result(r) = 'N' *> no result
+               perform set-failure
+               perform increment-p
+            when other *> fail the sequence
+               perform set-failure
+               perform increment-p
+           end-evaluate
+
+        when p-symbol(p) = '|' *> alternate
+            evaluate true
+            when s-result(s) = 'S' *> exit the sequence
+                perform display-skip-alternate
+                move s-end-control(s) to p
+            when other
+                perform display-take-alternate
+                move p-alternate(p) to s-alternate(s) *> the next alternate
+                perform increment-p
+                perform set-nothing
+            end-evaluate
+
+        when p-symbol(p) = 't' *> terminal
+            move p-definition(p) to t
+            move terminal-symbol-len(t) to t-len
+            perform display-terminal
+            evaluate true
+            when statement(l:t-len) = terminal-symbol(t)(1:t-len) *> successful match
+               perform set-success
+               perform display-recognize-terminal
+               perform process-token
+               move t-len to l-len
+               perform increment-l
+               perform increment-p
+            when s-alternate(s) <> 000 *> we are in an alternate sequence
+               move s-alternate(s) to p
+            when other *> fail the sequence
+               perform set-failure
+               move s-end-control(s) to p
+            end-evaluate
+
+        when other *> end control
+            perform display-control-failure *> shouldnt happen
+
+        end-evaluate
+
+     end-perform
+
+     evaluate true *> at end of evaluation
+     when error-found = 'y'
+         continue
+     when l <= l-lim *> not all tokens parsed
+         display 'error: invalid statement'
+         perform statement-error
+     when number-use <> spaces
+         display 'error:  not all numbers were used: ' number-use
+         move 'y' to error-found
+     end-evaluate
+    .
+increment-l.
+    evaluate true
+    when l > l-lim *> end of statement
+        continue
+    when other
+        add l-len to l
+        perform varying l from l by 1
+        until c(l) <> space
+        or l > l-lim
+            continue
+        end-perform
+        move 1 to l-len
+        if l > l-lim
+            perform end-tokens
+        end-if
+    end-evaluate
+    .
+increment-p.
+    evaluate true
+    when p >= p-max
+        display 'at' space p ' parse overflow'
+            space 's=<' s space s-entry(s) '>'
+        move 'y' to error-found
+    when other
+        add 1 to p
+        perform display-statement
+    end-evaluate
+    .
+increment-s.
+    evaluate true
+    when s >= s-max
+        display 'at' space p ' stack overflow '
+            space 's=<' s space s-entry(s) '>'
+        move 'y' to error-found
+    when other
+        move s to r
+        add 1 to s
+        initialize s-entry(s)
+        move 'N' to s-result(s)
+        move p to s-p(s)
+        move nt to s-nt(s)
+    end-evaluate
+    .
+decrement-s.
+    if s > 0
+        move s to r
+        subtract 1 from s
+        if s > 0
+            move s-nt(s) to nt
+        end-if
+    end-if
+    .
+set-failure.
+    move 'F' to s-result(s)
+    if s-count(s) > 0
+        display 'sequential parse failure'
+        perform statement-error
+    end-if
+    .
+set-success.
+    move 'S' to s-result(s)
+    add 1 to s-count(s)
+    .
+set-nothing.
+    move 'N' to s-result(s)
+    move 0 to s-count(s)
+    .
+statement-error.
+    display statement
+    move spaces to statement
+    move '^ syntax error' to statement(l:)
+    display statement
+    move 'y' to error-found
+    .
+*>=====================
+*> twentyfour semantics
+*>=====================
+test-variable.
+    *> check validity
+    perform varying nd from 1 by 1 until nd > 4
+    or c(l) = n(nd)
+        continue
+    end-perform
+    *> check usage
+    perform varying nu from 1 by 1 until nu > 4
+    or c(l) = u(nu)
+        continue
+    end-perform
+    evaluate true
+    when l > l-lim
+        perform set-failure
+    when c9(l) not numeric
+        perform set-failure
+    when nd > 4
+        display 'invalid number'
+        perform statement-error
+    when nu > 4
+        display 'number already used'
+        perform statement-error
+    when other
+        move space to u(nu)
+        perform set-success
+        add 1 to oqx
+        move c(l) to output-queue(oqx:1)
+    end-evaluate
+    .
+*> ==================================
+*> Dijkstra Shunting-Yard Algorithm
+*> to convert infix to rpn
+*> ==================================
+process-token.
+    evaluate true
+    when c(l) = '('
+        add 1 to osx
+        move c(l) to operator-stack(osx:1)
+    when c(l) = ')'
+        perform varying osx from osx by -1 until osx < 1
+        or operator-stack(osx:1) = '('
+            add 1 to oqx
+            move operator-stack(osx:1) to output-queue(oqx:1)
+        end-perform
+        if osx < 1
+            display 'parenthesis error'
+            perform statement-error
+            exit paragraph
+        end-if
+        subtract 1 from osx
+    when (c(l) = '+' or '-') and (operator-stack(osx:1) = '*' or '/')
+        *> lesser operator precedence
+        add 1 to oqx
+        move operator-stack(osx:1) to output-queue(oqx:1)
+        move c(l) to operator-stack(osx:1)
+    when other
+        *> greater operator precedence
+        add 1 to osx
+        move c(l) to operator-stack(osx:1)
+    end-evaluate
+    .
+end-tokens.
+    *> 1) copy stacked operators to the output-queue
+    perform varying osx from osx by -1 until osx < 1
+    or operator-stack(osx:1) = '('
+        add 1 to oqx
+        move operator-stack(osx:1) to output-queue(oqx:1)
+    end-perform
+    if osx > 0
+        display 'parenthesis error'
+        perform statement-error
+        exit paragraph
+    end-if
+    *> 2) evaluate the rpn statement
+    perform evaluate-rpn
+    if divide-by-zero-error = 'y'
+        display 'divide by zero error'
+    end-if
+    .
+evaluate-rpn.
+    move space to divide-by-zero-error
+    move 0 to rsx *> stack depth
+    perform varying oqx1 from 1 by 1 until oqx1 > oqx
+        if output-queue(oqx1:1) >= '1' and <= '9'
+            *> push current data onto the stack
+            add 1 to rsx
+            move top-numerator to numerator(rsx)
+            move top-denominator to denominator(rsx)
+            move output-queue(oqx1:1) to top-numerator
+            move 1 to top-denominator
+        else
+            *> apply the operation
+            evaluate true
+            when output-queue(oqx1:1) = '+'
+                compute top-numerator = top-numerator * denominator(rsx)
+                    + top-denominator * numerator(rsx)
+                compute top-denominator = top-denominator * denominator(rsx)
+            when output-queue(oqx1:1) = '-'
+                compute top-numerator = top-denominator * numerator(rsx)
+                    - top-numerator * denominator(rsx)
+                compute top-denominator = top-denominator * denominator(rsx)
+            when output-queue(oqx1:1) = '*'
+                compute top-numerator = top-numerator * numerator(rsx)
+                compute top-denominator = top-denominator * denominator(rsx)
+            when output-queue(oqx1:1) = '/'
+                compute work-number = numerator(rsx) * top-denominator
+                compute top-denominator = denominator(rsx) * top-numerator
+                if top-denominator = 0
+                    move 'y' to divide-by-zero-error
+                    exit paragraph
+                end-if
+                move work-number to top-numerator
+            end-evaluate
+            *> pop the stack
+            subtract 1 from rsx
+        end-if
+    end-perform
+    .
+*>====================
+*> diagnostic displays
+*>====================
+display-start-nonterminal.
+    perform varying nt from nt-lim by -1 until nt < 1
+    or p-definition(p) = nonterminal-statement-number(nt)
+        continue
+    end-perform
+    if nt > 0
+        move '1' to NL-flag
+        string '1' indent(1:s + s) 'at ' s space p ' start ' trim(nonterminal-statement(nt))
+            into message-area perform display-message
+        move nt to s-nt(s)
+    end-if
+    .
+display-continue-nonterminal.
+    move s-nt(s) to nt
+    string '1' indent(1:s + s) 'at ' s space p space p-symbol(p) ' continue ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
+            into message-area perform display-message
+    .
+display-end-nonterminal.
+    move s-nt(s) to nt
+    move '2' to NL-flag
+    string '1' indent(1:s + s) 'at ' s space p ' end ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
+            into message-area perform display-message
+    .
+display-start-control.
+    string '2' indent(1:s + s) 'at ' s space p ' start ' p-symbol(p) ' in ' trim(nonterminal-statement(nt))
+        into message-area perform display-message
+    .
+display-repeat-control.
+    string '2' indent(1:s + s) 'at ' s space p ' repeat ' p-symbol(p) ' in ' trim(nonterminal-statement(nt))  ' with result ' s-result(s)
+        into message-area perform display-message
+    .
+display-end-control.
+    string '2' indent(1:s + s) 'at ' s space p ' end ' p-symbol(p)  ' in ' trim(nonterminal-statement(nt)) ' with result ' s-result(s)
+        into message-area perform display-message
+    .
+display-take-alternate.
+    string '2' indent(1:s + s) 'at ' s space p ' take alternate' ' in ' trim(nonterminal-statement(nt))
+        into message-area perform display-message
+    .
+display-skip-alternate.
+    string '2' indent(1:s + s) 'at ' s space p ' skip alternate' ' in ' trim(nonterminal-statement(nt))
+        into message-area perform display-message
+    .
+display-terminal.
+    string '1' indent(1:s + s) 'at ' s space p
+        ' compare ' statement(l:t-len) ' to ' terminal-symbol(t)(1:t-len)
+        ' in ' trim(nonterminal-statement(nt))
+        into message-area perform display-message
+    .
+display-recognize-terminal.
+    string '1' indent(1:s + s) 'at ' s space p ' recognize terminal: ' c(l) ' in ' trim(nonterminal-statement(nt))
+        into message-area perform display-message
+    .
+display-recognize-variable.
+    string '1' indent(1:s + s) 'at ' s space p ' recognize digit: ' c(l) ' in ' trim(nonterminal-statement(nt))
+        into message-area perform display-message
+    .
+display-statement.
+    compute p1 = p - s-start-control(s)
+    string '3' indent(1:s + s) 'at ' s space p
+        ' statement: ' s-start-control(s) '/' p1
+        space p-symbol(p) space s-result(s)
+        ' in ' trim(nonterminal-statement(nt))
+        into message-area perform display-message
+    .
+display-control-failure.
+    display loop-count space indent(1:s + s) 'at' space p ' control failure' ' in ' trim(nonterminal-statement(nt))
+    display loop-count space indent(1:s + s) '   ' 'p=<' p p-entry(p) '>'
+    display loop-count space indent(1:s + s) '   ' 's=<' s space s-entry(s) '>'
+    display loop-count space indent(1:s + s) '   ' 'l=<' l space c(l)'>'
+    perform statement-error
+    .
+display-message.
+    if display-level = 1
+        move space to NL-flag
+    end-if
+    evaluate true
+    when loop-count > loop-lim *> loop control
+        display 'display count exceeds ' loop-lim
+        stop run
+    when message-level <= display-level
+        evaluate true
+        when NL-flag = '1'
+             display NL loop-count space trim(message-value)
+        when NL-flag = '2'
+             display loop-count space trim(message-value) NL
+        when other
+             display loop-count space trim(message-value)
+        end-evaluate
+    end-evaluate
+    add 1 to loop-count
+    move spaces to message-area
+    move space to NL-flag
+    .
+end program twentyfour.

Task/24-game/EasyLang/24-game.easy

@@ -4,7 +4,7 @@ func game .
    len cnt[] 9
    write ">> "
    for i to 4
-      h = random 9
+      h = random 1 9
       write h & " "
       cnt[h] += 1
    .

Task/24-game/PowerShell/24-game.ps1

@@ -0,0 +1,73 @@
+CLS
+
+Function isNumeric ($x)
+{
+    $x2 = 0
+    $isNum = [System.Int32]::TryParse($x,[ref]$x2)
+Return $isNum
+}
+
+$NumberArray = @()
+While( $NumberArray.Count -lt 4 ){
+    $NumberArray += Random -Minimum 1 -Maximum 10
+}
+
+Write-Host @"
+Welcome to the 24 game!
+
+Here are your numbers: $($NumberArray -join ",").
+Use division, multiplication, subtraction and addition to get 24 as a result with these 4 numbers.
+"@
+
+Do
+{
+$Wrong = 0
+$EndResult = $null
+$TempChar = $null
+$TempChar2 = $null
+$Count = $null
+
+$AllowableCharacters = $NumberArray + "+-*/()".ToCharArray()
+    $Result = Read-Host
+        Foreach($Char in $Result.ToCharArray())
+        {
+            If( $AllowableCharacters -notcontains $Char ){ $Wrong = 1 }
+        }
+
+        If($Wrong -eq 1)
+        {
+            Write-Warning "Wrong input! Please use only the given numbers."
+        }
+        Foreach($Char in $Result.ToCharArray())
+        {
+            If((IsNumeric $TempChar) -AND (IsNumeric $Char))
+            {
+                Write-Warning "Wrong input! Combining two or more numbers together is not allowed!"
+            }
+            $TempChar = $Char
+        }
+        Foreach($Char in $Result.ToCharArray())
+        {
+            If(IsNumeric $Char)
+            {
+                $Count++
+            }
+        }
+        If($Count -eq 4)
+        {
+            $EndResult = Invoke-Expression $Result
+                If($EndResult -eq 24)
+                {
+                    Write-Host "`nYou've won the game!"
+                }
+                Else
+                {
+                    Write-Host "`n$EndResult is not 24! Too bad."
+                }
+        }
+        Else
+        {
+            Write-Warning "Wrong input! You did not supply four numbers."
+        }
+}
+While($EndResult -ne 24)

Task/24-game/Rebol/24-game.rebol

@@ -0,0 +1,43 @@
+Rebol [
+    title: "Rosetta code: 24 game"
+    file: %24_game.r3
+    url: https://rosettacode.org/wiki/24_game
+    needs: 3.10.0 ; or something like that (ajoin/with)
+]
+game-24: function/with [
+    /seed val
+][
+    random/seed any [val now/precise]
+    valid: copy/part random digits 4
+    prin  "Using the following numbers, enter an expression that equals 24: "
+    print [valid/1 ", " valid/2 ", " valid/3 " and " valid/4]
+    print "Evaluation from left to right with no precedence, unless you use parenthesis."
+    sort valid
+
+    sucess: false
+
+    while [not sucess] [
+        guess: ask "Enter your expression: "
+        if guess = "q" [halt]
+        numbers: sort copy guess
+        numbers: take/part find numbers digit 4
+        either all [
+            valid = numbers
+            parse guess [some chars end]
+            integer? result: try load ajoin/with split guess 1 #" "
+        ][
+            print ["The result of your expression is: " result]
+            if result = 24 [sucess: true]
+        ][
+            print "Something is wrong with the expression, try again."
+        ]
+    ]
+    print "You got it right!"
+][
+    valid: guess: none
+    digits: "123456789"
+    digit:   charset digits
+    chars:   union digit charset "+-*/()"
+]
+
+game-24/seed 1

Task/4-rings-or-4-squares-puzzle/Ada/4-rings-or-4-squares-puzzle.adb

@@ -0,0 +1,68 @@
+with Ada.Text_IO;
+
+procedure Puzzle_Square_4 is
+
+   procedure Four_Rings (Low, High : in Natural; Unique, Show : in Boolean) is
+      subtype Test_Range is Natural range Low .. High;
+
+      type Value_List is array (Positive range <>) of Natural;
+      function Is_Unique (Values : Value_List) return Boolean is
+         Count : array (Test_Range) of Natural := (others => 0);
+      begin
+         for Value of Values loop
+            Count (Value) := Count (Value) + 1;
+            if Count (Value) > 1 then
+               return False;
+            end if;
+         end loop;
+         return True;
+      end Is_Unique;
+
+      function Is_Valid (A,B,C,D,E,F,G : in Natural) return Boolean is
+         Ring_1 : constant Integer := A + B;
+         Ring_2 : constant Integer := B + C + D;
+         Ring_3 : constant Integer := D + E + F;
+         Ring_4 : constant Integer := F + G;
+      begin
+         return
+           Ring_1 = Ring_2 and
+           Ring_1 = Ring_3 and
+           Ring_1 = Ring_4;
+      end Is_Valid;
+
+      use Ada.Text_IO;
+      Count : Natural := 0;
+   begin
+      for A in Test_Range loop
+         for B in Test_Range loop
+            for C in Test_Range loop
+               for D in Test_Range loop
+                  for E in Test_Range loop
+                     for F in Test_Range loop
+                        for G in Test_Range loop
+                           if Is_Valid (A,B,C,D,E,F,G) then
+                              if not Unique or (Unique and Is_Unique ((A,B,C,D,E,F,G))) then
+                                 Count := Count + 1;
+                                 if Show then
+                                    Put_Line (A'Image & B'Image & C'Image & D'Image & E'Image & F'Image & G'Image);
+                                 end if;
+                              end if;
+                           end if;
+                        end loop;
+                     end loop;
+                  end loop;
+               end loop;
+            end loop;
+         end loop;
+      end loop;
+      Put_Line ("There are " & Count'Image &
+                  (if Unique then " unique " else " non-unique ") &
+                    "solutions in " & Low'Image & " .." & High'Image);
+      New_Line;
+   end Four_Rings;
+
+begin
+   Four_Rings (Low => 1, High => 7, Unique => True,  Show => True);
+   Four_Rings (Low => 3, High => 9, Unique => True,  Show => True);
+   Four_Rings (Low => 0, High => 9, Unique => False, Show => False);
+end Puzzle_Square_4;

Task/4-rings-or-4-squares-puzzle/PARI-GP/4-rings-or-4-squares-puzzle.parigp

@@ -0,0 +1,39 @@
+foursquares(plo, phi, punique, pshow) = {
+    my(lo=plo, hi=phi, unique=punique, show=pshow, solutions, a, b, c, d, e, f, g);
+    print();
+    for (c = lo, hi,
+        for (d = lo, hi,
+            if (!unique || c != d,
+                a = c + d;
+                if (a >= lo && a <= hi && (!unique || (c != 0 && d != 0)),
+                    for (e = lo, hi,
+                        if (!unique || (e != a && e != c && e != d),
+                            g = d + e;
+                            if (g >= lo && g <= hi && (!unique || (g != a && g != c && g != d && g != e)),
+                                for (f = lo, hi,
+                                    if (!unique || (f != a && f != c && f != d && f != g && f != e),
+                                        b = e + f - c;
+                                        if (b >= lo && b <= hi && (!unique || (b != a && b != c && b != d && b != g && b != e && b != f)),
+                                            solutions++;
+                                            if (show, print(a, " ", b, " ", c, " ", d, " ", e, " ", f, " ", g));
+                                        )
+                                    )
+                                )
+                            )
+                        )
+                    )
+                )
+            )
+        )
+    );
+
+    if (unique,
+        print("\n", solutions, " unique solutions in ", lo, " to ", hi);
+    ,
+        print("\n", solutions, " non-unique solutions in ", lo, " to ", hi);
+    );
+}
+
+foursquares(1,7,1,1);
+foursquares(3,9,1,1);
+foursquares(0,9,0,0);

Task/4-rings-or-4-squares-puzzle/Uiua/4-rings-or-4-squares-puzzle.uiua

@@ -0,0 +1,4 @@
+# Solve 4 equations in 7 variables, all distinct.
+Test ← =1⧻◴≡⌟◇(/+⊏){0_1 1_2_3 3_4_5 5_6}
+▽⊸≡Test⧅≠⊸⧻+1⇡7
+▽⊸≡Test⧅≠⊸⧻+3⇡7

Task/9-billion-names-of-God-the-integer/Ada/9-billion-names-of-god-the-integer.adb

@@ -0,0 +1,142 @@
+with Ada.Text_IO;
+with Ada.Numerics.Big_Numbers.Big_Integers;
+
+procedure Names_Of_God is
+
+   NN         : constant := 100_000;
+   Row_Count  : constant := 25;
+   Max_Column : constant := 79;
+
+   package Triangle is
+      procedure Print;
+   end Triangle;
+
+   package Row_Summer is
+      procedure Calc (N : Integer);
+      procedure Put_Sums;
+   end Row_Summer;
+
+   package body Row_Summer is
+      use Ada.Text_IO;
+      use Ada.Numerics.Big_Numbers.Big_Integers;
+
+      P : array (0 .. NN + 1) of Big_Integer := (1, others => 0);
+
+      procedure Calc (N : Integer) is
+      begin
+         P (N) := 0;
+
+         for K in 1 .. N + 1 loop
+            declare
+               Add : constant Boolean := K mod 2 /= 0;
+               D_1 : constant Integer := N - K * (3 * K - 1) / 2;
+               D_2 : constant Integer := D_1 - K;
+            begin
+               exit when D_1 < 0;
+
+               if Add
+               then P (N) := P (N) + P (D_1);
+               else P (N) := P (N) - P (D_1);
+               end if;
+
+               exit when D_2 < 0;
+
+               if Add
+               then P (N) := P (N) + P (D_2);
+               else P (N) := P (N) - P (D_2);
+               end if;
+            end;
+         end loop;
+      end Calc;
+
+      procedure Put_Wrapped (Item : Big_Integer) is
+         Image : constant String := To_String (Item);
+      begin
+         Set_Col (11);
+         for I in Image'Range loop
+            if Ada.Text_IO.Col >= Max_Column then
+               Set_Col (12);
+            end if;
+            Put (Image (I));
+         end loop;
+      end Put_Wrapped;
+
+      procedure Put_Sums
+      is
+         package Integer_IO is new Ada.Text_IO.Integer_IO (Integer);
+
+         Printout : constant array (Natural range <>) of Integer :=
+           (23, 123, 1234, 12_345, 20_000, 30_000, 40_000, 50_000, NN);
+
+         Next : Natural := Printout'First;
+      begin
+         for A in 1 .. Printout (Printout'Last) loop
+            Calc (A);
+            if A = Printout (Next) then
+               Put ("G (");
+               Integer_IO.Put (A, Width => 0);
+               Put (")");
+               Put_Wrapped (P (A));
+               New_Line;
+               Next := Next + 1;
+            end if;
+         end loop;
+      end Put_Sums;
+
+   end Row_Summer;
+
+   package body Triangle is
+
+      Triangle : array (0 .. Row_Count,
+                        0 .. Row_Count) of Integer := (others => (others => 0));
+
+      procedure Calculate is
+      begin
+         Triangle (1,1) := 1;
+         Triangle (2,1) := 1;
+         Triangle (2,2) := 1;
+         Triangle (3,1) := 1;
+         Triangle (3,2) := 1;
+         Triangle (3,3) := 1;
+         for Row in 4 .. Row_Count loop
+            for Col in 1 .. Row loop
+               if Col * 2 > Row then
+                  Triangle (Row, Col) := Triangle (Row - 1, Col - 1);
+               else
+                  Triangle (Row, Col) :=
+                    Triangle (Row - 1, Col - 1) +
+                    Triangle (Row - Col, Col);
+               end if;
+            end loop;
+         end loop;
+      end Calculate;
+
+      procedure Print
+      is
+         use Ada.Text_IO;
+         Width : array (1 .. Row_Count) of Natural := (others => 0);
+      begin
+         for Row in 1 .. Row_count loop
+            for Col in 1 .. Row loop
+               Width (Row) := Width (Row) + Triangle (Row, Col)'Image'Length;
+            end loop;
+         end loop;
+
+         for Row in 1 .. Row_Count loop
+            Set_Col (1 + Positive_Count (1 + Width (Width'Last)
+                                           - Width (Row)) / 2);
+            for Col in 1 .. Row loop
+               Put (Triangle (Row, Col)'Image);
+            end loop;
+            New_Line;
+         end loop;
+      end Print;
+
+   begin
+      Calculate;
+   end Triangle;
+
+begin
+   Triangle.Print;
+   Row_Summer.Put_Sums;
+end Names_Of_God;

Task/9-billion-names-of-God-the-integer/EasyLang/9-billion-names-of-god-the-integer.easy

@@ -0,0 +1,64 @@
+func[] bnadd a[] b[] .
+   if len a[] < len b[] : swap a[] b[]
+   for i = 1 to len a[]
+      bi = 0
+      if i <= len b[] : bi = b[i]
+      h = a[i] + bi + c
+      r[] &= h mod 10000000
+      c = h div 10000000
+   .
+   if c > 0 : r[] &= c
+   return r[]
+.
+func[] bnsub a[] b[] .
+   for i = 1 to len a[]
+      ai = a[i]
+      bi = 0
+      if i <= len b[] : bi = b[i]
+      bi += c
+      c = 0
+      if bi > ai
+         ai += 10000000
+         c = 1
+      .
+      r[] &= ai - bi
+   .
+   while r[$] = 0 : len r[] -1
+   return r[]
+.
+func$ str bn[] .
+   s$ = bn[$]
+   for i = len bn[] - 1 downto 1
+      h$ = bn[i]
+      s$ &= substr "0000000" 1 (7 - len h$) & h$
+   .
+   return s$
+.
+proc parti n &p[][] .
+   subr upd
+      if k mod 2 = 1
+         h[] = bnadd p[n][] p[d][]
+      else
+         h[] = bnsub p[n][] p[d][]
+      .
+      p[n][] = h[]
+   .
+   for k = 1 to n
+      d = n - k * (3 * k - 1) div 2
+      if d < 0 : break 1
+      upd
+      d -= k
+      if d < 0 : break 1
+      upd
+   .
+.
+proc partitions_p n &p[][] .
+   p[][] = [ ]
+   len p[][] n + 1
+   p[0][] = [ 1 ]
+   for i to n : parti i p[][]
+.
+for nn in [ 23 123 1234 12345 ]
+   partitions_p nn p[][]
+   print nn & ": " & str p[nn][]
+.

Task/9-billion-names-of-God-the-integer/FutureBasic/9-billion-names-of-god-the-integer.basic

@@ -0,0 +1,179 @@
+//
+// 9 billion names of G-D the integer
+//
+// Using FutureBasic 7.0.35
+// September 2025, R.W.
+//
+
+include "gmp.incl"    // GMP only (MPFR not needed here)
+
+_kTriMax  = 25
+_kMaxP    = 123456    // compile-time bound for big_p[]
+
+UInt64 tri(_kTriMax, _kTriMax)   // the 25 by 25 triangle
+mpz_t  big_p(_kMaxP)            // partition values P(0.._kMaxP)
+
+//
+// Integer partition via GMP (mpz_t)
+//
+// Computes P(0..partMax) in global big_p[]
+// big_p(xxxxx) will have _kMaxP elements
+//
+// At its largest sum term (123456),
+// it would be greater than 10^385 or hundreds of digits
+// beyond a centillion
+
+local fn ComputePartitions( partMax as long )
+  long i, j, k
+  long a, b
+  mpz_t s
+
+  if partMax > _kMaxP then partMax = _kMaxP
+  // temp accumulator
+  mpz_init( s )
+
+  // base case
+  mpz_set_ui( big_p(0), 1 )
+
+  for i = 1 to partMax
+    // generalized pentagonal sequence setup
+    j = 1
+    k = 1
+    b = 2
+    a = 5
+
+    while j > 0
+      // j = i - (3*k*k+k) \ 2
+      // (implemented incrementally via b,a)
+      j = i - b
+      b = b + a
+      a = a + 3
+
+      if j >= 0
+        if (k AND 1) <> 0
+          mpz_add( s, s, big_p(j) )
+        else
+          mpz_sub( s, s, big_p(j) )
+        end if
+      end if
+      // second term at j + k
+      j = j + k
+      if j >= 0
+        if (k AND 1) <> 0
+          mpz_add( s, s, big_p(j) )
+        else
+          mpz_sub( s, s, big_p(j) )
+        end if
+      end if
+      k ++
+    wend
+
+    mpz_swap( big_p(i), s )
+  next
+
+  mpz_clear( s )
+end fn
+
+//
+// Partition triangle using 64-bit ints
+// p(n,k) -> # of partitions of n with
+// largest part exactly k
+//
+local fn BuildPartitionTriangle
+  CFStringRef pLine, filler
+  pLine = @""
+  filler = @"                                       "
+  long n, k
+
+  // first 3 rows are always 1's
+  tri(1,1) = 1
+  tri(2,1) = 1
+  tri(2,2) = 1
+  tri(3,1) = 1
+  tri(3,2) = 1
+  tri(3,3) = 1
+
+  for n = 4 to _kTriMax
+    for k = 1 to n
+      if k * 2 > n
+        tri(n,k) = tri(n-1, k-1)
+      else
+        tri(n,k) = tri(n-1, k-1) + tri(n-k, k)
+      end if
+    next
+  next
+
+  // display the triangle
+  for n = 1 to 25
+    pLine = @""
+    for k = 1 to n
+      pLine = concat(pLine, mid(str(tri(n,k)),1),@" ")
+    next k
+    pLine = concat(left(filler, 38 - len(pLine)/2) , pLine)
+    print pLine
+  next n
+end fn
+//
+//               MAIN
+// ----------------------------------------------
+Window 1, @"9 Billion Names of G-D the integer",¬
+(0,0,980,540)
+
+long n, k, max
+max = 123456      // must not exceed _kMaxP
+CFStringRef pLine
+pLine = @""
+
+CFTimeInterval t
+t = fn CACurrentMediaTime  // start clock
+
+fn BuildPartitionTriangle
+
+// Initialize big_p(0..kPartMax) to 0
+for n = 0 to max
+  mpz_init( big_p(n) )
+next
+
+// Compute partitions P(0..kPartMax)
+fn ComputePartitions( max )
+print@
+print @"Sums"
+print @"----"
+
+long cxCount
+cxCount = 5
+Int i
+long cx(5)
+cx(1) = 23
+cx(2) = 123
+cx(3) = 1234
+cx(4) = 12345
+cx(5) = 123456
+
+long at
+at = 1
+
+for i = 1 to max
+  if at <= cxCount
+    if i = cx(at)
+      pLine = fn mpz_cf( 10,big_p(i) )
+      print concat( @"G(", mid(str(i),1), @") = ", pLine )
+      at = at + 1
+    end if
+  else
+    exit for
+  end if
+next
+//
+// stop the clock
+print@
+printf @"Elapsed time = %.4f ms.", (fn CACurrentMediaTime - t)*1000
+
+// Cleanup
+for n = 0 to max
+  mpz_clear( big_p(n) )
+next
+
+HandleEvents
+
+//

Task/9-billion-names-of-God-the-integer/Pluto/9-billion-names-of-god-the-integer.pluto

@@ -0,0 +1,39 @@
+local bigint = require "pluto:bigint"
+local fmt = require "fmt"
+
+local zero <const> = bigint.new(0)
+local one  <const> = bigint.new(1)
+
+local cache = {{one}}
+
+local function cumu(n)
+    if #cache <= n then
+        for l = #cache, n do
+            local r = {zero}
+            for x = 1, l do
+                local min =  l - x
+                if x < min then min = x end
+                r:insert(r:back() + cache[l - x + 1][min + 1])
+            end
+            cache:insert(r)
+        end
+    end
+    return cache[n + 1]
+end
+
+local function row(n)
+    local r = cumu(n)
+    return range(1, n):map(|i| -> r[i + 1] - r[i])
+end
+
+print("Rows:")
+for i = 1, 25 do
+    fmt.write("%2d: ", i)
+    local r = row(i)
+    fmt.tprint("%3s", r, #r)
+end
+
+print("\nSums:")
+for {23, 123, 1234, 12345} as i do
+    fmt.print("%5d: %s", i, cumu(i):back())
+end

Task/9-billion-names-of-God-the-integer/Rebol/9-billion-names-of-god-the-integer.rebol

@@ -0,0 +1,101 @@
+Rebol [
+    title: "Rosetta code: 9 billion names of God the integer"
+    file:  %9_billion_names_of_God_the_integer.r3
+    url:    https://rosettacode.org/wiki/9_billion_names_of_God_the_integer
+    needs:  3.0.0
+    note:  {Based on Red language version}
+]
+names-of-god: function/with [
+    row   [integer!] "row number (>= 1)"
+    /show "Display intermediate results"
+    /all  "When showing, print all intermediate data"
+][
+    ;; Validate input - require row >= 1, otherwise trigger a runtime error
+    assert [row >= 1]
+
+    ;; If /show refinement is used, display results for the given row
+    if show [
+        ;; Ensure nums/:row is computed; if not, recursively compute it
+        unless nums/:row [names-of-god row]
+
+        ;; Loop from 1 to row
+        repeat i row [
+            either all [          ;; If /all refinement is used, display extra details
+                probe reduce [i nums/:i sums/:i]  ;; Show index, sequence, and sum
+            ][
+                print nums/:i     ;; Otherwise, just print the sequence
+            ]
+        ]
+    ]
+
+    ;; Compute a new row from scratch (if row not already computed)...
+    unless sum: sums/:row [
+        out: clear []              ;; Temporary storage for row's elements
+        half: to integer! row / 2  ;; Middle position of the row
+
+        ;; Ensure all required previous rows exist; generate missing ones
+        if row - 1 > last: length? nums [
+            repeat i row - last - 1 [
+                names-of-god last + i
+            ]
+        ]
+
+        ;; Build the `out` block for this row
+        repeat col row - 1 [
+            ;; Special case: the middle element
+            either col = (half + 1) [
+                append out at nums/(row - 1) half   ;; Insert from previous row's middle
+                break                              ;; Stop building here
+            ][
+                ;; General case: append sum-part of two earlier sequences
+                append out sum-part nums/(row - col) col
+            ]
+        ]
+
+        ;; Compute the sum of the row
+        sum: 0.0
+        forall out [
+            sum: sum + out/1
+        ]
+
+        ;; Cache the computed row and its sum
+        sums/:row: sum
+        nums/:row: copy out
+        clear out
+    ]
+    sums/:row ;; Return sum of the row
+][
+    ;; ===== WITH BLOCK (local helper definitions and persistent state) =====
+
+    ;; Helper function: sum the first `count` elements from the given block `nums`
+    sum-part: function [nums [block!] count [integer!]][
+        out: 0.0
+        loop count [
+            out: out + nums/1
+            if empty? nums: next nums [break]  ;; Stop if we've exhausted the block
+        ]
+        ;; If within integer range, convert to integer
+        if out <= 0#7fffffffffffffff [out: to integer! out]
+        out
+    ]
+
+    ;; Persistent storage for each computed row (map! with row → sequence)
+    ;; Start with base cases:
+    ;; row 1 = [1]
+    ;; row 2 = [1 1]
+    nums: make map! [1 [1] 2 [1 1]]
+
+    ;; Persistent storage for row sums (map! with row → sum)
+    ;; Base sums: row 1 sum = 1, row 2 sum = 2
+    sums: make map! [1 1 2 2]
+]
+
+
+
+print "rows: ^/"
+names-of-god/show 25
+
+print "^/sums: ^/"
+probe names-of-god 23
+probe names-of-god 123
+probe names-of-god 1234

Task/99-bottles-of-beer/Ada/99-bottles-of-beer-1.adb

@@ -0,0 +1,12 @@
+with Ada.Text_Io; use Ada.Text_Io;
+
+ procedure Bottles is
+ begin
+    for X in reverse 1..99 loop
+       Put_Line(Integer'Image(X) & " bottles of beer on the wall");
+       Put_Line(Integer'Image(X) & " bottles of beer");
+       Put_Line("Take one down, pass it around");
+       Put_Line(Integer'Image(X - 1) & " bottles of beer on the wall");
+       New_Line;
+    end loop;
+ end Bottles;

Task/99-bottles-of-beer/Ada/99-bottles-of-beer-2.adb

@@ -0,0 +1,39 @@
+with Ada.Text_Io; use Ada.Text_Io;
+
+procedure Tasking_99_Bottles is
+   subtype Num_Bottles is Natural range 1..99;
+   task Print is
+      entry Set (Num_Bottles);
+   end Print;
+   task body Print is
+      Num : Natural;
+   begin
+      for I in reverse Num_Bottles'range loop
+         select
+         accept
+            Set(I) do -- Rendezvous with Counter task I
+               Num := I;
+            end Set;
+            Put_Line(Integer'Image(Num) & " bottles of beer on the wall");
+            Put_Line(Integer'Image(Num) & " bottles of beer");
+            Put_Line("Take one down, pass it around");
+            Put_Line(Integer'Image(Num - 1) & " bottles of beer on the wall");
+            New_Line;
+         or terminate; -- end when all Counter tasks have completed
+         end select;
+      end loop;
+   end Print;
+   task type Counter(I : Num_Bottles);
+   task body Counter is
+   begin
+      Print.Set(I);
+   end Counter;
+   type Task_Access is access Counter;
+
+   Task_List : array(Num_Bottles) of Task_Access;
+
+begin
+   for I in Task_List'range loop -- Create 99 Counter tasks
+      Task_List(I) := new Counter(I);
+   end loop;
+end Tasking_99_Bottles;

Task/99-bottles-of-beer/Ballerina/99-bottles-of-beer.ballerina

@@ -0,0 +1,11 @@
+// https://rosettacode.org/wiki/99_bottles_of_beer
+import ballerina/io;
+
+public function main() {
+    foreach int i in int:range(99, 0, -1) {
+        io:print(i); io:println(" bottles of beer on the wall");
+        io:print(i); io:println(" bottles of beer");
+        io:println("Take one down, pass it around");
+        io:print(i-1); io:println(" bottles of beer on the wall\n");
+    }
+}

Task/99-bottles-of-beer/COBOL/99-bottles-of-beer-1.cob

@@ -0,0 +1,104 @@
+identification division.
+program-id. ninety-nine.
+environment division.
+data division.
+working-storage section.
+01	counter	pic 99.
+	88 no-bottles-left value 0.
+	88 one-bottle-left value 1.
+
+01	parts-of-counter redefines counter.
+	05	tens		pic 9.
+	05	digits		pic 9.
+
+01	after-ten-words.
+	05	filler	pic x(7) value spaces.
+	05	filler	pic x(7) value "Twenty".
+	05	filler	pic x(7) value "Thirty".
+	05	filler	pic x(7) value "Forty".
+	05	filler	pic x(7) value "Fifty".
+	05	filler	pic x(7) value "Sixty".
+	05	filler	pic x(7) value "Seventy".
+	05	filler	pic x(7) value "Eighty".
+	05	filler	pic x(7) value "Ninety".
+	05	filler	pic x(7) value spaces.
+
+01	after-ten-array redefines after-ten-words.
+	05	atens occurs 10 times pic x(7).
+
+01	digit-words.
+	05	filler	pic x(9) value "One".
+	05	filler	pic x(9) value "Two".
+	05	filler	pic x(9) value "Three".
+	05	filler	pic x(9) value "Four".
+	05	filler	pic x(9) value "Five".
+	05	filler	pic x(9) value "Six".
+	05	filler	pic x(9) value "Seven".
+	05	filler	pic x(9) value "Eight".
+	05	filler	pic x(9) value "Nine".
+	05	filler	pic x(9) value "Ten".
+	05	filler	pic x(9) value "Eleven".
+	05	filler	pic x(9) value "Twelve".
+	05	filler	pic x(9) value "Thirteen".
+	05	filler	pic x(9) value "Fourteen".
+	05	filler	pic x(9) value "Fifteen".
+	05	filler	pic x(9) value "Sixteen".
+	05	filler	pic x(9) value "Seventeen".
+	05	filler	pic x(9) value "Eighteen".
+	05	filler	pic x(9) value "Nineteen".
+	05	filler	pic x(9) value spaces.
+	
+01	digit-array redefines digit-words.
+	05	adigits occurs 20 times 	pic x(9).
+	
+01	number-name pic x(15).
+
+procedure division.
+100-main section.
+100-setup.
+	perform varying counter from 99 by -1 until no-bottles-left
+		perform 100-show-number
+		display " of beer on the wall"
+		perform 100-show-number
+		display " of beer"
+		display "Take " with no advancing
+		if one-bottle-left
+			display "it " with no advancing
+		else
+			display "one " with no advancing
+		end-if
+		display "down and pass it round"
+		subtract 1 from counter giving counter
+		perform 100-show-number
+		display " of beer on the wall"
+		add 1 to counter giving counter
+		display space
+	end-perform.
+	display "No more bottles of beer on the wall"
+	display "No more bottles of beer"
+	display "Go to the store and buy some more"
+	display "Ninety Nine bottles of beer on the wall"
+	stop run.
+	
+100-show-number.
+	if no-bottles-left
+		display "No more" with no advancing
+	else
+		if counter < 20
+			display function trim( adigits( counter ) ) with no advancing
+		else
+			if counter < 100
+				move spaces to number-name
+				string atens( tens ) delimited by space, space delimited by size, adigits( digits ) delimited by space into number-name
+				display function trim( number-name) with no advancing
+			end-if
+		end-if
+	end-if.
+	if one-bottle-left
+		display " bottle" with no advancing
+	else
+		display " bottles" with no advancing
+	end-if.
+
+100-end.
+end-program.

Task/99-bottles-of-beer/COBOL/99-bottles-of-beer-2.cob

@@ -0,0 +1,122 @@
+identification division.
+program-id. ninety-nine.
+environment division.
+data division.
+working-storage section.
+01	counter	pic 99.
+	88 no-bottles-left value 0.
+	88 one-bottle-left value 1.
+
+01	parts-of-counter redefines counter.
+	05	tens		pic 9.
+	05	digits		pic 9.
+
+01	after-ten-words.
+	05	filler	pic x(7) value spaces.
+	05	filler	pic x(7) value "Twenty".
+	05	filler	pic x(7) value "Thirty".
+	05	filler	pic x(7) value "Forty".
+	05	filler	pic x(7) value "Fifty".
+	05	filler	pic x(7) value "Sixty".
+	05	filler	pic x(7) value "Seventy".
+	05	filler	pic x(7) value "Eighty".
+	05	filler	pic x(7) value "Ninety".
+	05	filler	pic x(7) value spaces.
+
+01	after-ten-array redefines after-ten-words.
+	05	atens occurs 10 times pic x(7).
+
+01	digit-words.
+	05	filler	pic x(9) value "One".
+	05	filler	pic x(9) value "Two".
+	05	filler	pic x(9) value "Three".
+	05	filler	pic x(9) value "Four".
+	05	filler	pic x(9) value "Five".
+	05	filler	pic x(9) value "Six".
+	05	filler	pic x(9) value "Seven".
+	05	filler	pic x(9) value "Eight".
+	05	filler	pic x(9) value "Nine".
+	05	filler	pic x(9) value "Ten".
+	05	filler	pic x(9) value "Eleven".
+	05	filler	pic x(9) value "Twelve".
+	05	filler	pic x(9) value "Thirteen".
+	05	filler	pic x(9) value "Fourteen".
+	05	filler	pic x(9) value "Fifteen".
+	05	filler	pic x(9) value "Sixteen".
+	05	filler	pic x(9) value "Seventeen".
+	05	filler	pic x(9) value "Eighteen".
+	05	filler	pic x(9) value "Nineteen".
+	05	filler	pic x(9) value spaces.
+
+01	digit-array redefines digit-words.
+	05	adigits occurs 20 times 	pic x(9).
+
+01	number-name pic x(15).
+
+01	stringified pic x(30).
+01	outline		pic x(50).
+01  other-numbers.
+	03	n	pic 999.
+	03	r	pic 999.
+	
+procedure division.
+100-main section.
+100-setup.
+	perform varying counter from 99 by -1 until no-bottles-left
+		move spaces to outline
+		perform 100-show-number
+		string stringified delimited by "|", space, "of beer on the wall" into outline end-string
+		display outline end-display
+		move spaces to outline
+		string stringified delimited by "|", space, "of beer" into outline end-string
+		display outline end-display
+		move spaces to outline
+		move "Take" to outline
+		if one-bottle-left
+			string outline delimited by space, space, "it" delimited by size, space, "|" into outline end-string
+		else
+			string outline delimited by space, space, "one" delimited by size, space, "|" into outline end-string
+		end-if
+		string outline delimited by "|", "down and pass it round" delimited by size into outline end-string
+		display outline end-display
+		move spaces to outline
+		subtract 1 from counter giving counter end-subtract
+		perform 100-show-number
+		string stringified delimited by "|", space, "of beer on the wall" into outline end-string
+		display outline end-display
+		add 1 to counter giving counter end-add
+		display space end-display
+	end-perform.
+	display "No more bottles of beer on the wall"
+	display "No more bottles of beer"
+	display "Go to the store and buy some more"
+	display "Ninety-Nine bottles of beer on the wall"
+	stop run.
+
+100-show-number.
+	if no-bottles-left
+		move "No more|" to stringified
+	else
+		if counter < 20
+			string function trim( adigits( counter ) ), "|" into stringified
+		else
+			if counter < 100
+				move spaces to number-name
+				string atens( tens ) delimited by space, space delimited by size, adigits( digits ) delimited by space into number-name end-string
+				move function trim( number-name) to stringified
+				divide counter by 10 giving n remainder r end-divide
+				if r not = zero
+					inspect stringified replacing first space by "-"
+				end-if
+				inspect stringified replacing first space by "|"
+			end-if
+		end-if
+	end-if.
+	if one-bottle-left
+		string stringified delimited by "|", space, "bottle|" delimited by size into stringified end-string
+	else
+		string stringified delimited by "|", space, "bottles|" delimited by size into stringified end-string
+	end-if.
+
+100-end.
+end-program.