تولید رشته

[Mask]

با سلام.
در برنامه بروتی فورسی نیاز دارم که رشته تولید کنم و با مقدار اصلی مطابقت بدم.
چ الگوریتم و کدی رو برای تولید رشته حرفی تنها ، عددی تنها ، سیمبلها ، و جمع این کارکترها پیشنهاد میکنید.
ممنون.

[Felony]

میتونی از این ایده بگیری : http://www.swissdelphicenter.ch/torry/showcode.php?id=283

[Mask]

ممنون.
در این نمونه از تابع رندوم استفاده کرده . که یکمی جالب نیست. چون من میخام مدیریت تولید رشته با خودم باشه.
به طور مثال :
کاربر 2 حرف a b و با طول رشته 1 و 2 و 3 رو انتخاب میکنه
حالا باید کلماتی که با این حروف میشه ایجاد کنیم رو برنامه ایجاد کنه.
مثلا :
a
b
ab
ba
abb
aba
baa
bab
bba
aab

بیشتر دنبال روشی هستم که این کلمات رو تولید کنم.
ممنون از راهنماییتون.

[tdkhakpur]

کاربر 2 حرف a b و با طول رشته 1 و 2 و 3 رو انتخاب میکنه
به نظرم این شکلی مد نظر شما باشه.(البته کار شما یه مقدار کد بیشتری لازم داره اما زیربناش اینه.)
procedure TForm1.Button1Click(Sender: TObject);
var
alpha : array [1..2] of char;
rnd_arr : array [1..2] of integer;
i : integer;
Out_Text: string;
begin
Out_Text := '';
alpha[1]:='a';
alpha[2]:='b';
rnd_arr[1] := random(2)+1;
rnd_arr[2] := random(2)+1;
for i:=1 to 2 do
Out_Text := Out_Text + alpha[rnd_arr[i]];
showmessage(Out_Text);
end;

[Ananas]

سلام.

چون من میخام مدیریت تولید رشته با خودم باشه.
آرایه ای از کاراکتر ها که هر وقت خواستی طولش رو عوض کن و یا یک اشاره گر به اول رشته که به کاراکتر nil ختم بشه. چیزی غیر از این منظورتونه؟
مثال :

var
pwc, p : PWideChar;
count : Integer;
I: Integer;
s : string;
begin
count := 10;
pwc := AllocMem( SizeOf(WideChar) * (count + 1) );
p := pwc;
for I := 0 to count - 1 do
begin
p^ := WideChar( Word('A') + Random( Word('Z') - Word('A') ));
Inc(p);
end;
p^ := WideChar(nil);
ShowMessage(pwc);
// --------------
s := string(pwc);
pwc^ := '_';
ShowMessage(pwc);
ShowMessage(s);
end;

WideChar معادل Char هست که 2 بایت اندازشه و AnsiChar هم 1 بایته. خیلی راحت PWideChar رو به string و بر عکس می تونید تبدیل کنید.
یه مثال دیگه :

var
awc : array of WideChar;
count : Integer;
I: Integer;
baseStr, s : string;
begin
count := 32;
baseStr := 'ABC';
SetLength(awc, count + 1);
for I := 0 to count - 1 do
awc[I] := baseStr[ 1 + Random( Length(baseStr) ) ];
awc[count] := WideChar(0);
ShowMessage(PWideChar(@awc[0]));
// ---------- copy of string to array
s := 'WideChar string in Delphi';

SetLength(awc, Length(s) + 1);
CopyMemory( awc, @s[1], Length(s) * SizeOf(WideChar));

for I := 0 to High(awc) do
begin
if Word(awc[I]) >= Word('a') then
awc[I] := WideChar(Word(awc[I]) - 32);
end;
awc[ High(awc) ] := WideChar(0);

s := 'Set New String';
ShowMessage(s);
ShowMessage(PWideChar(@awc[0]));
// ---------- string pointer to array
Pointer(awc) := @s[1];
for I := 0 to High(awc) do
begin
if Word(awc[I]) >= Word('a') then
awc[I] := WideChar(Word(awc[I]) - 32);
end;
awc[ High(awc) ] := WideChar(0);

ShowMessage(PWideChar(@awc[0]));
end;

با این روش ها میتونی خیلی راحت با رشته ها و آرایه ها هرجور میخوای کار کنی.

[Mask]

