Текущий архив: 2006.01.29;
Скачать: CL | DM;
Вниз
Работа со строками Найти похожие ветки
← →
(CHALING 32)S K i N E R © (2006-01-07 20:51) [0]Здравствуйте! Меня интересует, каким образом можно сделать рейтинг слов в истории чата по сети! Алгоритм примерно такой программа ищет подряд слова (если слово новое записует в базу) ну и так ведет подсчет. Но вопрос еще в том как сделать чтобы прогр. искала любые не заданные ей слово? Заранее способа!
← →
вущ5 (2006-01-07 21:00) [1]хз
← →
Virgo_Style © (2006-01-07 21:15) [2](CHALING 32)S K i N E R © (07.01.06 20:51)
Но вопрос еще в том как сделать чтобы прогр. искала любые не заданные ей слово?
Переформулируйте вопрос (с)
← →
(CHALING 32)S K i N E R © (2006-01-07 21:19) [3]Ну я имею введу чтобы программа делала рейтинг слов которые чаще попадаются! Например просканировала какуето статтю и вывила все слова которые там есть и сколько раз повторяются! Подскажите плиз!
← →
Fay © (2006-01-07 21:31) [4]> какуето
(ЧУ)К Ч А, блин
← →
palva © (2006-01-07 21:32) [5]Ну значит нужно использовать динамический массив записей. Каждая запись содержит само слово и число раз, которое это слово встречается. При просмотре каждое слово надо сначала искать в массиве и наращивать счетчик если оно найдено. Если слова нет, то массив надо увеличивать на один и добавлять туда новое слово со счетиком один. В конце просмотра нужно отсортировать массив по убыванию счетчика. На верху будут находиться самые часто употребляемые слова. Обычно в таких подсчетах слова с длиною 1 и 2 не учитывают, поскольку это всякие предлоги. Хотя здесь уж как задача поставлена... Бывает что нужна частотность предлогов (лингвистический анализ).
← →
(CHALING 32)S K i N E R © (2006-01-07 21:42) [6]Это все хорошо, а как это реализовать, на коде?
← →
Anatoly Podgoretsky © (2006-01-07 21:59) [7]Ну это домашнее задания для непрограммирующих пользователей.
← →
ferr © (2006-01-07 22:49) [8]отсортировать все слова
← →
TUser © (2006-01-08 11:11) [9]
> palva © (07.01.06 21:32) [5]
Оптимальнее построить суффиксное дерево. Вот реализация, только у меня слова могли быть перекрывающимися - так что переписывай.
unit uTree;
interface
uses Classes;
var MaxLength:integer = 10;
type
TTree = class
private
FParent:TTree;
FChildren:array [1..4] of TTree;
FCount:integer;
FLetter:char;
function rSequence:string;
public
constructor Create(Parent:TTree; Letter:char);
destructor Destroy; override;
function GetChild(Letter:char):TTree;
property Parent:TTree read FParent;
property Sequence:string read rSequence;
property Count:integer read FCount write FCount;
property Letter:char read FLetter;
end;
var Ecoli:TTree;
const Lets:array [1..4] of char =
("A","C","G","T");
function NewTree:TTree;
procedure AddSequence(Root:TTree; Seq:string);
function GetCount(Root:TTree; Seq:string):integer;
procedure ListShorts(Root:TTree; List:TStrings);
implementation
uses SysUtils, Forms;
function GetLetterCode(C:char):byte;
begin
C:=UpCase(C);
case C of
"A": result:=1;
"C": result:=2;
"G": result:=3;
"T": result:=4;
else result:=0;
end;
end;
function TTree.rSequence:string;
begin
if FParent <> nil then
result:=FParent.Sequence+FLetter
else
result:=""
end;
constructor TTree.Create(Parent:TTree; Letter:char);
var i:integer;
begin
FParent:=Parent;
FLetter:=UpCase(Letter);
FCount:=0;
for i:=1 to 4 do
FChildren[i]:=nil;
end;
destructor TTree.Destroy;
var i:integer;
begin
for i:=1 to 4 do
if FChildren[i] <> nil then
FChildren[i].Free;
inherited;
end;
function TTree.GetChild(Letter:char):TTree;
var i:byte;
begin
i:=GetLetterCode(Letter);
if i = 0 then
result:=nil
else
result:=FChildren[i];
end;
function NewTree:TTree;
begin
result:=TTree.Create(nil," ");
end;
procedure AddSequence(Root:TTree; Seq:string);
var C:TTree;
i:byte;
begin
if Seq <> "" then begin
i:=GetLetterCode(Seq[1]);
if i = 0 then
raise Exception.Create("Wrong letter "+Seq[1]);
C:=Root.GetChild(Seq[1]);
if C = nil then begin
C:=TTree.Create(Root,Seq[1]);
Root.FChildren[i]:=C;
end;
C.Count:=C.Count + 1;
AddSequence(C,copy(Seq,2,length(Seq)-1));
end else
Root.Count:=Root.Count+1;
end;
function GetCount(Root:TTree; Seq:string):integer;
begin
if Root = nil then
result:=0
else
if Seq <> "" then
result:=GetCount(Root.GetChild(Seq[1]),copy(Seq,2,length(Seq)-1))
else
result:=Root.Count;
end;
procedure ListShorts(Root:TTree; List:TStrings);
var i,j:integer;
LenLists:array {[0..MaxLength-1]} of TStringList;
procedure Go(Root:TTree; Level:integer);
var i:integer;
C:TTree;
S:string;
begin
if Level < MaxLength then
for i:=1 to 4 do begin
C:=Root.GetChild(Lets[i]);
if C <> nil then
Go(C,Level+1)
else
LenLists[length(Root.Sequence)].Add("["+inttostr(length(Root.Sequence)+1)+"]"#9+Root.Sequence+Lets[i]);
end;
if Random(100) <= 1 then
Application.ProcessMessages;
end;
begin
List.Clear;
SetLength(LenLists,MaxLength);
for i:=0 to MaxLength-1 do
LenLists[i]:=TStringList.Create;
try
Go(Root,0);
for i:=0 to MaxLength-1 do
if LenLists[i].Count > 0 then
List.Add(LenLists[i].Text);
finally
for i:=0 to MaxLength-1 do
LenLists[i].Free;
SetLength(LenLists,0);
end;
end;
end.
← →
(CHALING 32)S K i N E R © (2006-01-08 14:10) [10]Чето я не догнал чё с этим кодом делать!
← →
Gero © (2006-01-08 18:08) [11]> (CHALING 32)S K i N E R © (08.01.06 14:10)
Забей.
← →
Джо © (2006-01-08 22:18) [12]> [11] Gero © (08.01.06 18:08)
> Забей.
И выкури :)
← →
(CHALING 32)S K i N E R © (2006-01-09 03:50) [13]
> > [11] Gero © (08.01.06 18:08)
> > Забей.
>
> И выкури :)
Смешно
← →
Gero © (2006-01-09 11:27) [14]> Смешно
Что, уже выкурил? :)
Страницы: 1 вся ветка
Текущий архив: 2006.01.29;
Скачать: CL | DM;
Память: 0.51 MB
Время: 0.025 c
