Дан файл, содержащий текст. Составить в алфавитном порядке список всех слов, встречающихся в этом тексте

code: #pascal
  1. const m=100;    // Максимальное кол-во слов.
  2.  
  3. var F:Text;
  4.     a:array[1..m] of string;
  5.     i:integer;
  6.     FileName:string;
  7.  
  8. Procedure Load(FileName:String);
  9. begin
  10. Assign(F,FileName);
  11. Reset(F);
  12. end;
  13.  
  14. Procedure Sort1;
  15. var s:string;
  16. begin
  17. i:=1;
  18. repeat
  19. ReadLn(F,s);
  20.  repeat
  21.  a[i]:=Copy(s,1,pos(' ',s)-1);
  22.  delete(s,1,pos(' ',s));
  23.  inc(i);
  24.  until pos(' ',s)=0;
  25.  a[i]:=s;
  26. until EoF(F);
  27. end;
  28.  
  29. Procedure Sort2;
  30. var n:integer;
  31.     s,s2:string;
  32.     z:boolean;
  33. begin
  34. repeat
  35. z:=false;
  36. for n:=1 to i-2 do
  37.  begin
  38.  s:=a[n];
  39.  s2:=a[n+1];
  40.  if ord(s[1]) > ord(s2[1]) then
  41.   begin
  42.   a[n]:=s2;
  43.   a[n+1]:=s;
  44.   z:=true;
  45.   end else
  46.   if (ord(s[2]) > ord(s2[2])) and (s[1]=s2[1])  then
  47.    begin
  48.    a[n]:=s2;
  49.    a[n+1]:=s;
  50.    z:=true;
  51.    end else
  52.    if (ord(s[3]) > ord(s2[3])) and (s[1]=s2[1]) and (s[2]=s2[2]) then
  53.     begin
  54.     a[n]:=s2;
  55.     a[n+1]:=s;
  56.     z:=true;
  57.     end;
  58.  end;
  59. until z = false;
  60. end;
  61.  
  62. Procedure Vivod;
  63. var n:integer;
  64. begin
  65. for n:=1 to i-1 do
  66. writeln(a[n]);
  67. end;
  68.  
  69. begin
  70. WriteLn('File:');
  71. Readln(FileName);
  72. Load(FileName);
  73. Sort1;
  74. Sort2;
  75. Vivod;
  76. readln;
  77. end.
Поделиться:

Похожие статьи: