by Revenger » Sat Aug 16, 2003 10:23 pm
Thanks for help
I've fixed some bugs
But still WA
My Code
[pascal]Program p755;
Const MaxN = 110000;
LDig : Array['A'..'Z']of Integer = ( 2, 2, 2,
3, 3, 3, 4, 4, 4, 5, 5, 5, 6, 6, 6,
7, 0, 7, 7, 8, 8, 8, 9, 9, 9, 0 );
Type Point = Record i : Integer; s : String[7]; End;
Var T,tt,i : Integer;
p,j,k,c : Integer;
Amount : Array[1..MaxN]of Point;
Tmp : Array[0..MaxN]of Point;
Procedure ReadPhone(Var Ph : Point);
Var S : String;
Ch : Char;
i : Integer;
begin
S:='';
While (Not Eoln) And (Not Eof) do begin
Read(Ch);
if Ch in ['0'..'9'] then S:=S+Ch;
if Ch in ['A'..'Z'] then S:=S+Ch;
end;
Readln;
Ph.s := S;
Ph.i := 0;
for i := 1 to length(S) do
if S[i] in ['A'..'Z'] then
Ph.i := Ph.i * 10 + LDig[S[i]]
else
Ph.i := Ph.i * 10 + Ord(S[i])-Ord('0');
end;
Procedure Swap(Var A1, A2 : Point);
Var t : Point;
begin
t := A1;
A1 := A2;
A2 := t;
end;
Procedure Merge(left,middle,rigth : integer);
Var Ileft,Irigth,Cur,i : integer;
begin
Ileft:=left;
Irigth:=middle+1;
Cur:=0;
While True do begin
Cur:=Cur+1;
if Amount[Ileft].i<Amount[Irigth].i then begin
Tmp[Cur]:=Amount[Ileft];
Ileft:=Ileft+1;
end else begin
Tmp[Cur]:=Amount[Irigth];
Irigth:=Irigth+1;
end;
if Ileft=middle+1 then begin
for i:=Irigth to rigth do begin
Cur:=Cur+1;
Tmp[Cur]:=Amount[i];
end;
break;
end;
if Irigth=rigth+1 then begin
for i:=Ileft to middle do begin
Cur:=Cur+1;
Tmp[Cur]:=Amount[i];
end;
break;
end;
end;
for i:=1 to rigth-left+1 do
Amount[left+i-1]:=Tmp[i];
end;
Procedure MergeSort(left,rigth : integer);
Var middle : integer;
begin
if rigth-left<=0 then exit;
if rigth-left=1 then begin
if Amount[left].i>Amount[rigth].i then
Swap(Amount[left],Amount[rigth]);
exit;
end;
middle:=(left + rigth) div 2;
MergeSort(left,middle);
MergeSort(middle+1,rigth);
Merge(left,middle,rigth);
end;
begin
Readln(T);
for tt:=1 to T do begin
Readln;
Readln(k);
for i:=1 to k do ReadPhone(Amount[i]);
j := 0;
MergeSort(1,k);
p := -1;
c := 0;
for i:=1 to k do
if Amount[i].i = p then begin
c := c + 1;
j := 1;
end else begin
if c >= 1 then Writeln(Amount[i - 1].S, ' ', c);
c := 1;
p := Amount[i].i;
end;
Writeln(Amount[k].S, ' ', c);
if j = 0 then Writeln('No duplicates.');
Writeln;
end;
end.[/pascal]