program ioi94day1prb3ver1(input, output, inp, out) ; { Tom Verhoeff, Eindhoven University of Technology } { General Section } const Test = true ; var inp, out: text ; procedure Init ; begin if Test then writeln('IOI''94 - Day 1 - Problem 3: The Primes') ; 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 } type digit = 0..9 ; index = 1..5 ; var ds: integer ; { given digit sum } tld: digit ; { given digit in top left-hand corner } S: array [index, index] of digit ; { the square } procedure ReadInput ; { read sum and topleft } begin readln(inp, ds) ; if Test then writeln('Digit sum is ', ds:1) ; readln(inp, tld) ; if Test then writeln('Digit in top left-hand corner is ', tld:1) ; end { ReadInput } ; type number = record d: array [index] of digit ; { d[i] is i-th digit of v } v: longint ; { 5-digit prime with digit sum ds } end { number } ; var n: integer ; { # primes } prime: array [0..800] of number ; { prime[0..n-1] filled in } first, last: array [digit] of integer ; { prime[i].d[1] = f for first[f] <= i <= last[f] } procedure ReadPrimes ; { read primes with digit sum ds from file } { pre: primes are sorted in increasing order } var primes: text ; p: longint ; s: integer ; i: index ; f: digit ; begin assign(primes, 'primes-5.dat') ; reset(primes) ; for n := 1 to 9 do begin first[n] := -1 ; last[n] := -2 end ; { empty ranges } n := 0 ; while not eof(primes) do begin readln(primes, p, s) ; { read a prime p and its digit sum s } if s = ds then with prime[n] do begin v := p ; for i := 5 downto 1 do begin d[i] := p mod 10 ; p := p div 10 end ; if first[d[1]] = -1 then first[d[1]] := n ; last[d[1]] := n ; inc(n) end { if with } end { while } ; if Test then begin writeln('Number of 5-digit primes with digit sum ', ds:1, ' is ', n:1) ; writeln('Number of these primes with first digit f:') ; write(' f = ') ; for f := 1 to 9 do write(f:4) ; writeln ; write(' # = ') ; for f := 1 to 9 do write(last[f]+1-first[f]:4) ; writeln end { if } end { ReadPrimes } ; function IsPrime(w: longint): boolean ; { return: w is a 5-digit prime with digit sum ds } var i, j, h: integer ; begin i := 0 ; j := n ; { binary search } { w in prime[0..n-1].v == w in prime[i..j-1].v } while i <> pred(j) do begin h := (i+j) div 2 ; if prime[h].v <= w then i := h else j := h end { while } ; IsPrime := (prime[i].v = w) end { IsPrime } ; procedure WriteSquare(var ff: text) ; var r, c: index ; begin for r := 1 to 5 do begin for c := 1 to 5 do write(ff, S[r, c]:1) ; writeln(ff) end { for r } ; writeln(ff) end { WriteSquare } ; var solutions: integer ; procedure WriteSolution ; begin WriteSquare(out) ; inc(solutions) ; if Test then begin writeln('Solution ', solutions:1) ; WriteSquare(output) end ; end { WriteSolution } ; procedure H1 ; forward; procedure H2 ; forward; procedure H3 ; forward; procedure H4 ; forward; procedure H5 ; forward; procedure V1 ; forward; procedure V2 ; forward; procedure V3 ; forward; procedure V4 ; forward; procedure V5 ; forward; procedure D1 ; forward; procedure D2 ; forward; procedure ComputeAnswer ; begin S[1, 1] := tld ; solutions := 0 ; H1 ; if Test then writeln('Number of solutions = ', solutions:1) end { ComputeAnswer } ; procedure H1 ; const R = 1 ; var i: integer ; c: index ; begin for i := first[tld] to last[tld] do with prime[i] do if d[2] <> 0 then if d[3] <> 0 then if d[4] <> 0 then begin for c := 2 to 5 do S[R, c] := d[c] ; V1 end { if } end { H1 } ; procedure V1 ; const C = 1 ; var i: integer ; r: index ; begin for i := first[tld] to last[tld] do with prime[i] do if d[2] <> 0 then if d[3] <> 0 then if d[4] <> 0 then begin for r := 2 to 5 do S[r, C] := d[r] ; D2 end { if } end { V1 } ; procedure D2 ; var i: integer ; begin for i := first[S[5, 1]] to last[S[5, 1]] do with prime[i] do if d[5] = S[1, 5] then begin S[4, 2] := d[2] ; S[3, 3] := d[3] ; S[2, 4] := d[4] ; H2 end { if } end { D2 } ; procedure H2 ; const R = 2 ; var i: integer ; begin for i := first[S[R, 1]] to last[S[R, 1]] do with prime[i] do if d[4] = S[R, 4] then begin S[R, 2] := d[2] ; S[R, 3] := d[3] ; S[R, 5] := d[5] ; V2 end { if } end { H2 } ; procedure V2 ; const C = 2 ; var i: integer ; begin for i := first[S[1, C]] to last[S[1, C]] do with prime[i] do if d[2] = S[2, C] then if d[4] = S[4, C] then begin S[3, C] := d[3] ; S[5, C] := d[5] ; H3 end { if } end { V2 } ; procedure H3 ; const R = 3 ; var i: integer ; begin for i := first[S[R, 1]] to last[S[R, 1]] do with prime[i] do if d[2] = S[R, 2] then if d[3] = S[R, 3] then begin S[R, 4] := d[4] ; S[R, 5] := d[5] ; V3 end { if } end { H3 } ; procedure V3 ; const C = 3 ; var i: integer ; begin for i := first[S[1, C]] to last[S[1, C]] do with prime[i] do if d[2] = S[2, C] then if d[3] = S[3, C] then begin S[4, C] := d[4] ; S[5, C] := d[5] ; H4 end { if } end { V3 } ; procedure H4 ; const R = 4 ; var i: integer ; begin for i := first[S[R, 1]] to last[S[R, 1]] do with prime[i] do if d[2] = S[R, 2] then if d[3] = S[R, 3] then begin S[R, 4] := d[4] ; S[R, 5] := d[5] ; V4 end { if } end { H4 } ; procedure V4 ; const C = 4 ; var d: integer ; w: longint ; r: index ; begin d := ds ; w := 0 ; for r := 1 to 4 do begin d := d - S[r, C] ; w := 10*w + S[r, C] end { for } ; if odd(d) and (0 <= d) and (d <= 9) then if IsPrime(10*w+d) then begin S[5, C] := d ; H5 end { if } end { V4 } ; procedure H5 ; const R = 5 ; var d: integer ; w: longint ; c: index ; begin d := ds ; w := 0 ; for c := 1 to 4 do begin d := d - S[R, c] ; w := 10*w + S[R, c] end { for } ; if odd(d) and (0 <= d) and (d <= 9) then if IsPrime(10*w+d) then begin S[R, 5] := d ; V5 end { if } end { H5 } ; procedure V5 ; const C = 5 ; var w: longint ; r: index ; begin w := 0 ; for r := 1 to 5 do w := 10*w + S[r, C] ; if IsPrime(w) then D1 end { V5 } ; procedure D1 ; var w: longint ; rc: index ; begin w := 0 ; for rc := 1 to 5 do w := 10*w + S[rc, rc] ; if IsPrime(w) then WriteSolution end { D1 } ; begin Init ; ReadInput ; ReadPrimes ; ComputeAnswer ; Fini end.