2024-01-08 15:27:18 +03:00
|
|
|
--- Towers of Hanoi is a puzzle with three rods and n disks of decreasing size.
|
|
|
|
--- The disks are stacked on top of each other through the first rod.
|
2022-08-10 14:02:14 +03:00
|
|
|
--- The aim of the game is to move the stack of disks to another rod while
|
|
|
|
--- following these rules:
|
2023-03-27 18:32:26 +03:00
|
|
|
---
|
2022-08-10 14:02:14 +03:00
|
|
|
--- 1. Only one disk can be moved at a time
|
2023-03-27 18:32:26 +03:00
|
|
|
---
|
2022-08-10 14:02:14 +03:00
|
|
|
--- 2. You may only move a disk from the top of one of the stacks to the top of another stack
|
2023-03-27 18:32:26 +03:00
|
|
|
---
|
2022-08-10 14:02:14 +03:00
|
|
|
--- 3. No disk may be moved on top of a smaller disk
|
2023-03-27 18:32:26 +03:00
|
|
|
---
|
2023-01-25 15:52:04 +03:00
|
|
|
--- The function ;hanoi; computes the sequence of moves to solve puzzle.
|
2022-08-10 14:02:14 +03:00
|
|
|
module Hanoi;
|
2023-03-23 11:57:38 +03:00
|
|
|
|
2023-05-19 18:33:56 +03:00
|
|
|
import Stdlib.Prelude open;
|
2023-03-23 11:57:38 +03:00
|
|
|
|
|
|
|
--- Concatenates a list of strings
|
|
|
|
--- ;concat (("a" :: nil) :: "b" :: nil); evaluates to ;"a"
|
|
|
|
:: "b"
|
|
|
|
:: nil;
|
2023-07-11 18:22:07 +03:00
|
|
|
concat : List String → String := foldl (++str) "";
|
2023-03-23 11:57:38 +03:00
|
|
|
|
2023-07-11 18:22:07 +03:00
|
|
|
intercalate : String → List String → String
|
|
|
|
| sep xs := concat (intersperse sep xs);
|
2023-03-23 11:57:38 +03:00
|
|
|
|
|
|
|
--- Produce a singleton List
|
2023-07-11 18:22:07 +03:00
|
|
|
singleton : {A : Type} → A → List A
|
|
|
|
| a := a :: nil;
|
2023-03-23 11:57:38 +03:00
|
|
|
|
|
|
|
--- Produce a ;String; representation of a ;List Nat;
|
2023-07-11 18:22:07 +03:00
|
|
|
showList : List Nat → String
|
|
|
|
| xs :=
|
|
|
|
"[" ++str intercalate "," (map natToString xs) ++str "]";
|
2023-03-23 11:57:38 +03:00
|
|
|
|
|
|
|
--- A Peg represents a peg in the towers of Hanoi game
|
|
|
|
type Peg :=
|
|
|
|
| left : Peg
|
|
|
|
| middle : Peg
|
|
|
|
| right : Peg;
|
|
|
|
|
2023-07-11 18:22:07 +03:00
|
|
|
showPeg : Peg → String
|
|
|
|
| left := "left"
|
|
|
|
| middle := "middle"
|
|
|
|
| right := "right";
|
2023-03-23 11:57:38 +03:00
|
|
|
|
|
|
|
--- A Move represents a move between pegs
|
2023-09-07 17:20:14 +03:00
|
|
|
type Move := move : Peg → Peg → Move;
|
2023-03-23 11:57:38 +03:00
|
|
|
|
2023-07-11 18:22:07 +03:00
|
|
|
showMove : Move → String
|
|
|
|
| (move from to) :=
|
|
|
|
showPeg from ++str " -> " ++str showPeg to;
|
2023-03-23 11:57:38 +03:00
|
|
|
|
|
|
|
--- Produce a list of ;Move;s that solves the towers of Hanoi game
|
2023-07-11 18:22:07 +03:00
|
|
|
hanoi : Nat → Peg → Peg → Peg → List Move
|
|
|
|
| zero _ _ _ := nil
|
|
|
|
| (suc n) p1 p2 p3 :=
|
|
|
|
hanoi n p1 p3 p2
|
|
|
|
++ singleton (move p1 p2)
|
|
|
|
++ hanoi n p3 p2 p1;
|
2023-03-23 11:57:38 +03:00
|
|
|
|
2023-07-11 18:22:07 +03:00
|
|
|
main : IO :=
|
2023-03-23 11:57:38 +03:00
|
|
|
printStringLn
|
|
|
|
(unlines (map showMove (hanoi 5 left middle right)));
|