POJ/3149.pas

   1 {$R+,S+,Q+,H+,O-}
   2 {$MINSTACKSIZE 4000000}
   3
   4 var
   5   n,i,ans:longint;
   6   a,b,c:array [0..100] of string;
   7   pre,plan:array [0..5000000] of string;
   8
   9 function getstr:string;
  10 var
  11   ch:char;
  12
  13 begin
  14   getstr:='';
  15   read(ch);
  16   while (ch<>#10) and (ch<>#13) and (ch<>' ') do
  17     begin
  18       getstr:=getstr+ch;
  19       read(ch);
  20     end;
  21 end;
  22
  23 procedure trans(var a,b:string);
  24 var
  25   i:longint;
  26
  27 begin
  28   b:=copy(a,1,length(a)-length(b))+b;
  29   a:='6'+a;
  30   while length(a)<12 do a:=a+'0';
  31   for i:=length(a) downto 1 do
  32     if a[i]='0' then a[i]:='9' else
  33       begin
  34         a[i]:=pred(a[i]);
  35         break;
  36       end;
  37   b:='6'+b;
  38   while length(b)<12 do b:=b+'9';
  39   for i:=length(b) downto 1 do
  40     if b[i]='9' then b[i]:='0' else
  41       begin
  42         b[i]:=succ(b[i]);
  43         break;
  44       end;
  45 end;
  46
  47 function cal(s:string):string;
  48 var
  49   i:longint;
  50
  51 begin
  52   cal:='@';
  53   for i:=1 to n do
  54     begin
  55       if (copy(a[i],1,length(s))=s) and (length(s)<12) then exit;
  56       if (copy(b[i],1,length(s))=s) and (length(s)<12) then exit;
  57       if (a[i]<s) and (s<b[i]) then exit(c[i]);
  58     end;
  59   cal:='invalid';
  60 end;
  61
  62 function build(prefix:string):string;
  63 var
  64   child:array ['0'..'9'] of string;
  65   i:char;
  66
  67 begin
  68   fillchar(child,sizeof(child),0);
  69   if length(prefix)>1 then
  70     begin
  71       build:=cal(prefix);
  72       if build<>'@' then exit;
  73     end;
  74   build:='';
  75   for i:='0' to '9' do
  76     begin
  77       child[i]:=build(prefix+i);
  78       if build='' then build:=child[i] else if build<>child[i] then build:='@';
  79     end;
  80   if (build='@') or (length(prefix)=1) then
  81     begin
  82       for i:='0' to '9' do
  83         if (child[i]<>'@') and (child[i]<>'invalid') then
  84           begin
  85             inc(ans);
  86             pre[ans]:=prefix+i;
  87             plan[ans]:=child[i];
  88           end;
  89     end;
  90 end;
  91
  92 procedure swap(var x,y:string); inline;
  93 var
  94   t:string;
  95
  96 begin
  97   t:=x;
  98   x:=y;
  99   y:=t;
 100 end;
 101
 102 procedure sort(l,r:longint);
 103 var
 104   i,j:longint;
 105   m,t:string;
 106
 107 begin
 108   i:=l;
 109   j:=r;
 110   m:=pre[(l+r) shr 1];
 111   repeat
 112     while pre[i]<m do inc(i);
 113     while pre[j]>m do dec(j);
 114     if i<=j then
 115       begin
 116         swap(pre[i],pre[j]);
 117         swap(plan[i],plan[j]);
 118         inc(i);
 119         dec(j);
 120       end;
 121   until i>j;
 122   if l<j then sort(l,j);
 123   if r>i then sort(i,r);
 124 end;
 125
 126 begin
 127   while not eof do
 128     begin
 129       readln(n);
 130       ans:=0;
 131       for i:=1 to n do
 132         begin
 133           a[i]:=getstr;
 134           getstr;
 135           b[i]:=getstr;
 136           c[i]:=getstr;
 137           trans(a[i],b[i]);
 138           readln;
 139         end;
 140       build('6');
 141       writeln(ans);
 142       if ans>1 then sort(1,ans);
 143       for i:=1 to ans do writeln(copy(pre[i],2,1000),' ',plan[i]);
 144     end;
 145 end.