ممنون دوست من.
از کد شما استفاده کردم. اما مشکلی که هست اینه که :
من در ثانیه فقط 800 هزارتا رشته بیشتر نمیتونم تولید کنم. در صورتی که حد اقل من باید تا 5 میلیون رشته رو بتونم در ثانیه تولید کنم.
آیا میشه این کد ها رو بهینه تر کرد تا بتوان رشته بیشتری تولید کرد؟
البته برنامه ای دارم که در ثانیه حدود 7 میلیون رشته تولید و تبدیل به md5 میکنه.
ممنون.

[Ananas]

آیا میشه این کد ها رو بهینه تر کرد تا بتوان رشته بیشتری تولید کرد؟
کدهای بنده فقط مثال بود که چطور حافظه گرفته بشه و اشاره گر به کاراکتر و رشته و آرایه به هم تبدیل بشن.
بهینه تر بودنش بستگی به کدی که نوشتید داره و من نمی دونم چی نوشتید فقط چند تا چیز به نظرم میرسه برای سرعت و استفاده از حافظه ی کمتر. اگه کاراکتر هایی که استفاده می کنید می تونن به شکل ansi استفاده بشن (تو 1 بایت جا بشن) به جای WideChar که 16 بیت هست از AnsiChar استفاده کنید که 8 بیت هست. به صرفه جویی در حافظه تا دو برابر کمک می کنه و قائدتا سرعت هم بیشتر میشه چون بلاک های کوچک تری رو می گیرید و می نویسید و می خونید و آزاد می کنید. نکته ی دیگه اینکه وقتی از operator + برای string استفاده می کنید سرعت خیلی میاد پایین مخصوصا تو حلقه و بهتره که به جای + بیاید از قبل اندازه ی حافظه ی لازم رو تعیین کنید و بگیرید و تو حلقه فقط داخل string بنویسید و طول string رو تا می تونید تغییر ندید چون ممکنه تغییر طول بیاد اون قسمت حافظه رو کلشو کپی کنه تو یه قسمت بزرگتر و string بعدی که می خواد جمع بشه پشت سرش کپی کنه. پس بهتره اینکار تو حلقه انجام نشه (حافظه گرفتن و کپی کردن و آزاد کردن).
البته تبدیل PWideChar به string هم کپی کردن لازم داره هر چند که بر عکسش لزوما کپی نمی خواد. مثلا تو کد زیر :

var
pwc : PWideChar;
s : string;
begin
s := 'abcdef';
ShowMessage('s is : "' + s + '"');
pwc := @s[1];
pwc^ := 'A';
ShowMessage(pwc);
ShowMessage(s);
// ------------------
// ------------------
// ------------------
s := pwc;
pwc^ := 'X';
ShowMessage(pwc);
ShowMessage(s);
end;

اول به string مقدار "abcdef" رو می دیم بعد pwc از جنس PWideChar رو مساوی آدرس ابتدای رشته قرار می دیم. حالا با تغییر دادن pwc به "Abcdef" ، مقدار string هم تغییر میکنه (دو تا ShowMessage تو مرحله ی اول) یعنی حافظه هاشون یکی هستن و مشترکه ولی تو مرحلهی دوم میایم string رو برابر PWideChar میگذاریم که از دو تا Message آخر معلوم میشه حافظه حا یکی نیستن پس موقع نسبت دادن یه حافظه ی جدید گرفته میشه. تو string های بزرگ و تو کار داخل حلقه می تونه سرعت رو خیلی بیاره پایین. به نظرم بهتره حین محاسبات کلا با همون اشاره گر کار کنید و فقط جاهای ضروری و در استفاده های نهایی، خیلی راحت اشاره گر رو به string تبدیل کنید.
یه کار دیگه هم که می تونید انجام بدید که الان به ذهنم رسید البته یکمی دردسر داره ولی چون می خواید یه کار خاص انجام بدید شاید لازم باشه، اینکه یک مجموعه از string هایی که همزمان دارید اشتفاده میکنید رو یکجا حافظه مشخص بگیرید بعد استفاده کنید. مثلا به جای 100 تا string که مثلا هر کدوم 6 تا کاراکتر داره بیاید یک حافظه ی 700 کاراکتری بگیرید و یا آرایه ای از آرایه ی 7 کاراکتری (یکی اضافه برای nil آخر رشته). بخاطر اینکه 100 دفعه نخواید حافظه ی کوچیک بگیرید و فقط یک بار حافظه ولی با سایز بزرگ بگیرید. نمی دونم اوضاع رو بهتر کنه یا بدتر ولی میشه امتحان کرد.

