hanoi = (ndisks, start_peg=1, end_peg=3) ->
  if ndisks
    staging_peg = 1 + 2 + 3 - start_peg - end_peg
    hanoi(ndisks-1, start_peg, staging_peg)
    console.log "Move disk #{ndisks} from peg #{start_peg} to #{end_peg}"
    hanoi(ndisks-1, staging_peg, end_peg)

hanoi(4)


(defun move (n from to via)
  (cond ((= n 1)
         (format t "Move from ~A to ~A.~%" from to))
        (t
         (move (- n 1) from via to)
         (format t "Move from ~A to ~A.~%" from to)
         (move (- n 1) via to from))))


import std.stdio;

void hanoi(in int n, in char from, in char to, in char via) {
    if (n > 0) {
        hanoi(n - 1, from, via, to);
        writefln("Move disk %d from %s to %s", n, from, to);
        hanoi(n - 1, via, to, from);
    }
}

void main() {
    hanoi(3, 'L', 'M', 'R');
}


main() {
  moveit(from,to) {
    print("move ${from} ---> ${to}");
  }

  hanoi(height,toPole,fromPole,usePole) {
    if (height>0) {
      hanoi(height-1,usePole,fromPole,toPole);
      moveit(fromPole,toPole);
      hanoi(height-1,toPole,usePole,fromPole);
    }
  }

  hanoi(3,3,1,2);
}


 [ # move(from, to)
    n           # print from
    [ --> ]n    # print " --> "
    p           # print to\n
    sw          # p doesn't pop, so get rid of the value
 ]sm

 [ # init(n)
    sw          # tuck n away temporarily
    9           # sentinel as bottom of stack
    lw          # bring n back
    1           # "from" tower's label
    3           # "to" tower's label
    0           # processed marker
 ]si

 [ # Move()
    lt          # push to
    lf          # push from
    lmx         # call move(from, to)
 ]sM

 [ # code block <d>
    ln          # push n
    lf          # push from
    lt          # push to
    1           # push processed marker 1
    ln          # push n
    1           # push 1
    -           # n - 1
    lf          # push from
    ll          # push left
    0           # push processed marker 0
 ]sd

 [ # code block <e>
    ln          # push n
    1           # push 1
    -           # n - 1
    ll          # push left
    lt          # push to
    0           # push processed marker 0
 ]se

 [ # code block <x>
    ln 1 =M
    ln 1 !=d
 ]sx

 [ # code block <y>
    lMx
    lex
 ]sy

 [ # quit()
    q           # exit the program
 ]sq

 [ # run()
    d 9 =q      # if stack empty, quit()
    sp          # processed
    st          # to
    sf          # from
    sn          # n
    6           #
    lf          #
    -           #
    lt          #
    -           # 6 - from - to
    sl          #
    lp 0 =x     #
    lp 0 !=y    #
    lrx         # loop
 ]sr

 5lix # init(n)
 lrx # run()


proc move(byte n, src, via, dest) void:
    if n>0 then
        move(n-1, src, dest, via);
        writeln("Move disk from pole ",src," to pole ",dest);
        move(n-1, via, src, dest)
    fi
corp

proc nonrec main() void:
    move(4, 1, 2, 3)
corp


func hanoi(n, a, b, c) {
    if n > 0 {
        hanoi(n - 1, a, c, b)
        print("Move disk from \(a) to \(c)")
        hanoi(n - 1, b, a, c)
    }
}

hanoi(4, "A", "B", "C")


def move(out, n, fromPeg, toPeg, viaPeg) {
    if (n.aboveZero()) {
        move(out, n.previous(), fromPeg, viaPeg, toPeg)
        out.println(`Move disk $n from $fromPeg to $toPeg.`)
        move(out, n.previous(), viaPeg, toPeg, fromPeg)
    }
}

move(stdout, 4, def left {}, def right {}, def middle {})


func hanoi n src dst aux . .
  if n >= 1
    call hanoi n - 1 src aux dst
    print "Move " & src & " to " & dst
    call hanoi n - 1 aux dst src
  .
.
call hanoi 5 1 2 3


[Towers of Hanoi task for Rosetta Code.]
[EDSAC program, Initial Orders 2.]

            T100K   [load program at location 100 (arbitrary)]
            GK
[Number of discs, in the address field]
      [0]   P3F     [<--- edit here, value 1..9]
[Letters to represent the rods]
      [1]   LF      [left]
      [2]   CF      [centre]
      [3]   RF      [right]

[Main routine. Enter with acc = 0]
      [4]   T1F     [1F := 0]
      [5]   [email protected]     [initialize recursive subroutine]
            [email protected]
            [email protected]      [number of discs]
            T1F     [pass to subroutines]
            [email protected]     [source rod]
            T4F     [pass to subroutines]
            [email protected]     [target rod]
            T5F     [pass to subroutines]
     [13]   [email protected]    [call subroutine to write header ]
            [email protected]
     [15]   [email protected]    [call recursive subroutine to write moves ]
            [email protected]
            ZF      [stop]

[Subroutine to write a header]
[Input:  1F = number of discs (in the address field)]
        [4F = letter for starting rod]
        [5F = letter for ending rod]
[Output: None. 1F, 4F, 5F must be preserved.]
     [18]   A3F     [plant return link as usual]
            [email protected]
            A1F     [number of discs]
            L512F   [shift 11 left to make output char]
            [email protected]    [plant in message]
            A4F     [starting rod]
            [email protected]    [plant in message]
            A5F     [ending rod]
            [email protected]    [plant in message]
            [email protected]    [O order for first char of message]
            [email protected]    [skip next order (code for 'O' is positive)]
     [29]   [email protected]    [restore acc after test below]
     [30]   [email protected]    [plant order to write next character]
     [31]   OF      [(planted) write next character]
            A2F     [inc address in previous order]
            [email protected]    [finished yet?]
            [email protected]    [if not, loop back]
     [35]   ZF      [(planted) exit with acc = 0]
     [36]   [email protected]    [O order for start of message]
     [37]   [email protected]    [O order for exclusive end of message]
     [38]   #F
     [39]   PFK2048F!FDFIFSFCFSF!FFFRFOFMF!F
     [53]   PF!FTFOF!F
     [58]   [email protected]&F
     [61]

[Subroutine to write a move of one disc.]
[Input:  1F = disc number 1..9 (in the address field)]
        [4F = letter for source rod]
        [5F = letter for target rod]
[Output: None. 1F, 4F, 5F must be preserved.]
[Condensed to save space; very similar to previous subroutine.]
     [61]   [email protected]@ [email protected]@[email protected]@
     [72]   [email protected]
     [73]   [email protected]
     [74]   [email protected]@
     [78]   ZF      [(planted) exit with acc = 0]
     [79]   [email protected]
     [80]   [email protected]
     [81]   K2048FMFOFVFEF!F#F
     [88]   PFK2048F!FFFRFOFMF!F
     [96]   PF!FTFOF!F
    [101]   [email protected]&F
    [104]

[Recursive subroutine to move discs 1..n, where 1 <= n <= 9.]
[Call with n = 0 to initialize.]
[Input:  1F = n (in the address field)]
        [4F = letter for source rod]
        [5F = letter for target rod]
[Output: None. 1F, 4F, 5F must be preserved.]
    [104]   A3F     [plant link as usual ]
            [email protected]
[The link will be saved in a stack if recursive calls are required.]
            S1F     [load -n]
            [email protected]   [jump if n > 0]
[Here if n = 0. Initialize; no recursive calls.]
            [email protected]   [initialize push order to start of stack]
            [email protected]
            [email protected]     [find total of the codes for the rod letters]
            [email protected]
            [email protected]
            [email protected]   [store for future use]
            [email protected]   [jump to link]
[Here with acc = -n in address field]
    [115]   A2F     [add 1]
            [email protected]   [jump if n > 1]
[Here if n = 1. Just write the move; no recursive calls.]
    [117]   [email protected]   [call write subroutine]
            [email protected]
            [email protected]   [jump to link]
[Here if n > 1. Recursive calls are required.]
    [120]   TF      [clear acc]
            [email protected]   [load link order]
    [122]   TF      [(planted) push link order onto stack]
            [email protected]   [inc address in previous order]
            A2F
            [email protected]
[First recursive call. Modify parameters 1F and 5F; 4F stays the same]
            A1F     [load n]
            S2F     [make n - 1]
            T1F     [pass as parameter]
            [email protected]   [get 3rd rod, neither source nor target]
            S4F
            S5F
            T5F
    [133]   [email protected]   [recursive call]
            [email protected]
[Returned, restore parameters]
            A1F
            A2F
            T1F
            [email protected]
            S4F
            S5F
            T5F
[Write move of largest disc]
    [142]   [email protected]
            [email protected]
[Second recursive call. Modify parameters 1F and 4F; 5F stays the same]
[Condensed to save space; very similar to first recursice call.]
            [email protected]
    [151]   [email protected]@[email protected]
[Pop return link off stack]
            [email protected]   [dec address in push order]
            S2F
            [email protected]
            [email protected]   [make A order with same address]
            [email protected]   [plant in code]
    [165]   AF      [(planted) pop return link from stack]
            [email protected]   [plant in code]
    [167]   ZF      [(planted) return to caller]
[Constants]
    [168]   PF      [(planted) sum of letters for rods]
    [169]   [email protected]   [T order for start of stack]
    [170]   MF      [add to T order to make A order, same address]
[Stack: placed at end of program, grows into free space.]
    [171]
            E4Z     [define entry point]
            PF      [acc = 0 on entry]
[end]


class
	APPLICATION

create
	make

feature {NONE} -- Initialization

	make
		do
			move (4, "A", "B", "C")
		end

feature -- Towers of Hanoi

	move (n: INTEGER; frm, to, via: STRING)
		require
			n > 0
	    do
			if n = 1 then
    			print ("Move disk from pole " + frm + " to pole " + to + "%N")
    		else
    			move (n - 1, frm, via, to)
    			move (1, frm, to, via)
    			move (n - 1, via, to, frm)
	        end
	    end
end


open monad io
:::IO

//Functional approach
hanoi 0 _ _ _ = []
hanoi n a b c = hanoi (n - 1) a c b ++ [(a,b)] ++ hanoi (n - 1) c b a

hanoiIO n = mapM_ f $ hanoi n 1 2 3 where
  f (x,y) = putStrLn $ "Move " ++ show x ++ " to " ++ show y

//Imperative approach using IO monad
hanoiM n = hanoiM' n 1 2 3 where
  hanoiM' 0 _ _ _ = return ()
  hanoiM' n a b c = do
    hanoiM' (n - 1) a c b
    putStrLn $ "Move " ++ show a ++ " to " ++ show b
    hanoiM' (n - 1) c b a


move = (n,from,to,via)
{
    if (n == 1)
    {
        console.printLine("Move disk from pole ",from," to pole ",to)
    }
    else
    {
        move(n-1,from,via,to);
        move(1,from,to,via);
        move(n-1,via,to,from)
    }
};


defmodule RC do
  def hanoi(n) when 0<n and n<10, do: hanoi(n, 1, 2, 3)

  defp hanoi(1, f, _, t), do: move(f, t)
  defp hanoi(n, f, u, t) do
    hanoi(n-1, f, t, u)
    move(f, t)
    hanoi(n-1, u, f, t)
  end

  defp move(f, t), do: IO.puts "Move disk from #{f} to #{t}"
end

RC.hanoi(3)


(defun move (n from to via)
  (if (= n 1)
      (message "Move from %S to %S" from to)
    (move (- n 1) from via to)
    (message "Move from %S to %S" from to)
    (move (- n 1) via to from)))


move(1, F, T, _V) ->
  io:format("Move from ~p to ~p~n", [F, T]);
move(N, F, T, V) ->
  move(N-1, F, V, T),
  move(1  , F, T, V),
  move(N-1, V, T, F).


!-----------------------------------------------------------
! HANOI.R : solve tower of Hanoi puzzle using a recursive
! modified algorithm.
!-----------------------------------------------------------

PROGRAM HANOI

!$INTEGER

!VAR I,J,MOSSE,NUMBER

PROCEDURE PRINTMOVE
  LOCAL SOURCE$,DEST$
  MOSSE=MOSSE+1
  CASE I OF
     1-> SOURCE$="Left" END ->
     2-> SOURCE$="Center" END ->
     3-> SOURCE$="Right" END ->
  END CASE
  CASE J OF
     1-> DEST$="Left" END ->
     2-> DEST$="Center" END ->
     3-> DEST$="Right" END ->
  END CASE
  PRINT("I move a disk from ";SOURCE$;" to ";DEST$)
END PROCEDURE

PROCEDURE MOVE
  IF NUMBER<>0 THEN
     NUMBER=NUMBER-1
     J=6-I-J
     MOVE
     J=6-I-J
     PRINTMOVE
     I=6-I-J
     MOVE
     I=6-I-J
     NUMBER=NUMBER+1
  END IF
END PROCEDURE

BEGIN
  MAXNUM=12
  MOSSE=0
  PRINT(CHR$(12);TAB(25);"--- TOWERS OF HANOI ---")
  REPEAT
     PRINT("Number of disks ";)
     INPUT(NUMBER)
  UNTIL NUMBER>1 AND NUMBER<=MAXNUM
  PRINT
  PRINT("For ";NUMBER;"disks the total number of moves is";2^NUMBER-1)
  I=1  ! number of source pole
  J=3  ! number of destination pole
  MOVE
END PROGRAM


SHOWHANOI
=LAMBDA(n,
    FILTERP(
        LAMBDA(x, "" <> x)
    )(
        HANOI(n)("left")("right")("mid")
    )
)

