Data update

Task/100-doors/CBASIC/100-doors.basic

@@ -0,0 +1,27 @@
+dim doors%(100)
+
+print "Finding solution to the 100 Doors Problem"
+
+rem - all doors are initially closed
+for i% = 1 to 100
+  doors%(i%) = 0
+next i%
+
+rem - pass through at increasing intervals
+for i% = 1 to 100
+  for j% = i% to 100 step i%
+    rem - flip each door encountered
+    doors%(j%) = 1 - doors%(j%)
+  next j%
+next i%
+
+rem - show which doors are open
+print "The open doors are: ";
+for i% = 1 to 100
+  if doors%(i%) = 1 then print i%;
+next i%
+
+print
+print "Thanks for consulting the puzzle guru!"
+
+end

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

@@ -4,7 +4,7 @@ type Door
 model
   int id
   Door:State state
-  new by int =id, Door:State =state do end
+  new by int ←id, Door:State ←state do end
   fun toggle ← <|me.state ← when(me.state æ Door:State.CLOSED, Door:State.OPEN, Door:State.CLOSED)
   fun asText ← <|"Door #" + me.id + " is " + when(me.state æ Door:State.CLOSED, "closed", "open")
 end

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

@@ -0,0 +1,24 @@
+package main
+
+import "core:fmt"
+
+main :: proc() {
+ using fmt
+
+  Door_State :: enum {Closed, Open}
+
+  doors := [?]Door_State { 0..<100 = .Closed }
+
+  for i in  1..=100 {
+    for j := i-1; j < 100; j += i {
+      if doors[j] == .Closed {
+        doors[j] = .Open
+      } else {
+        doors[j] = .Closed
+      }
+    }
+  }
+  for state, i in doors {
+    println("Door: ",int(i+1)," -> ",state)
+  }
+}

Task/100-doors/Odin/100-doors-2.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/OmniMark/100-doors-1.xom

@@ -0,0 +1,18 @@
+process
+  local switch doors size 100 ; all initialised ('1st pass' to false)
+
+  repeat over doors
+    repeat for integer door from #item to 100 by #item
+      do when doors[door] = false
+        activate doors[door] ; illustrating alternative to set ... to
+      else
+        set doors[door] to false
+      done
+    again
+  again
+
+  repeat over doors
+    do when doors = true
+      put #error '%d(#item)%n'
+    done
+  again

Task/100-doors/OmniMark/100-doors-2.xom

@@ -0,0 +1,10 @@
+process
+  local integer door initial {1}
+  local integer step initial {3}
+
+  repeat
+    output "Door %d(door) is open%n"
+    increment door by step
+    increment step by 2
+    exit when door > 100
+  again

Task/100-doors/PascalABC.NET/100-doors.pas

@@ -1,8 +0,0 @@
-// 100 doors. Nigel Galloway: January 1th., 2023
-type doorState=(Open,Closed);
-function flip(n:doorState):doorState:=if n=Open then Closed else Open;
-var Doors:Array of doorState:=ArrFill(100,Closed);
-begin
-  for var n:=1 to 100 do for var g:=n-1 to 99 step n do Doors[g]:=flip(Doors[g]);
-  for var n:=0 to 99 do if Doors[n]=Open then write(n+1,' '); writeLn
-end.

Task/100-doors/Tailspin/100-doors-1.tailspin

@@ -2,7 +2,10 @@ source hundredDoors
   @: [ 1..100 -> 0 ];
   templates toggle
     def jump: $;
-    $jump..100:$jump -> \(when <?($@hundredDoors($) <=0>)> do @hundredDoors($): 1;  otherwise @hundredDoors($): 0;\) -> !VOID
+    $jump..100:$jump -> \(
+      when <?($@hundredDoors($) <=0>)> do @hundredDoors($): 1;
+      otherwise @hundredDoors($): 0;
+    \) -> !VOID
   end toggle
   1..100 -> toggle -> !VOID
   $@ -> \[i](<=1> ' $i;' !\) !

Task/100-doors/Tailspin/100-doors-2.tailspin

@@ -0,0 +1,14 @@
+hundredDoors source
+  @ set [ 1..100 -> 0 ];
+  toggle templates
+    jump is $;
+    $jump..100:$jump -> templates
+      when <|?($@hundredDoors($) matches <|=0>)> do @hundredDoors($) set 1;
+      otherwise @hundredDoors($) set 0;
+    end -> !VOID
+  end toggle
+  1..100 -> toggle -> !VOID
+  $@(.. as i; -> if <|=1> -> ' $i;') !
+end hundredDoors
+
+$hundredDoors -> 'Open doors:$...;' !

Task/100-doors/YAMLScript/100-doors.ys

@@ -3,14 +3,15 @@
 defn main():
   say: |-
     Open doors after 100 passes:
-    $(apply str interpose(', ' open-doors()))
+    $(open-doors().join(', '))
 
 defn open-doors():
-  for [[d n] map(vector doors() iterate(inc 1)) :when d]:
-    n
+  ? for [d n] map(vector doors() range().drop(1))
+        :when d
+  : n
 
 defn doors():
   reduce:
-    fn(doors idx): assoc(doors idx true)
+    fn(doors idx): doors.assoc(idx true)
     into []: repeat(100 false)
-    map \(dec (%1 * %1)): 1 .. 10
+    map \(sqr(_).--): 1 .. 10

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

@@ -4,7 +4,7 @@ for i = 1 to 100
 .
 subr shuffle_drawer
    for i = len drawer[] downto 2
-      r = randint i
+      r = random i
       swap drawer[r] drawer[i]
    .
 .
@@ -13,7 +13,7 @@ subr play_random
    for prisoner = 1 to 100
       found = 0
       for i = 1 to 50
-         r = randint (100 - i)
+         r = random (100 - i)
          card = drawer[sampler[r]]
          swap sampler[r] sampler[100 - i - 1]
          if card = prisoner

Task/100-prisoners/YAMLScript/100-prisoners.ys

