Форум: "Основная";
Текущий архив: 2002.12.09;
Скачать: [xml.tar.bz2];

Вниз

Подсчет уникальных слов в массиве..............   Найти похожие ветки 

← →
valerchik   (2002-11-22 22:11) [0]

Помогите подсчитать сколько раз повторялось слово в тексте...
Вывод должен быть примерно такой (желательно запихать это все в два массива):
Слова число
--------------------
программер 5
Комп 10
процессор 123
--------------------

---

← →
Оливейра   (2002-11-23 00:10) [1]

Для этого ищи реализацию hash под Delphi, либо тупо юзай TStringList (Strings, Values, Objects или чего там еще...)

---

← →
Vlad1   (2002-11-24 14:08) [2]

Я использую такую функцию:
var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.CountWord(YourWord, YourText: String): integer;
var ss,i:integer;
begin
result:=0;
if (yourtext="")or(YourWord ="") then exit;
ss:=0;
YourWord:=#32+YourWord+#32;
YourText:=#32+YourText+#32;
repeat
for i :=1 to ss do
YourText[i]:=#0;
i:=pos(YourWord,YourText);
if i>0 then
inc(Result);
ss:=i+2;
until i=0
end;

Вот примеры её ислользования:
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit3.Text:=IntToStr(CountWord(Edit2.Text,Edit1.Text));
end;

procedure TForm1.Button2Click(Sender: TObject);
var T:String;i:integer;
begin
t:=memo1.Text;
for i:=1 to length(t) do
if t[i] in [#13,#10] then t[i]:=#32;
Edit3.Text:=IntToStr(CountWord(Edit2.Text,T));
end;
В YourText сколько угодно пробелов, а в YourWord пробелов быть не должно.

---

← →
Vlad1   (2002-11-24 20:47) [3]

Добавление: в самое начало функции CountWord можно вставить следующее:

YourWord:=Trim(YourWord);

---

← →
Vlad1   (2002-11-27 20:40) [4]

Более красивый вариант:
function CountWord( YourWord:String; YourText: String): integer;
var l:integer;
procedure Q1(w,t:string;var r:integer);
begin
if t="" then exit;
if pos(w,t)>0 then inc(r);
t:=copy(t,pos(w,t)+2,l);
q1(w,t,r);
end;
begin
l:=length(YourText);
Result:=0;
YourWord:=trim(YourWord);
if (Length(YourText)=0)or(trim(YourWord)="" )then exit;
YourWord:=#32+YourWord+#32;
YourText:=#32+YourText+#32;

Q1(YourWord,YourText,Result);
end;


---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.12.09;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.45 MB
Время: 0.008 c