Cod sursa(job #97129)

Utilizator RobybrasovRobert Hangu Robybrasov Data 5 noiembrie 2007 15:04:05
Problema Cifra Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.18 kb
var a:array[0..9,0..3] of byte;
    s:string;
    f,g:text;

procedure init;
var i:byte;
begin
  for i:=0 to 3 do begin a[0,i]:=0; a[1,i]:=1; end;
  a[2,0]:=6; a[2,1]:=2; a[2,2]:=4; a[2,3]:=8;
  a[3,0]:=1; a[3,1]:=3; a[3,2]:=9; a[3,3]:=7;
  a[4,0]:=6; a[4,1]:=4; a[4,2]:=6; a[4,3]:=4;
  for i:=0 to 3 do begin a[5,i]:=5; a[6,i]:=6; end;
  a[7,0]:=1; a[7,1]:=7; a[7,2]:=9; a[7,3]:=3;
  a[8,0]:=6; a[8,1]:=8; a[8,2]:=4; a[8,3]:=2;
  a[9,0]:=1; a[9,1]:=9; a[9,2]:=1; a[9,3]:=9;
end;

function ucif(k:integer):integer;
var s,i:integer;
begin
  s:=0;
  for i:=1 to k do
    begin
      inc(s,a[i mod 10,i mod 4]);
      if s>10 then s:=s mod 10;
    end;
  ucif:=s;
end;

procedure rezolva;
var i,j,nr,c,n,t:integer;
begin
  assign(f,'cifra.in');
  reset(f);
  assign(g,'cifra.out');
  rewrite(g);
  readln(f,t);
  for i:=1 to t do
    begin
      readln(f,s);
      n:=0;
      if length(s)<=3 then
        for j:=1 to length(s) do begin val(s[j],nr,c); n:=n*10+nr; end
      else
        for j:=length(s)-2 to length(s) do begin val(s[j],nr,c); n:=n*10+nr; end;
      writeln(g,ucif(n));
    end;
  close(f);
  close(g);
end;

begin
  init;
  rezolva;
end.