Счестчик слов

← →
FireWorks (2002-05-29 09:32) [0]

Необходим счетчик слов, отдельно считающий слова и союзы. Как это сделать?

← →
Anatoly Podgoretsky (2002-05-29 09:44) [1]

Ну или два счетчика или составной счетчик
Counter = record Words : Integer; unions : Integer; end;

← →
FireWorks (2002-05-29 09:53) [2]

если можно то хотелось бы поподробнее

← →
MBo (2002-05-29 09:59) [3]

procedure TForm1.Button1Click(Sender: TObject);
const letters:set of char=["А".."я","Ё","ё"];// задай то, что считаешь частями слов
var s:string;
i,words,unions:integer;
sl:tstringlist;
begin
s:="Мама мыла раму с мылом, а папа пил пиво с раками";
sl:=tstringlist.create;
for i:=1 to length(s) do
if not (s[i] in letters) then
s[i]:=" ";
sl.commatext:=s;
words:=0;
unions:=0;
for i:=0 to sl.count-1 do
if length(sl[i])=1 then //твой критерий различия
inc(unions)
else inc(words);
memo1.lines.assign(sl);
memo1.lines.add("слов: "+inttostr(words)+" союзов: "+inttostr(unions));
end;

← →
Anatoly Podgoretsky (2002-05-29 11:11) [4]

Я хочу только отметить, что с точки зрения алгоритма, лучше не части слова, а делать множество ограничителей слов, а разбиение на слова и союзы вынести в отдельную функцию GetWord(params: XXX): TWordType, которая будет возвращать признак - слово, союз, конец или подобное. Тогда это будет выглядеть приятнее

while ЧтоТо do begin
case GetWord(XXX) of
wtWord: inc(Counter.Words);
wtUnion: inc(Counter.Unions);
end;
end;

← →
FireWorks (2002-05-29 11:20) [5]

Попробую,
вот только у меня все не считает правильно предлоги и союзы могут быть от 1-3 букввы.. вот надо выделять их как бы отдельно

← →
Anatoly Podgoretsky (2002-05-29 11:32) [6]

Успех находится в списках союзов

← →
FireWorks (2002-05-29 11:36) [7]

Логично
массив под него выжделить чтоли?

← →
Anatoly Podgoretsky (2002-05-29 11:55) [8]

Разделить задачу на отдельные функции,
1. выделение слов из строки
2. определение типа слов

← →
-=Sergeante=- (2002-05-30 10:40) [9]

Вот три функции, выдранные из StrUtils
function WordCount(const S: string; const WordDelims: TCharSet): Integer; function ExtractWord(N: Integer; const S: string; const WordDelims: TCharSet): string; function WordPosition(const N: Integer; const S: string; const WordDelims: TCharSet): Integer; TCharSet = set of Char; ... function TForm1.WordPosition(const N: Integer; const S: string; const WordDelims: TCharSet): Integer; var Count, I: Integer; begin Count := 0; I := 1; Result := 0; while (I <= Length(S)) and (Count <> N) do begin while (I <= Length(S)) and (S[I] in WordDelims) do Inc(I); if I <= Length(S) then Inc(Count); if Count <> N then while (I <= Length(S)) and not (S[I] in WordDelims) do Inc(I) else Result := I; end; end; function TForm1.ExtractWord(N: Integer; const S: string; const WordDelims: TCharSet): string; var I: Integer; Len: Integer; begin Len := 0; I := WordPosition(N, S, WordDelims); if I <> 0 then while (I <= Length(S)) and not(S[I] in WordDelims) do begin Inc(Len); SetLength(Result, Len); Result[Len] := S[I]; Inc(I); end; SetLength(Result, Len); end; function TForm1.WordCount(const S: string; const WordDelims: TCharSet): Integer; var SLen, I: Cardinal; begin Result := 0; I := 1; SLen := Length(S); while I <= SLen do begin while (I <= SLen) and (S[I] in WordDelims) do Inc(I); if I <= SLen then Inc(Result); while (I <= SLen) and not(S[I] in WordDelims) do Inc(I); end; end;

Создаёшь список (массив) со всеми союзами.
В цикле i:=0 to wordcount(...)-1 делаешь перебор всех слов и ищешь на каждом проходе цикла текущее слово в массиве союзов. Если нашёл, то увеличиваешь счетчик союзов, если не нашел, то увеличиваешь счетчих обычных слов.
В WordDelims указываются разделители слов [" ",","...]

← →
KilkennyCat (2002-05-30 11:09) [10]

Как вы все усложняете....
у меня попроще

procedure TMain.HooIsHoo(tt : TMemoryStream);
var
TestString : string; // Тестируемая строка
Bukva : byte; // Байт чтения-записи
begin
TestString := ""; // Очищаем строку теста
tt.position := 0; // Устанвливаемся в начало исходного текста
// начали!!!
repeat
tt.ReadBuffer(Bukva,1); // Читаем первый байт
if (Bukva = 13) then begin // А может это перевод строки?
tt.ReadBuffer(Bukva,1); // Так как перевод два байта, а прочитали один, компенсируем...
if pos(TestString,"a,o,и,под,при...") <> 0 then inc(CountSouz);
inc(CountWord);
TestString := "";
end else begin // не-а, не перевод... нормальная буква.
if pos(chr(Bukva)," ,.-=!?:;+") <> 0 then begin
if pos(TestString,"a,o,и,под,при...") <> 0 then inc(CountSouz);
inc(CountWord);
TestString := "";
end else TestString := TestString + chr(Bukva); // прибавим к тестовой строке
end;
until tt.Position > tt.Size - 1; // Проверим, не хватит ли начинать?
end;

← →
KilkennyCat (2002-05-30 11:16) [11]

главное - работает быстро :)

> Mbo
Прости, не заметил твой алгоритм в начале :) Твой проще.

Счестчик слов Найти похожие ветки