towers of hanoi in pyret

towers.arr

fun hanoi(num-disks :: Number%(num-is-integer)) -> List:
  doc: "Solve the Towers of Hanoi puzzle"
  # our pegs are labeled 1, 2, and 3
  # our disks are labeled 1 to num-disks, where disk 1 is
  # the smallest disk
  fun _hanoi(n, from-peg, target-peg):
    if n == 0:
      [list:]
    else:
      # The way Hanoi works is that you recursively move all
      # disks, except the biggest one, to a staging peg, then you
      # move the biggest disk to the empty target peg, then
      # you recursively move the other pegs on to the target
      # peg.
      staging-peg = (1 + 2 + 3) - from-peg - target-peg
      big-stack-step-1 = _hanoi(n - 1, from-peg, staging-peg)
      small-step-2 = {from-peg: from-peg, to-peg: target-peg, disk: n}
      big-stack-step-3 = _hanoi(n - 1, staging-peg, target-peg)
      big-stack-step-1 + [list: small-step-2] + big-stack-step-3
    end
  end
  _hanoi(num-disks, 1, 2)
where:
  hanoi(2).length() is 3
  hanoi(3).length() is 7
  hanoi(4).length() is 15
  
  disk-moves = hanoi(5)
  disk-moves.filter(lam(move): move.disk == 1;).length() is 16
  disk-moves.filter(lam(move): move.disk == 2;).length() is 8
  disk-moves.filter(lam(move): move.disk == 3;).length() is 4
  disk-moves.filter(lam(move): move.disk == 4;).length() is 2
  disk-moves.filter(lam(move): move.disk == 5;).length() is 1
end

# Ok, the fun actually starts here, in building the machinery
# to verify the Hanoi algorithm works.

fun apply-move(pegs :: List, move) -> List:
  doc: "return a new set of pegs to reflect a disk moving"
  
  # return a new list using the expression syntax
  for map(peg from pegs):
    if peg.peg-number == move.from-peg:
      {
        peg-number: peg.peg-number,
        disks: peg.disks.rest
      }
    else if peg.peg-number == move.to-peg:
      {
        peg-number: peg.peg-number,
        disks: link(move.disk, peg.disks)
      }
    else:
      peg
    end
  end
end

fun get-peg-by-number(pegs, peg-number):
  pegs.filter(
    lam(p): p.peg-number == peg-number;
    ).first
end
  
fun verify-pull-move(pegs, move):
  peg = get-peg-by-number(pegs, move.from-peg)
  when is-empty(peg.disks):
    raise("no disk to pull on this peg")
  end
  when (peg.disks.first <> move.disk):
    raise("pulling wrong disk")
  end
end

fun verify-push-move(pegs, move):
  peg = get-peg-by-number(pegs, move.to-peg)
  when peg.disks.length() > 0:
    when (move.disk >= peg.disks.first):
      raise("disk is too big to place here")
    end
  end
end

fun verify-moves(pegs :: List, _moves :: List):
  cases(List) _moves:
    | empty => true
    | link(move, rest-of-moves) =>
      verify-pull-move(pegs, move)
      verify-push-move(pegs, move)
      verify-moves(apply-move(pegs, move), rest-of-moves)
  end
end

fun verify-moves-legal(num-disks :: Number, moves :: List):
  # The disks fields are lists, and they have the 
  # number of the disk that is physically on top of the peg
  # at the front of the list.
  starting-pegs = [list:
    {peg-number: 1, disks: range(1, num-disks + 1)},
    {peg-number: 2, disks: [list:]},
    {peg-number: 3, disks: [list:]}
  ]

  verify-moves(starting-pegs, moves)

where:
  disk-moves = hanoi(4)
  verify-moves-legal(4, disk-moves)
  
  verify-moves-legal(2, [list:
      {from-peg: 2, to-peg: 3, disk: 1}
    ]) raises "no disk to pull on this peg"

  verify-moves-legal(2, [list:
      {from-peg: 1, to-peg: 3, disk: 1},
      {from-peg: 1, to-peg: 3, disk: 1}
    ]) raises "pulling wrong disk"
  
  verify-moves-legal(2, [list:
      {from-peg: 1, to-peg: 3, disk: 1},
      {from-peg: 1, to-peg: 3, disk: 2}
    ]) raises "disk is too big to place here"
  
end

fun output-example():
  for each(step from hanoi(4)):
    print(step)
  end
end

output-example()