program lab_1_1_3; { This program solves the Tower of Hanoi puzzle Matyushin Vyacheslav (group 07-PO1) } const N = 10; type circle_array = array [1..N] of Integer; procedure PrintArray (a : circle_array); var i : Integer; begin for i := 1 to N do Write (a[i],' '); Writeln; end; { PrintArray } procedure PrintArrays (a, b, c : circle_array); begin Write ('A: '); PrintArray (a); Write ('B: '); PrintArray (b); Write ('C: '); PrintArray (c); Writeln; end; { PrintArrays } function ArrayIsEmpty (a : circle_array) : boolean; var i, flag : Integer; begin flag := 0; for i := 1 to N do begin if a[i] <> 0 then begin flag := 1; break; end; end; if flag = 0 then ArrayIsEmpty := true else ArrayIsEmpty := false; end; { ArrayIsEmpty } function ArrayHeigth (a : circle_array) : Integer; var i, flag : Integer; begin flag := 0; if ArrayIsEmpty (a) then ArrayHeigth := 0 else begin for i := 1 to N do if a[i] = 0 then begin ArrayHeigth := i - 1; flag := 1; break; end; if flag = 0 then ArrayHeigth := N; end; end; { ArrayHeigth } procedure Swap (var a, b : circle_array); var ha, hb : Integer; begin ha := ArrayHeigth (a); hb := ArrayHeigth (b); if (ha = 0) and (hb <> 0) then begin a[1] := b[hb]; b[hb] := 0; end; if (hb = 0) and (ha <> 0) then begin b[1] := a[ha]; a[ha] := 0; end; if a[ha] < b[hb] then begin b[hb + 1] := a[ha]; a[ha] := 0; end; if b[hb] < a[ha] then begin a[ha + 1] := b[hb]; b[hb] := 0; end; end; { Swap } procedure Solve (var a, b, c : circle_array; var d : Integer); {moving right: d = 1, moving left: d = 0} var ha, hb, hc : Integer; begin ha := ArrayHeigth (a); hb := ArrayHeigth (b); hc := ArrayHeigth (c); if (ha = 0) and (hb = 0) then Writeln ('Finished') else if d = 1 then begin c[hc + 1] := a[ha]; a[ha] := 0; PrintArrays (a, b, c); b[hb + 1] := a[ha - 1]; a[ha - 1] := 0; PrintArrays (a, b, c); b[hb + 2] := c[hc + 1]; c[hc + 1] := 0; PrintArrays (a, b, c); c[hc + 1] := a[ha - 2]; a[ha - 2] := 0; PrintArrays (a, b, c); a[ha - 2] := b[hb + 2]; b[hb + 2] := 0; PrintArrays (a, b, c); c[hc + 2] := b[hb + 1]; b[hb + 1] := 0; PrintArrays (a, b, c); c[hc + 3] := a[ha - 2]; a[ha - 2] := 0; PrintArrays (a, b, c); Swap (a, b); d := 0; PrintArrays (a, b, c); Solve (a, b, c, d); end else begin a[ha + 1] := c[hc]; c[hc] := 0; PrintArrays (a, b, c); b[hb + 1] := c[hc - 1]; c[hc - 1] := 0; PrintArrays (a, b, c); b[hb + 2] := a[ha + 1]; a[ha + 1] := 0; PrintArrays (a, b, c); a[ha + 1] := c[hc - 2]; c[hc - 2] := 0; PrintArrays (a, b, c); c[hc - 2] := b[hb + 2]; b[hb + 2] := 0; PrintArrays (a, b, c); a[ha + 2] := b[hb + 1]; b[hb + 1] := 0; PrintArrays (a, b, c); a[ha + 3] := c[hc - 2]; c[hc - 2] := 0; PrintArrays (a, b, c); Swap (b, c); d := 1; PrintArrays (a, b, c); Solve (a, b, c, d); end; end; { Solve } var a, b, c : circle_array; i, direction : Integer; begin Writeln ('Number of circles: ', N); for i := 1 to N do begin a[i] := N - i + 1; b[i] := 0; c[i] := 0; end; direction := 1; PrintArrays (a, b, c); Solve (a, b, c, direction); end.