[SAASTN]

من با این کد توی 3635 میلی ثانیه 61،035،155 تا string گرفتم. البته تعداد کاراکترها از 1 تا MaxLength بالا میره و انتخابی نیست.
procedure GetStr(const Chars: AnsiString; const Input: PAnsiChar;
const InputLength, CharsLength, MaxLength: Integer; Results: TList);
var
Result: PAnsiChar;
I: Integer;
begin
if InputLength < MaxLength then
begin
for I := 1 to CharsLength do
begin
Result := GetMemory(InputLength + 2);
CopyMemory(Result, Input, InputLength);
PAnsiChar(Result + InputLength)^ := Chars[I];
PAnsiChar(Result + InputLength + 1)^ := #0;
Results.Add(Result);
GetStr(Chars, Result, InputLength + 1, CharsLength, MaxLength, Results);
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Results: TList;
I, Ticks: Integer;
begin
Results := TList.Create;
Ticks := GetTickCount;
GetStr(Edit1.Text, nil, 0, Length(Edit1.Text), 11, Results);
Ticks := GetTickCount - Ticks;
Caption := Format('Time: %d ms, Count: %d', [Ticks, Results.Count]);
// Memo1.Visible := False;
// for I := 0 to Results.Count - 1 do
// Memo1.Lines.Add(PAnsiChar(Results[I]));
// Memo1.Visible := True;
for I := 0 to Results.Count - 1 do
FreeMemory(Results[I]);
Results.Free;
end;

[Mask]

ممنون از 3 دوست بزرگوار.
دوست خوبم جناب SAASTN اگه ممکنه در مورد روند کار این برنامه یه توضیحی بدید. هر چی خوندم زیاد سر در نیاوردم.
و موضوع بعد. چرا وقتی 2 بار عملیات تولید رو انجام میدیم ، با پیغام out of memory مواجه میشیم؟

[Felony]

و موضوع بعد. چرا وقتی 2 بار عملیات تولید رو انجام میدیم ، با پیغام out of memory مواجه میشیم؟
برای اینکه تو کد شئ Results که از کلاس TList هست در آخر کار آزاد نشده :

var
Results: TList;
I, Ticks: Integer;
begin
Results := TList.Create;
Ticks := GetTickCount;
GetStr(Edit1.Text, nil, 0, Length(Edit1.Text), 11, Results);
Ticks := GetTickCount - Ticks;
Caption := Format('Time: %d ms, Count: %d', [Ticks, Results.Count]);
for I := 0 to Results.Count - 1 do
FreeMemory(Results[I]);
Results.Free;
end;

[SAASTN]

اگه ممکنه در مورد روند کار این برنامه یه توضیحی بدید.
این تابع بصورت بازگشتی تمام رشته های با طول های 1 تا MaxLength ممکن رو از ترکیب کاراکتر های لیست شده در Chars بر می گردونه. برای بالا بردن کارایی تابع بجای string یا ansistring از PAnsiChar استفاده شده و همینطور برای جلوگیری از فراخونی تابع Length طول رشته های ورودی در قالب پارامتر های InputLength, CharsLength برای تابع ارسال شده. توی بدنه تابع هم حافظه لازم برای رشته های جدید گرفته میشه، رشته ورودی در اون کپی میشه و کاراکتر جدید به انتهای اون اضافه میشه و چون PAnsiChar یه Null Terminating String به حساب میاد آخر رشته هم با #0 بسته میشه. در واقع اگر کاراکترهای ورودی 'ALI' باشن تابع رشته های A, L, I رو تولید میکنه و در خروجی قرار میده و خودش رو با همین رشته های تولید شده فراخونی می کنه و این کار تا جایی ادامه پیدا می کنه که طول رشته ها به MaxLength برسه.

چرا وقتی 2 بار عملیات تولید رو انجام میدیم ، با پیغام out of memory مواجه میشیم؟
به علت کم توجهی من و آزاد نکردن Results! کد رو اصلاح کردم. علت اینه که 60 میلیون پوینتر خودش بیشتر از 400 مگ رم میگیره. در کل این تابع مصرف حافظه بالایی داره و بهتره پردازش لازم روی رشته ها تو یه ترد دیگه انجام بشه و حافظه اشغالی توسط رشته ها آزاد بشه و آدرس شروع رشته هم از Results حذف بشه. اما باید توجه داشته باشید که ممکنه لازم بشه تغییراتی تو ترتیب تولید رشته ها بدید، چون ممکنه پردازش روی یه رشته تموم بشه ولی ما هنوز حق نداشته باشیم آزدش کنیم، چون ممکنه خود GetStr هنوز کارش باهاش تموم نشده باشه و به عنوان ورودی برای خودش بهش نیاز داشته باشه. در صورتی که این اتفاق بیافته برنامه AV میده.

