Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник |
Коллекция курьезных вопросов из форумов
KOL и MCK |
KOL и MCK - Компактные программы на Delphi
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

Дубликаты в PStrList [Delphi, Windows]


RusSun ©   (05.05.16 21:12

Всем привет.
Пробовал такой код.
При строке длиной 5 символов '23651' и менее работает верно. То есть убирает дубликаты.
Но стоит строке вырасти в длину на 1 символ и более.
Перестаёт убирать дубли.
то есть для строки '236513' будет число 480 и числа будут дублироваться.
Вопрос как это исправить? Пробовал на всех последних версиях. Результат один и тот же.
program Project1;

uses
Windows,KOL;
 {$R *.res}
type
PForm1 = ^TForm1;
TForm1 = object(TObj)
  Form,
  ListBox1,
  EditBox1,
  Button1,
  StrListCount:PControl;
  //Button2:

public
 // procedure Timer1Timer(Sender: PObj);
 procedure Button1Click(Sender: PObj);
 procedure Button2Click(Sender: PObj);
end;

var
Form1: PForm1;
 t:Cardinal;

// : PStrList; Spisok:= NewStrList;

procedure TForm1.Button2Click(Sender: PObj);
begin
 ListBox1.Add('S')
end;

procedure TForm1.Button1Click(Sender: PObj);
var
 m: byte;
 sL: PStrList; //TStringList;
 L:integer;//cardinal;
 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];
                 //showmessage(Next+ ' <> '+ Last +' Last '+ Last );
                 if Next<>Last then Last:=Next else result:=false;
                   end;
//if Last=S0[m] then  else result:=false;

end;
procedure GenStr(S0, S1: string);
var
 i: byte;
begin
 if Length(S0) = m then begin
 if IndifStrnig(S0) then  sL.Add(S0); // msgok('добавляем строчку '+S0) end
                         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; //TStringList.Create;
 t:=Gettickcount;
 try
   //sL.Sort(false);
   //sL.Sort(true);
   //sL.Items[] //Duplicates := dupIgnore;
   m := Length(EditBox1.Text);
   GenStr('',EditBox1.Text);
   //ListBox1.text:= sL.Text; // .Items.Text

   StrListCount.Caption := int2str(sL.Count)+' время = '+int2str(Gettickcount-t) ;
   sLCount:=sL.Count-1;
   //for l := 0 to sLCount do ListBox1.Add(int2str(l)+' ) '+sL.Items[l]);//нужно было для просмотра
    for l := 0 to sLCount do ListBox1.Add(sL.Items[l]);//нужно было для просмотра
  // ListBox1.Text := sL.Text;

   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;   //loSort ,loNoIntegralHeight
   Result.ListBox1 := NewListBox( Result.Form, [loSort ] ).SetPosition( 128, 16 ).SetSize( 185, 193 );
   Result.ListBox1.Color := TColor(clWindow);
   //ListBox1.Add('Значения ');
   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';//236513264532
   Result.EditBox1.Color := TColor(clWindow);
   Result.StrListCount := NewLabel( Form, 'StrListCount' ).SetPosition( 8, 272 ).SetSize( 180, 17 );
   //.PlaceUnder.AutoSize(true);
   //SetSize(120, 13 );
  // Result.Button2 := NewButton( Result.Form, 'Button2' ).PlaceUnder.AutoSize(true);
  //Result.Button2.OnClick := Button2Click
end;
end;

begin
NewForm1(Form1, nil);
Run(Form1.Form);
end.


NoUser ©   (07.05.16 00:08[1]

> То есть убирает дубликаты.
и в какой строчке кода это должно происходить?
если так:
 //sL.Items[] //Duplicates := dupIgnore;
то причем KOL?

ну и
> При строке длиной 5 символов '23651' и менее работает верно.
при строке '2332' получаю результат N=8
(2323, 2323, 3232, 3232, 3232, 3232, 2323, 2323) это верно?


RusSun ©   (07.05.16 09:48[2]

Вот на 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
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 data : array of integer; // Тут будут храниться данные
 Step:integer;
implementation

{$R *.dfm}

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];
                //showmessage(Next+ ' <> '+ Last +' Last '+ Last );
                if Next<>Last then Last:=Next else result:=false;
                  end;
//if Last=S0[m] then  else result:=false;

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;
   //sL.Duplicates := dupIgnore;
   m := Length(Edit1.Text);
   GenStr('',Edit1.Text);
   ListBox1.Items.Text := sL.Text;
   Label3.Caption:=intTostr(sL.Count-1);
 finally
   sL.Free;
 end;
end;
end.


RusSun ©   (07.05.16 12:27[3]

уточнение
 ListBox1.Items.Text := sL.Text;
  Label3.Caption:=intTostr(sL.Count-1);
finally

должен быть просто sL.Count


NoUser ©   (07.05.16 21:49[4]

> где грабли?
ты о чём?
или думаешь, что в IndifStrnig "квантовая" память и она не пропустит дубли?


RusSun ©   (07.05.16 23:21[5]


> > где грабли?
> ты о чём?
> или думаешь, что в IndifStrnig "квантовая" память и она
> не пропустит дубли?


Знал бы, не стал спрашивать.)
VCL пробывал? там нет повторений?
да, есть.
достаточно сделать так
for I := 1 to m do begin
                Next:=S0[i];
                //showmessage(Next+ ' <> '+ Last +' Last '+ Last );
                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 версии' тоже не было?


NoUser ©   (08.05.16 19:13[6]

> достаточно сделать так

// 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;


RusSun ©   (09.05.16 20:54[7]

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 мин.


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо