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

[Altair]

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

СОБИРАЕМ!

[volvo]

Пожалуй, самый извращенный способ - используется реализация динамического массива (из FAQ) с ООП:

function pos(var p: byte;
         substr, s: string): boolean;
  begin
    p := system.pos(substr, s);
    pos := (p > 0)
  end;


const
  word_len = 100;
  max_words = 100;

type
  titerator = set of char;

const
  str_singlespace = #32;
  str_doublespace = #32#32;

  str_space: titerator = [#32];
  str_punct: titerator = ['.', ',', ':', ';', '?', '!'];

type
  ptwordstr = ^twordstr;
  twordstr = string[word_len];

  ttype = twordstr;

{$i array.pas}

type
  twordlist = object(tarray)
    constructor init(s: string;
                iterator: titerator);
    destructor done;

    { Iterator }
    function last: integer;
    { Iterator }

  private
    count: integer;

    procedure find(s: string;
              iterator: titerator);
    procedure append(s: string);
  end;

constructor twordlist.init(s: string;
            iterator: titerator);
  begin
    inherited init(max_words);
    count := 0;

    find(s, iterator)
  end;

destructor twordlist.done;
  begin
    inherited done
  end;

procedure twordlist.append(s: string);
  begin
    inc(count);
    if not put(count, s) then
      begin
        dec(count);
        writeln('max_words limit exceeded !')
      end
  end;


function twordlist.last: integer;
  begin last := count end;


function copy_delete(var s: string;
         index, count: integer): string;
  begin
    copy_delete := copy(s, index, count);
    delete(s, index, succ(count))
  end;

procedure twordlist.find(s: string;
          iterator: titerator);
  var i, ps: Byte;
  Begin
    for i := 1 to length(s) do
      if s[i] in iterator then s[i] := #32;

    repeat
      if pos(ps, str_doublespace, s)
        then delete(s, ps, 1)
    until ps = 0;

    If s[1] = ' ' Then Delete(s, 1, 1);
    If s[Length(s)] = ' ' Then
      Delete(s, Length(s), 1);

    i := 0;
    repeat
      if pos(ps, str_singlespace, s) then
        append(copy_delete(s, 1, pred(ps)))
      else append(s)
    until ps = 0
  End;

var
  i, count: Word;
  words: twordlist;

const
  s: string = ' That,is   all:folks ';
begin
  words.init(s, str_punct);

  writeln('the_test:');
  for i := words.first to words.last do
    writeln(words.get(i)^);
  words.done
end.

файл array.pas прилагается:  ARRAY.PAS ( 6.35 килобайт ) Кол-во скачиваний: 1641