[Mask]

ممنون از دوست عزیز
میشه بفرمایید آیا علت خاصی داره که MaxLength رو در این مثال بر روی 11 قرار دادید؟
و یه سوال دیگه اینکه : چرا وقتی رشته های تولید شده رو با مقدار اولیه مقایسه میکنم ، اینقدر افت زمانی پیش میاد؟
برای این قضیه راه حلی در نظر دارید؟

[SAASTN]

میشه بفرمایید آیا علت خاصی داره که MaxLength رو در این مثال بر روی 11 قرار دادید؟
کاراکترهای ورودی من 'Edit1' بودند! و رو سیستم من با پنج تا کاراکتر باید تا طول 11 میرفتم که زمان کل بیشتر از یک ثانیه بشه. شما هر مقداری که لازم می دونی می تونی ارسال کنی.

و یه سوال دیگه اینکه : چرا وقتی رشته های تولید شده رو با مقدار اولیه مقایسه میکنم ، اینقدر افت زمانی پیش میاد؟
من نمی دونم که چجوری و کجا مقایسه رو انجام دادید ولی کلا مقایسه رشته ها عمل سنگینیه چون کاراکتر ها تک به تک باید مقایسه بشن. هرچی بتونی تعداد این مقایسه ها رو کم کنی بهتره.

برای این قضیه راه حلی در نظر دارید؟
باید سعی بشه تو این مقایسه ها و حتی استفاده از رشته ها تبدیل نوع بین انواع رشته ای اتفاق نیافته و همه جا با همون PAnsiChar کار بشه. مثلا من اول برای لیست خروجی بجای TList از TStringList استفاده کرده بودم که باعث می شد زمان کلی چندین برابر بیشتر بشه، علتش هم این بود که وقتی میخواستم جواب جدید رو به لیست اضافه کنم اول یه تبدیل نوع از PAnsiChar به string انجام میشد و بعد مقدار از نوع string به لیست اضافه میشد، البته این چیزیه که من حدس میزنم، چون تصور نمی کنم پیاده سازی TList با TStringList زیاد تفاوت داشته باشه و میزان داده ای هم که تو هر Add کپی میشد بطور متوسط کمتر از 4 بایت (سایز پوینتر) بود. شما خودت می تونی توی همون کد همه TList ها رو به TStringList تبدیل کنی تا میزان افت سرعت رو حتی با MaxLength های کمتر از 4 ببینی.

[Felony]

برای مقایسه رشته ها از تابع SameStr از کتابخانه SysUtils استفاده کنید .

[Veyskarami]

من با این کد توی 3635 میلی ثانیه 61،035،155 تا string گرفتم. البته تعداد کاراکترها از 1 تا MaxLength بالا میره و انتخابی نیست.
procedure GetStr(const Chars: AnsiString; const Input: PAnsiChar;
const InputLength, CharsLength, MaxLength: Integer; Results: TList);
var
Result: PAnsiChar;
I: Integer;
begin
if InputLength < MaxLength then
begin
for I := 1 to CharsLength do
begin
Result := GetMemory(InputLength + 2);
CopyMemory(Result, Input, InputLength);
PAnsiChar(Result + InputLength)^ := Chars[I];
PAnsiChar(Result + InputLength + 1)^ := #0;
Results.Add(Result);
GetStr(Chars, Result, InputLength + 1, CharsLength, MaxLength, Results);
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Results: TList;
I, Ticks: Integer;
begin
Results := TList.Create;
Ticks := GetTickCount;
GetStr(Edit1.Text, nil, 0, Length(Edit1.Text), 11, Results);
Ticks := GetTickCount - Ticks;
Caption := Format('Time: %d ms, Count: %d', [Ticks, Results.Count]);
// Memo1.Visible := False;
// for I := 0 to Results.Count - 1 do
// Memo1.Lines.Add(PAnsiChar(Results[I]));
// Memo1.Visible := True;
for I := 0 to Results.Count - 1 do
FreeMemory(Results[I]);
Results.Free;
end;


