// ------------------------------------------------------------------
// Towers of Hanoi
// ------------------------------------------------------------------

// maximum number of disks
val N:ℕ; 
axiom notNull ⇔ N > 0;

type Disc = ℕ[N];           // a number 1..N, 0 = None
type Peg  = Array[N, Disc]; // an array of N discs
type PegIndex = ℕ[N-1];     // a peg index denoting a disc
type Board = Array[3, Peg]; // an array of 3 pegs
type BoardIndex = ℕ[2];     // a board index denoting a peg

// the number of discs on a peg
fun pheight(peg:Peg):Disc = 
  if peg[0] = 0 
    then 0
    else max i:PegIndex with peg[i] ≠ 0. 1+i;
 
// the initial and the zero peg
val ipeg:Peg = choose peg: Peg with ∀i:PegIndex. peg[i] = N-i;
val zpeg:Peg = Array[N, Disc](0);

// the initial board
val iboard:Board = Array[3, Peg](zpeg) with [0] = ipeg;

// a move is a pair (from,to)
type Move = Tuple[BoardIndex,BoardIndex];

// maximum number of moves required (to be proved ;-)
val M = 2^N-1;

// a sequence of moves
type Moves = Array[M,Move];
type MoveNumber = ℕ[M];

// the corresponding sequence of boards
type Boards = Array[M+1,Board];

// given board b, is move m legal?
pred legal(b:Board, m:Move) ⇔
  let h1 = pheight(b[m.1]), h2 = pheight(b[m.2]) in 
  m.1 ≠ m.2 ∧ h1 > 0 ∧ h2 < N ∧
  (h2 = 0 ∨ b[m.2][h2-1] > b[m.1][h1-1]);

// compute next board from current board b and move m
fun move(b:Board, m:Move): Board 
  requires legal(b, m);
= let h1 = pheight(b[m.1]), h2 = pheight(b[m.2]) in 
  b with [m.1] = (b[m.1] with [h1-1] = 0)
    with [m.2] = (b[m.2] with [h2] = b[m.1][h1-1]);
  
// b are the boards resulting from the first n moves of m
pred boards(n:MoveNumber, m:Moves, b:Boards) ⇔
  b[0] = iboard ∧
  ∀k:MoveNumber with k < n. 
    (∀k0:MoveNumber with k0 ≤ k. legal(b[k0], m[k0])) ⇒ 
    b[k+1] = move(b[k], m[k]);

// the boards resulting from moves m[k]...m[n] starting with initial state b
fun boards(k:MoveNumber, n:MoveNumber, m:Moves, b:Boards): Boards
  requires k ≤ n;
  decreases n-k;
= if k = n ∨ ¬legal(b[k], m[k]) 
    then b
    else boards(k+1, n, m, b with [k+1] = move(b[k], m[k]));
fun boards(n:MoveNumber, m:Moves): Boards
// ensures boards(n,m,result);
= boards(0, n, m, Array[M+1,Board](iboard));

// are the first r moves in m legal?
pred legal(r:MoveNumber, m:Moves) ⇔ 
  // choose bs:Boards with boards(r, m, bs) in
  let bs = boards(r, m) in
  ∀k:MoveNumber with k < r. legal(bs[k], m[k]);

// does board b describe the desired end situation?
pred end(b:Board) ⇔
  ∀k:Disc with 1 ≤ k ∧ k ≤ N. b[2][N-k] = k;
  
// describe the first r moves of m a complete game?
pred game(r:MoveNumber, m:Moves) ⇔
  let bs = boards(r, m) in
  (∀k:MoveNumber with k < r. legal(bs[k], m[k])) ∧
  end(bs[r]);

// we claim that a game for N discs always exists
theorem gameExists() ⇔
  // ∃r:MoveNumber, m:Moves. game(r, m);
  let r = 2^N-1 in ∃m:Moves. game(r, m);

// the result of a game
type Game = Tuple[MoveNumber,Moves];

// ------------------------------------------------------------------
// implicitly computing a solution
// ------------------------------------------------------------------

// choose a game for N discs
fun gameChoose(): Game =
  // choose r:MoveNumber, m:Moves with game(r, m);
  let r=2^N-1 in ⟨r, choose m:Moves with game(r, m)⟩;

// also a violation of this theorem determines a game for N discs
// (allows the application of multiple threads to each candidate)
theorem noGame(m:Moves) ⇔ ¬game(2^N-1, m); 

// ------------------------------------------------------------------
// computation by a transition system
// ------------------------------------------------------------------

// returns (b,n,m) such that if b is true, then the first
// n moves of m describe a complete game
proc game(): Tuple[Bool,MoveNumber,Moves]
  ensures result.1 ⇒ game(result.2,result.3);
{
  var moves:Moves = Array[M,Move](⟨0,0⟩);
  var board:Board = iboard;
  var found:Bool = end(board);
  var i:MoveNumber = 0;
  while ¬found ∧ i < M do
  {
    choose move:Move with legal(board,move);
    moves[i] ≔ move;
    board ≔ move(board, move);
    found ≔ end(board);
    i ≔ i+1;
  }
  if found then print i,moves;
  return ⟨found,i,moves⟩;
}

theorem noGame() ⇔ 
  let r = game() in ¬r.1; // ⊤ to print all games
  
// ------------------------------------------------------------------
// explicitly computing a solution
// ------------------------------------------------------------------

// extend game g by moving n discs from peg i to peg j
proc hanoi(n:Disc, i:BoardIndex, j:BoardIndex, g:Game): Game
  requires i ≠ j ∧ g.1 < M ∧ g.1+(2^n-1) <= M;
  requires   
    legal(g.1, g.2) ∧
    let bs = boards(g.1, g.2), b = bs[g.1], k=3-i-j,
        hi = pheight(b[i]), hj = pheight(b[j]), hk = pheight(b[k]) in
    hi ≥ n ∧ 
    (hj = 0 ∨ b[j][hj-1] > b[i][hi-n]) ∧ 
    (hk = 0 ∨ b[k][hk-1] > b[i][hi-n]);
  decreases n;
  ensures 
    legal(result.1, result.2) ∧
    let bs1 = boards(g.1, g.2), bs2 = boards(result.1, result.2) in
    let b1 = bs1[g.1], b2 = bs2[result.1] in
    let i1 = pheight(b1[i]), j1 = pheight(b1[j]) in
    let i2 = pheight(b2[i]), j2 = pheight(b2[j]) in
    i2 = i1-n ∧ j2 = j1+n ∧
    (∀k:Disc with k < n.
      b2[i][i1-k-1] = 0 ∧ b2[j][j2-k-1] = b1[i][i1-k-1]);
{
  var g0:Game = g;
  if n = 1 then
    g0 ≔ ⟨g0.1+1, g0.2 with [g0.1] = ⟨i,j⟩ ⟩;
  else if n > 1 then
  {
    val k = 3-i-j;
    g0 ≔ hanoi(n-1, i, k, g0);
    g0 ≔ ⟨g0.1+1, g0.2 with [g0.1] = ⟨i,j⟩ ⟩;
    g0 ≔ hanoi(n-1, k, j, g0);
  } 
  return g0;
}

// compute a game for N discs
fun gameCompute(): Game 
  ensures game(result.1, result.2);
= let g = ⟨0, Array[M,Move](⟨0,0⟩)⟩ in
  hanoi(N, 0, 2, g);

// ------------------------------------------------------------------
// end of file
// ------------------------------------------------------------------


