| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Работа со строками [D6, D7, WinXP]
(CHALING 32)S K i N E R © (2006-01-07 20:51:00)Здравствуйте! Меня интересует, каким образом можно сделать рейтинг слов в истории чата по сети! Алгоритм примерно такой программа ищет подряд слова (если слово новое записует в базу) ну и так ведет подсчет. Но вопрос еще в том как сделать чтобы прогр. искала любые не заданные ей слово? Заранее способа!
Gero (2006-01-09 11:27:00) [1]> Смешно
Что, уже выкурил? :)
(CHALING 32)S K i N E R (2006-01-09 03:50:00) [2]
> > [11] Gero © (08.01.06 18:08)
> > Забей.
>
> И выкури :)
Смешно
Джо (2006-01-08 22:18:00) [3]> [11] Gero © (08.01.06 18:08)
> Забей.
И выкури :)
Gero (2006-01-08 18:08:00) [4]> (CHALING 32)S K i N E R © (08.01.06 14:10)
Забей.
(CHALING 32)S K i N E R (2006-01-08 14:10:00) [5]Чето я не догнал чё с этим кодом делать!
TUser (2006-01-08 11:11:00) [6]
> 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.
ferr (2006-01-07 22:49:00) [7]отсортировать все слова
Anatoly Podgoretsky (2006-01-07 21:59:00) [8]Ну это домашнее задания для непрограммирующих пользователей.
(CHALING 32)S K i N E R (2006-01-07 21:42:00) [9]Это все хорошо, а как это реализовать, на коде?
palva (2006-01-07 21:32:00) [10]Ну значит нужно использовать динамический массив записей. Каждая запись содержит само слово и число раз, которое это слово встречается. При просмотре каждое слово надо сначала искать в массиве и наращивать счетчик если оно найдено. Если слова нет, то массив надо увеличивать на один и добавлять туда новое слово со счетиком один. В конце просмотра нужно отсортировать массив по убыванию счетчика. На верху будут находиться самые часто употребляемые слова. Обычно в таких подсчетах слова с длиною 1 и 2 не учитывают, поскольку это всякие предлоги. Хотя здесь уж как задача поставлена... Бывает что нужна частотность предлогов (лингвистический анализ).
Fay (2006-01-07 21:31:00) [11]> какуето
(ЧУ)К Ч А, блин
(CHALING 32)S K i N E R (2006-01-07 21:19:00) [12]Ну я имею введу чтобы программа делала рейтинг слов которые чаще попадаются! Например просканировала какуето статтю и вывила все слова которые там есть и сколько раз повторяются! Подскажите плиз!
Virgo_Style (2006-01-07 21:15:00) [13](CHALING 32)S K i N E R © (07.01.06 20:51)
Но вопрос еще в том как сделать чтобы прогр. искала любые не заданные ей слово?
Переформулируйте вопрос (с)
вущ5 (2006-01-07 21:00:00) [14]хз
| |
