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

[Altair]

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

СОБИРАЕМ!

[volvo]

Этот - немного попроще, здесь реализован список слов:

type
	TWordStr = string[100];
	TDelimiter = set of Char;

	{ Опишем структуру для хранения списка слов }
	PTItem = ^TItem;
	TItem = record
		Data: TWordStr;
		next: PTItem;
	end;
	TWordList = record
		first, last: PTItem;
	end;

{
	Эта процедура добавляет переданную ей строку к списку L
}
procedure InsertWord(var L: TWordList; s: string);
var p: PTItem;
begin
	New(p);
	p^.Data := s;
	p^.next := nil;
	
	if L.first = nil then L.first := p
	else L.last^.next := p;
	L.last := p
end;

{
	Функция разбиения строки на слова
}
function GetWords(s: string; var L: TWordList; delimiters: TDelimiter): Byte;
var i, p: Byte;
begin
	for i := 1 to Length(s) do
		if s[i] In delimiters then s[i] := #32;
	
	{ Удаляем лишние пробелы }
	repeat
		p := Pos('  ', s);
		if p > 0 then Delete(s, p, 1)
	until p = 0;
	{ Удаляем пробел из начала строки (если есть) }
	if s[1] = ' ' then Delete(s, 1, 1);
	{ Удаляем замыкающий пробел (если есть) }
	if s[Length(s)] = ' ' then Delete(s, Length(s), 1);
		
	i := 0;
	repeat
		p := Pos(' ', s); Inc(i);
		if p > 0 then begin
			InsertWord(L, Copy(s, 1, Pred(p)));
			Delete(s, 1, p)
		end
		else InsertWord(L, s)
	until p = 0;
	GetWords := i
end;

var
	i, count: Word;
	L: TWordList;
		
const
	s: string = ' That is - all folks;;. ';
var
	p: ptitem;
		
begin
	Count := GetWords(s, L, ['-', ';', '.']);
	WriteLn(Count, ' words found ...');
		
	p := L.first;
	while p <> nil do begin
		WriteLn(p^.Data);
		p := p^.next;
	end;
end.