  [ this ] is 100prisoners.qky

  [ dup size 2 / split ]                          is halve     (   [ --> [ [ )

  [ stack ]                                       is successes (     --> s   )

  [ [] swap times [ i join ] shuffle ]            is drawers   (   n --> [   )

  [ false unrot
    temp put
    dup shuffle
    halve drop
    witheach
      [ dip dup peek
        temp share = if
        [ dip not
          conclude ] ]
    drop
    temp release ]                                is naive     ( [ n --> b   )

  [ false unrot
    dup temp put
    over size 2 / times
      [ dip dup peek
        dup temp share = if
        [ rot not unrot
          conclude ] ]
    2drop
    temp release ]                                is smart     ( [ n --> b   )

  [ ]'[ temp put
    drawers
    0 successes put
    dup size times
      [ dup i temp share do
        successes tally ]
    size successes take =
    temp release ]                                is prisoners (   n --> b   )

  [ say "100 naive prisoners were pardoned "
    0 10000 times [ 100 prisoners naive + ] echo
    say " times out of 10000 simulations." cr

    say "100 smart prisoners were pardoned "
    0 10000 times [ 100 prisoners smart + ] echo
    say " times out of 10000 simulations." cr ]   is simulate  (     -->     )


#lang racket
(require srfi/1)

(define current-samples (make-parameter 10000))
(define *prisoners* 100)
(define *max-guesses* 50)

(define (evaluate-strategy instance-solved? strategy (s (current-samples)))
  (/ (for/sum ((_ s) #:when (instance-solved? strategy)) 1) s))

(define (build-drawers)
  (list->vector (shuffle (range *prisoners*))))

(define (100-prisoners-problem strategy)
  (every (strategy (build-drawers)) (range *prisoners*)))

(define ((strategy-1 drawers) p)
  (any (λ (_) (= p (vector-ref drawers (random *prisoners*)))) (range *max-guesses*)))

(define ((strategy-2 drawers) p)
  (define-values (_ found?)
    (for/fold ((d p) (found? #f)) ((_ *max-guesses*)) #:break found?
      (let ((card (vector-ref drawers d))) (values card (= card p)))))
  found?)

(define (print-sample-percentage caption f (s (current-samples)))
  (printf "~a: ~a%~%" caption (real->decimal-string (* 100 f) (- (order-of-magnitude s) 2))))

(module+ main
  (print-sample-percentage "random" (evaluate-strategy 100-prisoners-problem strategy-1))
  (print-sample-percentage "optimal" (evaluate-strategy 100-prisoners-problem strategy-2)))


unit sub MAIN (:$prisoners = 100, :$simulations = 10000);
my @prisoners = ^$prisoners;
my $half = floor +@prisoners / 2;

sub random ($n) {
    ^$n .race.map( {
        my @drawers = @prisoners.pick: *;
        @prisoners.map( -> $prisoner {
            my $found = 0;
            for @drawers.pick($half) -> $card {
                $found = 1 and last if $card == $prisoner
            }
            last unless $found;
            $found
        }
        ).sum == @prisoners
    }
    ).grep( *.so ).elems / $n * 100
}

sub optimal ($n) {
    ^$n .race.map( {
        my @drawers = @prisoners.pick: *;
        @prisoners.map( -> $prisoner {
            my $found = 0;
            my $card = @drawers[$prisoner];
            if $card == $prisoner {
                $found = 1
            } else {
                for ^($half - 1) {
                    $card = @drawers[$card];
                    $found = 1 and last if $card == $prisoner
                }
            }
            last unless $found;
            $found
        }
        ).sum == @prisoners
    }
    ).grep( *.so ).elems / $n * 100
}

say "Testing $simulations simulations with $prisoners prisoners.";
printf " Random play wins: %.3f%% of simulations\n", random $simulations;
printf "Optimal play wins: %.3f%% of simulations\n", optimal $simulations;


Red []

K_runs: 100000
repeat n 100 [append rand_arr: []  n]              ;; define array/series with numbers 1..100

;;-------------------------------
strat_optimal: function [pris ][
;;-------------------------------
  locker: pris                                    ;; start with locker equal to prisoner number
  loop 50 [
    if Board/:locker = pris [ return true ]       ;; locker with prisoner number found
    locker: Board/:locker
  ]
  false                                           ;; number not found - fail
]
;;-------------------------------
strat_rand: function [pris ][
;;-------------------------------
  random rand_arr                                                 ;; define set of  random lockers
  repeat n 50 [ if Board/(rand_arr/:n) = pris [ return true ]  ]  ;; try first 50, found ? then return success
  false
]

;;------------------------------
check_board: function [ strat][
;;------------------------------
repeat pris 100 [                                                   ;; for each prisoner
  either  strat = 'optimal [ unless strat_optimal pris [return false ]  ]
                            [ unless strat_rand pris [return false ]  ]
]
  true                                                  ;; all 100 prisoners passed test
]

saved: saved_rand: 0                                    ;; count all saved runs per strategy
loop K_runs [
  Board: random copy rand_arr                           ;; new board for every run
  if  check_board 'optimal [saved: saved + 1]           ;; optimal stategy
  if  check_board 'rand [saved_rand: saved_rand + 1]  ;; 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 ]


/*REXX program to simulate the problem of 100 prisoners:  random,  and optimal strategy.*/
parse arg men trials seed .                      /*obtain optional arguments from the CL*/
if    men=='' |    men==","  then    men=    100 /*number of   prisoners   for this run.*/
if trials=='' | trials==","  then trials= 100000 /*  "     "  simulations   "    "   "  */
if datatype(seed, 'W')  then call random ,,seed  /*seed for the random number generator.*/
try= men % 2;                swaps= men * 3      /*number tries for searching for a card*/
$.1= ' a simple ';           $.2= "an optimal"   /*literals used for the SAY instruction*/
say center(' running'  commas(trials)   "trials with"  commas(men)  'prisoners ', 70, "═")
say
    do strategy=1  for 2;    pardons= 0          /*perform the two types of strategies. */

      do trials;             call gCards         /*do trials for a strategy;  gen cards.*/
        do p=1  for men  until failure           /*have each prisoner go through process*/
        if strategy==1  then failure= simple()   /*Is 1st strategy?  Use simple strategy*/
                        else failure= picker()   /* " 2nd     "       "  optimal   "    */
        end   /*p*/                              /*FAILURE ≡ 1?  Then a prisoner failed.*/
      if #==men  then pardons= pardons + 1       /*was there a pardon of all prisoners? */
      end     /*trials*/                         /*if 1 prisoner fails, then they all do*/

    pc= format( pardons/trials*100, , 3);                           _= left('', pc<10)
    say right('Using', 9)  $.strategy  "strategy yields pardons "   _||pc"%  of the time."
    end       /*strategy*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas:  parse arg _;  do c=length(_)-3  to 1  by -3; _= insert(',', _, c); end;  return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
gCards: #= 0;                do j=1  for men;  @.j= j             /*define seq. of cards*/
                             end   /*j*/                          /*same as seq. of men.*/
               do swaps;             a= random(1, men)            /*get 1st rand number.*/
                   do until  b\==a;  b= random(1, men)            /* "  2nd   "     "   */
                   end   /*until*/                                /* [↑] ensure A ¬== B */
               parse value  @.a @.b  with  @.b @.a                /*swap 2 random cards.*/
               end       /*swaps*/;  return
/*──────────────────────────────────────────────────────────────────────────────────────*/
simple: !.= 0; do try;         do until !.?==0; ?= random(1, men) /*get random card ··· */
                               end   /*until*/                    /*··· not used before.*/
               if @.?==p  then do;   #= #+1;  return 0;  end      /*found his own card? */
               !.?= 1                                             /*flag as being used. */
               end   /*try*/;        return 1                     /*didn't find his card*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
picker: ?= p;  do try; if @.?==p  then do;   #= #+1;    return 0  /*Found his own card? */
                                       end       /* [↑]  indicate success for prisoner. */
               ?= @.?                            /*choose next drawer from current card.*/
               end   /*try*/;        return 1    /*choose half of the number of drawers.*/


prisoners = [*1..100]
N = 10_000
generate_rooms = ->{ [nil]+[*1..100].shuffle }

res = N.times.count do
  rooms = generate_rooms[]
  prisoners.all? {|pr| rooms[1,100].sample(50).include?(pr)}
end
puts "Random strategy : %11.4f %%" % (res.fdiv(N) * 100)

res = N.times.count do
  rooms = generate_rooms[]
  prisoners.all? do |pr|
    cur_room = pr
    50.times.any? do
      found = (rooms[cur_room] == pr)
      cur_room = rooms[cur_room]
      found
    end
  end
end
puts "Optimal strategy: %11.4f %%" % (res.fdiv(N) * 100)


class MAIN is
   shuffle (a: ARRAY{INT}) is
      ARR_PERMUTE_ALG{INT, ARRAY{INT}}::shuffle(a);
   end;

   try_random (n: INT, drawers: ARRAY{INT}, tries: INT): BOOL is
      my_tries ::= drawers.inds; shuffle(my_tries);
      loop tries.times!;
         if drawers[my_tries.elt!] = n then return true; end;
      end;
      return false;
   end;

   try_optimal (n: INT, drawers: ARRAY{INT}, tries: INT): BOOL is
      num ::= n;
      loop tries.times!;
         num := drawers[num];
         if num = n then return true; end;
      end;
      return false;
   end;

   stats (label: STR, rounds, successes: INT): STR is
      return #FMT("<^###########>: <#######> rounds. Successes: <#######> (<##.###>%%)\n",
                   label, rounds, successes, (successes.flt / rounds.flt)*100.0).str;
   end;

   try (name: STR, nrounds, ndrawers, npris, ntries: INT,
        strategy: ROUT{INT,ARRAY{INT},INT}:BOOL)
   is
      drawers: ARRAY{INT} := #(ndrawers);
      loop drawers.set!(drawers.ind!); end;
      successes ::= 0;
      loop nrounds.times!;
         shuffle(drawers);
         success ::= true;
         loop
            n ::= npris.times!;
            if ~strategy.call(n, drawers, ntries) then
               success := false;
               break!;
            end;
         end;
         if success then successes := successes + 1; end;
      end;
      #OUT + stats(name, nrounds, successes);
   end;

   main is
      RND::seed := #TIMES.wall_time;
      #OUT +"100 prisoners, 100 drawers, 50 tries:\n";
      try("random",  100000, 100, 100, 50, bind(try_random(_, _, _)));
      try("optimal", 100000, 100, 100, 50, bind(try_optimal(_, _, _)));

      #OUT +"\n10 prisoners, 10 drawers, 5 tries:\n";
      try("random",  100000, 10, 10, 5, bind(try_random(_, _, _)));
      try("optimal", 100000, 10, 10, 5, bind(try_optimal(_, _, _)));
   end;
end;


import scala.util.Random
import scala.util.control.Breaks._

object Main {
  def playOptimal(n: Int): Boolean = {
    val secretList = Random.shuffle((0 until n).toBuffer)

    for (i <- secretList.indices) {
      var prev = i
      breakable {
        for (_ <- 0 until secretList.size / 2) {
          if (secretList(prev) == i) {
            break()
          }
          prev = secretList(prev)
        }
        return false
      }
    }

    true
  }

  def playRandom(n: Int): Boolean = {
    val secretList = Random.shuffle((0 until n).toBuffer)

    for (i <- secretList.indices) {
      val trialList = Random.shuffle((0 until n).toBuffer)

      breakable {
        for (j <- 0 until trialList.size / 2) {
          if (trialList(j) == i) {
            break()
          }
        }
        return false
      }
    }

    true
  }

  def exec(n: Int, p: Int, play: Int => Boolean): Double = {
    var succ = 0.0
    for (_ <- 0 until n) {
      if (play(p)) {
        succ += 1
      }
    }
    (succ * 100.0) / n
  }

  def main(args: Array[String]): Unit = {
    val n = 100000
    val p = 100
    printf("# of executions: %,d\n", n)
    printf("Optimal play success rate: %f%%\n", exec(n, p, playOptimal))
    printf("Random play success rate: %f%%\n", exec(n, p, playRandom))
  }
}


import Foundation

struct PrisonersGame {
  let strategy: Strategy
  let numPrisoners: Int
  let drawers: [Int]

  init(numPrisoners: Int, strategy: Strategy) {
    self.numPrisoners = numPrisoners
    self.strategy = strategy
    self.drawers = (1...numPrisoners).shuffled()
  }

  @discardableResult
  func play() -> Bool {
    for num in 1...numPrisoners {
      guard findNumber(num) else {
        return false
      }
    }

    return true
  }

  private func findNumber(_ num: Int) -> Bool {
    var tries = 0
    var nextDrawer = num - 1

    while tries < 50 {
      tries += 1

      switch strategy {
      case .random where drawers.randomElement()! == num:
        return true
      case .optimum where drawers[nextDrawer] == num:
        return true
      case .optimum:
        nextDrawer = drawers[nextDrawer] - 1
      case _:
        continue
      }
    }

    return false
  }

  enum Strategy {
    case random, optimum
  }
}

let numGames = 100_000
let lock = DispatchSemaphore(value: 1)
var done = 0

print("Running \(numGames) games for each strategy")

DispatchQueue.concurrentPerform(iterations: 2) {i in
  let strat = i == 0 ? PrisonersGame.Strategy.random : .optimum
  var numPardoned = 0

  for _ in 0..<numGames {
    let game = PrisonersGame(numPrisoners: 100, strategy: strat)

    if game.play() {
      numPardoned += 1
    }
  }

  print("Probability of pardon with \(strat) strategy: \(Double(numPardoned) / Double(numGames))")

  lock.wait()
  done += 1
  lock.signal()

  if done == 2 {
    exit(0)
  }
}

dispatchMain()


set Samples 10000
set Prisoners 100
set MaxGuesses 50
set Strategies {random optimal}

# returns a random number between 0 and N-1.
proc random {n} {
  expr int(rand()*$n)
}

# Returns a list from 0 to N-1.
proc range {n} {
  set res {}
  for {set i 0} {$i < $n} {incr i} {
    lappend res $i
  }
  return $res
}

# Returns shuffled LIST.
proc nshuffle {list} {
    set len [llength $list]
    while {$len} {
        set n [expr {int($len * rand())}]
        set tmp [lindex $list $n]
        lset list $n [lindex $list [incr len -1]]
        lset list $len $tmp
    }
    return $list
}

# Returns a list of shuffled drawers.
proc buildDrawers {} {
  global Prisoners
  nshuffle [range $Prisoners]
}

# Returns true if P is found in DRAWERS within $MaxGuesses attempts using a
# random strategy.
proc randomStrategy {drawers p} {
  global Prisoners MaxGuesses
  foreach i [range $MaxGuesses] {
    if {$p == [lindex $drawers [random $Prisoners]]} {
      return 1
    }
  }
  return 0
}

# Returns true if P is found in DRAWERS within $MaxGuesses attempts using an
# optimal strategy.
proc optimalStrategy {drawers p} {
  global Prisoners MaxGuesses
  set j $p
  foreach i [range $MaxGuesses] {
    set k [lindex $drawers $j]
    if {$k == $p} {
      return 1
    }
    set j $k
  }
  return 0
}

# Returns true if all prisoners find their number using the given STRATEGY.
proc run100prisonersProblem {strategy} {
  global Prisoners
  set drawers [buildDrawers]
  foreach p [range $Prisoners] {
    if {![$strategy $drawers $p]} {
      return 0
    }
  }
  return 1
}

# Runs the given STRATEGY $Samples times and returns the number of times all
# prisoners succeed.
proc sampling {strategy} {
  global Samples
  set successes 0
  foreach s [range $Samples] {
    if {[run100prisonersProblem $strategy]} {
      incr successes
    }
  }
  return $successes
}

# Returns true if the given STRING starts with a vowel.
proc startsWithVowel {string} {
  expr [lsearch -exact {a e i o u} [string index $string 0]] >= 0
}

# Runs each of the STRATEGIES and prints a report on how well they
# worked.
proc compareStrategies {strategies} {
  global Samples
  set fmt "Using %s %s strategy, the prisoners were freed in %5.2f%% of the cases."
  foreach strategy $strategies {
    set article [expr [startsWithVowel $strategy] ? {"an"} : {"a"}]
    set pct [expr [sampling ${strategy}Strategy] / $Samples.0 * 100]
    puts [format $fmt $article $strategy $pct]
  }
}

compareStrategies $Strategies


USE rosettacode;
GO

SET NOCOUNT ON;
GO

CREATE TABLE dbo.numbers (n INT PRIMARY KEY);
GO

-- NOTE If you want to play more than 10000 games, you need to extend the query generating the numbers table by adding
-- next cross joins. Now the table contains enough values to solve the task and it takes less processing time.

WITH sample100 AS (
    SELECT TOP(100) object_id
    FROM master.sys.objects
)
INSERT numbers
    SELECT ROW_NUMBER() OVER (ORDER BY A.object_id) AS n
    FROM sample100 AS A
        CROSS JOIN sample100 AS B;
GO

CREATE TABLE dbo.drawers (drawer INT PRIMARY KEY, card INT);
GO

CREATE TABLE dbo.results (strategy VARCHAR(10), game INT, result BIT, PRIMARY KEY (game, strategy));
GO

CREATE PROCEDURE dbo.shuffleDrawers @prisonersCount INT
AS BEGIN
    SET NOCOUNT ON;

    IF NOT EXISTS (SELECT * FROM drawers)
        INSERT drawers (drawer, card)
        SELECT n AS drawer, n AS card
        FROM numbers
        WHERE n <= @prisonersCount;

    DECLARE @randoms TABLE (n INT, random INT);
    DECLARE @n INT = 1;
    WHILE @n <= @prisonersCount BEGIN
        INSERT @randoms VALUES (@n, ROUND(RAND() * (@prisonersCount - 1), 0) + 1);

        SET @n = @n + 1;
    END;

    WITH ordered AS (
        SELECT ROW_NUMBER() OVER (ORDER BY random ASC) AS drawer,
            n AS card
        FROM @randoms
    )
    UPDATE drawers
    SET card = o.card
    FROM drawers AS s
        INNER JOIN ordered AS o
            ON o.drawer = s.drawer;
END
GO

CREATE PROCEDURE dbo.find @prisoner INT, @strategy VARCHAR(10)
AS BEGIN
    -- A prisoner can open no more than 50 drawers.
    DECLARE @drawersCount INT = (SELECT COUNT(*) FROM drawers);
    DECLARE @openMax INT = @drawersCount / 2;

    -- Prisoners start outside the room.
    DECLARE @card INT = NULL;
    DECLARE @open INT = 1;
    WHILE @open <= @openMax BEGIN
        -- A prisoner tries to find his own number.
        IF @strategy = 'random' BEGIN
            DECLARE @random INT = ROUND(RAND() * (@drawersCount - 1), 0) + 1;
            SET @card = (SELECT TOP(1) card FROM drawers WHERE drawer = @random);
        END
        IF @strategy = 'optimal' BEGIN
            IF @card IS NULL BEGIN
                SET @card = (SELECT TOP(1) card FROM drawers WHERE drawer = @prisoner);
            END ELSE BEGIN
                SET @card = (SELECT TOP(1) card FROM drawers WHERE drawer = @card);
            END
        END

        -- A prisoner finding his own number is then held apart from the others.
        IF @card = @prisoner
            RETURN 1;

        SET @open = @open + 1;
    END

    RETURN 0;
END
GO

CREATE PROCEDURE dbo.playGame @gamesCount INT, @strategy VARCHAR(10), @prisonersCount INT = 100
AS BEGIN
    SET NOCOUNT ON;

    IF @gamesCount <> (SELECT COUNT(*) FROM results WHERE strategy = @strategy) BEGIN
        DELETE results
        WHERE strategy = @strategy;

        INSERT results (strategy, game, result)
        SELECT @strategy AS strategy, n AS game, 0 AS result
        FROM numbers
        WHERE n <= @gamesCount;
    END

    UPDATE results
    SET result = 0
    WHERE strategy = @strategy;

    DECLARE @game INT = 1;
    WHILE @game <= @gamesCount BEGIN
        -- A room having a cupboard of 100 opaque drawers numbered 1 to 100, that cannot be seen from outside.
        -- Cards numbered 1 to 100 are placed randomly, one to a drawer, and the drawers all closed; at the start.
        EXECUTE shuffleDrawers @prisonersCount;

        -- A prisoner tries to find his own number.
        -- Prisoners start outside the room.
        -- They can decide some strategy before any enter the room.
        DECLARE @prisoner INT = 1;
        DECLARE @found INT = 0;
        WHILE @prisoner <= @prisonersCount BEGIN
            EXECUTE @found = find @prisoner, @strategy;
            IF @found = 1
                SET @prisoner = @prisoner + 1;
            ELSE
                BREAK;
        END;

        -- If all 100 findings find their own numbers then they will all be pardoned. If any don't then all sentences stand.
        IF @found = 1
            UPDATE results SET result = 1 WHERE strategy = @strategy AND game = @game;

        SET @game = @game + 1;
    END
END
GO

CREATE FUNCTION dbo.computeProbability(@strategy VARCHAR(10))
RETURNS decimal (18, 2)
AS BEGIN
    RETURN (
        SELECT (SUM(CAST(result AS INT)) * 10000 / COUNT(*)) / 100
        FROM results
        WHERE strategy = @strategy
    );
END
GO

-- Simulate several thousand instances of the game:
DECLARE @gamesCount INT = 2000;

-- ...where the prisoners randomly open drawers.
EXECUTE playGame @gamesCount, 'random';

-- ...where the prisoners use the optimal strategy mentioned in the Wikipedia article.
EXECUTE playGame @gamesCount, 'optimal';

-- Show and compare the computed probabilities of success for the two strategies.
DECLARE @log VARCHAR(max);
SET @log = CONCAT('Games count: ', @gamesCount);
RAISERROR (@log, 0, 1) WITH NOWAIT;
SET @log = CONCAT('Probability of success with "random" strategy: ', dbo.computeProbability('random'));
RAISERROR (@log, 0, 1) WITH NOWAIT;
SET @log = CONCAT('Probability of success with "optimal" strategy: ', dbo.computeProbability('optimal'));
RAISERROR (@log, 0, 1) WITH NOWAIT;
GO

DROP FUNCTION dbo.computeProbability;
DROP PROCEDURE dbo.playGame;
DROP PROCEDURE dbo.find;
DROP PROCEDURE dbo.shuffleDrawers;
DROP TABLE dbo.results;
DROP TABLE dbo.drawers;
DROP TABLE dbo.numbers;
GO


Sub HundredPrisoners()

    NumberOfPrisoners = Int(InputBox("Number of Prisoners", "Prisoners", 100))
    Tries = Int(InputBox("Numer of Tries", "Tries", 1000))
    Selections = Int(InputBox("Number of Selections", "Selections", NumberOfPrisoners / 2))

    StartTime = Timer

    AllFoundOptimal = 0
    AllFoundRandom = 0
    AllFoundRandomMem = 0

    For i = 1 To Tries
        OptimalCount = HundredPrisoners_Optimal(NumberOfPrisoners, Selections)
        RandomCount = HundredPrisoners_Random(NumberOfPrisoners, Selections)
        RandomMemCount = HundredPrisoners_Random_Mem(NumberOfPrisoners, Selections)

        If OptimalCount = NumberOfPrisoners Then
            AllFoundOptimal = AllFoundOptimal + 1
        End If
        If RandomCount = NumberOfPrisoners Then
            AllFoundRandom = AllFoundRandom + 1
        End If
        If RandomMemCount = NumberOfPrisoners Then
            AllFoundRandomMem = AllFoundRandomMem + 1
        End If
    Next i

    ResultString = "Optimal: " & AllFoundOptimal & " of " & Tries & ": " & AllFoundOptimal / Tries * 100 & "%"
    ResultString = ResultString & Chr(13) & "Random: " & AllFoundRandom & " of " & Tries & ": " & AllFoundRandom / Tries * 100 & "%"
    ResultString = ResultString & Chr(13) & "RandomMem: " & AllFoundRandomMem & " of " & Tries & ": " & AllFoundRandomMem / Tries * 100 & "%"

    EndTime = Timer

    ResultString = ResultString & Chr(13) & "Elapsed Time: " & Round(EndTime - StartTime, 2) & " s"
    ResultString = ResultString & Chr(13) & "Trials/sec: " & Tries / Round(EndTime - StartTime, 2)

    MsgBox ResultString, vbOKOnly, "Results"

End Sub

Function HundredPrisoners_Optimal(ByVal NrPrisoners, ByVal NrSelections) As Long
    Dim DrawerArray() As Long

    ReDim DrawerArray(NrPrisoners - 1)

    For Counter = LBound(DrawerArray) To UBound(DrawerArray)
        DrawerArray(Counter) = Counter + 1
    Next Counter

    FisherYates DrawerArray

    For i = 1 To NrPrisoners
        NumberFromDrawer = DrawerArray(i - 1)
        For j = 1 To NrSelections - 1
            If NumberFromDrawer = i Then
                FoundOwnNumber = FoundOwnNumber + 1
                Exit For
            End If
            NumberFromDrawer = DrawerArray(NumberFromDrawer - 1)
        Next j
    Next i
    HundredPrisoners_Optimal = FoundOwnNumber
End Function

Function HundredPrisoners_Random(ByVal NrPrisoners, ByVal NrSelections) As Long
    Dim DrawerArray() As Long
    ReDim DrawerArray(NrPrisoners - 1)

    FoundOwnNumber = 0

    For Counter = LBound(DrawerArray) To UBound(DrawerArray)
        DrawerArray(Counter) = Counter + 1
    Next Counter

    FisherYates DrawerArray

    For i = 1 To NrPrisoners
        For j = 1 To NrSelections
            RandomDrawer = Int(NrPrisoners * Rnd)
            NumberFromDrawer = DrawerArray(RandomDrawer)
            If NumberFromDrawer = i Then
                FoundOwnNumber = FoundOwnNumber + 1
                Exit For
            End If
        Next j
    Next i
    HundredPrisoners_Random = FoundOwnNumber
End Function

Function HundredPrisoners_Random_Mem(ByVal NrPrisoners, ByVal NrSelections) As Long
    Dim DrawerArray() As Long
    Dim SelectionArray() As Long
    ReDim DrawerArray(NrPrisoners - 1)
    ReDim SelectionArray(NrPrisoners - 1)

    HundredPrisoners_Random_Mem = 0
    FoundOwnNumberMem = 0

    For Counter = LBound(DrawerArray) To UBound(DrawerArray)
        DrawerArray(Counter) = Counter + 1
    Next Counter

    For Counter = LBound(SelectionArray) To UBound(SelectionArray)
        SelectionArray(Counter) = Counter + 1
    Next Counter

    FisherYates DrawerArray

    For i = 1 To NrPrisoners
        FisherYates SelectionArray
        For j = 1 To NrSelections
            NumberFromDrawer = DrawerArray(SelectionArray(j - 1) - 1)
            If NumberFromDrawer = i Then
                FoundOwnNumberMem = FoundOwnNumberMem + 1
                Exit For
            End If
        Next j
    Next i
    HundredPrisoners_Random_Mem = FoundOwnNumberMem
End Function

Sub FisherYates(ByRef InputArray() As Long)

    Dim Temp As Long
    Dim PosRandom As Long
    Dim Counter As Long
    Dim Upper As Long
    Dim Lower As Long

    Lower = LBound(InputArray)
    Upper = UBound(InputArray)

    Randomize

    For Counter = Upper To (Lower + 1) Step -1
        PosRandom = CLng(Int((Counter - Lower + 1) * Rnd + Lower))
        Temp = InputArray(Counter)
        InputArray(Counter) = InputArray(PosRandom)
        InputArray(PosRandom) = Temp
    Next Counter

End Sub


Module Module1

    Function PlayOptimal() As Boolean
        Dim secrets = Enumerable.Range(0, 100).OrderBy(Function(a) Guid.NewGuid).ToList

        For p = 1 To 100
            Dim success = False

            Dim choice = p - 1
            For i = 1 To 50
                If secrets(choice) = p - 1 Then
                    success = True
                    Exit For
                End If
                choice = secrets(choice)
            Next

            If Not success Then
                Return False
            End If
        Next

        Return True
    End Function

    Function PlayRandom() As Boolean
        Dim secrets = Enumerable.Range(0, 100).OrderBy(Function(a) Guid.NewGuid).ToList

        For p = 1 To 100
            Dim choices = Enumerable.Range(0, 100).OrderBy(Function(a) Guid.NewGuid).ToList

            Dim success = False
            For i = 1 To 50
                If choices(i - 1) = p Then
                    success = True
                    Exit For
                End If
            Next

            If Not success Then
                Return False
            End If
        Next

        Return True
    End Function

    Function Exec(n As UInteger, play As Func(Of Boolean))
        Dim success As UInteger = 0
        For i As UInteger = 1 To n
            If play() Then
                success += 1
            End If
        Next
        Return 100.0 * success / n
    End Function

    Sub Main()
        Dim N = 1_000_000
        Console.WriteLine("# of executions: {0}", N)
        Console.WriteLine("Optimal play success rate: {0:0.00000000000}%", Exec(N, AddressOf PlayOptimal))
        Console.WriteLine(" Random play success rate: {0:0.00000000000}%", Exec(N, AddressOf PlayRandom))
    End Sub

End Module


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


import rand
import rand.seed
// Uses 0-based numbering rather than 1-based numbering throughout.
fn do_trials(trials int, np int, strategy string) {
    mut pardoned := 0
    for _ in 0..trials {
        mut drawers := []int{len: 100, init: it}
        rand.shuffle<int>(mut drawers) or {panic('shuffle failed')}
        mut next_trial := false
        for p in 0..np {
            mut next_prisoner := false
            if strategy == "optimal" {
                mut prev := p
                for _ in 0..50 {
                    this := drawers[prev]
                    if this == p {
                        next_prisoner = true
                        break
                    }
                    prev = this
                }
            } else {
                // Assumes a prisoner remembers previous drawers (s)he opened
                // and chooses at random from the others.
                mut opened := [100]bool{}
                for _ in 0..50 {
                    mut n := 0
                    for {
                        n = rand.intn(100) or {0}
                        if !opened[n] {
                            opened[n] = true
                            break
                        }
                    }
                    if drawers[n] == p {
                        next_prisoner = true
                        break
                    }
                }
            }
            if !next_prisoner {
                next_trial = true
                break
            }
        }
        if !next_trial {
            pardoned++
        }
    }
    rf := f64(pardoned) / f64(trials) * 100
    println("  strategy = ${strategy:-7}  pardoned = ${pardoned:-6} relative frequency = ${rf:-5.2f}%\n")
}

fn main() {
    rand.seed(seed.time_seed_array(2))
    trials := 100000
    for np in [10, 100] {
        println("Results from $trials trials with $np prisoners:\n")
        for strategy in ["random", "optimal"] {
            do_trials(trials, np, strategy)
        }
    }
}


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

var rand = Random.new()

var doTrials = Fn.new{ |trials, np, strategy|
    var pardoned = 0
    for (t in 0...trials) {
        var drawers = List.filled(100, 0)
        for (i in 0..99) drawers[i] = i
        rand.shuffle(drawers)
        var nextTrial = false
        for (p in 0...np) {
            var nextPrisoner = false
            if (strategy == "optimal") {
                var prev = p
                for (d in 0..49) {
                    var curr = drawers[prev]
                    if (curr == p) {
                        nextPrisoner = true
                        break
                    }
                    prev = curr
                }
            } else {
                var opened = List.filled(100, false)
                for (d in 0..49) {
                    var n
                    while (true) {
                        n = rand.int(100)
                        if (!opened[n]) {
                            opened[n] = true
                            break
                        }
                    }
                    if (drawers[n] == p) {
                        nextPrisoner = true
                        break
                    }
                }
            }
            if (!nextPrisoner) {
               nextTrial = true
               break
            }
        }
        if (!nextTrial) pardoned = pardoned + 1
    }
    var rf = pardoned/trials * 100
    Fmt.print("  strategy = $-7s  pardoned = $,6d relative frequency = $5.2f\%\n", strategy, pardoned, rf)
}

var trials = 1e5
for (np in [10, 100]) {
    Fmt.print("Results from $,d trials with $d prisoners:\n", trials, np)
    for (strategy in ["random", "optimal"]) doTrials.call(trials, np, strategy)
}


int     Drawer(100);

proc KShuffle;          \Randomly rearrange the cards in the drawers
\(Woe unto thee if Stattolo shuffle is used instead of Knuth shuffle.)
int  I, J, T;
[for I:= 100-1 downto 1 do
    [J:= Ran(I+1);      \range [0..I]
    T:= Drawer(I);  Drawer(I):= Drawer(J);  Drawer(J):= T;
    ];
];

func Stategy2;          \Return 'true' if stragegy succeeds
int  Prisoner, Card, Try;
[for Prisoner:= 1 to 100 do
   [Card:= Drawer(Prisoner-1);
   Try:= 1;
   loop [if Card = Prisoner then quit;
        if Try >= 50 then return false;
        Card:= Drawer(Card-1);
        Try:= Try+1;
        ];
    ];
return true;
];

func Stategy1;          \Return 'true' if stragegy succeeds
int  Prisoner, I, D(100);
[for Prisoner:= 1 to 100 do
   loop [for I:= 0 to 100-1 do D(I):= I+1;
        KShuffle;
        for I:= 1 to 50 do
            if Drawer(D(I-1)) = Prisoner then quit;
        return false;
        ];
return true;
];

proc Strategy(S);
int  S, I, Sample;
real Successes;
[Successes:= 0.;
for Sample:= 1 to 100_000 do
    [for I:= 0 to 100-1 do Drawer(I):= I+1;
    KShuffle;
    case S of
     1: if Stategy1 then Successes:= Successes + 1.;
     2: if Stategy2 then Successes:= Successes + 1.
    other [];
    ];
RlOut(0, Successes/100_000.*100.);  Text(0, "%^m^j");
];

[Format(3, 12);
Text(0, "Random strategy success rate:  ");
Strategy(1);
Text(0, "Optimal strategy success rate: ");
Strategy(2);
]


// Rosetta Code problem: http://rosettacode.org/wiki/100_prisoners
// by Galileo, 05/2022

sub play(prisoners, iterations, optimal)
    local prisoner, pardoned, found, drawer, drawers(prisoners), i, j, k, p, x

    for i = 1 to prisoners : drawers(i) = i : next

    for i = 1 to iterations
        for k = 1 to prisoners : x = ran(prisoners) + 1 : p = drawers(x) : drawers(x) = drawers(k) : drawers(k) = p : next
        for prisoner = 1 to prisoners
            found = false
            if optimal then drawer = prisoner else drawer = ran(prisoners) + 1 end if
            for j = 1 to prisoners / 2
                drawer = drawers(drawer)
                if drawer = prisoner found = true : break
                if not optimal drawer = ran(prisoners) + 1
            next
            if not found break
        next
        pardoned = pardoned + found
    next

    return 100 * pardoned / iterations
end sub

iterations = 10000
print "Simulation count: ", iterations
for prisoners = 10 to 100 step 90
    random = play(prisoners, iterations, false)
    optimal = play(prisoners, iterations, true)
    print "Prisoners: ", prisoners, ", random: ", random, ", optimal: ", optimal
next


const SLOTS=100, PRISONERS=100, TRIES=50, N=10_000;
fcn oneHundredJDI{	// just do it strategy
   cupboard,picks := [0..SLOTS-1].walk().shuffle(), cupboard.copy();
   // if this prisoner can't find their number in TRIES, all fail
   foreach p in (PRISONERS){ if(picks.shuffle().find(p)>=TRIES) return(False); }
   True		// all found their number
}
fcn oneHundredO{	// Optimal strategy
   cupboard := [0..SLOTS-1].walk().shuffle();
   foreach p in (PRISONERS){
      d:=p;
      do(TRIES){ if((d=cupboard[d]) == p) continue(2) }  // found my number
      return(False);  // this prisoner failed to find their number, all fail
   }
   True		// all found their number
}


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program puzzle15solvex64.s   */
/* this program is a adaptation algorithme C++ and go rosetta code */
/* thanck for the creators */
/* 1 byte by box on game board */

/* create a file with nano  */
/*  15,  2,   3,   4
    5,   6,   7,   1
    9,   10,  8,   11
   13,  14,  12, 0     */

/*   Run this programm : puzzle15solver64 <file name> */
/*   wait several minutes for résult */

/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly*/
.include "../includeConstantesARM64.inc"

.equ TRUE, 1
.equ FALSE, 0

.equ SIZE,           4
.equ NBBOX,          SIZE * SIZE
.equ TAILLEBUFFER,   100
.equ NBMAXIELEMENTS, 100

.equ CONST_I,    1
.equ CONST_G,    8
.equ CONST_E,    2
.equ CONST_L,    4

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessTitre:           .asciz "File name : "
sMessResult:           .ascii " "
sMessValeur:           .fill 22, 1, ' '             // size => 21
szCarriageReturn:      .asciz "\n"
szMessCounterSolution: .asciz "Solution in @ moves : \n"

szMessErreur:          .asciz "Error detected.\n"
szMessImpossible:      .asciz "!!! Impossible solution !!!\n"
szMessErrBuffer:       .asciz "buffer size too less !!"
szMessSpaces:          .asciz "    "

qTabNr:  .quad 3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3
qTabNc:  .quad 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
.align 8
sZoneConv:      .skip 24
qAdrHeap:       .skip 8
tbBox:          .skip SIZE * SIZE           // game boxes
qAdrFicName:    .skip 8
qTabN0:         .skip 8 * NBMAXIELEMENTS    // empty box
qTabN3:         .skip 8 * NBMAXIELEMENTS    // moves
qTabN4:         .skip 8 * NBMAXIELEMENTS    // ????
qTabN2:         .skip 8 * NBMAXIELEMENTS    // table game address
sBuffer:        .skip TAILLEBUFFER
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main
main:                            // INFO: main
    mov x0,sp                    // stack address for load parameter
    bl traitFic                  // read file and store value in array
    cmp x0,#-1
    beq 100f                     // error ?

    ldr x0,qAdrtbBox
    bl displayGame               // display array game

    ldr x0,qAdrtbBox              // control if solution exists
    bl controlSolution
    cmp x0,#TRUE
    beq 1f
    ldr x0,qAdrszMessImpossible  // no solution !!!
    bl affichageMess
    b 100f

1:

    ldr x0,qAdrtbBox
    ldr x9,qAdrqTabN2
    str x0,[x9]                  // N2 address global
    mov x10,#0                   // variable _n global
    mov x12,#0                   // variable n global
    bl searchSolution
    cmp x0,#TRUE
    bne 100f                     // no solution ?
    ldr x3,qAdrqTabN2
    ldr x0,[x3,x12,lsl #3]       // visual solution control
    bl displayGame
    mov x0,x12                   // move counter
    ldr x1,qAdrsZoneConv
    bl conversion10              // conversion counter
    ldr x0,qAdrszMessCounterSolution
    bl strInsertAtCharInc
    ldr x1,qAdrsZoneConv
    bl affichageMess
    ldr x5,qAdrqTabN3
    ldr x3,qAdrsBuffer
    mov x2,#1
    mov x4,#0
2:                                // loop solution display
    ldr x1,[x5,x2,lsl 3]
    cmp x2,#TAILLEBUFFER
    bge 99f
    strb w1,[x3,x4]
    add x4,x4,#1
    add x2,x2,#1
    cmp x2,x12
    ble 2b
    mov x1,#0
    strb w1,[x3,x4]                 // zéro final
    mov x0,x3
    bl affichageMess
    ldr x0,qAdrszCarriageReturn
    bl affichageMess

    b 100f

99:
    ldr x0,qAdrszMessErrBuffer
    bl affichageMess
100:                                 // standard end of the program
    mov x0, #0                       // return code
    mov x8, #EXIT                    // request to exit program
    svc #0                           // perform the system call

qAdrtbBox:                  .quad tbBox
qAdrqTabN0:                .quad qTabN0
qAdrqTabN2:                .quad qTabN2
qAdrqTabN3:                .quad qTabN3
qAdrqTabN4:                .quad qTabN4
qAdrszMessCounterSolution: .quad szMessCounterSolution
qAdrszMessImpossible:      .quad szMessImpossible
qAdrszMessErrBuffer:       .quad szMessErrBuffer
qAdrsZoneConv:             .quad sZoneConv
/******************************************************************/
/*      search    Solution                                        */
/******************************************************************/
searchSolution:                  // INFO: searchSolution
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
                                 // address allocation place on the heap
    mov x0,#0                    // allocation place heap
    mov x8,BRK                   // call system 'brk'
    svc #0
    cmp x0,#-1                   // allocation error
    beq 99f
    ldr x1,qAdrqAdrHeap
    str x0,[x1]                  // store heap address
    bl functionFN
    ldr x3,qAdrqTabN2
    ldr x0,[x3,x12,lsl #3]       // last current game
    bl gameOK                    // it is Ok ?
    cmp x0,#TRUE
    beq 100f                     // yes --> end

    ldr x1,qAdrqAdrHeap          // free up resources
    ldr x0,[x1]                  // restaur start address heap
    mov x8,BRK                   // call system 'brk'
    svc #0
    cmp x0,#-1                   // allocation error
    beq 99f
    add x10,x10,#1               // _n
    mov x12,#0                   // n
    bl searchSolution            // next recursif call
    b 100f
99:
    ldr x0,qAdrszMessErreur
    bl affichageMess
100:
    ldp x8,x9,[sp],16            // restaur des  2 registres
    ldp x6,x7,[sp],16            // restaur des  2 registres
    ldp x4,x5,[sp],16            // restaur des  2 registres
    ldp x2,x3,[sp],16            // restaur des  2 registres
    ldp x1,lr,[sp],16            // restaur des  2 registres
    ret
qAdrszMessErreur:           .quad szMessErreur
qAdrqAdrHeap:               .quad qAdrHeap
/******************************************************************/
/*     Fonction FN                                                */
/******************************************************************/
functionFN:                      // INFO: functionFN
    stp x1,lr,[sp,-16]!          // save  registres
    ldr x4,qAdrqTabN3
    ldr x3,[x4,x12,lsl #3]
    ldr x5,qAdrqTabN0            // load position empty box
    ldr x6,[x5,x12,lsl #3]
    cmp x6,#15                   // last box
    bne 2f
    cmp x3,#'R'
    bne 11f
    mov x0,#CONST_G
    bl functionFZ
    b 100f
11:
    cmp x3,#'D'
    bne 12f
    mov x0,#CONST_L
    bl functionFZ
    b 100f
12:
    mov x0,#CONST_G + CONST_L
    bl functionFZ
    b 100f

2:
    cmp x6,#12
    bne 3f
    cmp x3,#'L'
    bne 21f
    mov x0,#CONST_G
    bl functionFZ
    b 100f
21:
    cmp x3,#'D'
    bne 22f
    mov x0,#CONST_E
    bl functionFZ
    b 100f
22:
    mov x0,#CONST_E + CONST_G
    bl functionFZ
    b 100f
3:
    cmp x6,#13
    beq 30f
    cmp x6,#14
    bne 4f
30:
    cmp x3,#'L'
    bne 31f
    mov x0,#CONST_G + CONST_L
    bl functionFZ
    b 100f
31:
    cmp x3,#'R'
    bne 32f
    mov x0,#CONST_G + CONST_E
    bl functionFZ
    b 100f
32:
    cmp x3,#'D'
    bne 33f
    mov x0,#CONST_E + CONST_L
    bl functionFZ
    b 100f
33:
    mov x0,#CONST_L + CONST_E + CONST_G
    bl functionFZ
    b 100f
4:
    cmp x6,#3
    bne 5f
    cmp x3,#'R'
    bne 41f
    mov x0,#CONST_I
    bl functionFZ
    b 100f
41:
    cmp x3,#'U'
    bne 42f
    mov x0,#CONST_L
    bl functionFZ
    b 100f
42:
    mov x0,#CONST_I + CONST_L
    bl functionFZ
    b 100f
5:
    cmp x6,#0
    bne 6f
    cmp x3,#'L'
    bne 51f
    mov x0,#CONST_I
    bl functionFZ
    b 100f
51:
    cmp x3,#'U'
    bne 52f
    mov x0,#CONST_E
    bl functionFZ
    b 100f
52:
    mov x0,#CONST_I + CONST_E
    bl functionFZ
    b 100f
6:
    cmp x6,#1
    beq 60f
    cmp x6,#2
    bne 7f
60:
    cmp x3,#'L'
    bne 61f
    mov x0,#CONST_I + CONST_L
    bl functionFZ
    b 100f
61:
    cmp x3,#'R'
    bne 62f
    mov x0,#CONST_E + CONST_I
    bl functionFZ
    b 100f
62:
    cmp x3,#'U'
    bne 63f
    mov x0,#CONST_E + CONST_L
    bl functionFZ
    b 100f
63:
    mov x0,#CONST_I + CONST_E + CONST_L
    bl functionFZ
    b 100f
7:
    cmp x6,#7
    beq 70f
    cmp x6,#11
    bne 8f
70:
    cmp x3,#'R'
    bne 71f
    mov x0,#CONST_I + CONST_G
    bl functionFZ
    b 100f
71:
    cmp x3,#'U'
    bne 72f
    mov x0,#CONST_G + CONST_L
    bl functionFZ
    b 100f
72:
    cmp x3,#'D'
    bne 73f
    mov x0,#CONST_I + CONST_L
    bl functionFZ
    b 100f
73:
    mov x0,#CONST_I + CONST_G + CONST_L
    bl functionFZ
    b 100f
8:
    cmp x6,#4
    beq 80f
    cmp x6,#8
    bne 9f
80:
    cmp x3,#'D'
    bne 81f
    mov x0,#CONST_I + CONST_E
    bl functionFZ
    b 100f
81:
    cmp x3,#'U'
    bne 82f
    mov x0,#CONST_G + CONST_E
    bl functionFZ
    b 100f
82:
    cmp x3,#'L'
    bne 83f
    mov x0,#CONST_I + CONST_G
    bl functionFZ
    b 100f
83:
    mov x0,#CONST_G + CONST_E + CONST_I
    bl functionFZ
    b 100f
9:
    cmp x3,#'D'
    bne 91f
    mov x0,#CONST_I + CONST_E + CONST_L
    bl functionFZ
    b 100f
91:
    cmp x3,#'L'
    bne 92f
    mov x0,#CONST_I + CONST_G + CONST_L
    bl functionFZ
    b 100f
92:
    cmp x3,#'R'
    bne 93f
    mov x0,#CONST_I + CONST_G + CONST_E
    bl functionFZ
    b 100f
93:
    cmp x3,#'U'
    bne 94f
    mov x0,#CONST_G + CONST_E +  CONST_L
    bl functionFZ
    b 100f
94:
    mov x0,#CONST_G + CONST_L + CONST_I + CONST_E
    bl functionFZ
    b 100f

99:                             // error
    ldr x0,qAdrszMessErreur
    bl affichageMess
100:
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret

/******************************************************************/
/*     function FZ                           */
/*                                                 */
/***************************************************************/
/* x0 contains variable w           */
functionFZ:                    // INFO: functionFZ
    stp x1,lr,[sp,-16]!        // save  registres
    stp x2,x3,[sp,-16]!        // save  registres
    mov x2,x0
    and x1,x2,#CONST_I
    cmp x1,#0
    ble 1f
    bl functionFI
    bl functionFY
    cmp x0,#TRUE
    beq 100f
    sub x12,x12,#1              // variable n
1:
    ands x1,x2,#CONST_G
    ble 2f
    bl functionFG
    bl functionFY
    cmp x0,#TRUE
    beq 100f
    sub x12,x12,#1              // variable n
2:
    ands x1,x2,#CONST_E
    ble 3f
    bl functionFE
    bl functionFY
    cmp x0,#TRUE
    beq 100f
    sub x12,x12,#1              // variable n
3:
    ands x1,x2,#CONST_L
    ble 4f
    bl functionFL
    bl functionFY
    cmp x0,#TRUE
    beq 100f
    sub x12,x12,#1              // variable n
4:
    mov x0,#FALSE
100:
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*               function FY                                 */
/******************************************************************/
functionFY:                    // INFO: functionFY
    stp x1,lr,[sp,-16]!        // save  registres
    ldr x1,qAdrqTabN2
    ldr x0,[x1,x12,lsl #3]
    bl gameOK                  // game OK ?
    cmp x0,#TRUE
    beq 100f
    ldr x1,qAdrqTabN4
    ldr x0,[x1,x12,lsl #3]
    cmp x0,x10
    bgt 1f
    bl functionFN
    b 100f
1:
    mov x0,#FALSE
100:
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     the empty box is down                                     */
/******************************************************************/
functionFI:                       // INFO: functionFI
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    ldr x0,qAdrqTabN0
    ldr x1,[x0,x12,lsl #3]        // empty box
    add x2,x1,#4
    ldr x3,[x9,x12,lsl #3]        // load game current
    ldrb w4,[x3,x2]               // load box down empty box
    add x5,x12,#1                 // n+1
    add x8,x1,#4                  // new position empty case
    str x8,[x0,x5,lsl #3]         // store new position empty case
    ldr x6,qAdrqTabN3

    mov x7,#'D'                   // down
    str x7,[x6,x5,lsl #3]         // store move
    ldr x6,qAdrqTabN4
    ldr x7,[x6,x12,lsl #3]
    str x7,[x6,x5,lsl #3]         // N4 (n+1) = n4(n)
    mov x0,x3
    bl createGame                 // create copy game
    ldrb w3,[x0,x1]               // and inversion box
    ldrb w8,[x0,x2]
    strb w8,[x0,x1]
    strb w3,[x0,x2]
    str x0,[x9,x5,lsl #3]         // store new game in table
    lsr x1,x1,#2                  // line position empty case = N°/ 4
    ldr x0,qAdrqTabNr
    ldr x2,[x0,x4,lsl #3]         // load N° line box moved
    cmp x2,x1                     // compare ????
    ble 1f
    add x7,x7,#1                  // and increment ????
    str x7,[x6,x5,lsl #3]
1:
    add x12,x12,#1                // increment N
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
qAdrqTabNr:        .quad qTabNr
qAdrqTabNc:        .quad qTabNc
/******************************************************************/
/*     empty case UP   see explain in english in function FI      */
/******************************************************************/
functionFG:                      // INFO: functionFG
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    ldr x0,qAdrqTabN0
    ldr x1,[x0,x12,lsl #3]       // case vide
    sub x2,x1,#4                 // position case au dessus
    ldr x3,[x9,x12,lsl #3]       // extrait jeu courant
    ldrb w4,[x3,x2]              // extrait le contenu case au dessus
    add x5,x12,#1                // N+1 = N
    sub x8,x1,#4                 // nouvelle position case vide
    str x8,[x0,x5,lsl #3]        // et on la stocke
    ldr x6,qAdrqTabN3
    mov x7,#'U'                  // puis on stocke le code mouvement
    str x7,[x6,x5,lsl #3]
    ldr x6,qAdrqTabN4
    ldr x7,[x6,x12,lsl #3]
    str x7,[x6,x5,lsl #3]        // N4 (N+1) = N4 (N)
    mov x0,x3                    // jeu courant
    bl createGame                // création nouveau jeu
    ldrb w3,[x0,x1]              // et echange les 2 cases
    ldrb w8,[x0,x2]
    strb w8,[x0,x1]
    strb w3,[x0,x2]
    str x0,[x9,x5,lsl #3]        // stocke la nouvelle situation
    lsr x1,x1,#2                 // ligne case vide = position /4
    ldr x0,qAdrqTabNr
    ldr x2,[x0,x4,lsl #3]        // extrait table à la position case
    cmp x2,x1                    // et comparaison ???
    bge 1f
    add x7,x7,#1                 // puis increment N4 de 1  ???
    str x7,[x6,x5,lsl #3]
1:
    add x12,x12,#1               // increment de N
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*    empty case go right see explain finction FI ou FG en français */
/******************************************************************/
functionFE:                       // INFO: functionFE
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    ldr x0,qAdrqTabN0
    ldr x1,[x0,x12,lsl #3]
    add x2,x1,#1
    ldr x3,[x9,x12,lsl #3]
    ldrb w4,[x3,x2]               // extrait le contenu case
    add x5,x12,#1
    add x8,x1,#1
    str x8,[x0,x5,lsl #3]         // nouvelle case vide
    ldr x6,qAdrqTabN3
    mov x7,#'R'
    str x7,[x6,x5,lsl #3]         // mouvement
    ldr x6,qAdrqTabN4
    ldr x7,[x6,x12,lsl #3]
    str x7,[x6,x5,lsl #3]         // N4 ??
    mov x0,x3
    bl createGame
    ldrb w3,[x0,x1]               // exchange two boxes
    ldrb w8,[x0,x2]
    strb w8,[x0,x1]
    strb w3,[x0,x2]
    str x0,[x9,x5,lsl #3]         // stocke la nouvelle situation
    lsr x3,x1,#2
    sub x1,x1,x3,lsl #2
    ldr x0,qAdrqTabNc
    ldr x2,[x0,x4,lsl #3]         // extrait table à la position case
    cmp x2,x1
    ble 1f
    add x7,x7,#1
    str x7,[x6,x5,lsl #3]
1:
    add x12,x12,#1
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     empty box go left see explain function FI ou FG en français */
/******************************************************************/
functionFL:                       // INFO: functionFL
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    ldr x0,qAdrqTabN0
    ldr x1,[x0,x12,lsl #3]        // case vide
    sub x2,x1,#1
    ldr x3,[x9,x12,lsl #3]       // extrait jeu courant
    ldrb w4,[x3,x2]              // extrait le contenu case
    add x5,x12,#1
    sub x8,x1,#1
    str x8,[x0,x5,lsl #3]         // nouvelle case vide
    ldr x6,qAdrqTabN3
    mov x7,#'L'
    str x7,[x6,x5,lsl #3]         // mouvement
    ldr x6,qAdrqTabN4
    ldr x7,[x6,x12,lsl #3]
    str x7,[x6,x5,lsl #3]         // N4 ??
    mov x0,x3
    bl createGame
    ldrb w3,[x0,x1]               // exchange two boxes
    ldrb w8,[x0,x2]
    strb w8,[x0,x1]
    strb w3,[x0,x2]
    str x0,[x9,x5,lsl #3]         // stocke la nouvelle situation
    lsr x3,x1,#2
    sub x1,x1,x3,lsl #2           // compute remainder
    ldr x0,qAdrqTabNc
    ldr x2,[x0,x4,lsl #3]         // extrait table colonne à la position case
    cmp x2,x1
    bge 1f
    add x7,x7,#1
    str x7,[x6,x5,lsl #3]
1:
    add x12,x12,#1
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     create new Game                                            */
/******************************************************************/
/* x0 contains box address            */
/* x0 return address new game  */
createGame:                          // INFO: createGame
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    mov x4,x0                    // save value
    mov x0,#0                    // allocation place heap
    mov x8,BRK                   // call system 'brk'
    svc #0
    cmp x0,#-1                   // allocation error
    beq 99f
    mov x5,x0                    // save address heap for output string
    add x0,x0,#SIZE * SIZE       // reservation place one element
    mov x8,BRK                   // call system 'brk'
    svc #0
    cmp x0,#-1                   // allocation error
    beq 99f
    mov x2,#0
1:                               // loop copy boxes
    ldrb w3,[x4,x2]
    strb w3,[x5,x2]
    add x2,x2,#1
    cmp x2,#NBBOX
    blt 1b
    add x11,x11,#1
    mov x0,x5
    b 100f
99:                              // error
    ldr x0,qAdrszMessErreur
    bl affichageMess
100:
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     read file                                                   */
/******************************************************************/
/* x0 contains address stack begin           */
traitFic:                             // INFO: traitFic
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,fp,[sp,-16]!          // save  registres
    mov fp,x0                         //  fp <- start address
    ldr x4,[fp]                       // number of Command line arguments
    cmp x4,#1
    ble 99f
    add x5,fp,#16                      // second parameter address
    ldr x5,[x5]
    ldr x0,qAdrqAdrFicName
    str x5,[x0]
    ldr x0,qAdrszMessTitre
    bl affichageMess                  // display string
    mov x0,x5
    bl affichageMess
    ldr x0,qAdrszCarriageReturn
    bl affichageMess                  // display carriage return

    mov x0,AT_FDCWD
    mov x1,x5                         // file name
    mov x2,#O_RDWR                    // flags
    mov x3,#0                         // mode
    mov x8, #OPEN                     // call system OPEN
    svc 0
    cmp x0,#0                         // error ?
    ble 99f
    mov x7,x0                         // File Descriptor
    ldr x1,qAdrsBuffer                // buffer address
    mov x2,#TAILLEBUFFER              // buffer size
    mov x8,#READ                      // read file
    svc #0
    cmp x0,#0                         // error ?
    blt 99f
    // extraction datas
    ldr x1,qAdrsBuffer                // buffer address
    add x1,x1,x0
    mov x0,#0                         // store zéro final
    strb w0,[x1]
    ldr x0,qAdrtbBox                   // game box address
    ldr x1,qAdrsBuffer                // buffer address
    bl extracDatas
                                      // close file
    mov x0,x7
    mov x8, #CLOSE
    svc 0
    mov x0,#0
    b 100f
99:                                   // error
    ldr x0,qAdrszMessErreur           // error message
    bl   affichageMess
    mov x0,#-1
100:
    ldp x8,fp,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
qAdrqAdrFicName:              .quad qAdrFicName
qAdrszMessTitre:              .quad szMessTitre
qAdrsBuffer:                  .quad sBuffer
/******************************************************************/
/*     extrac digit file buffer                                   */
/******************************************************************/
/* x0 contains boxs address           */
/* x1 contains buffer address         */
extracDatas:                     // INFO: extracDatas
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    mov x7,x0
    mov x6,x1
    mov x2,#0                    // string buffer indice
    mov x4,x1                    // start digit ascii
    mov x5,#0                    // box index
1:
    ldrb w3,[x6,x2]
    cmp x3,#0                    // datas end ?
    beq 4f
    cmp x3,#0xA                  // line end ?
    beq 2f
    cmp x3,#','                  // box end ?
    beq 3f
    add x2,x2,#1
    b 1b
2:
    mov x3,#0
    strb w3,[x6,x2]              // zero final
    add x3,x2,#1                 // next character
    ldrb w3,[x6,x3]
    cmp x3,#0xD                  // line return
    bne 21f
    add x2,x2,#2                 // yes
    b 4f
21:
    add x2,x2,#1
    b 4f
3:
    mov x3,#0                    // zero final
    strb w3,[x6,x2]
    add x2,x2,#1
4:
    mov x0,x4                    // conversion character ascii in integer
    bl conversionAtoD
    strb w0,[x7,x5]              // and store value on 1 byte box
    cmp x0,#0                    // empty box ?
    bne 5f
    ldr x0,qAdrqTabN0
    str x5,[x0]                  // empty box in item zéro
5:
    add x5,x5,#1                 // increment counter boxes
    cmp x5,#NBBOX                // number box = maxi ?
    bge 100f
    add x4,x6,x2                 // new start address digit ascii
    b 1b
100:
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     control of the game solution                                      */
/******************************************************************/
/* x0 contains boxs address           */
/* x0 returns 0 if not possible       */
/* x0 returns 1 if possible           */
controlSolution:                 // INFO: controlSolution
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    stp x6,x7,[sp,-16]!          // save  registres
    stp x8,x9,[sp,-16]!          // save  registres
    mov x5,x0
    ldr x8,qAdrqTabN0
    ldr x8,[x8]                  // empty box
    //mov x7,#0
    cmp x8,#1
    cset x7,eq
    beq 1f
    cmp x8,#3
    cset x7,eq
    beq 1f
    cmp x8,#4
    cset x7,eq
    beq 1f
    cmp x8,#6
    cset x7,eq
    beq 1f
    cmp x8,#9
    cset x7,eq
    beq 1f
    cmp x8,#11
    cset x7,eq
    beq 1f
    cmp x8,#12
    cset x7,eq
    beq 1f
    cmp x8,#14
    cset x7,eq
1:
    mov x9,NBBOX - 1
    sub x6,x9,x8
    add x7,x7,x6
                                 // count permutations
    mov x1,#-1
    mov x6,#0
2:
    add x1,x1,#1
    cmp x1,#NBBOX
    bge 80f
    cmp x1,x8
    beq 2b
    ldrb w3,[x5,x1]
    mov x2,x1
3:
    add x2,x2,#1
    cmp x2,#NBBOX
    bge 2b
    cmp x2,x8
    beq 3b
    ldrb w4,[x5,x2]
    cmp x4,x3
    cinc x6,x6,lt
    b 3b
80:
    add x6,x6,x7
    tst x6,#1
    cset x0,eq
100:
    ldp x8,x9,[sp],16           // restaur des  2 registres
    ldp x6,x7,[sp],16           // restaur des  2 registres
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     game Ok ?                                      */
/******************************************************************/
/* x0 contains boxs address           */
gameOK:                          // INFO: gameOK
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    mov x2,#0
    ldrb w3,[x0,x2]
    cmp x3,#0
    bne 0f
    mov x3,#0xF
0:
    add x2,x2,#1
1:
    ldrb w4,[x0,x2]
    cmp x4,#0
    bne 11f
    mov x3,#0xF
11:
    cmp x4,x3
    ble 99f
    mov x3,x4
    add x2,x2,#1
    cmp x2,#NBBOX -2
    ble 1b
    mov x0,#TRUE                  // game Ok
    b 100f
99:
   mov  x0,#FALSE              // game not Ok
100:
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
/******************************************************************/
/*     display game                                       */
/******************************************************************/
/* x0 contains boxs address           */
displayGame:                            // INFO: displayGame
    stp x1,lr,[sp,-16]!          // save  registres
    stp x2,x3,[sp,-16]!          // save  registres
    stp x4,x5,[sp,-16]!          // save  registres
    mov x4,x0
    ldr x0,qAdrszMessTitre
    bl affichageMess            // display titre
    ldr x0,qAdrqAdrFicName
    ldr x0,[x0]
    bl affichageMess            // display string
    ldr x0,qAdrszCarriageReturn
    bl affichageMess            // display line return
    mov x2,#0
    ldr x1,qAdrsMessValeur
1:
    ldrb w0,[x4,x2]
    cmp x0,#0
    beq 3f
    bl conversion10             // call conversion decimal
    cmp x0,1
    bne 2f
    mov x0,#0x002020
    str w0,[x1,#1]              // zéro final
    b 4f
2:
    mov x0,#0x20
    str w0,[x1,#2]              // zéro final
    b 4f
3:
    ldr x0,iSpaces              // store spaces to empty case
    str w0,[x1]
4:
    ldr x0,qAdrsMessResult
    bl affichageMess            // display message
    add x0,x2,#1
    tst x0,#0b11
    bne 5f
    ldr x0,qAdrszCarriageReturn
    bl affichageMess            // display message
5:
    add x2,x2,#1
    cmp x2,#NBBOX - 1
    ble 1b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess            // display line return

100:
    ldp x4,x5,[sp],16           // restaur des  2 registres
    ldp x2,x3,[sp],16           // restaur des  2 registres
    ldp x1,lr,[sp],16           // restaur des  2 registres
    ret
iSpaces:                       .quad 0x00202020       // spaces
qAdrszCarriageReturn:          .quad szCarriageReturn
qAdrsMessValeur:               .quad sMessValeur
qAdrsMessResult:               .quad sMessResult
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


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;