@@ -0,0 +1,79 @@
+!yamlscript/v0
+
+defn main(n=5000):
+  :: https://rosettacode.org/wiki/100_prisoners
+
+  random-successes optimal-successes run-count =:
+    simulate-n-runs(n)
+      .slice(q(random-successes optimal-successes run-count))
+
+  say: "Probability of survival with random search: $F(random-successes / run-count)"
+
+  say: "Probability of survival with ordered search: $F(optimal-successes / run-count)"
+
+defn simulate-n-runs(n):
+  :: Simulate n runs of the 100 prisoner problem and returns a success count
+     for each search method.
+
+  loop random-successes 0, optimal-successes 0, run-count 0:
+    # If we've done the loop n times
+    if n == run-count:
+      # return results
+      then::
+        random-successes  :: random-successes
+        optimal-successes :: optimal-successes
+        run-count         :: run-count
+
+      # Otherwise, run for another batch of prisoners
+      else:
+        next-result =: simulate-100-prisoners()
+        recur:
+          (random-successes + next-result.random)
+          (optimal-successes + next-result.optimal)
+          run-count.++
+
+defn simulate-100-prisoners():
+  :: Simulates all prisoners searching the same drawers by both strategies,
+     returns map showing whether each was successful.
+
+  # Create 100 drawers with randomly ordered prisoner numbers:
+  drawers =: random-drawers()
+  hash-map:
+    :random   try-luck(drawers search-50-random-drawers)
+    :optimal  try-luck(drawers search-50-optimal-drawers)
+
+defn try-luck(drawers drawer-searching-function):
+  :: Returns 1 if all prisoners find their number otherwise 0.
+
+  loop prisoners range(100):
+    if prisoners.?:
+      if prisoners.0.drawer-searching-function(drawers):
+        recur: rest(prisoners)
+        else: 0
+      else: 1
+
+defn search-50-optimal-drawers(prisoner-number drawers):
+  :: Open 50 drawers according to the agreed strategy, returning true if
+     prisoner's number was found.
+
+  loop next-drawer prisoner-number, drawers-opened 0:
+    when drawers-opened != 50:
+      result =: drawers.$next-drawer
+      result == prisoner-number ||:
+        recur: result drawers-opened.++
+
+defn search-50-random-drawers(prisoner-number drawers):
+  :: Select 50 random drawers and return true if the prisoner's number was
+     found.
+
+  drawers:
+    .shuffle()
+    .take(50)
+    .filter(eq(prisoner-number))
+    .count()
+    .eq(1)
+
+defn random-drawers():
+  :: Returns a list of shuffled numbers.
+
+  shuffle: range(100)

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

@@ -1,4 +1,4 @@
-sys topleft
+sysconf topleft
 background 432
 textsize 13
 len f[] 16
@@ -44,7 +44,7 @@ proc init . .
    .
    # shuffle
    for i = 15 downto 2
-      r = randint i
+      r = random i
       swap f[r] f[i]
    .
    # make it solvable

Task/15-puzzle-game/Jq/15-puzzle-game.jq

@@ -0,0 +1,93 @@
+include "MRG32k3a" {search: "."};  # see above
+
+# The following may be omitted if using the C implementation of jq
+def _nwise($n):
+  def n: if length <= $n then . else .[0:$n] , (.[$n:] | n) end;
+  n;
+
+### Generic utilities
+
+def lpad($len): tostring | ($len - length) as $l | (" " * $l) + .;
+
+# tabular print
+def tprint($columns; $width):
+  reduce _nwise($columns) as $row ("";
+     . + ($row|map(lpad($width)) | join(" ")) + "\n" );
+
+def array_swap($i; $j):
+  if $j < $i then array_swap($j;$i)
+  elif $i == $j then .
+  else .[:$i] + [.[$j]] + .[$i+1:$j] + [.[$i]] + .[$j+1:]
+  end ;
+
+### Pre-requisite: MRG32k3a
+# Input: an array to be shuffled
+# Output: the shuffled array using a seed based on `now`
+def shuffle:
+  { prng: (seed(now | tostring | sub("^.*[.]";"") | tonumber)),
+    array: . }
+  | knuthShuffle
+  | .array;
+
+### 15-Puzzle
+
+# Pretty-print the board
+def pp:
+  .board | map(if . == 0 then "" end) | tprint(4;3);
+
+def row: ./4 | floor;
+def col: . % 4;
+
+def move($p):
+  .zero as $zero
+  | (.board |= array_swap($zero; $p))
+  | .zero = $p
+  | .n += 1 ;
+
+def SolvedBoard: [range(1;16), 0];
+
+# Output: {goal, n, board, zero}
+def init($easy):
+  SolvedBoard as $init
+  | { goal: $init,
+      n: 0,          # number of moves so far
+      board: ($init | if $easy then array_swap(14;15) else shuffle end)
+    }
+  | .zero = (.board|index(0)) ;
+
+# If $m is a valid single-letter move, then emit the corresponding
+# index of the proposed new position.
+# Input must include .zero
+def isValidMove($m):
+  if   ($m == "u") then if (.zero|row) != 0 then .zero - 4 else false end
+  elif ($m == "d") then if (.zero|row) != 3 then .zero + 4 else false end
+  elif ($m == "r") then if (.zero|col) != 3 then .zero + 1 else false end
+  elif ($m == "l") then if (.zero|col) != 0 then .zero - 1 else false end
+  else false
+  end;
+
+def instructions:
+  "Please enter \"u\", \"d\", \"l\", or \"r\" to move the empty cell",
+  "up, down, left, or right. You can also enter \"q\" to quit.",
+  "Upper or lowercase is accepted and only the first character",
+  "is important, so for example you could enter `up` instead of `u`.";
+
+def play($easy):
+  def prompt:
+    pp,
+    if .board == .goal then "Congratulations. You solved the puzzle in \(.n) moves."
+    else
+      "Enter move #\(.n + 1) (u, d, l, r or q): ",
+      ( (limit(1;inputs)[:1]|ascii_downcase) as $m
+        | if $m == "q" then halt
+          else isValidMove($m) as $p
+          | if $p then move($p) | prompt
+            else "Invalid move.", prompt
+            end
+          end)
+    end;
+
+  instructions,
+  (init($easy) | prompt);
+
+play(ARGS.named.easy)

