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

[Altair]

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

СОБИРАЕМ!

[klem4]

я вот это использую всегда :

const

   limits = [#0..#32,'.',',',':',';','!','?','"'];
type

   TWords = array[1..40] of string;

var
   text : string;
   words : TWords;

function GetWords(s : string; var w : TWords) : byte;
var
   i,back,n : byte;
begin
   i := 1;
   n := 0;
   while(i<=length(s)) do begin
      while(i<=length(s)) and (s[i] in limits) do
       inc(i);
      if i<=length(s) then begin
         back := i;
         while(i<=length(s)) and not(s[i] in limits) do
          inc(i);
         inc(n);
         w[n] := copy(s, back, i-back);
      end;
   end;

   GetWords := n;
end;

Сообщение отредактировано: klem4 - 18.11.2005 12:34

[kornet]

Еще один способ разбивки строки на слова (похож на метод в сообщении № 3).
Алгоритм таков:
1) Заменяем все знаки пунктуации на пробелы (так же как и в методе в сообщении № 3).)
2) Удаляем все лишние пробелы (так же как и в методе сообщении № 3) и добавим последний пробел, если его нет.
3) Находим кол-во пробелов, в нашем случае оно будет равняться кол-ву слов, так как мы заранее добавили последний пробел.
Заносим местоположение пробелов в байтовый массив
4) Ориентируясь на местоположение в строке пробелов, которое хранится в массиве, копируем слова в динамический список.
В методе, представленном volvo в сообщении № 3, находится первый пробел во время цикла с помощью функции Pos, затем копируется часть строки с начала строки до первого пробела (слово) в динамический список, затем строка обрезается и поиск начинается сначала, и так до тех пор, пока в строке ничего не останется.
В представленном мной методе сперва находятся все пробелы, а затем в соответствии с их местоположением копируются слова в динамический массив, строка при этом не обрезается (за начало каждого слова отвечает переменная start, которой перед циклом присваивается значение 1 (начало первого слова), затем её значение равно местоположению очередного пробела + 1: start := x[i3] + 1, длина слова определяется разностью между местоположением пробела и переменной start: x[i3] - start )

program cuxtstringpr;

const delimeters : set of char = [',','.',':',';','-', '!', '?'];

type Spisok = ^spisoks;
     spisoks = record
     words : string;
     link : spisok;
     end;

     spsrecord = record
     First, Last : spisok;
     end;

     spsarray = array [1..128] of byte;

var s : string;
    p : spisok;
    sps : spsrecord;

function changetosps (s : string) : string;  {заменим все разделители пробелами}
var i : byte;
begin
        for i := 1 to length(s) do
         if s[i] in delimeters then
           s[i] := #32;

         changetosps := s
end;

function clearsps (s : string) : string; {удалим лишние пробелы}
var x : byte;
begin
     repeat
     x := pos (#32#32, s);
     if x <> 0 then
       delete (s, x, 1)
     until x = 0;

     if s[1] = #32 then
     delete (s, 1, 1);
     if s[length(s)]  <> #32 then
       s := s + ' ';

      clearsps := s
end;

procedure cutstring (var sps : spsrecord; s : string);
var i, i2, i3, start : byte;
    x : spsarray;
    numwords : byte;

procedure addsps (var sps : spsrecord; s : string);  {добавить в список}
     var p : spisok;
begin
       with sps do begin
     if first = nil then begin
       new (last);
       first := last
     end else begin
        new (last^.link);
        last := last^.link
     end;
        last^.words := s;
        last^.link := nil
     end

end;

begin
             {инициализация}
       sps.first := nil;
       sps.last := nil;
       numwords := 0;  {кол-во слов - 0}

     s := clearsps (changetosps(s));  {очистим строку от мусора}

               {найдем кол-во пробелов и добавим их расположение
                        в массив}

     i2 := 0; {длина заполненного массива}
     for i := 1 to length (s) do
         if s[i] = #32 then begin
        inc (numwords);
        inc (i2);
        x[i2] := i
       end;

          {добавляем слова в список}
           start := 1;
      for i3 := 1 to i2 do begin
        addsps (sps, copy (s, start, x[i3] - start));
        start := x[i3] + 1
      end
  end;

begin
    s := 'Hello, Mike! How are you, my dear friend:??';
     cutstring (sps, s);
     p := sps.first;
     while p <> nil do begin
      writeln (p^.words);
      p := p^.link
     end;
    readln
end.

Сообщение отредактировано: kornet - 19.08.2007 15:01