-
Всем привет. Пробовал такой код. При строке длиной 5 символов '23651' и менее работает верно. То есть убирает дубликаты. Но стоит строке вырасти в длину на 1 символ и более. Перестаёт убирать дубли. то есть для строки '236513' будет число 480 и числа будут дублироваться. Вопрос как это исправить? Пробовал на всех последних версиях. Результат один и тот же. program Project1;
uses
Windows,KOL;
type
PForm1 = ^TForm1;
TForm1 = object(TObj)
Form,
ListBox1,
EditBox1,
Button1,
StrListCount:PControl;
public
procedure Button1Click(Sender: PObj);
procedure Button2Click(Sender: PObj);
end;
var
Form1: PForm1;
t:Cardinal;
procedure TForm1.Button2Click(Sender: PObj);
begin
ListBox1.Add('S')
end;
procedure TForm1.Button1Click(Sender: PObj);
var
m: byte;
sL: PStrList; L:integer; sLCount:integer;
function IndifStrnig(S0: string):boolean;
var Last,Next:string;
i:byte;
begin
result:=true ;
Last:='';
for I := 1 to m do begin
Next:=S0[i];
if Next<>Last then Last:=Next else result:=false;
end;
end;
procedure GenStr(S0, S1: string);
var
i: byte;
begin
if Length(S0) = m then begin
if IndifStrnig(S0) then sL.Add(S0); end
else
for i := 1 to Length(S1) do
GenStr(S0+S1[i], copy(S1,1,i-1) + copy(S1,i+1,Length(S1)));
end;
begin
sL := NewStrList; t:=Gettickcount;
try
m := Length(EditBox1.Text);
GenStr('',EditBox1.Text);
StrListCount.Caption := int2str(sL.Count)+' время = '+int2str(Gettickcount-t) ;
sLCount:=sL.Count-1;
for l := 0 to sLCount do ListBox1.Add(sL.Items[l]);
sL.SaveToFile('Data.txt');
finally
sL.Free;
end;
end;
procedure NewForm1(var Result: PForm1; AParent: PControl);
begin
New(Result, Create);
with Result^ do
begin
Form := NewForm(AParent, 'Project1');
Form.Add2AutoFree(Result);
Applet := Form;
Form.Font.FontName:='TimesNewRoman';
Form.Font.FontHeight:=-14;
Form.SetClientSize(340, 320).CenterOnParent; Result.ListBox1 := NewListBox( Result.Form, [loSort ] ).SetPosition( 128, 16 ).SetSize( 185, 193 );
Result.ListBox1.Color := TColor(clWindow);
Result.Button1 := NewButton( Result.Form, 'Button1' ).SetPosition( 8, 200 );
Result.Button1.OnClick := Button1Click;
Result.EditBox1 := NewEditBox( Result.Form, [ ] ).SetPosition( 8, 232 ).SetSize( 129, 17 );
Result.EditBox1.Text := '236513'; Result.EditBox1.Color := TColor(clWindow);
Result.StrListCount := NewLabel( Form, 'StrListCount' ).SetPosition( 8, 272 ).SetSize( 180, 17 );
end;
end;
begin
NewForm1(Form1, nil);
Run(Form1.Form);
end.
-
> То есть убирает дубликаты.и в какой строчке кода это должно происходить? если так: то причем KOL? ну и > При строке длиной 5 символов '23651' и менее работает верно.при строке '2332' получаю результат N=8 (2323, 2323, 3232, 3232, 3232, 3232, 2323, 2323) это верно?
-
Вот на VCL : для '2332' должно выходить так (2323,3232) где грабли? unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Count: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
data : array of integer; Step:integer;
implementation
procedure TForm1.Button1Click(Sender: TObject);
var
m: integer;
sL: TStringList;
function IndifStrnig(S0: string):boolean;
var Last,Next:string;
i:byte;
begin
result:=true ;
Last:='';
for I := 1 to m do begin
Next:=S0[i];
if Next<>Last then Last:=Next else result:=false;
end;
end;
procedure GenStr(S0, S1: string);
var
i: integer;
begin
if Length(S0) = m then begin
if IndifStrnig(S0) then sL.Add(S0)
end
else
for i := 1 to Length(S1) do begin
GenStr(S0+S1[i], copy(S1,1,i-1) + copy(S1,i+1,Length(S1)));
inc(Step); Application.ProcessMessages;Count.Caption:=intTostr(Step)
end;
end;
begin
sL := TStringList.Create;
try
sL.Sorted := True;
m := Length(Edit1.Text);
GenStr('',Edit1.Text);
ListBox1.Items.Text := sL.Text;
Label3.Caption:=intTostr(sL.Count-1);
finally
sL.Free;
end;
end;
end.
-
уточнение ListBox1.Items.Text := sL.Text;
Label3.Caption:=intTostr(sL.Count-1);
finally должен быть просто sL.Count
-
> где грабли? ты о чём? или думаешь, что в IndifStrnig "квантовая" память и она не пропустит дубли?
-
> > где грабли? > ты о чём? > или думаешь, что в IndifStrnig "квантовая" память и она > не пропустит дубли?
Знал бы, не стал спрашивать.) VCL пробывал? там нет повторений? да, есть. достаточно сделать так for I := 1 to m do begin
Next:=S0[i];
form1.Caption:='добавляем строчку '+S0;
sleep(100);
if Next<>Last then Last:=Next else result:=false;
end; Возьмём ту же последовательность '2332' и появится 2323,3232 и если сделать сохранение в файл ListBox1.Items.Text := sL.Text;
Label3.Caption:=intTostr(sL.Count);
sL.SaveToFile('Data.txt');
finally то там будет только эти строки. Так, то что нужно сделать чтобы повторов в 'KOL версии' тоже не было?
-
> достаточно сделать так
// VCL' begin sL := TStringList.Create; try sL.Sorted := True; // !
.... function TStringList.AddObject(const S: string; AObject: TObject): Integer; begin if not Sorted then // ! Result := FCount else if Find(S, Result) then // Добавь что-то такое себе в KOL, если нужно case Duplicates of dupIgnore: Exit; // dupIgnore = 0; // default ! dupError: Error(@SDuplicateString, 0); end; InsertItem(Result, S, AObject); end;
// KOL function TStrList.Add(const S: Ansistring): integer; begin Result := fCount; Insert( Result, S ); end;
-
to NoUser Спасибо натолкнул на идею. До этого не обращал внимания. 1 я понял почему небыло повторений для данных последовательностей Потому что в них небыло повторющихся цифр, а в последовательности 236513 появилась ещё одна 3ка. Что и дало дубли. Полученные результаты теста KOL (дубли не убираюся) и VCL (дубли подавляюся) как оказалось по умочанию так вводимая послед-сть| KOL | VCL 232 | 3 | 2 время = 0 | 1 время = 0 236 | 3 | 6 время = 0 | 6 время = 0 2365 | 4 | 24 время = 0 | 24 время = 0 23651 | 5 | 120 время = 0 | 120 время = 0 236513 | 6 | 480 время = 0 | 240 время = 15 2365132 | 7 | 2640 время = 0 | 660 время = 46 23651326 | 8 | 17760 время = 78 | 2220 время = 375 236513264 | 9 | 175680 время = 858 | 21960 время = 4212 2365132645 | 10 | 1543680 время = 10795 | 96480 время = 31075 23651326453 |11 | 11859840 время = 110823 | 247080 время = 284093 236513264532 |12 | Runtime error 203 at 00404BF | 755040 время = 2955346 что 2955346 миллисек (для длины 12ть) примерно равно 49.26 мин.
|