Алгоритм поиска всех уникальных слов в файле

Previous  Top  Next

    
 

 

 

Code:

////////////////////////////////////////////////////////////////////////////////

//

//  ****************************************************************************

//  * Unit Name : Dictionary

//  * Purpose   : Набор классов для работы с индексированным списком поиска

//  * Author    : Александр Багель

//  * Version   : 1.00

//  ****************************************************************************

//

 

unit Dictionary;

 

interface

 

uses

Windows, Classes, SysUtils{, FullTextGetter};

 

type

// Класс отвечающий за создание словаря уникальных слов

TDictionaryFounder = class

private

   FDict: TList;

   FDictMem: array of String;

   FDictMemCount: Integer;

protected

   function GetPos(const Value: String): Integer; virtual;

   procedure Insert(Value: String; Position: Integer); virtual;

   function Prepare(const Value: String): String; virtual;

public

   constructor Create;

   destructor Destroy; override;

   procedure AddData(Value: String); //overload;

  // procedure AddData(ObjText: IFullTextGetter); overload;

   procedure SaveToStream(var AStream: TMemoryStream);

end;

 

// Класс осуществляющий поиск в словаре

// полученном от TDictionaryFounder

TDictionaryFinder = class

private

   FDict: array of ShortString;

   FDictLength: Cardinal;

protected

   function GetPos(const Value: ShortString;

     const SubStr: Boolean = False): Boolean; virtual;

public

   destructor Destroy; override;

   procedure LoadFromStream(const AStream: TMemoryStream);

   function Find(const Value: String;

     const SubStr: Boolean = False): Boolean;

end;

 

implementation

 

{ TDictionaryFounder }

 

//

//  Добавление информации для построения массива индексов

// =============================================================================

procedure TDictionaryFounder.AddData(Value: String);

var

Tmp: String;

Position, I: Integer;

S: TStringList;

begin

Value := Prepare(Value);

S := TStringList.Create;

try

   S.Text := Value;

   for I := 0 to S.Count - 1 do

   begin

     Tmp := S[I];

     if Tmp = '' then Continue;

     if FDict.Count = 0 then

       Insert(Tmp, 0)

     else

     begin

       Position := GetPos(Tmp);

       if (Position >= 0) then

         if FDict.Count > Position then

         begin

           if String(FDict.Items[Position]) <> Tmp then

             Insert(Tmp, Position);

         end

         else

           Insert(Tmp, Position);

     end;

   end;

finally

   S.Free;

end;

end;

 

//

//  Добавление информации для построения массива индексов

//  Информация приходит из интерфейса

// =============================================================================

{procedure TDictionaryFounder.AddData(ObjText: IFullTextGetter);

var

S: String;

begin

if ObjText = nil then

   raise Exception.Create('IFullTextGetter is empty.');

S := ObjText.GetText;

AddData(S);

end;   }

 

constructor TDictionaryFounder.Create;

begin

FDict := TList.Create;

end;

 

destructor TDictionaryFounder.Destroy;

begin

FDict.Free;

FDictMemCount := 0;

SetLength(FDictMem, FDictMemCount);

inherited;

end;

 

//

//  Возвращает номер позиции где находится слово, или должно находится...

//  Поиск методом половинного деления...

// =============================================================================

function TDictionaryFounder.GetPos(const Value: String): Integer;

var

FLeft, FRight, FCurrent: Cardinal;

begin

if FDict.Count = 0 then

begin

   Result := 0;

   Exit;

end;

FLeft := 0;

FRight := FDict.Count - 1;

FCurrent := (FRight + FLeft) div 2;

if String(FDict.Items[FLeft]) > Value then

begin

   Result := 0;

   Exit;

end;

if String(FDict.Items[FRight]) < Value then

begin

   Result := FRight + 1;

   Exit;

end;

repeat

   if String(FDict.Items[FCurrent]) = Value then

   begin

     Result := FCurrent;

     Exit;

   end;

   if String(FDict.Items[FCurrent]) < Value then

     FLeft := FCurrent

   else

     FRight := FCurrent;

   FCurrent := (FRight + FLeft) div 2;

until FLeft = FCurrent;

if String(FDict.Items[FCurrent]) < Value then Inc(FCurrent);

Result := FCurrent;

end;

 

//

//  Добавление нового индекса в массив индексов

// =============================================================================

procedure TDictionaryFounder.Insert(Value: String; Position: Integer);

begin

if FDictMemCount < FDict.Count + 1 then

begin

   Inc(FDictMemCount, FDict.Count + 1);

   SetLength(FDictMem, FDictMemCount);

end;

FDictMem[FDict.Count] := Value;

FDict.Insert(Position, @FDictMem[FDict.Count][1]);

end;

 

//

//  Сохранение массива индексов в поток

// =============================================================================

procedure TDictionaryFounder.SaveToStream(var AStream: TMemoryStream);

var

I: Integer;

S: PChar;

TmpS: TStringList;

begin

if AStream = nil then Exit;

TmpS := TStringList.Create;

try

   for I := 0 to FDict.Count - 1 do

   begin

     S := FDict.Items[I];

     TmpS.Add(S);

   end;

   AStream.Position := 0;

   AStream.Size := Length(TmpS.Text);

   AStream.Write(TmpS.Text[1], Length(TmpS.Text));

   AStream.Position := 0;

finally

   TmpS.Free;

end;

end;

 

//

//  Подготовка данных к обработке...

//  Удаляются все не буквенные символы, каждое слово начинется с новой строки...

// =============================================================================