سلام
سرعت کد بالا بد نیست ولی روش کار اصلا استاندارد نیست
مثلا برای ورودی abcd به شکل زیر عمل میکنه
a
aa
aaa
aaaa
aaab
...
که این یه حالت غیر استاندارده و برای کرک فوق العاده ضعیف عمل میکنه.
در صورتی که کد باید به صورت تصاعد طول رشته به سمت بالا حرکت کنه نه چیدن حروف مشابه با طول های غیر یکسان
مثلا به شکل زیر باید عمل کنه:
a
b
c
d
aa
...

دوستان اگه کد استاندارد بهتری دارن که بتونه مثل بالا عمل کنه حتما بذارن تا بیشتر استفاده کنیم
با سپاس

[SAASTN]

مثلا به شکل زیر باید عمل کنه:
یه راهش اینه:
procedure GetStr2(const Chars: AnsiString; const Input: PAnsiChar;
const InputLength, CharsLength, ExactLength: Integer; Results: TList);
var
Result: PAnsiChar;
I: Integer;
begin
if InputLength < ExactLength - 1 then
begin
for I := 1 to CharsLength do
begin
Result := GetMemory(InputLength + 2);
CopyMemory(Result, Input, InputLength);
PAnsiChar(Result + InputLength)^ := Chars[I];
PAnsiChar(Result + InputLength + 1)^ := #0;
GetStr2(Chars, Result, InputLength + 1, CharsLength, ExactLength, Results);
FreeMemory(Result);
end;
end
else
begin
for I := 1 to CharsLength do
begin
Result := GetMemory(InputLength + 2);
CopyMemory(Result, Input, InputLength);
PAnsiChar(Result + InputLength)^ := Chars[I];
PAnsiChar(Result + InputLength + 1)^ := #0;
Results.Add(Result);
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Results, Results2: TList;
I, Ticks, Ticks2: Integer;
begin
Results := TList.Create;
Ticks := GetTickCount;
GetStr(Edit1.Text, nil, 0, Length(Edit1.Text), 11, Results);
Ticks := GetTickCount - Ticks;
// Memo1.Visible := False;
// for I := 0 to Results.Count - 1 do
// Memo1.Lines.Add(PAnsiChar(Results[I]));
// Memo1.Visible := True;
Caption := Format('Time1: %d ms, Count1: %d', [Ticks, Results.Count]);
for I := 0 to Results.Count - 1 do
FreeMemory(Results[I]);
Results.Free;

Results2 := TList.Create;
Ticks2 := GetTickCount;
for I := 1 to 11 do
GetStr2(Edit1.Text, nil, 0, Length(Edit1.Text), I, Results2);
Ticks2 := GetTickCount - Ticks2;
// Memo2.Visible := False;
// for I := 0 to Results2.Count - 1 do
// Memo2.Lines.Add(PAnsiChar(Results2[I]));
// Memo2.Visible := True;
Caption := Caption + Format('; Time2: %d ms, Count2: %d', [Ticks2, Results2.Count]);
for I := 0 to Results2.Count - 1 do
FreeMemory(Results2[I]);
Results2.Free;
end;

اما روش این تابع خیلی برای کار شما مناسب نیست. چون GetStr2 هربار که از Button1Click فراخونی میشه کار رو از رشته خالی شروع میکنه، در واقع اون محاسباتی که برای طول 2 انجام شده کلا برای طول 3 هم انجام میشه و این مسئله توی طولای بالاتر مشکل ساز میشه. حالا یکم روش فکر کنید با یکی دوتا While میشه کاری کرد که محتویات خود Results توی طولهای پائین تر رو برای GetStr2 یا حتی GetStr برای تولید طولهای بالاتر ارسال کرد. من دیگه حس دیباگشو نداشتم بیخیال شدم.:لبخند:
اما نکته جالب اینه که با تمام این تفاسیر روی سیستم من زمان کلی برای همون طول 11 در حدود نیم ثانیه افزایش پیدا کرد! که این نشون میده عمده زمان این تابع داره تو TList.Add صرف میشه!! و در مقابل اعمال حافظه ای چقدر سریعتر انجام میشه. پس شاید بتونید برای برگردوندن لیست خروجی هم یه روش سریعتر ابداع کنید.

[Veyskarami]

این یکی دیگه خیلی نوبر بود دهن مموری آسفالت شد :D
باید یه فکری واسه مموری بکنیم