delphi4arab منتديات دلفي للعرب
Anagram - نسخة قابلة للطباعة

+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : سؤال و جواب حول دلفي (https://delphi4arab.net/forum/forumdisplay.php?fid=15)
+--- الموضوع : Anagram (/showthread.php?tid=1613)

الصفحات: 1 2 3

Anagram - TF6M - 05-02-2010

أولا نستعمل [COLOR="Red"]BlockRead أسرع من Read
و كل ما كانت سعة خطوة القراءة كبير كل ما كانت القراءة أسرع مثال :[/COLOR]

PHP كود :
Function IsMyWordHere(MyWord:String):Boolean;
Var
 MyFile: File Of Int64;
 Temp: String;
 NbR: Dword;

Begin
Result:= False;

{$I-}
AssignFile(MyFile,'MyList.txt');
ReSet(MyFile);
Seek(MyFile,0);

If IoResult <> 0 Then
  Begin
  CloseFile(MyFile);
  Exit;
  End;

While Not EoF(MyFile) Do
 Begin
 SetLength(Temp,FileSize(MyFile));
 BlockRead(MyFile,Temp[1],FileSize(MyFile),NbR);
 If (IoResult <> 0) Or (NbR <> FileSize(MyFile)) Then
  Begin
  CloseFile(MyFile);
  Exit;
  End;
  If AnsiPos (MyWord,Temp) <> 0 Then
   Result:= True Else
    Result:= False;
 End;
CloseFile(MyFile);
{$I+}
End; 

الأن كيف نجلب أقرب كلمة مشابهة للتي في القاموس :

PHP كود :
Function GetRndWord (BadWord:String):String;
Var
 _Index,i: Word;
 MyFile : TextFile;
 Temp : String;
 MyListArr: Array [0..100] Of String;

begin

Result:= '';i:= 0;

If IsMyWordHere(BadWord) Then
 Begin
 MessageBox(0,'Word Exsist !',Nil,0);
 Exit;
 End;

AssignFile(MyFile,'MyList.txt');
Reset(MyFile);
While Not Eof(MyFile) do
  begin
  Readln(MyFile,Temp);
  MyListArr[i]:= Temp;
  Inc(i);
  End;
CloseFile(MyFile);

i:= 0;_Index := 1;
While (_Index <= Length(BadWord)) And (i <= 100)Do
 Begin
 If Pos(BadWord[_Index],MyListArr[i]) <= 0 Then
  Inc(i) Else Inc(_Index);
 If Length(BadWord) = Length(MyListArr[i]) Then
  Result:= MyListArr[i] Else
   Result:= '';
 End;
End; 

كما تلاحظ ... [COLOR="Red"]يبقى فقط تبديل الكلمة المشابهة بالمعطوبة دون إستخدام Random و عليه
ستكون النتيجة أسرع و أضمن !!! .

لكن :

ماذا لو كانت عندنا أكثر من كلمة مشابهة ؟؟ أيضا لا تنسى تأثير MinChar / MaxChar .[/COLOR]

Anagram - Goblin - 06-02-2010

[COLOR="RoyalBlue"]- استاذ TF6M, المثال غير مكتمل, و لا استطيع معرفة كيف يعمل, بعض التوضيح.

- قمت ببعض التعديلات منها:
* تحميل القاموس عند بدأ البرنامج و تجنب تكرار فتحة.
* تعديل علي RandomRange, اضافة +1 حتي يصل لاخر حرف فى الكلمة (لا اعرف كيف كنت بهذا الغباء !).[/COLOR]

PHP كود :
Procedure LoadDictornary(DictornaryPath : String);
var F : TextFile;
i : Integer;
begin
i := 0;
AssignFile(F,DictornaryPath);
Reset(F);
While Not EOF(F) do
begin
Readln(F,DictornaryArray[i]);
Inc(i);
end;
CloseFile(F);
end;

procedure TForm1.Button1Click(Sender: TObject);
var FRand, MRand, RandedWord : String;
RandIndex : Integer;
Counter : Integer;
begin
Counter := 0;
FRand := Edit1.Text;
RandedWord := FRand;
While (AnsiIndexText(RandedWord,DictornaryArray) = -1) do
begin
MRand := FRand;
RandedWord := '';
Repeat
Application.ProcessMessages;
Randomize;
RandIndex := RandomRange(1,Length(MRand) + 1);
RandedWord := RandedWord + MRand[RandIndex];
Delete(MRand,RandIndex,1);
Until MRand = '';
Counter := Counter + 1;
end;
Edit2.Text := RandedWord + ' | ' + IntToStr(Counter);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
LoadDictornary('wordlist.txt');
MessageBox(Form1.Handle,'Dictonary Loaded.','Info',64);
end; 

- لكن مازال البرنامج يعمل علي طريقة الRandom الهمجية ! هل من افكار اخري ؟

Anagram - TF6M - 06-02-2010

Goblin كتب :

- قمت ببعض التعديلات منها:
* تحميل القاموس عند بدأ البرنامج و تجنب تكرار فتحة.
- لكن مازال البرنامج يعمل علي طريقة الRandom الهمجية ! هل من افكار اخري ؟

قلت مثلا لو نستغني على Random و نستعمل دالة تأتي بأقرب كلمة مشابه
و تقوم بتعويضها فقط ! .
- المشكلة المتبقية كما قلت ماذا لو كانت الكلمات المشابهة في الملف كثيرة مثلا :
golnib , lnbiog .... و الكلمة التي نريد تصحيحها وفق اللائحة gobiln هنا سيقع لبس.
- بالإظافة إلى حالة الحروف كبيرة أم صغيرة ؟؟ .

Anagram - Goblin - 06-02-2010

TF6M كتب :
قلت مثلا لو نستغني على Random و نستعمل دالة تأتي بأقرب كلمة مشابه
و تقوم بتعويضها فقط ! .
تعويضها سيكون بخورزمية منظمة, لكن لا استطيع تخطيطها بشكل جيد.

TF6M كتب :- المشكلة المتبقية كما قلت ماذا لو كانت الكلمات المشابهة في الملف كثيرة
مثلا :
golnib , lnbiog .... و الكلمة التي نريد تصحيحها وفق اللائحة gobiln هنا سيقع لبس.
- بالإظافة إلى حالة الحروف كبيرة أم صغيرة ؟؟ .
لا يهم, يمكننا ان ندخل جميع المدخلات (القاموس و الكلمة الغير مرتبة) فى حالة "LowerCase", هذه ليست المشكلة الان, دعك من ذلك.

Anagram - Goblin - 15-02-2010

الحمد لله, انتهيت من نسخة اولية للبرنامج, لكنها تحتاج للتحسين:

PHP كود :
var
  Form1: TForm1;
  DictionaryArray : array[0..2000] of string;

Const Numbrs : string = '123456789';

implementation

{$R *.dfm}

Function GenerateSequence(CPoint : String; L : Integer): String;
var Increaser : array[1..8] of Integer;
i : Integer;
AnagramSequence : String;
begin
FillChar(Increaser,SizeOf(Increaser),0);
For i := 1 to Length(CPoint) do
Increaser[9 - i] := StrToInt(CPoint[L + 1 - i]);

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

If Increaser[8] <= L Then
Increaser[8] := Increaser[8] + 1;

If Increaser[8] > L Then
begin
Increaser[8] := 1;
Increaser[7] := Increaser[7] + 1;
end;

If (Increaser[7] > L - 1) and (L > 3) Then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := Increaser[6] + 1;
end;

If (Increaser[6] > L - 2) and (L > 4) Then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := Increaser[5] + 1;
end;

If (Increaser[5] > L - 3) and (L > 5) Then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := 1;
Increaser[4] := Increaser[4] + 1;
end;

If (Increaser[4] > L - 4) and (L > 6) Then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := 1;
Increaser[4] := 1;
Increaser[3] := Increaser[3] + 1;
end;

If (Increaser[3] > L - 5) and (L > 7) Then
begin
Increaser[8] := 1;
Increaser[7] := 1;
Increaser[6] := 1;
Increaser[5] := 1;
Increaser[4] := 1;
Increaser[3] := 1;
Increaser[2] := Increaser[2] + 1;
end;

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

AnagramSequence := IntToStr(Increaser[1]) + IntToStr(Increaser[2]) + IntToStr(Increaser[3]) + IntToStr(Increaser[4]) + IntToStr(Increaser[5]) + IntToStr(Increaser[6]) + IntToStr(Increaser[7]) + IntToStr(Increaser[8]);
Result := AnsiReplaceStr(AnagramSequence,'0','')
end;

procedure LoadDictionary(DictionaryPath : String);
var F : TextFile;
i : Integer;
begin
i := 0;
AssignFile(F,DictionaryPath);
Reset(F);
While Not Eof(F)do
begin
Readln(F,DictionaryArray[i]);
Inc(i);
end;
CloseFile(F);
end;

function CheckInDictionary(RandedWord : String): Boolean;
begin
If (AnsiIndexText(RandedWord,DictionaryArray) = -1) then
Result := False
else
Result := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
LoadDictionary('wordlist.txt');
Label1.Caption := 'Dictionary: Loaded.';
Label1.Font.Color := ClGreen;
end;

procedure TForm1.Button1Click(Sender: TObject);
var FRand, MRand, RandedWord, AnagramSequence : String;
RandedIndex, i : Integer;
begin
FRand := Edit1.Text;
MRand := FRand;
RandedWord := MRand;
AnagramSequence := StringOfChar('1',Length(FRand));
While CheckInDictionary(RandedWord) = False do
begin
MRand := FRand;
RandedWord := '';

AnagramSequence := GenerateSequence(AnagramSequence, Length(FRand));

For i := Length(AnagramSequence) downto 1 do
begin
Application.ProcessMessages;
RandedIndex := StrToInt(AnagramSequence[i]);
RandedWord := RandedWord + MRand[RandedIndex];
Delete(MRand,RandedIndex,1);
end;

end;
Edit2.Text := RandedWord;
end; 


Anagram - Goblin - 22-02-2010

[COLOR="RoyalBlue"]النسخة السابقة كانت بطيئه لانها كنت تعتميد علي مبدأ "Brute Forcing".

هذه النسخة فكرتها بسيطة:
- يقوم البرنامج بتحميل ملف القاموس فى مصفوفة (Dictionary Array).
- يقوم بترتيب كل كلمة فى مصفوفة القاموس ترتيبا ابجديا فى مصفوفة اخري,
مثال: لو ان كلمة (efab) موجودة فى مصفوفة القاموس, ستكون (abef) فى المصفوفة المُرتبة.
- عندما يدخل المستخدم كلمة غير مرتبة للبحث عن ترتيبها الصحيح, يقوم البرنامج بترتيب الكلمة المدخلة ترتيبا ابجديا.
- بذلك ستجد أن, مهما اختلف ترتيب الكلمة, سيقوم البرنامج بتريبها ترتيب معين (الترتيب الابجدي).
[/COLOR]
PHP كود :
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  DictionaryArray, SortedArray : array[0..2000] of string;

implementation

{$R *.dfm}

Function SortWordAlphabetically(Word : String): String;
Const LowAlphabets : string = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
var SortedWord : String;
i,j : Integer;
begin
for i := 1 to Length(LowAlphabets) do begin
for j := 1 to Length(Word) do begin
If LowAlphabets[i] = Word[j] then begin
SortedWord := SortedWord + LowAlphabets[i];
Break;
end;
end;
If Length(SortedWord) = Length(Word) then
Break;
end;
Result := SortedWord;
end;

procedure LoadDictionary(Path : String);
var F : TextFile;
i : Integer;
begin
i := 0;
AssignFile(F,Path);
Reset(F);
While Not Eof(F) do begin
Readln(F,DictionaryArray[i]);
Inc(i);
end;
CloseFile(F);
For i := 0 to Length(DictionaryArray) - 1 do
SortedArray[i] := SortWordAlphabetically(DictionaryArray[i]);
Form1.Label1.Caption := 'Dictonary loaded.';
Form1.Label1.Font.Color := clGreen;
end;

procedure TForm1.Button1Click(Sender: TObject);
var RandedWord : String;
i : Integer;
begin
RandedWord := SortWordAlphabetically(Edit1.Text);

For i := 1 to Length(SortedArray) - 1 do
If Pos(RandedWord,SortedArray[i]) <> 0 then
Edit2.Text := DictionaryArray[i];
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
LoadDictionary('wordlist.txt');
end;

end. 

- اذا كان لديكم افكار اخري للبرنامج (ترتيب الاحرف لاستخلاص كلمات) او خورزميات للترتيب (Sorting Algorithms), فشاركوني بها, و ساكون شاكر لكم.

Anagram - AL-MOB4RM3G - 22-02-2010

إقتباس :- عندما يدخل المستخدم كلمة غير مرتبة للبحث عن ترتيبها الصحيح, يقوم البرنامج بترتيب الكلمة المدخلة ترتيبا ابجديا.
- بذلك ستجد أن, مهما اختلف ترتيب الكلمة, سيقوم البرنامج بتريبها ترتيب معين (الترتيب الابجدي).
جميل اخ جوبلين, اعجبني حلّك, Smile
هل انت من توصلت لهذا الحلّ؟ ام اخذته من فكرة شخص آخر ؟

بالتوفيق اخي,

Anagram - mohfa - 22-02-2010

اغلب القواميس ان لم نقل كلها تعتمد على B-Trees وخاصة ال Balanced Trees :

* سرعة البحث
* سرعة ال Sorting
* سرعة ال Loading .
.
.

او استعمل ال Hash Tables ....

والسلام عليكم

Anagram - Goblin - 23-02-2010

AL-MOB4RM3G كتب :جميل اخ جوبلين, اعجبني حلّك, Smile
يسعدني انه اعجبك.

mohfa كتب :اغلب القواميس ان لم نقل كلها تعتمد على B-Trees وخاصة ال Balanced Trees :
اعذرني, ليس لدي فكرة عن B-Trees. هل هي نفس "Trie" ? **** التوضيح.

mohfa كتب :او استعمل ال Hash Tables ....
لقد وجد مقال كتبه الاستاذ Wajdy Essam يتحدث عن الHash Tables, ساحول توظيف فكرته فى البرنامج .

Anagram - mohfa - 23-02-2010

[url=http://en.wikipedia.org/wiki/B-tree][/url]اقراء هذا :

http://en.wikipedia.org/wiki/B-tree