Task/15-puzzle-game/Zig/15-puzzle-game.zig

@@ -64,7 +64,7 @@ fn waitForMove() !Move {
 }
 
 fn shuffle(moves: u8) !void {
-    var random = std.rand.DefaultPrng.init(@intCast(std.time.microTimestamp()));
+    var random = std.Random.DefaultPrng.init(@intCast(std.time.microTimestamp()));
     const rand = random.random();
     var n: u8 = 0;
     while (n < moves) {

Task/15-puzzle-solver/Jq/15-puzzle-solver.jq

@@ -0,0 +1,192 @@
+# The following may be omitted if using the C implementation
+# or if the debug messages are deleted.
+def debug(msg): (msg | tostring | debug | empty), .;
+
+### Generic functions
+
+def array_swap($i; $j):
+  if $j < $i then array_swap($j;$i)
+  elif $i == $j then .
+  else .[:$i] + [.[$j]] + .[$i+1:$j] + [.[$i]] + .[$j+1:]
+  end ;
+
+def sum(s): reduce s as $x (0; . + $x);
+
+### The 15-Puzzle
+
+# manhattan distance between points $ix and $iy where these are indices in the flat array
+def distance($ix; $jx):
+  def row: ./4 | floor;
+  def col: . % 4;
+  [$ix, $jx]
+  | map(row) as $mr  # [$ri, $rj]
+  | map(col) as $mc  # [$ci, $cj]
+  | [$mr[0] - $mr[1], $mc[0] - $mc[1]]
+  | map(length) # i.e. abs
+  | add;
+
+# What is the Manhattan distance between the position of $tile in the goal
+# and the location corresponding to index $ix, where $ix is in range(0;16)
+def manhattan($tile; $ix):
+  .position[$tile|tostring] as $jx
+  | distance($ix; $jx);
+
+# The total of the discrepancies
+def total_manhattan_distance:
+  sum( range(0;16) as $p | .board[$p] as $tile | select($tile != 0) | manhattan($tile; $p) )
+  | debug;
+
+# Input:
+#  .goal is the desired board (flat array)
+#  .position is the JSON object mapping tiles to the goal index
+#  .zero is the location of 0
+#  .board is the current state of the board (flat array)
+#  .distance is incremented by $delta after each move
+#  .seen is our memory
+# If allowed, move the zero tile to $p where $p has been properly specified in relation to .zero;
+# otherwise emit empty
+def move($p):
+  if $p >= 0 and $p < 16
+  then .board[$p] as $tile
+  # Are we making things worse off?
+  | (manhattan($tile; .zero) - manhattan($tile; $p)) as $delta
+  | if $delta > 0 and .distance > (.N - .n)
+    then if .n >= .N then debug({n, N, distance,sequence: (.sequence|length)}) end | empty
+    else # make the move
+    .zero as $zero
+    | (.board | array_swap($zero; $p)) as $candidate
+    | ($candidate|tostring) as $s
+    | if .seen[$s]
+      then empty
+      else .board = $candidate
+      | .zero = $p
+      | .n += 1
+      | .seen[$s] = true
+      end
+    end
+  # We should only reach here if the move has been made
+  | if $delta != 0
+    then .distance += $delta
+    end
+  else empty
+  end
+;
+
+def row: . / 4 | floor;
+def col: . % 4;
+
+def up:
+  if (.zero | row) == 0 then empty
+  else move(.zero - 4)
+  | .sequence += ["u"]
+  end;
+
+def down:
+  if (.zero | row) == 3 then empty
+  else move(.zero + 4)
+  | .sequence += ["d"]
+  end;
+
+def left:
+  if (.zero|col) == 0 then empty
+  else move(.zero - 1)
+  | .sequence += ["l"]
+  end;
+
+def right:
+  if (.zero|col) == 3 then empty
+  else move(.zero + 1)
+  | .sequence += ["r"]
+  end;
+
+# $array is a permutation of range(0;16), e.g. the goal
+# Output: a JSON object such that .[$tile] is the position of $tile in the goal
+def positions($array):
+  reduce range(0; $array|length) as $i ({}; . + {($array[$i]|tostring): $i});
+
+# map a string of lowercase hex digits to an array of decimals
+def symbols2array: explode | map(if . > 96 then .-87 else .-48 end);
+
+# $start should be a string of length 16 representing the starting state;
+# the goal is: "123456789abcdef0"
+def init($start):
+  if $start|length == 16 then . else error end
+  | [range(1;16), 0] as $init
+  | {goal: $init,
+     position: positions($init),
+     distance: 0,
+     n: 0,           # number of moves so far
+     sequence: [],   # the sequence of moves so far
+     seen: {}
+  }
+  | .board =  ($start | symbols2array)
+  | .zero = (.board|index(0))
+  | (.board|tostring) as $s
+  | .seen[$s] = true
+;
+
+# Output: If the move of the zero tile to $p is legal in one step,
+#         then emit manhattan($tile; .zero) - manhattan($tile; $p)
+#         where $tile is the tile at $p;
+#         otherwise: null
+def delta_move($p):
+  if $p >= 0 and $p < 16
+  then distance($p; .zero) as $base
+  | if ($base|length) == 1  # abs
+    then .board[$p] as $tile
+    | manhattan($tile; .zero) - manhattan($tile; $p)
+    else null
+    end
+  else null
+  end ;
+
+# For comparing the possible moves:
+def moves:
+   {"u": delta_move( .zero - 4),
+    "d": delta_move( .zero + 4),
+    "l": delta_move( .zero - 1),
+    "r": delta_move( .zero + 1) }
+   | to_entries
+   | map(select( .value ) )
+   | sort_by(.value)
+   ;
+
+
+# input: the output of moves
+def execute($moves):
+  ($moves[] |.key) as $key
+  |   if $key == "l" then left
+    elif $key == "r" then right
+    elif $key == "u" then up
+    elif $key == "d" then down
+    else empty
+    end;
+
+# $N is the maximum number of moves allowed
+# Input: as per `input`; .n is the number of moves so far
+def possible_moves($N):
+  def possible_moves:
+    if .board == .goal then .  # a solution
+    elif (.sequence|length) >= $N then empty
+    else .sequence[-1] as $lastmove
+    | if   $lastmove == "l"  then execute(moves | map(select(.key != "r")))
+      elif $lastmove == "r"  then execute(moves | map(select(.key != "l")))
+      elif $lastmove == "u"  then execute(moves | map(select(.key != "d")))
+      elif $lastmove == "d"  then execute(moves | map(select(.key != "u")))
+      else                        execute(moves)
+      end
+    | possible_moves
+    end ;
+  possible_moves;
+
+def solve($goal):
+  init($goal)
+  | total_manhattan_distance as $d
+  | first( range($d; 100) as $n
+           | .N = $n
+           | .distance = $d
+           | debug("before: n=\($n) distance = \($d))")
+           | possible_moves($n)
+           | .sequence | join("") ) ;
+
+solve("fe169b4c0a73d852")

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

@@ -17,7 +17,7 @@ repeat
   else
     sleep 1
     if sum mod 4 = 1
-      n = randint 3
+      n = random 3
     else
       n = 4 - (sum + 3) mod 4
     .

Task/21-game/J/21-game.j

@@ -1,37 +1,32 @@
-g21=: summarize@play@setup ::('g21: error termination'"_)
+g21=: summarize@play@setup ::'g21: error termination'
 
-NB. non-verb must be defined before use, otherwise are assumed verbs.
-Until=: 2 :'u^:(0-:v)^:_'
+Until=: {{u^:(0-:v)^:_}}
 
-t=: 'score turn choice'
-(t)=: i. # ;: t
-empty erase't'
-
-Fetch=: &{
-Alter=: }
+'score turn choice'=: 0 1 2
 
 play=: move Until done
-done=: 21 <: score Fetch
-move=: [: update you`it@.(turn Fetch)
+move=: [: update you`it@.(turn&{)
+done=: 21 <: score&{
+
 
 update=: swap@display@add
-add=: score Alter~ (score Fetch + choice Fetch)
-display=: [ ([: echo 'sum: {}' format~ score Fetch)
-swap=: turn Alter~ ([: -. turn Fetch)
+add=: score}~ score&{ + choice&{
+display=: [ 'sum: {}' echo@format~ score&{
+swap=: turn}~ [: -. turn&{
 
-it=: ([ [: echo 'It chose {}.' format~ choice Fetch)@(choice Alter~ cb)
-cb=: (1:`r`3:`2:)@.(4 | score Fetch)     NB. computer brain
-r=: 3 :'>:?3'
+it=: ([ 'It chose {}.' echo@format~ choice&{)@(choice}~ cb)
+cb=: 1:`(>:@?@3)`3:`2:@.(4 | score&{)     NB. computer brain
 
 you=: qio1@check@acquire@prompt
-prompt=: [ ([: echo 'your choice?'"_)
-acquire=: choice Alter~ ('123' i. 0 { ' ' ,~ read)
-check=: (choice Alter~ (665 - score Fetch))@([ ([: echo 'g21: early termination'"_))^:(3 = choice Fetch)
-qio1=: choice Alter~ ([: >: choice Fetch)
+prompt=: [ echo@'your choice?'
+acquire=: choice}~'123'i.0{' ',~read
+check=: (choice}~ 665 - score&{)@([ echo@'g21: early termination')^:(3 = choice&{)
+qio1=: choice}~ ([: >: choice&{)
 
-setup=: ([ [: echo 'On your turn enter 1 2 or 3, other entries exit'"_)@((3 :'?2') turn Alter ])@0 0 0"_  NB. choose first player randomly
-summarize=: ' won' ,~  (];._2 'it you ') {~ turn Fetch
+setup=: ([ echo@'On your turn enter 1 2 or 3, other entries exit')@(?@2 turn} ])@0 0 0  NB. choose first player randomly
 
-read=: 1!:1@:1:
-write=: 1!:2 4: NB. unused
-format=: ''&$: :([: ; (a: , [: ":&.> [) ,. '{}' ([ (E. <@}.;._1 ]) ,) ])
+summarize=: ' won',~ ];._2@'it you '{~turn&{
+
+read=: 1!:1@1
+write=: 1!:2&4 NB. unused
+format=: ''&$: : ([: ; (a: , [: ":&.> [) ,. '{}' ([ (E. <@}.;._1 ]) ,) ])

Task/24-game-Solve/Fortran/24-game-solve-3.f

@@ -0,0 +1,481 @@
+module game24_module
+    use omp_lib
+    use iso_fortran_env, only: int64
+    implicit none
+    ! Define constants
+    integer, parameter :: max_limit = 8     ! Maximum allowed value for the number of inputs
+    integer, parameter :: expr_len = 200   ! Maximum length for expressions
+
+    ! Precomputed total calls for n=6,7,8
+    integer(int64), parameter :: total_calls_n6 = 20000000_int64
+    integer(int64), parameter :: total_calls_n7 = 2648275200_int64
+    integer(int64), parameter :: total_calls_n8 = 444557593600_int64
+
+    !----------------------- Progress Indicator Variables ---------------------
+    integer(int64) :: total_calls = 0           ! Total number of recursive calls
+    integer(int64) :: completed_calls = 0       ! Number of completed recursive calls
+    integer :: last_percentage = -1              ! Last percentage reported
+    integer, parameter :: progress_bar_width = 50  ! Width of the progress bar
+    character(len=1) :: carriage_return = char(13) ! Carriage return character
+    logical :: show_progress = .false.           ! Flag to show progress bar
+    !--------------------------------------------------------------------------
+contains
+
+    !-----------------------------------------------------------------------
+    ! ! Aborted function: calculate_total_calls
+    ! ! Description:
+    ! !   Estimates the total number of recursive calls for a given n,
+    ! !   considering commutativity (addition and multiplication).
+    ! ! Arguments:
+    ! !   n: The number of input numbers.
+    ! ! Returns:
+    ! !   The estimated total number of recursive calls as an integer.
+    ! !-----------------------------------------------------------------------
+    ! integer function calculate_total_calls(n)
+    !     implicit none
+    !     integer, intent(in) :: n
+    !     integer :: k
+    !     calculate_total_calls = 1
+    !     do k = 2, n
+    !         ! For each pair, there are 6 possible operations:
+    !         ! 1 addition, 1 multiplication (commutative)
+    !         ! 2 subtraction, 2 division (non-commutative)
+    !         calculate_total_calls = calculate_total_calls * ((k * (k - 1)) / 2) * 6
+    !     end do
+    ! end function calculate_total_calls
+
+    !-----------------------------------------------------------------------
+    ! Subroutine: convert_to_number
+    ! Description:
+    !   Converts user input (numbers or card values) into numeric values.
+    !   Handles card values such as 'A', 'J', 'Q', 'K' and converts them into
+    !   corresponding numbers (A=1, J=11, Q=12, K=13).
+    ! Arguments:
+    !   input_str: Input string representing the number or card.
+    !   number:    Output real number after conversion.
+    !   ios:       I/O status indicator (0 for success, non-zero for error).
+    !-----------------------------------------------------------------------
+    subroutine convert_to_number(input_str, number, ios)
+        implicit none
+        character(len=*), intent(in) :: input_str
+        real, intent(out)            :: number
+        integer, intent(out)         :: ios
+        character(len=1)             :: first_char
+        real                         :: temp_number
+
+        ios = 0  ! Reset the I/O status to 0 (valid input by default)
+        first_char = input_str(1:1)
+
+        select case (first_char)
+        case ('A', 'a')
+            number = 1.0
+        case ('J', 'j')
+            number = 11.0
+        case ('Q', 'q')
+            number = 12.0
+        case ('K', 'k')
+            number = 13.0
+        case default
+            read (input_str, *, iostat=ios) temp_number  ! Attempt to read a real number
+
+            ! If input is not a valid real number or is not an integer, set ios to 1
+            if (ios /= 0 .or. mod(temp_number, 1.0) /= 0.0) then
+                ios = 1  ! Invalid input
+            else
+                number = temp_number  ! Valid integer input
+            end if
+        end select
+    end subroutine convert_to_number
+
+    !-----------------------------------------------------------------------
+    ! Subroutine: remove_decimal_zeros
+    ! Description:
+    !   Removes trailing zeros after the decimal point from a string.
+    ! Arguments:
+    !   str:    Input string that may contain trailing zeros.
+    !   result: Output string with trailing zeros removed.
+    !-----------------------------------------------------------------------
+    subroutine remove_decimal_zeros(str, result)
+        implicit none
+        character(len=*), intent(in)  :: str       ! Input: String to remove zeros from
+        character(len=*), intent(out) :: result    ! Output: String without trailing zeros
+        integer                        :: i, len_str  ! Loop counter and string length
+
+        len_str = len_trim(str)
+        result = adjustl(str(1:len_str))
+
+        ! Find the position of the decimal point
+        i = index(result, '.')
+
+        ! If there's a decimal point, remove trailing zeros
+        if (i > 0) then
+            do while (len_str > i .and. result(len_str:len_str) == '0')
+                len_str = len_str - 1
+            end do
+            if (result(len_str:len_str) == '.') len_str = len_str - 1
+            result = result(1:len_str)
+        end if
+    end subroutine remove_decimal_zeros
+
+    !-----------------------------------------------------------------------
+    ! Subroutine: create_new_arrays
+    ! Description:
+    !   Creates new arrays after performing an operation.
+    ! Arguments:
+    !   nums:      Input array of numbers.
+    !   exprs:     Input array of expressions.
+    !   idx1:      Index of the first element to remove.
+    !   idx2:      Index of the second element to remove.
+    !   result:    Result of the operation.
+    !   new_expr:  New expression string.
+    !   new_nums:  Output array of numbers with elements removed and result added.
+    !   new_exprs: Output array of expressions with elements removed and new_expr added.
+    !-----------------------------------------------------------------------
+    subroutine create_new_arrays(nums, exprs, idx1, idx2, result, new_expr, new_nums, new_exprs)
+        implicit none
+        real, intent(in)                        :: nums(:)       ! Input: Array of numbers
+        character(len=expr_len), intent(in)     :: exprs(:)      ! Input: Array of expressions
+        integer, intent(in)                     :: idx1, idx2    ! Input: Indices of elements to remove
+        real, intent(in)                        :: result        ! Input: Result of the operation
+        character(len=expr_len), intent(in)     :: new_expr      ! Input: New expression
+        real, allocatable, intent(out)          :: new_nums(:)   ! Output: New array of numbers
+        character(len=expr_len), allocatable, intent(out) :: new_exprs(:) ! Output: New array of expressions
+        integer                                 :: i, j, n       ! Loop counters and size of input arrays
+
+        n = size(nums)
+        allocate (new_nums(n - 1))
+        allocate (new_exprs(n - 1))
+
+        j = 0
+        do i = 1, n
+            if (i /= idx1 .and. i /= idx2) then
+                j = j + 1
+                new_nums(j) = nums(i)
+                new_exprs(j) = exprs(i)
+            end if
+        end do
+
+        ! Add the result of the operation to the new arrays
+        new_nums(n - 1) = result
+        new_exprs(n - 1) = new_expr
+    end subroutine create_new_arrays
+
+    !-----------------------------------------------------------------------
+    ! Subroutine: update_progress_bar
+    ! Description:
+    !   Updates and displays the horizontal percentage-based progress bar.
+    ! Arguments:
+    !   None
+    !-----------------------------------------------------------------------
+    subroutine update_progress_bar()
+        implicit none
+        real :: percentage
+        integer :: filled_length
+        character(len=progress_bar_width) :: bar
+        integer :: int_percentage
+
+        if (total_calls == 0 .or. .not. show_progress) return  ! Avoid division by zero and check the flag
+
+        percentage = real(completed_calls) / real(total_calls) * 100.0
+
+        ! Ensure percentage does not exceed 100%
+        if (percentage > 100.0) percentage = 100.0
+
+        ! Calculate integer percentage
+        int_percentage = int(percentage)
+
+        ! Update progress bar only when percentage increases by at least 1%
+        if (int_percentage > last_percentage) then
+            last_percentage = int_percentage
+
+            ! Calculate the filled length of the progress bar
+            filled_length = min(int(percentage / 100.0 * progress_bar_width), progress_bar_width)
+
+            ! Construct the progress bar string
+            bar = repeat('=', filled_length)
+            if (filled_length < progress_bar_width) then
+                bar = bar//'>'//repeat(' ', progress_bar_width - filled_length - 1)
+            end if
+
+            ! Print the progress bar and integer percentage
+            write (*, '(A, F4.1, A)', advance='no') carriage_return//'['//bar//'] ', percentage, '%'
+            call flush (0)  ! Ensure output is displayed immediately
+        end if
+    end subroutine update_progress_bar
+
+    !-----------------------------------------------------------------------
+    ! Recursive Subroutine: solve_24
+    ! Description:
+    !   Recursively solves the 24 game by trying all possible operations.
+    !   Utilizes OpenMP tasks for parallelization.
+    ! Arguments:
+    !   nums:   Array of numbers to use in the game.
+    !   exprs:  Array of string expressions representing the numbers.
+    !   found:  Logical flag indicating if a solution has been found.
+    !-----------------------------------------------------------------------
+    recursive subroutine solve_24(nums, exprs, found)
+        use omp_lib
+        implicit none
+        real, intent(in)                         :: nums(:)       ! Input: Array of numbers
+        character(len=expr_len), intent(in)      :: exprs(:)      ! Input: Array of expressions
+        logical, intent(inout)                   :: found         ! Input/Output: Flag indicating if a solution is found
+        integer                                  :: n             ! Size of the input arrays
+        integer                                  :: i, j, op      ! Loop counters
+        real                                     :: a, b, result  ! Temporary variables for calculations
+        real, allocatable                        :: new_nums(:)   ! Temp array to store numbers after an operation
+        character(len=expr_len), allocatable     :: new_exprs(:)  ! Temp array to store expressions after an operation
+        character(len=expr_len)                  :: expr_a, expr_b, new_expr ! Temp variables for expressions
+
+        n = size(nums)
+
+        ! Increment the completed_calls counter and update progress bar
+        if (show_progress) then
+            !$omp atomic
+            completed_calls = completed_calls + 1
+            call update_progress_bar()
+        end if
+
+        ! If a solution is found, return
+        if (found) return
+
+        ! Base case: If only one number is left, check if it is 24
+        if (n == 1) then
+            if (abs(nums(1) - 24.0) < 1e-4) then
+                if (show_progress) then
+                    write (*, '(A, F5.1, A)', advance='no') carriage_return//'['//repeat('=', progress_bar_width)//'] ', 100.0, '%'
+                    write (*, '(A)') ''  ! Insert a blank line
+                end if
+                !$omp critical
+                write (*, '(A, A, A, F10.7, A)') 'Solution found:', trim(exprs(1)), '= 24 (', nums(1), ')'
+                found = .true.
+                !$omp end critical
+            end if
+            return
+        end if
+
+        ! Iterate over all pairs of numbers
+        do i = 1, n - 1
+            do j = i + 1, n
+                a = nums(i)
+                b = nums(j)
+                expr_a = exprs(i)
+                expr_b = exprs(j)
+
+                ! Iterate over all operators
+                do op = 1, 4
+                    ! Avoid division by zero
+                    if ((op == 4 .and. abs(b) < 1e-6)) cycle
+
+                    ! Perform the operation and create the new expression
+                    select case (op)
+                    case (1)
+                        result = a + b
+                        new_expr = '('//trim(expr_a)//'+'//trim(expr_b)//')'
+                    case (2)
+                        result = a - b
+                        new_expr = '('//trim(expr_a)//'-'//trim(expr_b)//')'
+                    case (3)
+                        result = a * b
+                        new_expr = '('//trim(expr_a)//'*'//trim(expr_b)//')'
+                    case (4)
+                        result = a / b
+                        new_expr = '('//trim(expr_a)//'/'//trim(expr_b)//')'
+                    end select
+
+                    ! Create new arrays with the selected numbers removed
+                    call create_new_arrays(nums, exprs, i, j, result, new_expr, new_nums, new_exprs)
+
+                    ! For the first few recursion levels, create parallel tasks
+                    if (n >= 6 .and. omp_get_level() < 2) then
+                        !$omp task shared(found) firstprivate(new_nums, new_exprs)
+                        call solve_24(new_nums, new_exprs, found)
+                        !$omp end task
+                    else
+                        call solve_24(new_nums, new_exprs, found)
+                    end if
+
+                    ! If a solution is found, deallocate memory and return
+                    if (found) then
+                        deallocate (new_nums)
+                        deallocate (new_exprs)
+                        return
+                    end if
+
+                    ! Handle commutative operations only once
+                    if (op == 1 .or. op == 3) cycle
+
+                    ! Swap operands for subtraction and division
+                    if (op == 2 .or. op == 4) then
+                        if (op == 4 .and. abs(a) < 1e-6) cycle  ! Avoid division by zero
+
+                        select case (op)
+                        case (2)
+                            result = b - a
+                            new_expr = '('//trim(expr_b)//'-'//trim(expr_a)//')'
+                        case (4)
+                            result = b / a
+                            new_expr = '('//trim(expr_b)//'/'//trim(expr_a)//')'
+                        end select
+
+                        ! Create new arrays with the selected numbers removed
+                        call create_new_arrays(nums, exprs, i, j, result, new_expr, new_nums, new_exprs)
+
+                        ! For the first few recursion levels, create parallel tasks
+                        if (n >= 6 .and. omp_get_level() < 2) then
+                            !$omp task shared(found) firstprivate(new_nums, new_exprs)
+                            call solve_24(new_nums, new_exprs, found)
+                            !$omp end task
+                        else
+                            ! Recursively call the solve_24 function with the new arrays
+                            call solve_24(new_nums, new_exprs, found)
+                        end if
+
+                        ! If a solution is found, deallocate memory and return
+                        if (found) then
+                            deallocate (new_nums)
+                            deallocate (new_exprs)
+                            return
+                        end if
+                    end if
+
+                end do  ! End of operator loop
+            end do  ! End of j loop
+        end do  ! End of i loop
+    end subroutine solve_24
+
+end module game24_module
+
+program game24
+    use game24_module
+    implicit none
+
+    ! Declare variables
+    integer                        :: maxn            ! Number of numbers to be entered by the user
+    real, allocatable              :: numbers(:)      ! Array to store the numbers entered by the user
+    character(len=expr_len), allocatable :: expressions(:)  ! Array to store the expressions
+    integer                        :: i, ios          ! Loop counter and I/O status
+    logical                        :: found_solution  ! Flag to indicate if a solution was found
+    character(len=10)              :: user_input      ! Variable to store user input
+    character(len=1)               :: play_again      ! Variable to store the user's decision
+
+    do  ! Game loop to allow restarting the game
+
+        ! Prompt the user for the number of numbers to use in the game
+        do
+            write (*, '(A,I0,A)', advance='no') 'Enter the number of numbers (1 to ', max_limit, '): '
+            read (*, *, iostat=ios) maxn
+
+            ! Check if the input is valid
+            if (ios /= 0) then
+                write (*, '(A,I0,A)') 'Invalid input. Please enter an integer between 1 and ', max_limit, '.'
+                cycle
+            end if
+
+            ! Validate the input: Ensure the number of numbers is within the valid range
+            if (maxn < 1 .or. maxn > max_limit) then
+                write (*, '(A,I0,A)') 'Error: Number of numbers must be between 1 and ', max_limit, '. Try again.'
+                cycle
+            end if
+
+            exit  ! Exit loop if the input is valid
+        end do
+
+        ! Allocate memory for the arrays based on the number of numbers
+        allocate (numbers(maxn))
+        allocate (expressions(maxn))
+
+        ! Prompt the user to enter the numbers or card values
+        write (*, '(A,I0,A)') 'Enter ', maxn, ' numbers or card values (A=1, J=11, Q=12, K=13).'
+        do i = 1, maxn
+            do
+                ! Prompt the user to enter a number or card value
+                write (*, '(A,I0,A)', advance='no') 'Enter value for card ', i, ': '
+                read (*, '(A)', iostat=ios) user_input
+
+                ! Check if input is an integer or valid card symbol (A, J, Q, K)
+                call convert_to_number(user_input, numbers(i), ios)
+
+                ! If the input is valid, exit loop
+                if (ios == 0) exit
+
+                ! Invalid input: prompt the user to try again
+                write (*, '(A)') 'Invalid input. Please enter an integer or valid card symbol (A, J, Q, K).'
+            end do
+
+            ! Convert the number to a string expression and remove trailing zeros
+            write (expressions(i), '(F0.2)') numbers(i)
+            call remove_decimal_zeros(expressions(i), expressions(i))
+        end do
+
+        ! Initialize the solution flag to false
+        found_solution = .false.
+
+        ! Assign precomputed total_calls based on n
+        select case (maxn)
+        case (6)
+            total_calls = total_calls_n6
+        case (7)
+            total_calls = total_calls_n7
+        case (8)
+            total_calls = total_calls_n8
+        case default
+            total_calls = 0
+        end select
+
+        ! Decide whether to show progress bar based on n
+        if (maxn >= 6) then
+            show_progress = .true.
+            completed_calls = 0
+            last_percentage = -1
+
+            ! Initialize progress bar display
+            write (*, '(A)', advance='no') '['//repeat(' ', progress_bar_width)//'] 0%'
+            call flush (0)  ! Ensure the output is displayed immediately
+        else
+            show_progress = .false.
+        end if
+
+        ! Start parallel region
+        !$omp parallel
+        !$omp single nowait
+        call solve_24(numbers, expressions, found_solution)
+        !$omp end single
+        !$omp end parallel
+
+        ! After search completes, ensure the progress bar reaches 100% if shown
+        if (show_progress .and. .not. found_solution) then
+            write (*, '(A, A)', advance='no') carriage_return//'['//repeat('=', progress_bar_width)//'] 100%  '
+            call flush (0)
+            write (*, '(A)') ''  ! Insert a blank line
+        end if
+
+        ! If a solution was found and progress bar is shown, ensure a blank line
+        if (show_progress .and. found_solution) then
+            ! Progress bar already refreshed to 100% and blank line inserted in solve_24
+        end if
+
+        ! If no solution was found, print a message
+        if (.not. found_solution) then
+            write (*, '(A)') 'No valid solution found.'
+        end if
+
+        ! Deallocate the memory used by the arrays
+        deallocate (numbers)
+        deallocate (expressions)
+
+        ! Ask the user if they want to play again
+        if (show_progress) then
+            write (*, '(A)', advance='no') carriage_return//'Play again? (Enter y/n to continue or any other key to exit): '
+        else
+            write (*, '(A)', advance='no') 'Play again? (Enter y/n to continue or any other key to exit): '
+        end if
+        read (*, '(A)') play_again  ! Read user input
+
+        ! Check if the user wants to exit
+        if (play_again /= 'y' .and. play_again /= 'Y') exit
+
+    end do  ! End of game loop
+
+    write (*, '(A)') 'Exiting the game...'
+
+end program game24

Task/24-game-Solve/FutureBasic/24-game-solve.basic

@@ -15,7 +15,6 @@ void local fn eval( t as CFStringRef )
   end if
 end fn
 
-
 clear local fn work( t as CFStringRef )
   Short a, b, c, d, e, f, g
   CGFloat n(3)
@@ -44,7 +43,6 @@ clear local fn work( t as CFStringRef )
   next : next : next : next
 end fn
 
-
 window 1, @"24 Game", ( 0, 0,  250, 250 )
 fn work(@"3388")
 fn work(@"1346")

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

@@ -0,0 +1,69 @@
+print "Enter an equation in RPN form using all of, and"
+print "only the following single digits which evaluates"
+print "to 24. Only '*', '/', '+' and '-' are allowed:"
+func game .
+   len cnt[] 9
+   write ">> "
+   for i to 4
+      h = random 9
+      write h & " "
+      cnt[h] += 1
+   .
+   print ""
+   s$ = input
+   print s$
+   if s$ = ""
+      return 1
+   .
+   for c$ in strchars s$
+      if c$ = "+" or c$ = "-" or c$ = "*" or c$ = "/"
+         if len st[] < 2
+            print "Stack empty"
+            return 1
+         .
+         if c$ = "+"
+            st[$ - 1] = st[$ - 1] + st[$]
+         elif c$ = "-"
+            st[$ - 1] = st[$ - 1] - st[$]
+         elif c$ = "*"
+            st[$ - 1] = st[$ - 1] * st[$]
+         else
+            st[$ - 1] = st[$ - 1] / st[$]
+         .
+         len st[] -1
+      elif c$ <> " "
+         h = strcode c$ - 48
+         if h < 1 or h > 9
+            print "Wrong command " & c$
+            return 0
+         .
+         if cnt[h] = 0
+            print "Wrong number " & h
+            return 0
+         .
+         cnt[h] -= 1
+         st[] &= h
+      .
+   .
+   for c in cnt[]
+      s += c
+   .
+   if s > 0
+      print "Not all numbers used"
+      return 0
+   .
+   if len st[] > 1
+      print "Calculation not finished"
+      return 0
+   .
+   print st[1]
+   if abs (st[1] - 24) < 1e-10
+      print "Well done"
+   else
+      print "Wrong result"
+   .
+.
+repeat
+   print ""
+   until game = 1
+.

Task/9-billion-names-of-God-the-integer/ALGOL-68/9-billion-names-of-god-the-integer.alg

@@ -0,0 +1,41 @@
+INT number of rows = 123;
+MODE NAMEG = LONG INT;
+
+
+[ number of rows ]REF[]NAMEG c;
+[ number ofrows ]      NAMEG names;
+FOR i TO UPB names DO
+    names[ i ] := 0;
+    c[ i ] := HEAP [ i ]NAMEG;
+    FOR j TO i DO c[ i ][ j ] := 0 OD
+OD;
+
+FOR n TO UPB names DO
+    FOR col TO n DO
+        c[ n ][ col ] := IF   col = 1                         THEN 1
+                         ELIF col = 2                         THEN n OVER 2
+                         ELIF col >= n - 1                    THEN 1
+                         ELIF ( n - col ) < col               THEN names[ n - col ]
+                         ELIF ( n - col ) = col AND NOT ODD n THEN names[ n - col ]
+                         ELSE
+                             NAMEG partial sum := 0;
+                             FOR k TO col DO partial sum +:= c[ n - col ][ k ] OD;
+                             partial sum
+                         FI
+    OD;
+    names[ n ]:= 0;
+    FOR k TO n DO names[ n ] +:= c[ n ][ k ] OD
+; IF n MOD 200 = 0 THEN print( ( "...", whole( n, 0 ), newline ) ) FI
+OD;
+
+# display the first 25 rows of the triangle #
+FOR n TO 25 DO
+    print( ( "(", whole( names[ n ], -6 ), ")", whole( n, -3 ), ":" ) );
+    FOR col TO n DO
+        print( ( " ", whole( c[ n ][ col ], -3 ) ) )
+    OD;
+    print( ( newline ) )
+OD;
+
+print( ( "   23: ", whole( names[    23 ], 0 ), newline ) );
+print( ( "  123: ", whole( names[   123 ], 0 ), newline ) )

Task/99-bottles-of-beer/EMal/99-bottles-of-beer.emal

@@ -1,30 +1,28 @@
 type NinetynineBottles
-int DEFAULT_BOTTLES_COUNT = 99
+int DEFAULT_BOTTLES_COUNT ← 99
 model
   int initialBottlesCount, bottlesCount
-  new by int =bottlesCount
-    me.initialBottlesCount = bottlesCount
+  new by int ←bottlesCount
+    me.initialBottlesCount ← bottlesCount
   end
-  fun subject = <|when(me.bottlesCount == 1, "bottle", "bottles")
-  fun bottles = <|when(me.bottlesCount == 0, "no more", text!me.bottlesCount)
-  fun goToWall = void by block
-    text line = me.bottles() + " " + me.subject() + " of beer on the wall, " +
+  fun subject ← <|when(me.bottlesCount æ 1, "bottle", "bottles")
+  fun bottles ← <|when(me.bottlesCount æ 0, "no more", text!me.bottlesCount)
+  fun goToWall ← void by block
+    text line ← me.bottles() + " " + me.subject() + " of beer on the wall, " +
       me.bottles() + " " + me.subject() + " of beer."
-	if me.bottlesCount == 0 do line[0] = line[0].upper() end # text can be modified
+	if me.bottlesCount æ 0 do line[0] ← line[0].upper() end # text can be modified
     writeLine(line)
   end
-  fun takeOne = logic by block
+  fun takeOne ← logic by block
     if --me.bottlesCount < 0 do return false end # cannot take a beer down
     writeLine("Take one down and pass it around, " + me.bottles() +
       " " + me.subject() + " of beer on the wall.")
     writeLine()
     return true
   end
-  fun goToStore = void by block
-    writeLine("Go to the store and buy some more, " + me.initialBottlesCount +
-      " bottles of beer on the wall.")
-  end
-  fun play = void by block
+  fun goToStore ← <|writeLine("Go to the store and buy some more, " +
+    me.initialBottlesCount + " bottles of beer on the wall.")
+  fun play ← void by block
     for ever
       me.goToWall()
       if not me.takeOne()