HANOI
=LAMBDA(n,
    LAMBDA(l,
        LAMBDA(r,
            LAMBDA(m,
                IF(0 = n,
                    "",
                    LET(
                        next, n - 1,
                        APPEND(
                            APPEND(
                                HANOI(next)(l)(m)(r)
                            )(
                                CONCAT(l, " -> ", r)
                            )
                        )(
                            HANOI(next)(m)(r)(l)
                        )
                    )
                )
            )
        )
    )
)


# (C) 2013 Ezhil Language Project
# Tower of Hanoi – recursive solution

நிரல்பாகம் ஹோனாய்(வட்டுகள், முதல்அச்சு, இறுதிஅச்சு,வட்டு)

  @(வட்டுகள் == 1 ) ஆனால்
     பதிப்பி  “வட்டு ” + str(வட்டு) + “ஐ \t  (” + str(முதல்அச்சு) + “  —> ” +  str(இறுதிஅச்சு)+ “) அச்சிற்கு நகர்த்துக.”
  இல்லை

  @( ["இ", "அ",  "ஆ"]  இல் அச்சு ) ஒவ்வொன்றாக
          @( (முதல்அச்சு != அச்சு)  && (இறுதிஅச்சு  != அச்சு) ) ஆனால்
              நடு = அச்சு
          முடி
  முடி

    # solve problem for n-1 again between src and temp pegs
    ஹோனாய்(வட்டுகள்-1,   முதல்அச்சு,நடு,வட்டுகள்-1)

    # move largest disk from src to destination
    ஹோனாய்(1, முதல்அச்சு, இறுதிஅச்சு,வட்டுகள்)

    # solve problem for n-1 again between different pegs
    ஹோனாய்(வட்டுகள்-1, நடு, இறுதிஅச்சு,வட்டுகள்-1)
  முடி
முடி

ஹோனாய்(4,”அ”,”ஆ”,0)


#light
let rec hanoi num start finish =
  match num with
  | 0 -> [ ]
  | _ -> let temp = (6 - start - finish)
         (hanoi (num-1) start temp) @ [ start, finish ] @ (hanoi (num-1) temp finish)

[<EntryPoint>]
let main args =
  (hanoi 4 1 2) |> List.iter (fun pair -> match pair with
                                          | a, b -> printf "Move disc from %A to %A\n" a b)
  0


USING: formatting kernel locals math ;
IN: rosettacode.hanoi

: move ( from to -- )
    "%d->%d\n" printf ;
:: hanoi ( n from to other -- )
    n 0 > [
        n 1 - from other to hanoi
        from to move
        n 1 - other to from hanoi
    ] when ;


Func Hanoi( n, f, t, v ) =
if n = 0 then
    !'';
else
    Hanoi(n - 1, f, v, t);
    !f;!' -> ';!t;!',   ';
    Hanoi(n - 1, v, t, f)
fi.


CREATE peg1 ," left "
CREATE peg2 ," middle "
CREATE peg3 ," right "

: .$   COUNT TYPE ;
: MOVE-DISK
  LOCALS| via to from n |
  n 1 =
  IF   CR ." Move disk from " from .$ ." to " to .$
  ELSE n 1- from via to RECURSE
       1    from to via RECURSE
       n 1- via to from RECURSE
  THEN ;


PROGRAM TOWER

  CALL Move(4, 1, 2, 3)

CONTAINS

  RECURSIVE SUBROUTINE Move(ndisks, from, to, via)
    INTEGER, INTENT (IN) :: ndisks, from, to, via

    IF (ndisks == 1) THEN
       WRITE(*, "(A,I1,A,I1)") "Move disk from pole ", from, " to pole ", to
    ELSE
       CALL Move(ndisks-1, from, via, to)
       CALL Move(1, from, to, via)
       CALL Move(ndisks-1, via, to, from)
    END IF
  END SUBROUTINE Move

END PROGRAM TOWER


' FB 1.05.0 Win64

Sub move(n As Integer, from As Integer, to_ As Integer, via As Integer)
  If n > 0 Then
    move(n - 1, from, via, to_)
    Print "Move disk"; n; " from pole"; from; " to pole"; to_
    move(n - 1, via, to_, from)
  End If
End Sub

Print "Three disks" : Print
move 3, 1, 2, 3
Print
Print "Four disks" : Print
move 4, 1, 2, 3
Print "Press any key to quit"
Sleep


/** Set up the recursive call for n disks */
hanoi[n] := hanoi[n, 1, 3, 2]

/** The recursive call. */
hanoi[n, source, target, aux] :=
{
   if n > 0
   {
      hanoi[n-1, source, aux, target]
      println["Move from $source to $target"]
      hanoi[n-1, aux, target, source]
   }
}

hanoi[7]


window 1, @"Towers of Hanoi", ( 0, 0, 300, 300 )

void local fn Move( n as long, fromPeg as long, toPeg as long, viaPeg as long )
  if n > 0
    fn Move( n-1, fromPeg, viaPeg, toPeg )
    print "Move disk from "; fromPeg; " to "; toPeg
    fn Move( n-1, viaPeg, toPeg, fromPeg )
  end if
end fn

fn Move( 4, 1, 2, 3 )
print
print "Towers of Hanoi puzzle solved."

HandleEvents


Hanoi := function(n)
	local move;
	move := function(n, a, b, c) # from, through, to
		if n = 1 then
			Print(a, " -> ", c, "\n");
		else
			move(n - 1, a, c, b);
			move(1, a, b, c);
			move(n - 1, b, a, c);
		fi;
	end;
	move(n, "A", "B", "C");
end;

Hanoi(1);
# A -> C

Hanoi(2);
# A -> B
# A -> C
# B -> C

Hanoi(3);
# A -> C
# A -> B
# C -> B
# A -> C
# B -> A
# B -> C
# A -> C


package main

import "fmt"

// a towers of hanoi solver just has one method, play
type solver interface {
    play(int)
}

func main() {
    var t solver    // declare variable of solver type
    t = new(towers) // type towers must satisfy solver interface
    t.play(4)
}

// towers is example of type satisfying solver interface
type towers struct {
    // an empty struct.  some other solver might fill this with some
    // data representation, maybe for algorithm validation, or maybe for
    // visualization.
}

// play is sole method required to implement solver type
func (t *towers) play(n int) {
    // drive recursive solution, per task description
    t.moveN(n, 1, 2, 3)
}

// recursive algorithm
func (t *towers) moveN(n, from, to, via int) {
    if n > 0 {
        t.moveN(n-1, from, via, to)
        t.move1(from, to)
        t.moveN(n-1, via, to, from)
    }
}

// example function prints actions to screen.
// enhance with validation or visualization as needed.
func (t *towers) move1(from, to int) {
    fmt.Println("move disk from rod", from, "to rod", to)
}


def tail = { list, n ->  def m = list.size(); list.subList([m - n, 0].max(),m) }

final STACK = [A:[],B:[],C:[]].asImmutable()

def report = { it -> }
def check = { it -> }

def moveRing = { from, to ->  to << from.pop(); report(); check(to) }

def moveStack
moveStack = { from, to, using = STACK.values().find { !(it.is(from) || it.is(to)) } ->
    if (!from) return
    def n = from.size()
    moveStack(tail(from, n-1), using, to)
    moveRing(from, to)
    moveStack(tail(using, n-1), to, from)
}


hanoi :: Integer -> a -> a -> a -> [(a, a)]
hanoi 0 _ _ _ = []
hanoi n a b c = hanoi (n-1) a c b ++ [(a,b)] ++ hanoi (n-1) c b a


U0 Move(U8 n, U8 from, U8 to, U8 via) {
  if (n > 0) {
    Move(n - 1, from, via, to);
    Print("Move disk from pole %d to pole %d\n", from, to);
    Move(n - 1, via, to, from);
  }
}

Move(4, 1, 2, 3);


procedure main(arglist)
hanoi(arglist[1]) | stop("Usage: hanoi n\n\rWhere n is the number of disks to move.")
end

#procedure hanoi(n:integer, needle1:1, needle2:2)   # unicon shorthand for icon code 1,2,3 below

procedure hanoi(n, needle1, needle2)   #: solve towers of hanoi by moving  n disks from needle 1 to needle2 via other
local other

n := integer(0 < n) | runerr(n,101)       # 1 ensure integer (this also ensures it's positive too)
/needle1 := 1                             # 2 default
/needle2 := 2                             # 3 default

if n = 1 then
   write("Move disk from ", needle1, " to ", needle2)
else {
   other := 6 - needle1 - needle2         # clever but somewhat un-iconish way to find other
   hanoi(n-1, needle1, other)
   write("Move disk from ", needle1, " to ", needle2)
   hanoi(n-1, other, needle2)
}
return
end


Hanoi is a room.

A post is a kind of supporter. A post is always fixed in place.

The left post, the middle post, and the right post are posts in Hanoi.

A disk is a kind of supporter.
The red disk is a disk on the left post.
The orange disk is a disk on the red disk.
The yellow disk is a disk on the orange disk.
The green disk is a disk on the yellow disk.

Definition: a disk is topmost if nothing is on it.

When play begins:
	move 4 disks from the left post to the right post via the middle post.

To move (N - number) disk/disks from (FP - post) to (TP - post) via (VP - post):
	if N > 0:
		move N - 1 disks from FP to VP via TP;
		say "Moving a disk from [FP] to [TP]...";
		let D be a random topmost disk enclosed by FP;
		if a topmost disk (called TD) is enclosed by TP, now D is on TD;
		otherwise now D is on TP;
		move N - 1 disks from VP to TP via FP.


hanoi := method(n, from, to, via,
  if (n == 1) then (
    writeln("Move from ", from, " to ", to)
  ) else (
    hanoi(n - 1, from, via, to  )
    hanoi(1    , from, to , via )
    hanoi(n - 1, via , to , from)
  )
)


100 PROGRAM "Hanoi.bas"
110 CALL HANOI(4,1,3,2)
120 DEF HANOI(DISK,FRO,TO,WITH)
130   IF DISK>0 THEN
140     CALL HANOI(DISK-1,FRO,WITH,TO)
150     PRINT "Move disk";DISK;"from";FRO;"to";TO
160     CALL HANOI(DISK-1,WITH,TO,FRO)
170   END IF
180 END DEF


