Thankx, you give me a idea~ : )

http://citeseer.ist.psu.edu/rd/76932935%2C259876%2C1%2C0.25%2CDownload/http://citeseer.ist.psu.edu/cache/papers/cs/11961/http:zSzzSzolymp.informatik.uni-bonn.dezSzIVzSzblumzSzpaperszSzgmatching.pdf/blum99maximum.pdf

pdf version

It is UNIX archive. Use 7-Zip

Read Oleg's comment above... This test is incorrect

You are right. Thanks. )) I hurried and was inattentive. But how can you see my submits? )) I tried to open someone's solutions but I couldn't. Why?

In test:
3
russian
russian
french
we can use new language, for example, "qwerty". The result must be:
3
russian-qwerty
french-qwerty
french-russian

I am right?

Thanks! Sorry for my small intellegence))))

Try to use dx and limits which can be represented in binary form exactly (e.g. 1/1024.0 instead of 1e-3)

Thank you a lot, I AC!!!!!!!!!!!!!!

type
  Ttree=^atree;
  atree=record
    name:string;
    son:Ttree;
    same:Ttree;
  end;
var
  tree:Ttree;
  i,j,k,n:integer;
  p:Ttree;
  s:string;
procedure create(s:string;var p:Ttree);
var
  t,q:ttree;
  ss:string;
begin
  if s='' then exit;
  new(q);q^.name:='';
  q^.same:=nil;
  q^.son:=nil;
  ss:=copy(s,1,pos('\',s)-1);
  delete(s,1,pos('\',s));
  if p=nil then begin
    q^.name:=ss;
    create(s,q^.son);
    p:=q;
    p^.same:=p;
  end else begin
    t:=p;
    while (p^.name<ss)and(p^.same<>t)and(p^.same^.name<=ss)
do
      p:=p^.same;
    if p^.name=ss then create(s,p^.son) else begin
      q^.name:=ss;
      create(s,q^.son);
      q^.same:=p^.same;
      p^.same:=q;
    end;
  end;
  while p^.same^.name>p^.name do
    p:=p^.same;
  while p^.same^.name<p^.name do
    p:=p^.same;
end;
procedure print(i:integer;q:Ttree);
var
  t:ttree;
begin
  t:=q;
  repeat
    writeln(' ':i+1,q^.name);
    if q^.son<>nil then print(i+1,q^.son);
    q:=q^.same;
  until q=t;
end;

begin
  tree:=nil;
  readln(n);
  for i:=1 to n do begin
    readln(s);
    create(s+'\',tree);
  end;
  print(0,tree);
end.

Program disktree;
  const
    max=500;
  var
    a:array[1..max] of string[100];
    n:integer;

procedure init;
  var
    i,j:integer;
  begin
    readln(n);
    for i:=1 to n do
      begin
        readln(a[i]);
        for j:=1 to length(a[i]) do
          if a[i,j]='\' then
            a[i,j]:=#1;
      end;
  end;

procedure mendheap(i,now:integer);
  var
    t:integer;
    st:string[80];
  begin
    while i shl 1<=now do
      begin
        if i shl 1=now then
          t:=now
        else
          if a[i shl 1]>a[i shl 1+1] then
            t:=i shl 1
          else
            t:=i shl 1+1;
        if a[i]<a[t] then
          begin
            st:=a[i]; a[i]:=a[t]; a[t]:=st;
            i:=t;
          end
        else
          i:=now;
      end;
  end;

procedure dothing;
  var
    i:integer;
    st:string[80];
  begin
    for i:=n shr 1 downto 1 do
      mendheap(i,n);
    for i:=n-1 downto 2 do
      begin
        st:=a[1]; a[1]:=a[i+1]; a[i+1]:=st;
        mendheap(1,i);
      end;
    st:=a[1]; a[1]:=a[2]; a[2]:=st;
  end;

procedure print;
  var
    i,j,t,t1:integer;
    s,s1,s2,st:string;
  begin
    s:=#0#0;
    for i:=1 to n do
      begin
        st:=a[i];
        if s=copy(st,1,length(s)) then
          begin
            t:=1;
            for j:=1 to length(s) do
              if s[j]=#1 then
                inc(t);
          end
        else
          begin
            j:=1; t:=0;
            while st[j]=s[j] do
              begin
                if st[j]=#1 then
                  inc(t);
                inc(j);
              end;
          end;
        j:=1; t1:=t;
        while t1>0 do
          begin
            if st[j]=#1 then
              dec(t1);
            inc(j);
          end;
        s:=st; st:=st+#1;
        delete(st,1,j-1);
        while st>'' do
          begin
            if t>0 then
              write(' ':t);
            j:=pos(#1,st);
            writeln(copy(st,1,j-1));
            inc(t);
            delete(st,1,j);
          end;
      end;
  end;

  Begin
    init;
    dothing;
    print;
  End.

Thank you for your information.But I still misunderstand your meaning
Please explain more details
                    Thanks Again!!!