function TDictionaryFounder.Prepare(const Value: String): String;

var

I: Integer;

Len: Cardinal;

C: PAnsiChar;

LastEnter: Boolean;

begin

SetLength(Result, Length(Value) * 2);

Len := 0;

LastEnter := False;

for I := 1 to Length(Value) do

begin

   C := CharLower(@Value[I]);

   if C^ in ['a'..'z', 'а'..'я'] then

   begin

     Inc(Len);

     Result[Len] := C^;

     LastEnter := False;

   end

   else

     if not LastEnter then

     begin

       Inc(Len);

       Result[Len] := #13;

       Inc(Len);

       Result[Len] := #10;

       LastEnter := True;

     end;

end;

SetLength(Result, Len);

end;

 

{ TDictionaryFinder }

 

destructor TDictionaryFinder.Destroy;

begin

FDictLength := 0;

SetLength(FDict, FDictLength);

inherited;

end;

 

//

//  Поиск введенных слов...

// =============================================================================

function TDictionaryFinder.Find(const Value: String;

const SubStr: Boolean = False): Boolean;

var

S: TStringList;

I: Integer;

begin

Result := False;

if Value = '' then Exit;

S := TStringList.Create;

try

   S.Text := StringReplace(Value, ' ', #13#10, [rfReplaceAll]);

   S.Text := AnsiLowerCase(S.Text);

   if S.Count = 0 then Exit;

   for I := 0 to S.Count - 1 do

   begin

     Result := GetPos(S.Strings[I], SubStr);

     if not Result then Exit;

   end;

finally

   S.Free;

end;

end;

 

//

//  Поиск каждого слова в массиве индексов

// =============================================================================

function TDictionaryFinder.GetPos(const Value: ShortString;

const SubStr: Boolean = False): Boolean;

var

FLeft, FRight, FCurrent, I: Cardinal;

begin

Result := False;

if SubStr then

begin

   for I := 0 to FDictLength - 1 do

     if Pos(Value, FDict[I]) > 0 then

     begin

       Result := True;

       Exit;

     end;

end

else

begin

   if FDictLength = 0 then Exit;

   FLeft := 0;

   FRight := FDictLength - 1;

   FCurrent := (FRight + FLeft) div 2;

   if FDict[FLeft] > Value then Exit;

   if FDict[FRight] < Value then Exit;

   if FDict[FLeft] = Value then

   begin

     Result := True;

     Exit;

   end;

   if FDict[FRight] = Value then

   begin

     Result := True;

     Exit;

   end;

   repeat

     if FDict[FCurrent] = Value then

     begin

       Result := True;

       Exit;

     end;

     if FDict[FCurrent] < Value then

       FLeft := FCurrent

     else

       FRight := FCurrent;

     FCurrent := (FRight + FLeft) div 2;

   until FLeft = FCurrent;

end;

end;

 

//

//  Загрузка массива индексов из потока

// =============================================================================

procedure TDictionaryFinder.LoadFromStream(const AStream: TMemoryStream);

var

S: TStringList;

I: Integer;

begin

S := TStringList.Create;

try

   AStream.Position := 0;

   S.LoadFromStream(AStream);

   FDictLength := S.Count;

   if FDictLength = 0 then Exit;

   SetLength(FDict, FDictLength);

   for I := 0 to FDictLength - 1 do

     FDict[I] := S.Strings[I];

finally

   S.Free;

end;

end;

 

end.

 

 

 

 

 

пример использования:

Code:

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, Dictionary;

 

type

TForm1 = class(TForm)

   Button1: TButton;

   ProgressBar1: TProgressBar;

   Button2: TButton;

   Edit1: TEdit;

   Label1: TLabel;

   CheckBox1: TCheckBox;

   procedure Button1Click(Sender: TObject);

   procedure Button2Click(Sender: TObject);

end;

 

var

Form1: TForm1;

 

implementation

 

uses ComObj;

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

var

SH: TDictionaryFounder;

S: TStringList;

M: TMemoryStream;

I: Integer;

Start: Cardinal;

begin

S := TStringList.Create;

try

   S.LoadFromFile('c:\1.txt');

   ProgressBar1.Position := 0;

   ProgressBar1.Max := S.Count;

   SH := TDictionaryFounder.Create;

   try

     Start := GetTickCount;

     for I := 0 to S.Count - 1 do

     begin

       SH.AddData(S.Strings[I]);

       ProgressBar1.Position := I;

     end;

     ShowMessage('Время составления словаря: ' + IntToStr(GetTickCount - Start));

     M := TMemoryStream.Create;

     try

       SH.SaveToStream(M);

       M.SaveToFile('c:\2.txt');

       ProgressBar1.Position := 0;

       Button2.Enabled := True;

     finally

       M.Free;

     end;

   finally

     SH.Free;

   end;

finally

   S.Free;

end;

end;

 

 

procedure TForm1.Button2Click(Sender: TObject);

var

S: TDictionaryFinder;

M: TMemoryStream;

begin

S := TDictionaryFinder.Create;

try

   M := TMemoryStream.Create;

   try

     M.LoadFromFile('c:\2.txt');       

     S.LoadFromStream(M);

     if S.Find(Edit1.Text, CheckBox1.Checked) then

       ShowMessage('Элемент найден')

     else

       ShowMessage('Элемент не найден');

   finally

     M.Free;

   end;

finally

   S.Free;

end;

end;

 

end.

 

 

 

Автор: Александр (Rouse_) Багель

©Drkb::04206

Взято из http://forum.sources.ru