program ioi94day2prb1ver2(input, output, inp, out); { Tom Verhoeff, Eindhoven University of Technology } { Solution based on solving a system of linear algebraic equations } { General Section } const Test = true ; var inp, out: text ; procedure Init ; begin if Test then writeln('IOI''94 - Day 2 - Problem 1: The Clocks') ; assign(inp, 'input.txt') ; reset(inp) ; assign(out, 'output.txt') ; rewrite(out) ; if Test then writeln('Initialized') end { Init } ; procedure Fini ; begin close(inp) ; close(out) end { Fini } ; { Problem Specific Section } var s: array ['A'..'I'] of integer; { s[c] is state of dial c, in quarter turns } n: integer; { # moves in solution } move: array [1..27] of integer; { move[1..n] is solution sequence } procedure ReadInput ; { read state of clocks into s['A'..'I'] } begin readln(inp, s['A'], s['B'], s['C']) ; readln(inp, s['D'], s['E'], s['F']) ; readln(inp, s['G'], s['H'], s['I']) ; if Test then begin writeln('The starting configuration is:') ; writeln(s['A']:2, s['B']:2, s['C']:2) ; writeln(s['D']:2, s['E']:2, s['F']:2) ; writeln(s['G']:2, s['H']:2, s['I']:2) end { if } end { ReadInput } ; procedure ComputeAnswer ; var A: array[1..9, 1..9] of integer; { matrix of coefficients } b: array [1..9] of integer; { components of right-hand side } { The system of linear algebraic equations to solve: } { (Sum j: j in [1..9]: A[i,j] * t[j]) = b[i] for i in [1..9] } procedure WriteMatrix ; { for testing } var i, j: integer; begin for i := 1 to 9 do begin for j := 1 to 9 do write(A[i, j]:2) ; writeln(b[i]:5) end { for i } ; writeln end { WriteMatrix } ; procedure SetUp ; var f: text; i, j: integer; c: char; begin assign(f, 'matrix.dat') ; reset(f) ; for i := 1 to 9 do begin for j := 1 to 9 do read(f, A[i, j]) ; readln(f) ; end { for i } ; close(f) ; { set up right-hand side in b[1..9] } c := 'A' ; for i := 1 to 9 do begin b[i] := (3*s[c]) mod 4 ; { -1 = 3 (mod 4) } c := succ(c) end { for i } ; if Test then begin writeln('Initial set up is:') ; WriteMatrix end { if } end { SetUp } ; procedure Solve ; { by Gauss-Jordan elimination with `partial pivoting' } var h, i, j, k: integer; begin { transform A into the unit matrix and b into a solution vector } for i := 1 to 9 do begin { process column i } { find pivot by bounded linear search for first 1 or 3 in column i } k := i ; h := 10 ; while k <> h do if A[k, i] in [1, 3] then h := k else inc(k) ; if k = 10 then begin writeln('Pivot not found in step ', i:1) ; halt end { if } ; if Test then writeln('Pivot for column ', i:1, ' found in row ', k:1) ; { swap rows i and k } for j := i to 9 do begin h := A[i, j] ; A[i, j] := A[k, j] ; A[k, j] := h end { for j } ; h := b[i] ; b[i] := b[k] ; b[k] := h ; { normalize row i, yielding A[i, i] = 1 } h := A[i, i] ; { h * A[i, i] = 1 (mod 4) } for j := i to 9 do A[i, j] := (h * A[i, j]) mod 4 ; b[i] := (h * b[i]) mod 4 ; { sweep column i to zeroes in rows other than i } for k := 1 to 9 do begin { take care of row k } if k <> i then begin h := 3*A[k, i] ; for j := i to 9 do A[k, j] := (A[k, j] + h*A[i, j]) mod 4 ; b[k] := (b[k] + h*b[i]) mod 4 end { if } end { for j } ; if Test then begin writeln('Situation after step ', i:1) ; WriteMatrix end { if } end { for i } end { Solve } ; procedure Solution ; var p, m: integer; begin n := 0 ; for p := 1 to 9 do for m := 1 to b[p] do begin inc(n) ; move[n] := p end end { Solution } ; begin { ComputeAnswer } SetUp ; Solve ; Solution end { ComputeAnswer } ; procedure WriteOutput ; var m: integer; begin if Test then begin write('A ', n:1, '-move solution is:') ; for m := 1 to n do write(move[m]:2) ; writeln end { if } ; for m := 1 to n do write(out, move[m]:2) ; writeln(out) end { WriteOutput } ; begin Init ; ReadInput ; ComputeAnswer ; WriteOutput ; Fini end.