program P1002;
  const
    max=100000;
  type
    ar=record
         num,times:longint;
       end;
  var
    same,m,n,number,times:longint;
    call:array[1..max] of ar;
  procedure getnumber;
    var
      i,k,code:integer;
      base:longint;
      strings,rest:string;
    begin
      readln(strings);
      rest:='';
      for i:=1 to length(strings) do
        if (strings[i] in ['0'..'9'])or
           (strings[i] in ['A'..'Y']) then
          rest:=rest+strings[i];
      for i:=1 to length(rest) do
        if rest[i] in ['A'..'Y'] then
          if rest[i]<'Q' then
            rest[i]:=chr(((ord(rest[i])-65) div 3+2)+48) else
            rest[i]:=chr(((ord(rest[i])-66) div 3+2)+48);
      base:=1000000;
      number:=0;
      for i:=1 to 7 do
        begin
          val(rest[i],k,code);
          number:=number+longint(base*k);
          base:=base div 10;
        end;
    end;
  function min(x,y:longint):longint;
    begin
      if x<y then
        min:=x else
        min:=y;
    end;
  procedure builtheap;
    var
      mid:ar;
      k:longint;
    begin
      call[n].num:=number;
      call[n].times:=1;
      k:=n;
      while (k div 2>0)and(call[k div 2].num>=call[k].num) do
        begin
          if call[k div 2].num>call[k].num then
            begin
              mid:=call[k div 2];
              call[k div 2]:=call[k];
              call[k]:=mid;
              k:=k div 2;
            end                            else
          if call[k div 2].num=call[k].num then
            begin
              inc(call[k div 2].times);
              call[k]:=call[n];
              call[n].num:=0;
              call[n].times:=0;
              dec(n);
              while (call[k].num>min(call[2*k].num,call[2*k+1].num))and
                    (2*k<=n) do
                begin
                  if (2*k+1>n)or
                     ((2*k+1<=n)and(call[2*k].num<call[2*k+1].num)) then
                    begin
                      mid:=call[k];
                      call[k]:=call[2*k];
                      call[2*k]:=mid;
                      k:=2*k;
                    end      else
                    begin
                      mid:=call[k];
                      call[k]:=call[2*k+1];
                      call[2*k+1]:=mid;
                      k:=2*k+1;
                    end;
                end;
              break;
            end;
        end;
    end;
  procedure getmin;
    var
      mid:ar;
      k:longint;
    begin
      number:=call[1].num;
      times:=call[1].times;
      k:=1;
      call[k]:=call[n];
      call[n].num:=0;
      call[n].times:=0;
      dec(n);
      while (call[k].num>min(call[2*k].num,call[2*k+1].num))and
            (2*k<=n) do
        begin
          if (2*k+1>n)or
             ((2*k+1<=n)and(call[2*k].num<call[2*k+1].num)) then
            begin
              mid:=call[k];
              call[k]:=call[2*k];
              call[2*k]:=mid;
              k:=2*k;
            end      else
            begin
              mid:=call[k];
              call[k]:=call[2*k+1];
              call[2*k+1]:=mid;
              k:=2*k+1;
            end;
        end;
    end;
  procedure print;
    var
      i:integer;
      base:longint;
    begin
      base:=1000000;
      for i:=1 to 7 do
        begin
          write(number div base);
          number:=number mod base;
          base:=base div 10;
          if i=3 then
            write('-');
        end;
      writeln(' ',times);
      inc(same);
    end;
  procedure doing;
    var
      i:longint;
    begin
      same:=0;
      for i:=1 to max do
        begin
          call[i].num:=0;
          call[i].times:=0;
        end;
      readln(m);
      n:=0;
      for i:=1 to m do
        begin
          getnumber;
          inc(n);
          builtheap;
        end;
      m:=n;
      times:=0;
      for i:=1 to m do
        begin
          getmin;
          if times>1 then
            print;
        end;
      if same=0 then
        writeln('No duplicates.');
    end;
  begin
    {assign(input,'1002.in');
    reset(input);}
    doing;
    {close(input);}
  end.

• Re:各位高手，谁能帮我看看程序，感激不尽。我实在是不知道哪里错了。 (4617) Birdsong 2005-03-19 23:34:53