Разбиение на слова. Все способы. Опции

[Altair]

Предлагаю в теме собрать все способы разбиения строки на слова.
(рекурсивные, итерационные, с использованием массивов, без использования массивов, с ДСД, с чем-то еще... вобщем программы и алгоритмы преобразования предложения в набор слов )

СОБИРАЕМ!

[Altair]

Функция с дополнительными возможностями.

function SepWord(s,Alf:string):tlist;

Функция вовзращает указатель на структуру вида:

 TElem = string;
 TList = ^TNode;
 TNode = record
	       Info: TElem;
	       Next: TList
	      end;

Проще говоря, на односвязный, динамический список:


Параметры вызова функции
s (string) - строка, подлежащая разбиению на слова.
Alf (string) - пользовательский алфавит.
описание
Если первый символ $, то alf интерплитируется как алфавит.
Пример
alf='$1234567890';
тогда алфавит = {'1','2','3','4','5','6','7','8','9','0'}
То есть таким образом можно легко распознавать например только числа в строке с мусором.
Если первый символ # то далее идущие символы интерплитируются как разделители.
Если первый символ другой, то alf - имя файла из которого считывается алфавит (символы - НЕ разделители).

Код функции

function SepWord(s,Alf:string):tlist;
         procedure  AddLast(var L: TList; E: TElem);
         var
           N, P: TList;
         Begin
           new(N);
           N^.Info :=E; N^.Next :=nil;
           if L= nil then L:=N else  begin
             P:=L;
             while P^.Next <> nil do P:=P^.Next;
             P^.Next:=N
           end
         End;
const
 i:integer=1;
 r:set of char = [chr(0)..chr(255)]-['A'..'Z','a'..'z','1'..'9','0'];
var
 SL:boolean; L: TList;   ss:string;f:file of byte;b:byte;
begin
 if Alf<>'' then begin
  if (alf[1]<>'#') and (alf[1]<>'$') then begin
   assign(f,alf); {$I-} reset(f); {$I+}
   if IOresult=0 then begin
    while not eof(f) do begin
     read(f,b);
     include(r,chr(b));
    end;
    r:= [chr(0)..chr(255)]-r;
    close(f)
   end
  end else begin
   r:=[];
   if alf[1]='#' then  for i:=2 to length(alf) do include(r,alf[i]);
   if alf[1]='$' then  begin
    for i:=2 to length(alf) do include(r,alf[i]) ;
    r:= [chr(0)..chr(255)]-r;
   end;
  end;
 end;
 sl:=false; L:=nil; ss:='' ;  i:=1;
 while i<=length(s) do begin
   if ((not(s[i] in r)) and (sl=false))  then sl:=true;
   if (not(s[i] in r)) and (sl=true) then ss:=ss+s[i];
   if ((s[i] in r)or(i=length(s)))  and (sl=true) then
   begin
    AddLast(L,ss); ss:=''; sl:=false;
   end;
   inc(i)
 end;
 SepWord:=L;
end;

Пример программы:  test.pas ( 1.91 килобайт ) Кол-во скачиваний: 2712


Используемый алгоритм

Просматриваем строку.
Изначально полагаем что мы не просматриваем слово.
Далее если встречаем НЕ разделитель , а признак просмотра слова ложь, меняем признак на ИСТИНУ.
Далее если встречаем символ не разделитель и признак слова не ложь то прибавляем символ к временнйо строке.
Если стретили символ разделитель и признак слова истина, то
добавляем слово из временнйо строку в список слов.
обнуляем временную строку.
признак слова в ложь
переходим к следующему символу.