H =: [email protected],&2 ` (({&0 2 1,0 2,{&1 0 2)@$:@<:) @. *    NB. tacit using anonymous recursion


public void move(int n, int from, int to, int via) {
  if (n == 1) {
    System.out.println("Move disk from pole " + from + " to pole " + to);
  } else {
    move(n - 1, from, via, to);
    move(1, from, to, via);
    move(n - 1, via, to, from);
  }
}


function move(n, a, b, c) {
  if (n > 0) {
    move(n-1, a, c, b);
    console.log("Move disk from " + a + " to " + c);
    move(n-1, b, a, c);
  }
}
move(4, "A", "B", "C");


DEFINE hanoi == [[rolldown] infra] dip
                [ [ [null] [pop pop] ]
                  [ [dup2 [[rotate] infra] dip pred]
                    [ [dup rest put] dip
                      [[swap] infra] dip pred ]
                    [] ] ]
                condnestrec.


# n is the number of disks to move from From to To
def move(n; From; To; Via):
  if n > 0 then
     # move all but the largest at From to Via (according to the rules):
     move(n-1; From; Via; To),
     # ... so the largest disk at From is now free to move to its final destination:
     "Move disk from \(From) to \(To)",
     # Move the remaining disks at Via to To:
     move(n-1; Via; To; From)
  else empty
  end;


/* Towers of Hanoi, in Jsish */

function move(n, a, b, c) {
  if (n > 0) {
    move(n-1, a, c, b);
    puts("Move disk from " + a + " to " + c);
    move(n-1, b, a, c);
  }
}

if (Interp.conf('unitTest')) move(4, "A", "B", "C");

/*
=!EXPECTSTART!=
Move disk from A to B
Move disk from A to C
Move disk from B to C
Move disk from A to B
Move disk from C to A
Move disk from C to B
Move disk from A to B
Move disk from A to C
Move disk from B to C
Move disk from B to A
Move disk from C to A
Move disk from B to C
Move disk from A to B
Move disk from A to C
Move disk from B to C
=!EXPECTEND!=
*/


function solve(n::Integer, from::Integer, to::Integer, via::Integer)
  if n == 1
    println("Move disk from $from to $to")
  else
    solve(n - 1, from, via, to)
    solve(1, from, to, via)
    solve(n - 1, via, to, from)
  end
end

solve(4, 1, 2, 3)


include ..\Utilitys.tlhy

:moveDisc %B !B %C !C %A !A %n !n { n A C B }
    $n [
        $n 1 - $A $B $C moveDisc
        ( "Move disc " $n " from pole " $A " to pole " $C ) lprint nl
        $n 1 - $B $C $A moveDisc
    ] if
;

{ Move disc 3 from pole 1 to pole 3, with pole 2 as spare }
3 1 3 2 moveDisc

" " input


// version 1.1.0

class Hanoi(disks: Int) {
    private var moves = 0

    init {
        println("Towers of Hanoi with $disks disks:\n")
        move(disks, 'L', 'C', 'R')
        println("\nCompleted in $moves moves\n")
    }

    private fun move(n: Int, from: Char, to: Char, via: Char) {
        if (n > 0) {
            move(n - 1, from, via, to)
            moves++
            println("Move disk $n from $from to $to")
            move(n - 1, via, to, from)
        }
    }
}

fun main(args: Array<String>) {
    Hanoi(3)
    Hanoi(4)
}


{def move
 {lambda {:n :from :to :via}
  {if {<= :n 0}
   then >
   else {move {- :n 1} :from :via :to}
         move disk :n from :from to :to {br}
        {move {- :n 1} :via :to :from} }}}
-> move
{move 4 A B C}
> move disk 1 from A to C
> move disk 2 from A to B
> move disk 1 from C to B
> move disk 3 from A to C
> move disk 1 from B to A
> move disk 2 from B to C
> move disk 1 from A to C
> move disk 4 from A to B
> move disk 1 from C to B
> move disk 2 from C to A
> move disk 1 from B to A
> move disk 3 from C to B
> move disk 1 from A to C
> move disk 2 from A to B
> move disk 1 from C to B


#!/usr/bin/lasso9

define towermove(
	disks::integer,
	a,b,c
) => {
	if(#disks > 0) => {
		towermove(#disks - 1, #a, #c, #b )
		stdoutnl("Move disk from " + #a + " to " + #c)
		towermove(#disks - 1, #b, #a, #c )
	}
}

towermove((integer($argv -> second || 3)), "A", "B", "C")


   source$ ="A"
    via$    ="B"
    target$ ="C"

    call hanoi 4, source$, target$, via$        '   ie call procedure to move legally 4 disks from peg A to peg C via peg B

    wait

    sub hanoi numDisks, source$, target$, via$
        if numDisks =0 then
            exit sub
        else
            call hanoi numDisks -1, source$, via$, target$
            print " Move disk "; numDisks; " from peg "; source$; " to peg "; target$
            call hanoi numDisks -1, via$, target$, source$
        end if
    end sub

    end


on hanoi (n, a, b, c)
  if n > 0 then
    hanoi(n-1, a, c, b)
    put "Move disk from" && a && "to" && c
    hanoi(n-1, b, a, c)
  end if
end


to move :n :from :to :via
  if :n = 0 [stop]
  move :n-1 :from :via :to
  (print [Move disk from] :from [to] :to)
  move :n-1 :via :to :from
end
move 4 "left "middle "right


:- object(hanoi).

    :- public(run/1).
    :- mode(run(+integer), one).
    :- info(run/1, [
        comment is 'Solves the towers of Hanoi problem for the specified number of disks.',
        argnames is ['Disks']]).

    run(Disks) :-
        move(Disks, left, middle, right).

    move(1, Left, _, Right):-
        !,
        report(Left, Right).
    move(Disks, Left, Aux, Right):-
        Disks2 is Disks - 1,
        move(Disks2, Left, Right, Aux),
        report(Left, Right),
        move(Disks2, Aux, Left, Right).

    report(Pole1, Pole2):-
        write('Move a disk from '),
        writeq(Pole1),
        write(' to '),
        writeq(Pole2),
        write('.'),
        nl.

:- end_object.


HAI 1.2

HOW IZ I HANOI YR N AN YR SRC AN YR DST AN YR VIA
    BTW VISIBLE SMOOSH "HANOI N=" N " SRC=" SRC " DST=" DST " VIA=" VIA MKAY
    BOTH SAEM N AN 0, O RLY?
        YA RLY
            BTW VISIBLE "Done."
            GTFO
        NO WAI
            I HAS A LOWER ITZ DIFF OF N AN 1
            I IZ HANOI YR LOWER AN YR SRC AN YR VIA AN YR DST MKAY
            VISIBLE SMOOSH "Move disc " N " from " SRC " to " DST MKAY
            I IZ HANOI YR LOWER AN YR VIA AN YR DST AN YR SRC MKAY
    OIC
IF U SAY SO

I IZ HANOI YR 4 AN YR 1 AN YR 2 AN YR 3  MKAY

KTHXBYE


function move(n, src, dst, via)
    if n > 0 then
        move(n - 1, src, via, dst)
        print(src, 'to', dst)
        move(n - 1, via, dst, src)
    end
end

move(4, 1, 2, 3)


Module Hanoi {
      Rem HANOI TOWERS
      Print "Three disks" : Print
      move(3, 1, 2, 3)
      Print
      Print "Four disks" : Print
      move(4, 1, 2, 3)

      Sub move(n, from, to, via)
            If n <=0 Then Exit Sub
            move(n - 1, from, via, to)
            Print "Move disk"; n; " from pole"; from; " to pole"; to
            move(n - 1, via, to, from)
      End Sub
}
Hanoi


            NORMAL MODE IS INTEGER
            DIMENSION LIST(100)
            SET LIST TO LIST

            VECTOR VALUES MOVFMT =
          0  $20HMOVE DISK FROM POLE ,I1,S1,8HTO POLE ,I1*$

            INTERNAL FUNCTION(DUMMY)
            ENTRY TO MOVE.
LOOP        NUM = NUM - 1
            WHENEVER NUM.E.0
                PRINT FORMAT MOVFMT,FROM,DEST
            OTHERWISE
                SAVE RETURN
                SAVE DATA NUM,FROM,VIA,DEST
                TEMP=DEST
                DEST=VIA
                VIA=TEMP
                MOVE.(0)
                RESTORE DATA NUM,FROM,VIA,DEST
                RESTORE RETURN
                PRINT FORMAT MOVFMT,FROM,DEST
                TEMP=FROM
                FROM=VIA
                VIA=TEMP
                TRANSFER TO LOOP
            END OF CONDITIONAL
            FUNCTION RETURN
            END OF FUNCTION

            NUM  = 4
            FROM = 1
            VIA  = 2
            DEST = 3
            MOVE.(0)

            END OF PROGRAM


Hanoi := proc(n::posint,a,b,c)
   if n = 1 then
       printf("Move disk from tower %a to tower %a.\n",a,c);
   else
       Hanoi(n-1,a,c,b);
       Hanoi(1,a,b,c);
       Hanoi(n-1,b,a,c);
    fi;
end:

printf("Moving 2 disks from tower A to tower C using tower B.\n");
Hanoi(2,A,B,C);


Hanoi[0, from_, to_, via_] := Null
Hanoi[n_Integer, from_, to_, via_] := (Hanoi[n-1, from, via, to];Print["Move disk from pole ", from, " to ", to, "."];Hanoi[n-1, via, to, from])


function towerOfHanoi(n,A,C,B)
    if (n~=0)
        towerOfHanoi(n-1,A,B,C);
        disp(sprintf('Move plate %d from tower %d to tower %d',[n A C]));
        towerOfHanoi(n-1,B,C,A);
    end
end


moveDisc = function(n, A, C, B)
    if n == 0 then return
    moveDisc n-1, A, B, C
    print "Move disc " + n + " from pole " + A + " to pole " + C
    moveDisc n-1, B, C, A
end function

// Move disc 3 from pole 1 to pole 3, with pole 2 as spare
moveDisc 3, 1, 3, 2


# Towers of Hanoi
# MIPS assembly implementation (tested with MARS)
# Source: https://stackoverflow.com/questions/50382420/hanoi-towers-recursive-solution-using-mips/50383530#50383530

.data
prompt: .asciiz "Enter a number: "
part1: .asciiz "\nMove disk "
part2: .asciiz " from rod "
part3: .asciiz " to rod "

.text
.globl main
main:
    li $v0,  4          # print string
    la $a0,  prompt
    syscall
    li $v0,  5          # read integer
    syscall

    # parameters for the routine
    add $a0, $v0, $zero # move to $a0
    li $a1, 'A'
    li $a2, 'B'
    li $a3, 'C'

    jal hanoi           # call hanoi routine

    li $v0, 10          # exit
    syscall

hanoi:

    #save in stack
    addi $sp, $sp, -20
    sw   $ra, 0($sp)
    sw   $s0, 4($sp)
    sw   $s1, 8($sp)
    sw   $s2, 12($sp)
    sw   $s3, 16($sp)

    add $s0, $a0, $zero
    add $s1, $a1, $zero
    add $s2, $a2, $zero
    add $s3, $a3, $zero

    addi $t1, $zero, 1
    beq $s0, $t1, output

    recur1:

        addi $a0, $s0, -1
        add $a1, $s1, $zero
        add $a2, $s3, $zero
        add $a3, $s2, $zero
        jal hanoi

        j output

    recur2:

        addi $a0, $s0, -1
        add $a1, $s3, $zero
        add $a2, $s2, $zero
        add $a3, $s1, $zero
        jal hanoi

    exithanoi:

        lw   $ra, 0($sp)        # restore registers from stack
        lw   $s0, 4($sp)
        lw   $s1, 8($sp)
        lw   $s2, 12($sp)
        lw   $s3, 16($sp)

        addi $sp, $sp, 20       # restore stack pointer

        jr $ra

    output:

        li $v0,  4              # print string
        la $a0,  part1
        syscall
        li $v0,  1              # print integer
        add $a0, $s0, $zero
        syscall
        li $v0,  4              # print string
        la $a0,  part2
        syscall
        li $v0,  11             # print character
        add $a0, $s1, $zero
        syscall
        li $v0,  4              # print string
        la $a0,  part3
        syscall
        li $v0,  11             # print character
        add $a0, $s2, $zero
        syscall

        beq $s0, $t1, exithanoi
        j recur2


^	2	x^y	П0	<->	2	/	{x}	x#0	16
3	П3	2	П2	БП	20	3	П2	2	П3
1	П1	ПП	25	КППB	ПП	28	КППA	ПП	31
КППB	ПП	34	КППA	ИП1	ИП3	КППC	ИП1	ИП2	КППC
ИП3	ИП2	КППC	ИП1	ИП3	КППC	ИП2	ИП1	КППC	ИП2
ИП3	КППC	ИП1	ИП3	КППC	В/О	ИП1	ИП2	БП	62
ИП2	ИП1	КППC	ИП1	ИП2	ИП3	П1	->	П3	->
П2	В/О	1	0	/	+	С/П	КИП0	ИП0	x=0
89	3	3	1	ИНВ	^	ВП	2	С/П	В/О


MODULE Towers;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,ReadChar;

PROCEDURE Move(n,from,to,via : INTEGER);
VAR buf : ARRAY[0..63] OF CHAR;
BEGIN
    IF n>0 THEN
        Move(n-1, from, via, to);
        FormatString("Move disk %i from pole %i to pole %i\n", buf, n, from, to);
        WriteString(buf);
        Move(n-1, via, to, from)
    END
END Move;

BEGIN
    Move(3, 1, 3, 2);

    ReadChar
END Towers.


MODULE Hanoi EXPORTS Main;

FROM IO IMPORT Put;
FROM Fmt IMPORT Int;

PROCEDURE doHanoi(n, from, to, using: INTEGER) =
  BEGIN
    IF n > 0 THEN
      doHanoi(n - 1, from, using, to);
      Put("move " & Int(from) & " --> " & Int(to) & "\n");
      doHanoi(n - 1, using, to, from);
    END;
  END doHanoi;

BEGIN
  doHanoi(4, 1, 2, 3);
END Hanoi.


def move(n, fromPeg, toPeg, viaPeg):
    if (n > 0):
        move(n.previous(), fromPeg, viaPeg, toPeg)
        traceln(`Move disk $n from $fromPeg to $toPeg`)
        move(n.previous(), viaPeg, toPeg, fromPeg)

move(3, "left", "right", "middle")


hanoi = (n, src, dest, via) ->
  if n > 1
    hanoi n-1, src, via, dest
  print "#{src} -> #{dest}"
  if n > 1
    hanoi n-1, via, dest, src

hanoi 4,1,3,2


using System;
using System.Console;

module Towers
{
    Hanoi(n : int, from = 1, to = 3, via = 2) : void
    {
        when (n > 0)
        {
            Hanoi(n - 1, from, via, to);
            WriteLine("Move disk from peg {0} to peg {1}", from, to);
            Hanoi(n - 1, via, to, from);
        }
    }

    Main() : void
    {
        Hanoi(4)
    }
}


/* NetRexx */
options replace format comments java crossref symbols binary

runSample(arg)
return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) private static
  parse arg discs .
  if discs = '', discs < 1 then discs = 4
  say 'Minimum moves to solution:' 2 ** discs - 1
  moves = move(discs)
  say 'Solved in' moves 'moves.'
  return

-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method move(discs = int 4, towerFrom = int 1, towerTo = int 2, towerVia = int 3, moves = int 0) public static
  if discs == 1 then do
    moves = moves + 1
    say 'Move disc from peg' towerFrom 'to peg' towerTo '- Move No:' Rexx(moves).right(5)
    end
  else do
    moves = move(discs - 1, towerFrom, towerVia, towerTo, moves)
    moves = move(1, towerFrom, towerTo, towerVia, moves)
    moves = move(discs - 1, towerVia, towerTo, towerFrom, moves)
    end
  return moves


(define (move n from to via)
			(if (> n 0)
				(move (- n 1) from via to
				(print "move disk from pole " from " to pole " to "\n")
				(move (- n 1) via to from))))

(move 4 1 2 3)


proc hanoi(disks: int; fromTower, toTower, viaTower: string) =
  if disks != 0:
    hanoi(disks - 1, fromTower, viaTower, toTower)
    echo("Move disk ", disks, " from ", fromTower, " to ", toTower)
    hanoi(disks - 1, viaTower, toTower, fromTower)

hanoi(4, "1", "2", "3")


class Hanoi {
  function : Main(args : String[]) ~ Nil {
    Move(4, 1, 2, 3);
  }

  function: Move(n:Int, f:Int, t:Int, v:Int) ~ Nil {
    if(n = 1) {
      "Move disk from pole {$f} to pole {$t}"->PrintLine();
    }
    else {
      Move(n - 1, f, v, t);
      Move(1, f, t, v);
      Move(n - 1, v, t, f);
    };
  }
}


#import <Foundation/NSObject.h>

@interface TowersOfHanoi: NSObject {
	int pegFrom;
	int pegTo;
	int pegVia;
	int numDisks;
}

-(void) setPegFrom: (int) from andSetPegTo: (int) to andSetPegVia: (int) via andSetNumDisks: (int) disks;
-(void) movePegFrom: (int) from andMovePegTo: (int) to andMovePegVia: (int) via andWithNumDisks: (int) disks;
@end


let rec hanoi n a b c =
  if n <> 0 then begin
    hanoi (pred n) a c b;
    Printf.printf "Move disk from pole %d to pole %d\n" a b;
    hanoi (pred n) c b a
  end

let () =
  hanoi 4 1 2 3


function hanoimove(ndisks, from, to, via)
  if ( ndisks == 1 )
    printf("Move disk from pole %d to pole %d\n", from, to);
  else
    hanoimove(ndisks-1, from, via, to);
    hanoimove(1, from, to, via);
    hanoimove(ndisks-1, via, to, from);
  endif
endfunction

hanoimove(4, 1, 2, 3);


: move(n, from, to, via)
   n 0 > ifTrue: [
      move(n 1-, from, via, to)
      System.Out "Move disk from " << from << " to " << to << cr
      move(n 1-, via, to, from)
      ] ;

5 $left $middle $right) move


declare
  proc {TowersOfHanoi N From To Via}
     if N > 0 then
        {TowersOfHanoi N-1 From Via To}
        {System.showInfo "Move from "#From#" to "#To}
        {TowersOfHanoi N-1 Via To From}
     end
  end
in
  {TowersOfHanoi 4 left middle right}


\\ Towers of Hanoi
\\ 8/19/2016 aev
\\ Where: n - number of disks, sp - start pole, ep - end pole.
HanoiTowers(n,sp,ep)={
  if(n!=0,
    HanoiTowers(n-1,sp,6-sp-ep);
    print("Move disk ", n, " from pole ", sp," to pole ", ep);
    HanoiTowers(n-1,6-sp-ep,ep);
    );
}
\\ Testing n=3:
HanoiTowers(3,1,3);


program Hanoi;
type
  TPole = (tpLeft, tpCenter, tpRight);
const
  strPole:array[TPole] of string[6]=('left','center','right');

 procedure MoveStack (const Ndisks : integer; const Origin,Destination,Auxiliary:TPole);
 begin
  if Ndisks >0 then begin
     MoveStack(Ndisks - 1, Origin,Auxiliary, Destination );
     Writeln('Move disk ',Ndisks ,' from ',strPole[Origin],' to ',strPole[Destination]);
     MoveStack(Ndisks - 1, Auxiliary, Destination, origin);
  end;
 end;

begin
 MoveStack(4,tpLeft,tpCenter,tpRight);
end.


sub hanoi {
    my ($n, $from, $to, $via) = (@_, 1, 2, 3);

    if ($n == 1) {
        print "Move disk from pole $from to pole $to.\n";
    } else {
        hanoi($n - 1, $from, $via, $to);
        hanoi(1, $from, $to, $via);
        hanoi($n - 1, $via, $to, $from);
    };
};


constant poles = {"left","middle","right"}
enum               left,  middle,  right

sequence disks
integer moves

procedure showpegs(integer src, integer dest)
    string desc = sprintf("%s to %s:",{poles[src],poles[dest]})
    disks[dest] &= disks[src][$]
    disks[src] = disks[src][1..$-1]
    for i=1 to length(disks) do
        printf(1,"%-16s | %s\n",{desc,join(sq_add(disks[i],'0'),' ')})
        desc = ""
    end for
    printf(1,"\n")
    moves += 1
end procedure

procedure hanoir(integer n, src=left, dest=right, via=middle)
    if n>0 then
        hanoir(n-1, src, via, dest)
        showpegs(src,dest)
        hanoir(n-1, via, dest, src)
    end if
end procedure

procedure hanoi(integer n)
    disks = {reverse(tagset(n)),{},{}}
    moves = 0
    hanoir(n)
    printf(1,"completed in %d moves\n",{moves})
end procedure

hanoi(3) -- (output of 4,5,6 also shown)


module hanoi;

extern printf;

@Void move(@Integer n, @Integer from, @Integer to, @Integer via) [
	if (n > 0) {
		move(n - 1, from, via, to);
		printf("Move disk from pole %d to pole %d\n", from, to);
		move(n - 1, via, to, from);
	}
]

@Integer main [
	move(4, 1,2,3);
	return 0;
]


function move($n,$from,$to,$via) {
    if ($n === 1) {
        print("Move disk from pole $from to pole $to");
    } else {
        move($n-1,$from,$via,$to);
        move(1,$from,$to,$via);
        move($n-1,$via,$to,$from);
    }
}


main =>
    hanoi(3, left, center, right).

hanoi(0, _From, _To, _Via) => true.
hanoi(N, From, To, Via) =>
    hanoi(N - 1, From, Via, To),
    printf("Move disk %w from pole %w to pole %w\n", N, From, To),
    hanoi(N - 1, Via, To, From).


(de move (N A B C)  # Use: (move 3 'left 'center 'right)
   (unless (=0 N)
      (move (dec N) A C B)
      (println 'Move 'disk 'from A 'to B)
      (move (dec N) C B A) ) )


tower: proc options (main);

   call Move (4,1,2,3);

Move: procedure (ndiscs, from, to, via) recursive;
   declare (ndiscs, from, to, via) fixed binary;

   if ndiscs = 1 then
      put skip edit ('Move disc from pole ', trim(from), ' to pole ',
         trim(to) ) (a);
   else
      do;
         call Move (ndiscs-1, from, via, to);
         call Move (1, from, to, via);
         call Move (ndiscs-1, via, to, from);
      end;
end Move;

end tower;


100H: /* ITERATIVE TOWERS OF HANOI; TRANSLATED FROM TINY BASIC (VIA ALGOL W) */

   /* CP/M BDOS SYSTEM CALL                                                  */
   BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
   /* I/O ROUTINES                                                           */
   PR$CHAR:   PROCEDURE( C ); DECLARE C BYTE;    CALL BDOS( 2, C );  END;
   PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S );  END;

   DECLARE ( D, N, X, S, T ) ADDRESS;
   /* FIXED NUMBER OF DISCS: 4 */
   N = 1;
   DO D = 1 TO 4;
       N = N + N;
   END;
   DO X = 1 TO N - 1;
       /* AS IN ALGOL W, WE CAN USE PL/M'S BIT ABD MOD OPERATORS             */
       S =   ( X AND ( X - 1 ) )       MOD 3;
       T = ( ( X OR  ( X - 1 ) ) + 1 ) MOD 3;
       CALL PR$STRING( .'MOVE DISC ON PEG $' );
       CALL PR$CHAR( '1' + S );
       CALL PR$STRING( .' TO PEG $' );
       CALL PR$CHAR( '1' + T );
       CALL PR$STRING( .( 0DH, 0AH, '$' ) );
   END;
EOF


\newcount\hanoidepth
\def\hanoi#1{%
  \hanoidepth = #1
  \move abc
}%
\def\move#1#2#3{%
  \advance \hanoidepth by -1
  \ifnum \hanoidepth > 0
    \move #1#3#2
  \fi
  Move the upper disk from pole #1 to pole #3.\par
  \ifnum \hanoidepth > 0
    \move#2#1#3
  \fi
  \advance \hanoidepth by 1
}

\hanoi{5}
\end


define hanoi(n, src, dst, via);
if n > 0 then
    hanoi(n - 1, src, via, dst);
    'Move disk ' >< n >< ' from ' >< src >< ' to ' >< dst >< '.' =>
    hanoi(n - 1, via, dst, src);
endif;
enddefine;

hanoi(4, "left", "middle", "right");


%!PS-Adobe-3.0
%%BoundingBox: 0 0 300 300

/plate {
        exch 100 mul 50 add exch th mul 10 add moveto
        dup s mul neg 2 div 0 rmoveto
        dup s mul 0 rlineto
        0 th rlineto
        s neg mul 0 rlineto
        closepath gsave .5 setgray fill grestore 0 setgray stroke
} def

/drawtower {
        0 1 2 { /x exch def /y 0 def
                tower x get {
                        dup 0 gt { x y plate /y y 1 add def } {pop} ifelse
                } forall
        } for showpage
} def

/apop { [ exch aload pop /last exch def ] last } def
/apush{ [ 3 1 roll aload pop counttomark -1 roll ] } def

/hanoi {
        0 dict begin /from /mid /to /h 5 -1 2 { -1 roll def } for
        h 1 eq {
                tower from get apop tower to get apush
                tower to 3 -1 roll put
                tower from 3 -1 roll put
                drawtower
        } {
                /h h 1 sub def
                from to mid h hanoi
                from mid to 1 hanoi
                mid from to h hanoi
        } ifelse
        end
} def

/n 12 def
/s 90 n div def
/th 180 n div def
/tower [ [n 1 add -1 2 { } for ] [] [] ] def

drawtower 0 1 2 n hanoi

%%EOF


function hanoi($n, $a,  $b, $c) {
    if($n -eq 1) {
        "$a -> $c"
    } else{
         hanoi ($n - 1) $a $c $b
         hanoi 1 $a $b $c
         hanoi ($n - 1) $b $a $c
    }
}
hanoi 3 "A" "B" "C"


hanoi(N) :- move(N,left,center,right).

move(0,_,_,_) :- !.
move(N,A,B,C) :-
    M is N-1,
    move(M,A,C,B),
    inform(A,B),
    move(M,C,B,A).

inform(X,Y) :- write([move,a,disk,from,the,X,pole,to,Y,pole]), nl.


Procedure Hanoi(n, A.s, C.s, B.s)
  If n
    Hanoi(n-1, A, B, C)
    PrintN("Move the plate from "+A+" to "+C)
    Hanoi(n-1, B, C, A)
  EndIf
EndProcedure


def hanoi(ndisks, startPeg=1, endPeg=3):
    if ndisks:
        hanoi(ndisks-1, startPeg, 6-startPeg-endPeg)
        print "Move disk %d from peg %d to peg %d" % (ndisks, startPeg, endPeg)
        hanoi(ndisks-1, 6-startPeg-endPeg, endPeg)

hanoi(ndisks=4)


  [ stack ]                     is rings    (     --> [ )

  [ rings share
    depth share -
    8 * times sp
    emit sp emit sp
    say 'move' cr ]             is echomove ( c c -->   )

  [ dup rings put
    depth put
    char a char b char c
    [ swap decurse
      rot 2dup echomove
      decurse
      swap rot ]
    3 times drop
    depth release
    rings release ]             is hanoi    (   n --> n )

  say 'How to solve a three ring Towers of Hanoi puzzle:' cr cr
  3 hanoi cr


'This is implemented on the Quite BASIC website
'http://www.quitebasic.com/prj/puzzle/towers-of-hanoi/


hanoimove <- function(ndisks, from, to, via) {
  if (ndisks == 1) {
    cat("move disk from", from, "to", to, "\n")
  } else {
    hanoimove(ndisks - 1, from, via, to)
    hanoimove(1, from, to, via)
    hanoimove(ndisks - 1, via, to, from)
  }
}

hanoimove(4, 1, 2, 3)


#lang racket
(define (hanoi n a b c)
  (when (> n 0)
    (hanoi (- n 1) a c b)
    (printf "Move ~a to ~a\n" a b)
    (hanoi (- n 1) c b a)))
(hanoi 4 'left 'middle 'right)


subset Peg of Int where 1|2|3;

multi hanoi (0,      Peg $a,     Peg $b,     Peg $c)     { }
multi hanoi (Int $n, Peg $a = 1, Peg $b = 2, Peg $c = 3) {
    hanoi $n - 1, $a, $c, $b;
    say "Move $a to $b.";
    hanoi $n - 1, $c, $b, $a;
}


public void hanoi(ndisks, startPeg, endPeg){
	if(ndisks>0){
		hanoi(ndisks-1, startPeg, 6 - startPeg - endPeg);
		println("Move disk <ndisks> from peg <startPeg> to peg <endPeg>");
		hanoi(ndisks-1, 6 - startPeg - endPeg, endPeg);
	}
}


define hanoi use ndisks, startpeg, endpeg
   ndisks 0 > if
      6 startpeg - endpeg - startpeg ndisks 1 - hanoi
      endpeg startpeg ndisks "Move disk %d from peg %d to peg %d\n" print
      endpeg 6 startpeg - endpeg - ndisks 1 - hanoi

define dohanoi use ndisks
   # startpeg=1, endpeg=3
   3 1 ndisks hanoi

# 4 disks
4 dohanoi


rebol [
	Title: "Towers of Hanoi"
	URL: http://rosettacode.org/wiki/Towers_of_Hanoi
]

hanoi: func [
	{Begin moving the golden disks from one pole to the next.
	 Note: when last disk moved, the world will end.}
	disks [integer!] "Number of discs on starting pole."
	/poles "Name poles."
	from to via
][
    if disks = 0 [return]
	if not poles [from: 'left  to: 'middle  via: 'right]

    hanoi/poles disks - 1 from via to
	print [from "->" to]
    hanoi/poles disks - 1 via to from
]

hanoi 4


~~~
{ 'Num 'From 'To 'Via } [ var ] a:for-each

:set     !Via !To !From !Num ;
:display @To @From 'Move_a_ring_from_%n_to_%n\n s:format s:put ;

:hanoi (num,from,to,via-)
  set @Num n:-zero?
  [ @Num @From @To @Via
    @Num n:dec @From @Via @To hanoi set display
    @Num n:dec @Via @To @From hanoi ] if ;

#3 #1 #3 #2 hanoi nl
~~~


/*REXX program  displays  the  moves  to solve  the  Tower of Hanoi  (with  N  disks).  */
parse arg N .                                    /*get optional number of disks from CL.*/
if N=='' | N==","  then N=3                      /*Not specified?  Then use the default.*/
#= 0                                             /*#:  the number of disk moves (so far)*/
z= 2**N  -  1                                    /*Z:   "     "    " minimum # of moves.*/
call mov  1, 3, N                                /*move the top disk,  then recurse ··· */
say                                              /* [↓]  Display the minimum # of moves.*/
say 'The minimum number of moves to solve a '      N"─disk  Tower of Hanoi is "     z
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
mov: procedure expose # z; parse arg  @1,@2,@3;          L= length(z)
     if @3==1  then do;  #= # + 1                /*bump the (disk) move counter by one. */
                         say 'step'   right(#, L)":  move disk on tower"   @1  '───►'   @2
                    end
               else do;  call mov @1,               6 [email protected] [email protected],         @3 -1
                         call mov @1,               @2,                  1
                         call mov 6 - @1 - @2,      @2,                @3 -1
                    end
     return                                      /* [↑]  this subroutine uses recursion.*/


move(4, 1, 2, 3)

func move n, src, dst, via
     if n > 0 move(n - 1, src, via, dst)
        see "" + src + " to " + dst + nl
        move(n - 1, via, dst, src) ok


def move(num_disks, start=0, target=1, using=2)
  if num_disks == 1
   @towers[target] << @towers[start].pop
    puts "Move disk from #{start} to #{target} : #{@towers}"
  else
    move(num_disks-1, start, using, target)
    move(1,           start, target, using)
    move(num_disks-1, using, target, start)
  end
end

n = 5
@towers = [[*1..n].reverse, [], []]
move(n)


a = move(4, "1", "2", "3")
function move(n, a$, b$, c$)
if n > 0 then
	a = move(n-1, a$, c$, b$)
	print "Move disk from " ; a$ ; " to " ; c$
	a = move(n-1, b$, a$, c$)
end if
end function


fn move_(n: i32, from: i32, to: i32, via: i32) {
    if n > 0 {
        move_(n - 1, from, via, to);
        println!("Move disk from pole {} to pole {}", from, to);
        move_(n - 1, via, to, from);
    }
}

fn main() {
    move_(4, 1,2,3);
}


hanoi 8 ‘abc"
WHERE
hanoi 0 (a,b,c,) = ()
hanoi n ( a,b,c) = hanoi (n-1) (a,c,b) ,
                   ‘move a disc from " , a , ‘ to " , b , NL ,
                   hanoi (n-1) (c,b,a)
?


class MAIN is

  move(ndisks, from, to, via:INT) is
    if ndisks = 1 then
      #OUT + "Move disk from pole " + from + " to pole " + to + "\n";
    else
      move(ndisks-1, from, via, to);
      move(1, from, to, via);
      move(ndisks-1, via, to, from);
    end;
  end;

  main is
    move(4, 1, 2, 3);
  end;
end;


def move(n: Int, from: Int, to: Int, via: Int) : Unit = {
    if (n == 1) {
      Console.println("Move disk from pole " + from + " to pole " + to)
    } else {
      move(n - 1, from, via, to)
      move(1, from, to, via)
      move(n - 1, via, to, from)
    }
  }


(define (towers-of-hanoi n from to spare)
  (define (print-move from to)
    (display "Move[")
    (display from)
    (display ", ")
    (display to)
    (display "]")
    (newline))
  (cond ((= n 0) "done")
        (else
         (towers-of-hanoi (- n 1) from spare to)
         (print-move from to)
         (towers-of-hanoi (- n 1) spare to from))))

(towers-of-hanoi 3 "A" "B" "C")


const proc: hanoi (in integer: disk, in string: source, in string: dest, in string: via) is func
  begin
    if disk > 0 then
      hanoi(pred(disk), source, via, dest);
      writeln("Move disk " <& disk <& " from " <& source <& " to " <& dest);
      hanoi(pred(disk), via, dest, source);
    end if;
  end func;


func hanoi(n, from=1, to=2, via=3) {
    if (n == 1) {
        say "Move disk from pole #{from} to pole #{to}.";
    } else {
        hanoi(n-1, from, via,   to);
        hanoi(  1, from,  to,  via);
        hanoi(n-1,  via,  to, from);
    }
}

hanoi(4);


*       # Note: count is global

        define('hanoi(n,src,trg,tmp)') :(hanoi_end)
hanoi   hanoi = eq(n,0) 1 :s(return)
        hanoi(n - 1, src, tmp, trg)
        count  = count + 1
        output = count ': Move disc from ' src ' to ' trg
        hanoi(n - 1, tmp, trg, src) :(return)
hanoi_end

*       # Test with 4 discs
        hanoi(4,'A','C','B')
end


   fun hanoi(0, a, b, c) = [] |
       hanoi(n, a, b, c) = hanoi(n-1, a, c, b) @ [(a,b)] @ hanoi(n-1, c, b, a);


function hanoi(n, a, b, c) {
	if (n>0) {
		hanoi(n-1, a, c, b)
		printf("Move from %f to %f\n", a, b)
		hanoi(n-1, c, b, a)
	}
}

hanoi(3, 1, 2, 3)

Move from 1 to 2
Move from 1 to 3
Move from 2 to 3
Move from 1 to 2
Move from 3 to 1
Move from 3 to 2
Move from 1 to 2


func hanoi(n:Int, a:String, b:String, c:String) {
    if (n > 0) {
        hanoi(n - 1, a, c, b)
        println("Move disk from \(a) to \(c)")
        hanoi(n - 1, b, a, c)
    }
}

hanoi(4, "A", "B", "C")


interp alias {} hanoi {} do_hanoi 0

proc do_hanoi {count n {from A} {to C} {via B}} {
    if {$n == 1} {
        interp alias {} hanoi {} do_hanoi [incr count]
        puts "$count: move from $from to $to"
    } else {
        incr n -1
        hanoi $n $from $via $to
        hanoi 1  $from $to $via
        hanoi $n $via $to $from
    }
}

hanoi 4


PROGRAM:TOHSOLVE
0→A
1→B
0→C
0→D
0→M
1→R
While A<1 or A>7
Input "No. of rings=?",A
End
randM(A+1,3)→[C]
[[1,2][1,3][2,3]]→[E]

Fill(0,[C])
For(I,1,A,1)
I?[C](I,1)
End
ClrHome
While [C](1,3)≠1 and [C](1,2)≠1

For(J,1,3)
For(I,1,A)
If [C](I,J)≠0:Then
Output(I+1,3J,[C](I,J))
End
End
End
While C=0
Output(1,3B," ")
1→I
[E](R,2)→J
While [C](I,J)=0 and I≤A
I+1→I
End
[C](I,J)→D
1→I
[E](R,1)→J
While [C](I,J)=0 and I≤A
I+1→I
End
If (D<[C](I,J) and D≠0) or [C](I,J)=0:Then
[E](R,2)→B
Else
[E](R,1)→B
End

1→I
While [C](I,B)=0 and I≤A
I+1→I
End
If I≤A:Then
[C](I,B)→C
0→[C](I,B)
Output(I+1,3B," ")
End
Output(1,3B,"V")
End

While C≠0
Output(1,3B," ")
If B=[E](R,2):Then
[E](R,1)→B
Else
[E](R,2)→B
End

1→I
While [C](I,B)=0 and I≤A
I+1→I
End
If [C](I,B)=0 or [C](I,B)>C:Then
C→[C](I-1,B)
0→C
M+1→M
End
End
Output(1,3B,"V")
R+1→R
If R=4:Then:1→R:End

End


 5  PRINT "How many disks?"
    INPUT D
    IF D < 1 THEN GOTO 5
    IF D > 10 THEN GOTO 5
    LET N = 1
10  IF D = 0 THEN GOTO 20
    LET D = D - 1
    LET N = 2*N
    GOTO 10
20  LET X = 0
30  LET X = X + 1
    IF X = N THEN END
    GOSUB 40
    LET S = S - 3*(S/3)
    GOSUB 50
    LET T = T + 1
    LET T = T - 3*(T/3)
    PRINT "Move disc on peg ",S+1," to peg ",T+1
    GOTO 30
40  LET B = X - 1
    LET A = X
    LET S = 0
    LET Z = 2048
45  LET C = 0
    IF B >= Z THEN LET C = 1
    IF A >= Z THEN LET C = C + 1
    IF C = 2 THEN LET S = S + Z
    IF A >= Z THEN LET A = A - Z
    IF B >= Z THEN LET B = B - Z
    LET Z = Z / 2
    IF Z = 0 THEN RETURN
    GOTO 45
50  LET B = X - 1
    LET A = X
    LET T = 0
    LET Z = 2048
55  LET C = 0
    IF B >= Z THEN LET C = 1
    IF A >= Z THEN LET C = C + 1
    IF C > 0 THEN LET T = T + Z
    IF A >= Z THEN LET A = A - Z
    IF B >= Z THEN LET B = B - Z
    LET Z = Z / 2
    IF Z = 0 THEN RETURN
    GOTO 55


value| sa sb sc n |
[ to sc to sb to sa to n ] is vars!
[ ( num from to via -- )
  vars!
  n 0 <>
  [
    n sa sb sc
    n 1- sa sc sb recurse
    vars!
    ." Move a ring from " sa . ." to " sb . cr
    n 1- sc sb sa recurse
  ] ifTrue
] is hanoi


DECLARE SUB hanoi

SUB hanoi(n, desde , hasta, via)
    IF n > 0 THEN
       CALL hanoi(n - 1, desde, via, hasta)
       PRINT "Mover disco"; n; "desde posición"; desde; "hasta posición"; hasta
       CALL hanoi(n - 1, via, hasta, desde)
    END IF
END SUB

PRINT "Tres discos"
PRINT
CALL hanoi(3, 1, 2, 3)
PRINT
PRINT "Cuatro discos"
PRINT
CALL hanoi(4, 1, 2, 3)
PRINT
PRINT "Pulsa un tecla para salir"
END


// library: program: run: towersofhanoi: recursive: sub <description></description> <version>1.0.0.0.0</version> <version control></version control> (filenamemacro=runprrsu.s) [kn, ri, tu, 07-02-2012 19:54:23]
PROC PROCProgramRunTowersofhanoiRecursiveSub( INTEGER totalDiskI, STRING fromS, STRING toS, STRING viaS, INTEGER bufferI )
 IF ( totalDiskI == 0 )
  RETURN()
 ENDIF
 PROCProgramRunTowersofhanoiRecursiveSub( totalDiskI - 1, fromS, viaS, toS, bufferI )
 AddLine( Format( "Move disk", " ", totalDiskI, " ", "from peg", " ", "'", fromS, "'", " ", "to peg", " ", "'", toS, "'" ), bufferI )
 PROCProgramRunTowersofhanoiRecursiveSub( totalDiskI - 1, viaS, toS, fromS, bufferI )
END

// library: program: run: towersofhanoi: recursive <description></description> <version>1.0.0.0.6</version> <version control></version control> (filenamemacro=runprtre.s) [kn, ri, tu, 07-02-2012 19:40:45]
PROC PROCProgramRunTowersofhanoiRecursive( INTEGER totalDiskI, STRING fromS, STRING toS, STRING viaS )
 INTEGER bufferI = 0
 PushPosition()
 bufferI = CreateTempBuffer()
 PopPosition()
 PROCProgramRunTowersofhanoiRecursiveSub( totalDiskI, fromS, toS, viaS, bufferI )
 GotoBufferId( bufferI )
END

PROC Main()
STRING s1[255] = "4"
IF ( NOT ( Ask( "program: run: towersofhanoi: recursive: totalDiskI = ", s1, _EDIT_HISTORY_ ) ) AND ( Length( s1 ) > 0 ) ) RETURN() ENDIF
 PROCProgramRunTowersofhanoiRecursive( Val( s1 ), "source", "target", "via" )
END


Proc  _Move(4, 1,2,3)                  ' 4 disks, 3 poles
End

_Move Param(4)
  If ([email protected] > 0) Then
    Proc _Move ([email protected] - 1, [email protected], [email protected], [email protected])
    Print "Move disk from pole ";[email protected];" to pole ";[email protected]
    Proc _Move ([email protected] - 1, [email protected], [email protected], [email protected])
  EndIf
Return


#!/bin/bash

move()
{
  local n="$1"
  local from="$2"
  local to="$3"
  local via="$4"

  if [[ "$n" == "1" ]]
  then
    echo "Move disk from pole $from to pole $to"
  else
    move $(($n - 1)) $from $via $to
    move 1 $from $to $via
    move $(($n - 1)) $via $to $from
  fi
}

move $1 $2 $3 $4


#import nat

move = ~&al^& ^rlPlrrPCT/~&arhthPX ^|W/~& ^|G/predecessor ^/~&htxPC ~&zyxPC

#show+

main = ^|T(~&,' -> '--)* move/4 <'start','end','middle'>


Sub Move(n,fromPeg,toPeg,viaPeg)
	If n > 0 Then
		Move n-1, fromPeg, viaPeg, toPeg
		WScript.StdOut.Write "Move disk from " & fromPeg & " to " & toPeg
		WScript.StdOut.WriteBlankLines(1)
		Move n-1, viaPeg, toPeg, fromPeg
	End If
End Sub

Move 4,1,2,3
WScript.StdOut.Write("Towers of Hanoi puzzle completed!")


#1=1; #2=2; #3=3; #4=4          // move 4 disks from 1 to 2
Call("MOVE_DISKS")
Return

// Move disks
// #1 = from, #2 = to, #3 = via, #4 = number of disks
//
:MOVE_DISKS:
if (#4 > 0) {
    Num_Push(1,4)
        #9=#2; #2=#3; #3=#9; #4--       // #1 to #3 via #2
        Call("MOVE_DISKS")
    Num_Pop(1,4)

    Ins_Text("Move a disk from ")       // move one disk
    Num_Ins(#1, LEFT+NOCR)
    Ins_Text(" to ")
    Num_Ins(#2, LEFT)

    Num_Push(1,4)
        #9=#1; #1=#3; #3 = #9; #4--     // #3 to #2 via #1
        Call("MOVE_DISKS")
    Num_Pop(1,4)
}
Return


function TowersOfHanoi(n, from, to, via)
  if (a:n > 1)
    call TowersOfHanoi(a:n-1, a:from, a:via, a:to)
  endif
  echom("Move a disc from " . a:from . " to " . a:to)
  if (a:n > 1)
    call TowersOfHanoi(a:n-1, a:via, a:to, a:from)
  endif
endfunction

call TowersOfHanoi(4, 1, 3, 2)


Module TowersOfHanoi
    Sub MoveTowerDisks(ByVal disks As Integer, ByVal fromTower As Integer, ByVal toTower As Integer, ByVal viaTower As Integer)
        If disks > 0 Then
            MoveTowerDisks(disks - 1, fromTower, viaTower, toTower)
            System.Console.WriteLine("Move disk {0} from {1} to {2}", disks, fromTower, toTower)
            MoveTowerDisks(disks - 1, viaTower, toTower, fromTower)
        End If
    End Sub

    Sub Main()
        MoveTowerDisks(4, 1, 2, 3)
    End Sub
End Module


class Hanoi {
    construct new(disks) {
        _moves = 0
        System.print("Towers of Hanoi with %(disks) disks:\n")
        move(disks, "L", "C", "R")
        System.print("\nCompleted in %(_moves) moves\n")
    }

    move(n, from, to, via) {
        if (n > 0) {
            move(n - 1, from, via, to)
            _moves = _moves + 1
            System.print("Move disk %(n) from %(from) to %(to)")
            move(n - 1, via, to, from)
        }
    }
}

Hanoi.new(3)
Hanoi.new(4)


code Text=12;

proc MoveTower(Discs, From, To, Using);
int  Discs, From, To, Using;
[if Discs > 0 then
    [MoveTower(Discs-1, From, Using, To);
    Text(0, "Move from ");  Text(0, From);
    Text(0, " peg to ");  Text(0, To);  Text(0, " peg.^M^J");
    MoveTower(Discs-1, Using, To, From);
    ];
];

MoveTower(3, "left", "right", "center")


declare function local:hanoi($disk as xs:integer, $from as xs:integer,
    $to as xs:integer, $via as xs:integer) as element()*
{
  if($disk > 0)
  then (
    local:hanoi($disk - 1, $from, $via, $to),
    <move disk='{$disk}'><from>{$from}</from><to>{$to}</to></move>,
    local:hanoi($disk - 1, $via, $to, $from)
  )
  else ()
};

<hanoi>
{
  local:hanoi(4, 1, 2, 3)
}
</hanoi>


<xsl:template name="hanoi">
<xsl:param name="n"/>
<xsl:param name="from">left</xsl:param>
<xsl:param name="to">middle</xsl:param>
<xsl:param name="via">right</xsl:param>
  <xsl:if test="$n > 0">
    <xsl:call-template name="hanoi">
      <xsl:with-param name="n"    select="$n - 1"/>
      <xsl:with-param name="from" select="$from"/>
      <xsl:with-param name="to"   select="$via"/>
      <xsl:with-param name="via"  select="$to"/>
    </xsl:call-template>
    <fo:block>
      <xsl:text>Move disk from </xsl:text>
      <xsl:value-of select="$from"/>
      <xsl:text> to </xsl:text>
      <xsl:value-of select="$to"/>
    </fo:block>
    <xsl:call-template name="hanoi">
      <xsl:with-param name="n"    select="$n - 1"/>
      <xsl:with-param name="from" select="$via"/>
      <xsl:with-param name="to"   select="$to"/>
      <xsl:with-param name="via"  select="$from"/>
    </xsl:call-template>
  </xsl:if>
</xsl:template>


sub hanoi(ndisks, startPeg, endPeg)
    if ndisks then
        hanoi(ndisks-1, startPeg, 6-startPeg-endPeg)
        //print "Move disk ", ndisks, " from ", startPeg, " to ", endPeg
        hanoi(ndisks-1, 6-startPeg-endPeg, endPeg)
    end if
end sub

print "Be patient, please.\n\n"
print "Hanoi 1 ellapsed ... ";

t1 = peek("millisrunning")
hanoi(22, 1, 3)
t2 = peek("millisrunning")
print t2-t1, " ms"

sub hanoi2(n, from, to_, via)
    if n = 1 then
	//print "Move from ", from, " to ", to_
    else
	hanoi2(n - 1, from, via , to_ )
    	hanoi2(1    , from, to_ , via )
    	hanoi2(n - 1, via , to_ , from)
    end if
end sub

print "Hanoi 2 ellapsed ... ";
hanoi2(22, 1, 3, 2)
print peek("millisrunning") - t2, " ms"


const std = @import("std");

pub fn print(from: u32, to: u32) void {
    std.log.info("Moving disk from rod {} to rod {}", .{ from, to });
}

pub fn move(n: u32, from: u32, via: u32, to: u32) void {
    if (n > 1) {
        move(n - 1, from, to, via);
        print(from, to);
        move(n - 1, via, from, to);
    } else {
        print(from, to);
    }
}

pub fn main() !void {
    move(4, 1, 2, 3);
}


fcn move(n, from,to,via){
   if (n>0){
      move(n-1, from,via,to);
      println("Move disk from pole %d to pole %d".fmt(from, to));
      move(n-1, via,to,from);
   }
}
move(3, 1,2,3);


package main

import (
        "flag"
        "fmt"
        "math"
        "runtime"
        "sort"
)

// Note, the standard "image" package has Point and Rectangle but we
// can't use them here since they're defined using int rather than
// float64.

type Circle struct{ X, Y, R, rsq float64 }

func NewCircle(x, y, r float64) Circle {
        // We pre-calculate r² as an optimization
        return Circle{x, y, r, r * r}
}

func (c Circle) ContainsPt(x, y float64) bool {
        return distSq(x, y, c.X, c.Y) <= c.rsq
}

func (c Circle) ContainsC(c2 Circle) bool {
        return distSq(c.X, c.Y, c2.X, c2.Y) <= (c.R-c2.R)*(c.R-c2.R)
}

func (c Circle) ContainsR(r Rect) (full, corner bool) {
        nw := c.ContainsPt(r.NW())
        ne := c.ContainsPt(r.NE())
        sw := c.ContainsPt(r.SW())
        se := c.ContainsPt(r.SE())
        return nw && ne && sw && se, nw || ne || sw || se
}

func (c Circle) North() (float64, float64) { return c.X, c.Y + c.R }
func (c Circle) South() (float64, float64) { return c.X, c.Y - c.R }
func (c Circle) West() (float64, float64)  { return c.X - c.R, c.Y }
func (c Circle) East() (float64, float64)  { return c.X + c.R, c.Y }

type Rect struct{ X1, Y1, X2, Y2 float64 }

func (r Rect) Area() float64          { return (r.X2 - r.X1) * (r.Y2 - r.Y1) }
func (r Rect) NW() (float64, float64) { return r.X1, r.Y2 }
func (r Rect) NE() (float64, float64) { return r.X2, r.Y2 }
func (r Rect) SW() (float64, float64) { return r.X1, r.Y1 }
func (r Rect) SE() (float64, float64) { return r.X2, r.Y1 }

func (r Rect) Centre() (float64, float64) {
        return (r.X1 + r.X2) / 2.0, (r.Y1 + r.Y2) / 2.0
}

func (r Rect) ContainsPt(x, y float64) bool {
        return r.X1 <= x && x < r.X2 &&
                r.Y1 <= y && y < r.Y2
}

func (r Rect) ContainsPC(c Circle) bool { //  only N,W,E,S points of circle
        return r.ContainsPt(c.North()) ||
                r.ContainsPt(c.South()) ||
                r.ContainsPt(c.West()) ||
                r.ContainsPt(c.East())
}

func (r Rect) MinSide() float64 {
        return math.Min(r.X2-r.X1, r.Y2-r.Y1)
}

func distSq(x1, y1, x2, y2 float64) float64 {
        Δx, Δy := x2-x1, y2-y1
        return (Δx * Δx) + (Δy * Δy)
}

type CircleSet []Circle

// sort.Interface for sorting by radius big to small:
func (s CircleSet) Len() int           { return len(s) }
func (s CircleSet) Swap(i, j int)      { s[i], s[j] = s[j], s[i] }
func (s CircleSet) Less(i, j int) bool { return s[i].R > s[j].R }

func (sp *CircleSet) RemoveContainedC() {
        s := *sp
        sort.Sort(s)
        for i := 0; i < len(s); i++ {
                for j := i + 1; j < len(s); {
                        if s[i].ContainsC(s[j]) {
                                s[j], s[len(s)-1] = s[len(s)-1], s[j]
                                s = s[:len(s)-1]
                        } else {
                                j++
                        }
                }
        }
        *sp = s
}

func (s CircleSet) Bounds() Rect {
        x1 := s[0].X - s[0].R
        x2 := s[0].X + s[0].R
        y1 := s[0].Y - s[0].R
        y2 := s[0].Y + s[0].R
        for _, c := range s[1:] {
                x1 = math.Min(x1, c.X-c.R)
                x2 = math.Max(x2, c.X+c.R)
                y1 = math.Min(y1, c.Y-c.R)
                y2 = math.Max(y2, c.Y+c.R)
        }
        return Rect{x1, y1, x2, y2}
}

var nWorkers = 4

func (s CircleSet) UnionArea(ε float64) (min, max float64) {
        sort.Sort(s)
        stop := make(chan bool)
        inside := make(chan Rect)
        outside := make(chan Rect)
        unknown := make(chan Rect, 5e7) // XXX

        for i := 0; i < nWorkers; i++ {
                go s.worker(stop, unknown, inside, outside)
        }
        r := s.Bounds()
        max = r.Area()
        unknown <- r
        for max-min > ε {
                select {
                case r = <-inside:
                        min += r.Area()
                case r = <-outside:
                        max -= r.Area()
                }
        }
        close(stop)
        return min, max
}

func (s CircleSet) worker(stop <-chan bool, unk chan Rect, in, out chan<- Rect) {
        for {
                select {
                case <-stop:
                        return
                case r := <-unk:
                        inside, outside := s.CategorizeR(r)
                        switch {
                        case inside:
                                in <- r
                        case outside:
                                out <- r
                        default:
                                // Split
                                midX, midY := r.Centre()
                                unk <- Rect{r.X1, r.Y1, midX, midY}
                                unk <- Rect{midX, r.Y1, r.X2, midY}
                                unk <- Rect{r.X1, midY, midX, r.Y2}
                                unk <- Rect{midX, midY, r.X2, r.Y2}
                        }
                }
        }
}

func (s CircleSet) CategorizeR(r Rect) (inside, outside bool) {
        anyCorner := false
        for _, c := range s {
                full, corner := c.ContainsR(r)
                if full {
                        return true, false // inside
                }
                anyCorner = anyCorner || corner
        }
        if anyCorner {
                return false, false // uncertain
        }
        for _, c := range s {
                if r.ContainsPC(c) {
                        return false, false // uncertain
                }
        }
        return false, true // outside
}

func main() {
        flag.IntVar(&nWorkers, "workers", nWorkers, "how many worker go routines to use")
        maxproc := flag.Int("cpu", runtime.NumCPU(), "GOMAXPROCS setting")
        flag.Parse()

        if *maxproc > 0 {
                runtime.GOMAXPROCS(*maxproc)
        } else {
                *maxproc = runtime.GOMAXPROCS(0)
        }

        circles := CircleSet{
                NewCircle(1.6417233788, 1.6121789534, 0.0848270516),
                NewCircle(-1.4944608174, 1.2077959613, 1.1039549836),
                NewCircle(0.6110294452, -0.6907087527, 0.9089162485),
                NewCircle(0.3844862411, 0.2923344616, 0.2375743054),
                NewCircle(-0.2495892950, -0.3832854473, 1.0845181219),
                NewCircle(1.7813504266, 1.6178237031, 0.8162655711),
                NewCircle(-0.1985249206, -0.8343333301, 0.0538864941),
                NewCircle(-1.7011985145, -0.1263820964, 0.4776976918),
                NewCircle(-0.4319462812, 1.4104420482, 0.7886291537),
                NewCircle(0.2178372997, -0.9499557344, 0.0357871187),
                NewCircle(-0.6294854565, -1.3078893852, 0.7653357688),
                NewCircle(1.7952608455, 0.6281269104, 0.2727652452),
                NewCircle(1.4168575317, 1.0683357171, 1.1016025378),
                NewCircle(1.4637371396, 0.9463877418, 1.1846214562),
                NewCircle(-0.5263668798, 1.7315156631, 1.4428514068),
                NewCircle(-1.2197352481, 0.9144146579, 1.0727263474),
                NewCircle(-0.1389358881, 0.1092805780, 0.7350208828),
                NewCircle(1.5293954595, 0.0030278255, 1.2472867347),
                NewCircle(-0.5258728625, 1.3782633069, 1.3495508831),
                NewCircle(-0.1403562064, 0.2437382535, 1.3804956588),
                NewCircle(0.8055826339, -0.0482092025, 0.3327165165),
                NewCircle(-0.6311979224, 0.7184578971, 0.2491045282),
                NewCircle(1.4685857879, -0.8347049536, 1.3670667538),
                NewCircle(-0.6855727502, 1.6465021616, 1.0593087096),
                NewCircle(0.0152957411, 0.0638919221, 0.9771215985),
        }
        fmt.Println("Starting with", len(circles), "circles.")
        circles.RemoveContainedC()
        fmt.Println("Removing redundant ones leaves", len(circles), "circles.")
        fmt.Println("Using", nWorkers, "workers with maxprocs =", *maxproc)
        const ε = 0.0001
        min, max := circles.UnionArea(ε)
        avg := (min + max) / 2.0
        rng := max - min
        fmt.Printf("Area = %v±%v\n", avg, rng)
        fmt.Printf("Area ≈ %.*f\n", 5, avg)
}


public class CirclesTotalArea {

    /*
     * Rectangles are given as 4-element arrays [tx, ty, w, h].
     * Circles are given as 3-element arrays [cx, cy, r].
     */

    private static double distSq(double x1, double y1, double x2, double y2) {
        return (x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1);
    }

    private static boolean rectangleFullyInsideCircle(double[] rect, double[] circ) {
        double r2 = circ[2] * circ[2];
        // Every corner point of rectangle must be inside the circle.
        return distSq(rect[0], rect[1], circ[0], circ[1]) <= r2 &&
          distSq(rect[0] + rect[2], rect[1], circ[0], circ[1]) <= r2 &&
          distSq(rect[0], rect[1] - rect[3], circ[0], circ[1]) <= r2 &&
          distSq(rect[0] + rect[2], rect[1] - rect[3], circ[0], circ[1]) <= r2;
    }

    private static boolean rectangleSurelyOutsideCircle(double[] rect, double[] circ) {
        // Circle center point inside rectangle?
        if(rect[0] <= circ[0] && circ[0] <= rect[0] + rect[2] &&
          rect[1] - rect[3] <= circ[1] && circ[1] <= rect[1]) { return false; }
        // Otherwise, check that each corner is at least (r + Max(w, h)) away from circle center.
        double r2 = circ[2] + Math.max(rect[2], rect[3]);
        r2 = r2 * r2;
        return distSq(rect[0], rect[1], circ[0], circ[1]) >= r2 &&
          distSq(rect[0] + rect[2], rect[1], circ[0], circ[1]) >= r2 &&
          distSq(rect[0], rect[1] - rect[3], circ[0], circ[1]) >= r2 &&
          distSq(rect[0] + rect[2], rect[1] - rect[3], circ[0], circ[1]) >= r2;
    }

    private static boolean[] surelyOutside;

    private static double totalArea(double[] rect, double[][] circs, int d) {
        // Check if we can get a quick certain answer.
        int surelyOutsideCount = 0;
        for(int i = 0; i < circs.length; i++) {
            if(rectangleFullyInsideCircle(rect, circs[i])) { return rect[2] * rect[3]; }
            if(rectangleSurelyOutsideCircle(rect, circs[i])) {
                surelyOutside[i] = true;
                surelyOutsideCount++;
            }
            else { surelyOutside[i] = false; }
        }
        // Is this rectangle surely outside all circles?
        if(surelyOutsideCount == circs.length) { return 0; }
        // Are we deep enough in the recursion?
        if(d < 1) {
            return rect[2] * rect[3] / 3;  // Best guess for overlapping portion
        }
        // Throw out all circles that are surely outside this rectangle.
        if(surelyOutsideCount > 0) {
            double[][] newCircs = new double[circs.length - surelyOutsideCount][3];
            int loc = 0;
            for(int i = 0; i < circs.length; i++) {
                if(!surelyOutside[i]) { newCircs[loc++] = circs[i]; }
            }
            circs = newCircs;
        }
        // Subdivide this rectangle recursively and add up the recursively computed areas.
        double w = rect[2] / 2; // New width
        double h = rect[3] / 2; // New height
        double[][] pieces = {
            { rect[0], rect[1], w, h }, // NW
            { rect[0] + w, rect[1], w, h }, // NE
            { rect[0], rect[1] - h, w, h }, // SW
            { rect[0] + w, rect[1] - h, w, h } // SE
        };
        double total = 0;
        for(double[] piece: pieces) { total += totalArea(piece, circs, d - 1); }
        return total;
    }

    public static double totalArea(double[][] circs, int d) {
        double maxx = Double.NEGATIVE_INFINITY;
        double minx = Double.POSITIVE_INFINITY;
        double maxy = Double.NEGATIVE_INFINITY;
        double miny = Double.POSITIVE_INFINITY;
        // Find the extremes of x and y for this set of circles.
        for(double[] circ: circs) {
            if(circ[0] + circ[2] > maxx) { maxx = circ[0] + circ[2]; }
            if(circ[0] - circ[2] < minx) { minx = circ[0] - circ[2]; }
            if(circ[1] + circ[2] > maxy) { maxy = circ[1] + circ[2]; }
            if(circ[1] - circ[2] < miny) { miny = circ[1] - circ[2]; }
        }
        double[] rect = { minx, maxy, maxx - minx, maxy - miny };
        surelyOutside = new boolean[circs.length];
        return totalArea(rect, circs, d);
    }

    public static void main(String[] args) {
        double[][] circs = {
            { 1.6417233788, 1.6121789534, 0.0848270516 },
            {-1.4944608174, 1.2077959613, 1.1039549836 },
            { 0.6110294452, -0.6907087527, 0.9089162485 },
            { 0.3844862411, 0.2923344616, 0.2375743054 },
            {-0.2495892950, -0.3832854473, 1.0845181219 },
            {1.7813504266, 1.6178237031, 0.8162655711 },
            {-0.1985249206, -0.8343333301, 0.0538864941 },
            {-1.7011985145, -0.1263820964, 0.4776976918 },
            {-0.4319462812, 1.4104420482, 0.7886291537 },
            {0.2178372997, -0.9499557344, 0.0357871187 },
            {-0.6294854565, -1.3078893852, 0.7653357688 },
            {1.7952608455, 0.6281269104, 0.2727652452 },
            {1.4168575317, 1.0683357171, 1.1016025378 },
            {1.4637371396, 0.9463877418, 1.1846214562 },
            {-0.5263668798, 1.7315156631, 1.4428514068 },
            {-1.2197352481, 0.9144146579, 1.0727263474 },
            {-0.1389358881, 0.1092805780, 0.7350208828 },
            {1.5293954595, 0.0030278255, 1.2472867347 },
            {-0.5258728625, 1.3782633069, 1.3495508831 },
            {-0.1403562064, 0.2437382535, 1.3804956588 },
            {0.8055826339, -0.0482092025, 0.3327165165 },
            {-0.6311979224, 0.7184578971, 0.2491045282 },
            {1.4685857879, -0.8347049536, 1.3670667538 },
            {-0.6855727502, 1.6465021616, 1.0593087096 },
            {0.0152957411, 0.0638919221, 0.9771215985 }
        };
        double ans = totalArea(circs, 24);
        System.out.println("Approx. area is " + ans);
        System.out.println("Error is " + Math.abs(21.56503660 - ans));
    }
}


circles:=File("circles.txt").pump(List,'wrap(line){
   line.split().apply("toFloat")  // L(x,y,r)
});
    # compute the bounding box of the circles
x_min:=(0.0).min(circles.apply(fcn([(x,y,r)]){ x - r })); // (0) not used, just the list of numbers
x_max:=(0.0).max(circles.apply(fcn([(x,y,r)]){ x + r }));
y_min:=(0.0).min(circles.apply(fcn([(x,y,r)]){ y - r }));
y_max:=(0.0).max(circles.apply(fcn([(x,y,r)]){ y + r }));

box_side:=500;
dx:=(x_max - x_min)/box_side;
dy:=(y_max - y_min)/box_side;

count:=0;
foreach r in (box_side){
   y:=y_min + dy*r;
   foreach c in (box_side){
      x:=x_min + dx*c;
      count+=circles.filter1('wrap([(cx,cy,cr)]){
         x-=cx; y-=cy;
      	 x*x + y*y <= cr*cr
      }).toBool(); // -->False|L(x,y,z), L(x,y,r).toBool()-->True,
   }
}

println("Approximated area: ", dx*dy*count);


T Node
   Int data
   Node? left
   Node? right

   F (data, Node? left = N, Node? right = N)
      .data = data
      .left = left
      .right = right

   F preorder(visitor) -> N
      visitor(.data)
      I .left != N
         .left.preorder(visitor)
      I .right != N
         .right.preorder(visitor)

   F inorder(visitor) -> N
      I .left != N
         .left.inorder(visitor)
      visitor(.data)
      I .right != N
         .right.inorder(visitor)

   F postorder(visitor) -> N
      I .left != N
         .left.postorder(visitor)
      I .right != N
         .right.postorder(visitor)
      visitor(.data)

   F preorder2(&d, level = 0) -> N
      d[level].append(.data)
      I .left != N
         .left.preorder2(d, level + 1)
      I .right != N
         .right.preorder2(d, level + 1)

   F levelorder(visitor)
      DefaultDict[Int, [Int]] d
      .preorder2(&d)
      L(k) sorted(d.keys())
         L(v) d[k]
            visitor(v)

V tree = Node(1,
              Node(2,
                   Node(4,
                        Node(7, N, N),
                        N),
                   Node(5, N, N)),
              Node(3,
                   Node(6,
                        Node(8, N, N),
                        Node(9, N, N)),
                   N))

F printwithspace(Int i)
   print(‘#. ’.format(i), end' ‘’)

print(‘  preorder: ’, end' ‘’)
tree.preorder(printwithspace)
print()
print(‘   inorder: ’, end' ‘’)
tree.inorder(printwithspace)
print()
print(‘ postorder: ’, end' ‘’)
tree.postorder(printwithspace)
print()
print(‘levelorder: ’, end' ‘’)
tree.levelorder(printwithspace)
print()


/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program deftree64.s   */

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

.equ NBVAL,    9

/*******************************************/
/* Structures                               */
/********************************************/
/* structure tree     */
    .struct  0
tree_root:                             // root pointer
    .struct  tree_root + 8
tree_size:                             // number of element of tree
    .struct  tree_size + 8
tree_fin:
/* structure node tree */
    .struct  0
node_left:                             // left pointer
    .struct  node_left + 8
node_right:                            // right pointer
    .struct  node_right + 8
node_value:                            // element value
    .struct  node_value + 8
node_fin:
/* structure queue*/
    .struct  0
queue_begin:                           // next pointer
    .struct  queue_begin + 8
queue_end:                             // element value
    .struct  queue_end + 8
queue_fin:
/* structure node queue    */
    .struct  0
queue_node_next:                       // next pointer
    .struct  queue_node_next + 8
queue_node_value:                      // element value
    .struct  queue_node_value + 8
queue_node_fin:
/*******************************************/
/* Initialized data                        */
/*******************************************/
.data
szMessInOrder:        .asciz "inOrder :\n"
szMessPreOrder:       .asciz "PreOrder :\n"
szMessPostOrder:      .asciz "PostOrder :\n"
szMessLevelOrder:     .asciz "LevelOrder :\n"
szCarriageReturn:     .asciz "\n"
/* datas error display */
szMessErreur:         .asciz "Error detected.\n"
/* datas message display */
szMessResult:         .ascii "Element value : @ \n"

/*******************************************/
/* UnInitialized data                      */
/*******************************************/
.bss
.align 4
sZoneConv:            .skip 24
stTree:               .skip tree_fin    // place to structure tree
stQueue:              .skip queue_fin   // place to structure queue
/*******************************************/
/*  code section                           */
/*******************************************/
.text
.global main
main:
    mov x1,1                            // node tree value
1:
    ldr x0,qAdrstTree                   // structure tree address
    bl insertElement                    // add element value x1
    cmp x0,-1
    beq 99f
    add x1,x1,1                         // increment value
    cmp x1,NBVAL                        // end ?
    ble 1b                              // no -> loop

    ldr x0,qAdrszMessPreOrder
    bl affichageMess
    ldr x3,qAdrstTree                   // tree root address (begin structure)
    ldr x0,[x3,#tree_root]
    ldr x1,qAdrdisplayElement           // function to execute
    bl preOrder

    ldr x0,qAdrszMessInOrder
    bl affichageMess
    ldr x3,qAdrstTree
    ldr x0,[x3,#tree_root]
    ldr x1,qAdrdisplayElement           // function to execute
    bl inOrder

    ldr x0,qAdrszMessPostOrder
    bl affichageMess
    ldr x3,qAdrstTree
    ldr x0,[x3,#tree_root]
    ldr x1,qAdrdisplayElement           // function to execute
    bl postOrder

    ldr x0,qAdrszMessLevelOrder
    bl affichageMess
    ldr x3,qAdrstTree
    ldr x0,[x3,#tree_root]
    ldr x1,qAdrdisplayElement           // function to execute
    bl levelOrder
    b 100f
99:                                     // display error
    ldr x0,qAdrszMessErreur
    bl affichageMess
100:                                    // standard end of the program
    mov x8,EXIT                         // request to exit program
    svc 0                               // perform system call
qAdrszMessInOrder:         .quad szMessInOrder
qAdrszMessPreOrder:        .quad szMessPreOrder
qAdrszMessPostOrder:       .quad szMessPostOrder
qAdrszMessLevelOrder:      .quad szMessLevelOrder
qAdrszMessErreur:          .quad szMessErreur
qAdrszCarriageReturn:      .quad szCarriageReturn
qAdrstTree:                .quad stTree
qAdrstQueue:               .quad stQueue
qAdrdisplayElement:        .quad displayElement
/******************************************************************/
/*     insert element in the tree                                 */
/******************************************************************/
/* x0 contains the address of the tree structure */
/* x1 contains the value of element              */
/* x0 returns address of element or - 1 if error */
insertElement:
    stp x1,lr,[sp,-16]!           // save  registers
    mov x4,x0
    mov x0,node_fin               // reservation place one element
    bl allocHeap
    cmp x0,-1                     // allocation error
    beq 100f
    mov x5,x0
    str x1,[x5,node_value]        // store value in address heap
    mov x1,0
    str x1,[x5,node_left]         // init left pointer with zero
    str x1,[x5,node_right]        // init right pointer with zero
    ldr x2,[x4,tree_size]         // load tree size
    cbnz x2,1f                    // 0 element ?
    str x5,[x4,tree_root]         // yes -> store in root
    b 6f
1:                                // else search free address in tree
    ldr x3,[x4,tree_root]         // start with address root
    add x6,x2,1                   // increment tree size
    clz x7,x6                     // compute zeroes left bits
    add x7,x7,1                   // for sustract the first left bit
    lsl x6,x6,x7                  // shift number in left
2:
    tst x6,1<<63                  // test left bit
    lsl x6,x6,1                   // shift left bit
    bne 3f                        // bit at one
    ldr x1,[x3,node_left]         // no store node address in left pointer
    cbz x1,4f                     // if equal zero
    mov x3,x1                     // else loop with next node
    b 2b
3:                                    // yes
    ldr x1,[x3,node_right]           // store node address in right pointer
    cbz x1,5f                         // if equal zero
    mov x3,x1                         // else loop with next node
    b 2b
4:
    str x5,[x3,node_left]
    b 6f
5:
    str x5,[x3,node_right]
6:
    add x2,x2,1                         // increment tree size
    str x2,[x4,tree_size]
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     preOrder                                  */
/******************************************************************/
/* x0 contains the address of the node */
/* x1 function address                 */
preOrder:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    cmp x0,#0
    beq 100f
    mov x2,x0
    blr x1                                // call function

    ldr x0,[x2,#node_left]
    bl preOrder
    ldr x0,[x2,#node_right]
    bl preOrder
100:
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     inOrder                                  */
/******************************************************************/
/* x0 contains the address of the node */
/* x1 function address                 */
inOrder:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    cbz x0,100f
    mov x3,x0
    mov x2,x1
    ldr x0,[x3,node_left]
    bl inOrder
    mov x0,x3
    blr x2                        // call function

    ldr x0,[x3,node_right]
    mov x1,x2
    bl inOrder
100:
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     postOrder                                  */
/******************************************************************/
/* x0 contains the address of the node */
/* x1 function address                 */
postOrder:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    cbz x0,100f
    mov x3,x0
    mov x2,x1
    ldr x0,[x3,#node_left]
    bl postOrder

    ldr x0,[x3,#node_right]
    mov x1,x2
    bl postOrder
    mov x0,x3
    blr x2                         // call function
100:
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     levelOrder                                  */
/******************************************************************/
/* x0 contains the address of the node */
/* x1 function address                 */
levelOrder:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    cbz x0,100f
    mov x2,x1
    mov x1,x0
    ldr x0,qAdrstQueue                    // adresse queue
    bl enqueueNode                        // queue the node
1:                                        // begin loop
    ldr x0,qAdrstQueue
    bl isEmptyQueue                       // is queue empty
    cbz x0,100f                           // yes -> end
    ldr x0,qAdrstQueue
    bl dequeueNode
    mov x3,x0                             // save node
    blr x2                                // call function
    ldr x14,[x3,#node_left]                // left node ok ?
    cbz x14,2f
    ldr x0,qAdrstQueue                    // yes -> enqueue
    mov x1,x14
    bl enqueueNode
2:
    ldr x14,[x3,#node_right]               // right node ok ?
    cbz x14,3f
    ldr x0,qAdrstQueue                    // yes -> enqueue
    mov x1,x14
    bl enqueueNode
3:
    b 1b                                  // and loop
100:
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     display node                                               */
/******************************************************************/
/* x0 contains node  address          */
displayElement:
    stp x1,lr,[sp,-16]!           // save  registers
    ldr x0,[x0,#node_value]
    ldr x1,qAdrsZoneConv
    bl conversion10S
    ldr x0,qAdrszMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc         // insert result at @ character
    bl affichageMess
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
qAdrszMessResult:          .quad szMessResult
qAdrsZoneConv:             .quad sZoneConv
/******************************************************************/
/*     enqueue node                                  */
/******************************************************************/
/* x0 contains the address of the queue */
/* x1 contains the value of element  */
/* x0 returns address of element or - 1 if error */
enqueueNode:
    stp x1,lr,[sp,-16]!           // save  registers
    stp x2,x3,[sp,-16]!           // save  registers
    mov x14,x0
    mov x0,#queue_node_fin                // allocation place heap
    bl allocHeap
    cmp x0,#-1                            // allocation error
    beq 100f
    mov x15,x0                             // save heap address
    str x1,[x15,#queue_node_value]         // store node value
    mov x1,#0
    str x1,[x15,#queue_node_next]          // init pointer next
    ldr x0,[x14,#queue_end]
    cbz x0,1f
    str x15,[x0,#queue_node_next]
    b 2f
1:
    str x15,[x14,#queue_begin]
2:
    str x15,[x14,#queue_end]
    mov x0,#0
100:
    ldp x2,x3,[sp],16              // restaur  2 registers
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     dequeue node                                  */
/******************************************************************/
/* x0 contains the address of the queue */
/* x0 returns address of element or - 1 if error */
dequeueNode:
    stp x1,lr,[sp,-16]!           // save  registers
    ldr x14,[x0,#queue_begin]
    ldr x15,[x14,#queue_node_value]
    ldr x16,[x14,#queue_node_next]
    str x16,[x0,#queue_begin]
    cbnz x16,1f
    str x16,[x0,#queue_end]
1:
    mov x0,x15
100:
    ldp x1,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*     dequeue node                                  */
/******************************************************************/
/* x0 contains the address of the queue */
/* x0 returns 0 if empty else 1  */
isEmptyQueue:
    ldr x0,[x0,#queue_begin]
    cmp x0,#0
    cset x0,ne
    ret                             // return
/******************************************************************/
/*     memory allocation on the heap                                  */
/******************************************************************/
/* x0 contains the size to allocate */
/* x0 returns address of memory heap or - 1 if error */
/* CAUTION : The size of the allowance must be a multiple of 4  */
allocHeap:
    stp x8,lr,[sp,-16]!          // save  registers
                                 // allocation
    mov x16,x0                   // save size
    mov x0,0                     // read address start heap
    mov x8,BRK                   // call system 'brk'
    svc 0
    mov x15,x0                   // save address heap for return
    add x0,x0,x16                   // reservation place for size
    mov x8,BRK                   // call system 'brk'
    svc 0
    cmp x0,-1                    // allocation error
    beq 100f
    mov x0,x15                    // return address memory heap
100:
    ldp x8,lr,[sp],16            // restaur  2 registers
    ret                          // return to address lr x30
/***********************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"


(defun flatten-preorder (tree)
   (if (endp tree)
       nil
       (append (list (first tree))
               (flatten-preorder (second tree))
               (flatten-preorder (third tree)))))

(defun flatten-inorder (tree)
   (if (endp tree)
       nil
       (append (flatten-inorder (second tree))
               (list (first tree))
               (flatten-inorder (third tree)))))

(defun flatten-postorder (tree)
   (if (endp tree)
       nil
       (append (flatten-postorder (second tree))
               (flatten-postorder (third tree))
               (list (first tree)))))

(defun flatten-level-r1 (tree level levels)
   (if (endp tree)
       levels
       (let ((curr (cdr (assoc level levels))))
            (flatten-level-r1
             (second tree)
             (1+ level)
             (flatten-level-r1
              (third tree)
              (1+ level)
              (put-assoc level
                         (append curr (list (first tree)))
                         levels))))))

(defun flatten-level-r2 (levels max-level)
   (declare (xargs :measure (nfix (1+ max-level))))
   (if (zp (1+ max-level))
       nil
       (append (flatten-level-r2 levels
                                 (1- max-level))
               (reverse (cdr (assoc max-level levels))))))

(defun flatten-level (tree)
   (let ((levels (flatten-level-r1 tree 0 nil)))
      (flatten-level-r2 levels (len levels))))


with Ada.Text_Io; use Ada.Text_Io;
with Ada.Unchecked_Deallocation;
with Ada.Containers.Doubly_Linked_Lists;

procedure Tree_Traversal is
   type Node;
   type Node_Access is access Node;
   type Node is record
      Left : Node_Access := null;
      Right : Node_Access := null;
      Data : Integer;
   end record;
   procedure Destroy_Tree(N : in out Node_Access) is
      procedure free is new Ada.Unchecked_Deallocation(Node, Node_Access);
   begin
      if N.Left /= null then
         Destroy_Tree(N.Left);
      end if;
      if N.Right /= null then
         Destroy_Tree(N.Right);
      end if;
      Free(N);
   end Destroy_Tree;
   function Tree(Value : Integer; Left : Node_Access; Right : Node_Access) return Node_Access is
      Temp : Node_Access := new Node;
   begin
      Temp.Data := Value;
      Temp.Left := Left;
      Temp.Right := Right;
      return Temp;
   end Tree;
   procedure Preorder(N : Node_Access) is
   begin
      Put(Integer'Image(N.Data));
      if N.Left /= null then
         Preorder(N.Left);
      end if;
      if N.Right /= null then
         Preorder(N.Right);
      end if;
   end Preorder;
   procedure Inorder(N : Node_Access) is
   begin
      if N.Left /= null then
         Inorder(N.Left);
      end if;
      Put(Integer'Image(N.Data));
      if N.Right /= null then
         Inorder(N.Right);
      end if;
   end Inorder;
   procedure Postorder(N : Node_Access) is
   begin
      if N.Left /= null then
         Postorder(N.Left);
      end if;
      if N.Right /= null then
         Postorder(N.Right);
      end if;
      Put(Integer'Image(N.Data));
   end Postorder;
   procedure Levelorder(N : Node_Access) is
      package Queues is new Ada.Containers.Doubly_Linked_Lists(Node_Access);
      use Queues;
      Node_Queue : List;
      Next : Node_Access;
   begin
      Node_Queue.Append(N);
      while not Is_Empty(Node_Queue) loop
         Next := First_Element(Node_Queue);
         Delete_First(Node_Queue);
         Put(Integer'Image(Next.Data));
         if Next.Left /= null then
            Node_Queue.Append(Next.Left);
         end if;
         if Next.Right /= null then
            Node_Queue.Append(Next.Right);
         end if;
      end loop;
   end Levelorder;
   N : Node_Access;
begin
   N := Tree(1,
      Tree(2,
         Tree(4,
            Tree(7, null, null),
            null),
         Tree(5, null, null)),
      Tree(3,
         Tree(6,
            Tree(8, null, null),
            Tree(9, null, null)),
         null));

   Put("preorder:    ");
   Preorder(N);
   New_Line;
   Put("inorder:     ");
   Inorder(N);
   New_Line;
   Put("postorder:   ");
   Postorder(N);
   New_Line;
   Put("level order: ");
   Levelorder(N);
   New_Line;
   Destroy_Tree(N);
end Tree_traversal;


open import Data.List using (List; _∷_; []; concat)
open import Data.Nat using (ℕ; suc; zero)
open import Level using (Level)
open import Relation.Binary.PropositionalEquality using (_≡_; refl)

data Tree {a} (A : Set a) : Set a where
  leaf : Tree A
  node : A → Tree A → Tree A → Tree A

variable
  a : Level
  A : Set a

preorder : Tree A → List A
preorder tr = go tr []
  where
  go : Tree A → List A → List A
  go leaf           ys = ys
  go (node x ls rs) ys = x ∷ go ls (go rs ys)

inorder : Tree A → List A
inorder tr = go tr []
  where
  go : Tree A → List A → List A
  go leaf           ys = ys
  go (node x ls rs) ys = go ls (x ∷ go rs ys)

postorder : Tree A → List A
postorder tr = go tr []
  where
  go : Tree A → List A → List A
  go leaf           ys = ys
  go (node x ls rs) ys = go ls (go rs (x ∷ ys))

level-order : Tree A → List A
level-order tr = concat (go tr [])
  where
  go : Tree A → List (List A) → List (List A)
  go leaf qs                 = qs
  go (node x ls rs) []       = (x ∷ []) ∷ go ls (go rs [])
  go (node x ls rs) (q ∷ qs) = (x ∷ q ) ∷ go ls (go rs qs)

example-tree : Tree ℕ
example-tree =
  node 1
    (node 2
      (node 4
        (node 7
          leaf
          leaf)
        leaf)
      (node 5
        leaf
        leaf))
    (node 3
      (node 6
        (node 8
          leaf
          leaf)
        (node 9
          leaf
          leaf))
      leaf)

_ : preorder example-tree ≡ 1 ∷ 2 ∷ 4 ∷ 7 ∷ 5 ∷ 3 ∷ 6 ∷ 8 ∷ 9 ∷ []
_ = refl

_ : inorder example-tree ≡ 7 ∷ 4 ∷ 2 ∷ 5 ∷ 1 ∷ 8 ∷ 6 ∷ 9 ∷ 3 ∷ []
_ = refl

_ : postorder example-tree ≡ 7 ∷ 4 ∷ 5 ∷ 2 ∷ 8 ∷ 9 ∷ 6 ∷ 3 ∷ 1 ∷ []
_ = refl

_ : level-order example-tree ≡ 1 ∷ 2 ∷ 3 ∷ 4 ∷ 5 ∷ 6 ∷ 7 ∷ 8 ∷ 9 ∷ []
_ = refl