Dizideki aynı elemanları bulma

[JavaCiva]

Merhaba

Delphi ile bir dizideki elemanlardan kaçar tane olduğunu en hızlı nasıl sayabilirim

Diyelim ki
Dizimiz

1
1
2
3
3
3
4
4

gibi olsun

Yapmak istediğim şey
1 den 2 adet
2 den 1 adet
3 den 3 adet
4 den 2 adet
gibi yazmak
iç içe 2 for döngüsü ile yaptığım zaman çok yavaş oluyor.
Daha hızlı bir yöntem var mıdır?

[kirve]

bu isi en hızlı selection sort algoritması ile yapabilirsin bence.
diğer algoritma türleri istediğin sonucu vermeyebilir.

[JavaCiva]

Sıralamada sorunum yok.
Sorunum saydırmada

[kimimben]

Merhaba

Test edip sonucu paylaşabilir misiniz ?

Kod: Tümünü seç

unit Unit2;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls,

  Generics.Collections,
  Generics.Defaults,
  System.Diagnostics;

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure Hesapla(Elements: array of Integer);
var
  Dictionary: TDictionary<Integer, Integer>;
  Element: Integer;
  outValue: Integer;
begin
  Dictionary := TDictionary<Integer, Integer>.Create();
  for Element in Elements do
  begin
    if not Dictionary.ContainsKey(Element) then
      Dictionary.Add(Element, 1)
    else
    begin
      Dictionary.TryGetValue(Element, outValue);
      Inc(outValue);
      Dictionary.Items[Element] := outValue;
    end;
  end;

  for Element in Dictionary.Keys do
    Form2.Memo1.Lines.Add(IntToStr(Element) + ' den ' + IntToStr(Dictionary.Items[Element]) + ' adet');

  Dictionary.Free;
end;

procedure TForm2.FormCreate(Sender: TObject);
var
  Stopwatch: TStopwatch;
begin
  Stopwatch := TStopwatch.StartNew;
  Hesapla([1, 1, 2, 3, 3, 3, 4, 4]);
  Caption := Stopwatch.ElapsedMilliseconds.ToString();
end;

end.

[SimaWB]

Daha önce kullandığım için tavsiye ederim: GpLists.
Tek bit unit ve içinde TList'ten türemiş birçok sınıf var.
Sizin işinize yarayacak olan sınıf TGpCountedIntegerList.

Bu unit'i kullanarak istediğinizi yapabileceğiniz ve kimimbenin paylaştığı kod ile karşılaştırabileceğiniz örnek:

Kod: Tümünü seç

procedure GpListleHesapla(Elements: array of integer);
var
  IntList: TGpCountedIntegerList;
  Element: Integer;
begin
  IntList := TGpCountedIntegerList.Create;
  for Element in Elements do
  begin
    if IntList.IndexOf(Element) = -1 then
      IntList.Add(Element, 1)
    else
      IntList.ItemCounter[Element] := IntList.ItemCounter[Element] + 1;
  end;

  for Element in IntList do
    Form1.Memo1.Lines.Add(IntToStr(Element) + ' den ' + IntToStr(IntList.ItemCounter[Element]) + ' adet');
end;

[SimaWB]

Ayrıca; gerçekten milisaniyeler (belki de nanosaniyeler ) sizin için önemliyse döngülerde enumarator kullanmak biraz daha yavaş olur gibi.
Yani

Kod: Tümünü seç

for Element in Elements do

yerine

Kod: Tümünü seç

for i := 0 to ArrayUzunlugu do

daha hızlı olur tahminim.

[kimimben]

SimaWB Bey HesaplaV2'yi yazdım.

Before


After

Kod: Tümünü seç

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Generics.Collections,
  Generics.Defaults,
  System.Diagnostics, GpLists, SpinLock;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  Stopwatch: TStopwatch;

  PKeys, PValues: TList<Integer>;
  Data: array of Integer;
  I: Integer;

implementation

{$R *.dfm}

procedure L(Line: string);
begin
  Form2.Memo1.Lines.Add(Line);
end;

procedure Hesapla(var Elements: array of Integer);
var
  Dictionary: TDictionary<Integer, Integer>;
  Element: Integer;
  outValue: Integer;
begin
  Dictionary := TDictionary<Integer, Integer>.Create();
  for Element in Elements do
  begin
    if not Dictionary.ContainsKey(Element) then
      Dictionary.Add(Element, 1)
    else
    begin
      Dictionary.TryGetValue(Element, outValue);
      Inc(outValue);
      Dictionary.Items[Element] := outValue;
    end;
  end;

  for Element in Dictionary.Keys do
    L(IntToStr(Element) + ' den ' + IntToStr(Dictionary.Items[Element])
      + ' adet');

  Dictionary.Free;
end;

procedure HesaplaV2(var Elements: array of Integer);
var
  Element: Integer;
  Index: Integer;
  I: Integer;
begin
  PKeys := TList<Integer>.Create;
  PValues := TList<Integer>.Create;

  for Element in Elements do
  begin
    Index := PKeys.IndexOf(Element);
    if Index = -1 then
    begin
      PKeys.Add(Element);
      PValues.Add(1);
    end
    else
      PValues.Items[Index] := PValues.Items[Index] + 1;
  end;

  for I := 0 to PKeys.Count - 1 do
    L(IntToStr(PKeys.Items[I]) + ' den ' + IntToStr(PValues.Items[I]) +
      ' adet');
end;

procedure GpListleHesapla(var Elements: array of Integer);
var
  IntList: TGpCountedIntegerList;
  Element: Integer;
begin
  IntList := TGpCountedIntegerList.Create;
  for Element in Elements do
  begin
    if IntList.IndexOf(Element) = -1 then
      IntList.Add(Element, 1)
    else
      IntList.ItemCounter[Element] := IntList.ItemCounter[Element] + 1;
  end;

  for Element in IntList do
    L(IntToStr(Element) + ' den ' + IntToStr(IntList.ItemCounter[Element])
      + ' adet');
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  Hesapla(Data);
  Button1.Caption :=  IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  GpListleHesapla(Data);
  Button2.Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  HesaplaV2(Data);
  Button3.Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  SetLength(Data, 100000000);
  for I := Low(Data) to High(Data) do
    Data[I] := Random(5);
end;


end.

Test.zip

Test Projesi

(111.43 KiB) 129 kere indirildi

[ertank]

Merhaba,

Şahsen bu tür işlemler için memory table kullanıyorum. kbmMemTable ücretsiz ve birçok yerde kullanılan test edilmiş. Performans odaklı bileşenlere sahip.
http://components4developers.com/

Ekte örnek projeyi bulabilirsiniz. Çalıştığı bilgisayarda 1 milyon değer arasından yinelenenleri hesaplaması 7 saniye civarında sürüyor. Diğer kodlar ile kıyaslama yaparak performans anlamında en uygun olanını tercih etmeniz mümkün.

[JavaCiva]

Merhabalar

Sorunu Memtable ile çözdükj.

Diğer tüm cevap verenlere teşekkür ediyorum.

[kimimben]

Son halini paylaşıyorum.Burada bilgi olarak kalsın istedim.
HesaplaV3, HesaplaV4 methodlarını ekledim.
1 milyon değer üzerinden hesaplaması ortalama 1,5 saniye civarında sürüyor.





Hesapla, HesaplaV3, HesaplaV4 fonksiyonlardan biri kullanılabilinir.

Kod: Tümünü seç

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Generics.Collections,
  Generics.Defaults, System.Contnrs,
  System.Diagnostics, GpLists, SpinLock;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  DEFAULT_COUNT = 1;

var
  Form2: TForm2;
  Stopwatch: TStopwatch;

  PKeys, PValues: TList<Integer>;

  Data: array of Integer;
  I: Integer;

implementation

{$R *.dfm}

procedure L(Line: string);
begin
  Form2.Memo1.Lines.Add(Line);
end;

procedure Hesapla(var Elements: array of Integer);
var
  Dictionary: TDictionary<Integer, Integer>;
  Element: Integer;
  outValue: Integer;
begin
  Dictionary := TDictionary<Integer, Integer>.Create();
  for Element in Elements do
  begin
    if not Dictionary.ContainsKey(Element) then
      Dictionary.Add(Element, DEFAULT_COUNT)
    else
    begin
      Dictionary.TryGetValue(Element, outValue);
      Inc(outValue);
      Dictionary.Items[Element] := outValue;
    end;
  end;

  Form2.Memo1.Lines.BeginUpdate;
  for Element in Dictionary.Keys do
    L(IntToStr(Element) + ' den ' + IntToStr(Dictionary.Items[Element]) + ' adet');
  Form2.Memo1.Lines.EndUpdate;

  Dictionary.Free;
end;

procedure HesaplaV2(var Elements: array of Integer);
var
  Element: Integer;
  Index: Integer;
begin
  PKeys := TList<Integer>.Create;
  PValues := TList<Integer>.Create;

  for Element in Elements do
  begin
    Index := PKeys.IndexOf(Element);
    if Index = -1 then
    begin
      PKeys.Add(Element);
      PValues.Add(DEFAULT_COUNT);
    end
    else
      PValues.Items[Index] := PValues.Items[Index] + 1;
  end;

  Form2.Memo1.Lines.BeginUpdate;
  for I := 0 to PKeys.Count - 1 do
    L(IntToStr(PKeys.Items[I]) + ' den ' + IntToStr(PValues.Items[I]) +
      ' adet');
  Form2.Memo1.Lines.EndUpdate;
end;

procedure HesaplaV3(var Elements: array of Integer);
var
  Element: Integer;
  HashMap: TDictionary<Integer, Integer>;
begin
  HashMap := TDictionary<Integer, Integer>.Create();
  TArray.Sort<Integer>(Elements);

  for I := Low(Elements) to High(Elements) do
  begin
    Element := Elements[I];

    if not HashMap.ContainsKey(Element) then
      HashMap.Add(Element, DEFAULT_COUNT);

    if (Elements[I] = Elements[I - 1]) then
      HashMap.Items[Element] := HashMap.Items[Element] + 1;
  end;

  Form2.Memo1.Lines.BeginUpdate;
  for Element in HashMap.Keys do
    L(IntToStr(Element) + ' den ' + IntToStr(HashMap.Items[Element]) + ' adet');
  Form2.Memo1.Lines.EndUpdate;

  HashMap.Free;
end;

procedure HesaplaV4(var Elements: array of Integer);
var
  P: PByte;
  PLast: PByte;
  Element: Integer;
  ElementPrev: Integer;

  HashMap: TDictionary<Integer, Integer>;
begin
  TArray.Sort<Integer>(Elements);

  HashMap := TDictionary<Integer, Integer>.Create();

  P := @Elements[Low(Elements)];
  PLast := @Elements[High(Elements)];

  while P <= PLast do
  begin
    Element := PInteger(P)^;

    if not HashMap.ContainsKey(Element) then
      HashMap.Add(Element, DEFAULT_COUNT);

    ElementPrev := (PInteger(P - SizeOf(Integer)))^;
    if (Element = ElementPrev) then
      HashMap.Items[Element] := HashMap.Items[Element] + 1;

    Inc(P, SizeOf(Integer));
  end;

  Form2.Memo1.Lines.BeginUpdate;
  for Element in HashMap.Keys do
    L(IntToStr(Element) + ' den ' + IntToStr(HashMap.Items[Element]) + ' adet');
  Form2.Memo1.Lines.EndUpdate;

  HashMap.Free;
end;

procedure GpListleHesapla(var Elements: array of Integer);
var
  IntList: TGpCountedIntegerList;
  Element: Integer;
begin
  IntList := TGpCountedIntegerList.Create;
  for Element in Elements do
  begin
    if IntList.IndexOf(Element) = -1 then
      IntList.Add(Element, DEFAULT_COUNT)
    else
      IntList.ItemCounter[Element] := IntList.ItemCounter[Element] + 1;
  end;

  Form2.Memo1.Lines.BeginUpdate;
  for Element in IntList do
    L(IntToStr(Element) + ' den ' + IntToStr(IntList.ItemCounter[Element])+ ' adet');
  Form2.Memo1.Lines.EndUpdate;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  Hesapla(Data);
  TButton(Sender).Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  GpListleHesapla(Data);
  TButton(Sender).Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  HesaplaV2(Data);
  TButton(Sender).Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.Button4Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  HesaplaV3(Data);
  TButton(Sender).Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.Button6Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  HesaplaV4(Data);
  TButton(Sender).Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  SetLength(Data, 1000000);
  for I := Low(Data) to High(Data) do
    Data[I] := Random(10000);
end;

end.

Test.zip

Test

(111.74 KiB) 127 kere indirildi

[greenegitim]

Son halini paylaşıyorum.Burada bilgi olarak kalsın istedim.
HesaplaV3, HesaplaV4 methodlarını ekledim.
1 milyon değer üzerinden hesaplaması ortalama 1,5 saniye civarında sürüyor.





Hesapla, HesaplaV3, HesaplaV4 fonksiyonlardan biri kullanılabilinir.

Kod: Tümünü seç

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Generics.Collections,
  Generics.Defaults, System.Contnrs,
  System.Diagnostics, GpLists, SpinLock;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  DEFAULT_COUNT = 1;

var
  Form2: TForm2;
  Stopwatch: TStopwatch;

  PKeys, PValues: TList<Integer>;

  Data: array of Integer;
  I: Integer;

implementation

{$R *.dfm}

procedure L(Line: string);
begin
  Form2.Memo1.Lines.Add(Line);
end;

procedure Hesapla(var Elements: array of Integer);
var
  Dictionary: TDictionary<Integer, Integer>;
  Element: Integer;
  outValue: Integer;
begin
  Dictionary := TDictionary<Integer, Integer>.Create();
  for Element in Elements do
  begin
    if not Dictionary.ContainsKey(Element) then
      Dictionary.Add(Element, DEFAULT_COUNT)
    else
    begin
      Dictionary.TryGetValue(Element, outValue);
      Inc(outValue);
      Dictionary.Items[Element] := outValue;
    end;
  end;

  Form2.Memo1.Lines.BeginUpdate;
  for Element in Dictionary.Keys do
    L(IntToStr(Element) + ' den ' + IntToStr(Dictionary.Items[Element]) + ' adet');
  Form2.Memo1.Lines.EndUpdate;

  Dictionary.Free;
end;

procedure HesaplaV2(var Elements: array of Integer);
var
  Element: Integer;
  Index: Integer;
begin
  PKeys := TList<Integer>.Create;
  PValues := TList<Integer>.Create;

  for Element in Elements do
  begin
    Index := PKeys.IndexOf(Element);
    if Index = -1 then
    begin
      PKeys.Add(Element);
      PValues.Add(DEFAULT_COUNT);
    end
    else
      PValues.Items[Index] := PValues.Items[Index] + 1;
  end;

  Form2.Memo1.Lines.BeginUpdate;
  for I := 0 to PKeys.Count - 1 do
    L(IntToStr(PKeys.Items[I]) + ' den ' + IntToStr(PValues.Items[I]) +
      ' adet');
  Form2.Memo1.Lines.EndUpdate;
end;

procedure HesaplaV3(var Elements: array of Integer);
var
  Element: Integer;
  HashMap: TDictionary<Integer, Integer>;
begin
  HashMap := TDictionary<Integer, Integer>.Create();
  TArray.Sort<Integer>(Elements);

  for I := Low(Elements) to High(Elements) do
  begin
    Element := Elements[I];

    if not HashMap.ContainsKey(Element) then
      HashMap.Add(Element, DEFAULT_COUNT);

    if (Elements[I] = Elements[I - 1]) then
      HashMap.Items[Element] := HashMap.Items[Element] + 1;
  end;

  Form2.Memo1.Lines.BeginUpdate;
  for Element in HashMap.Keys do
    L(IntToStr(Element) + ' den ' + IntToStr(HashMap.Items[Element]) + ' adet');
  Form2.Memo1.Lines.EndUpdate;

  HashMap.Free;
end;

procedure HesaplaV4(var Elements: array of Integer);
var
  P: PByte;
  PLast: PByte;
  Element: Integer;
  ElementPrev: Integer;

  HashMap: TDictionary<Integer, Integer>;
begin
  TArray.Sort<Integer>(Elements);

  HashMap := TDictionary<Integer, Integer>.Create();

  P := @Elements[Low(Elements)];
  PLast := @Elements[High(Elements)];

  while P <= PLast do
  begin
    Element := PInteger(P)^;

    if not HashMap.ContainsKey(Element) then
      HashMap.Add(Element, DEFAULT_COUNT);

    ElementPrev := (PInteger(P - SizeOf(Integer)))^;
    if (Element = ElementPrev) then
      HashMap.Items[Element] := HashMap.Items[Element] + 1;

    Inc(P, SizeOf(Integer));
  end;

  Form2.Memo1.Lines.BeginUpdate;
  for Element in HashMap.Keys do
    L(IntToStr(Element) + ' den ' + IntToStr(HashMap.Items[Element]) + ' adet');
  Form2.Memo1.Lines.EndUpdate;

  HashMap.Free;
end;

procedure GpListleHesapla(var Elements: array of Integer);
var
  IntList: TGpCountedIntegerList;
  Element: Integer;
begin
  IntList := TGpCountedIntegerList.Create;
  for Element in Elements do
  begin
    if IntList.IndexOf(Element) = -1 then
      IntList.Add(Element, DEFAULT_COUNT)
    else
      IntList.ItemCounter[Element] := IntList.ItemCounter[Element] + 1;
  end;

  Form2.Memo1.Lines.BeginUpdate;
  for Element in IntList do
    L(IntToStr(Element) + ' den ' + IntToStr(IntList.ItemCounter[Element])+ ' adet');
  Form2.Memo1.Lines.EndUpdate;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  Hesapla(Data);
  TButton(Sender).Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  GpListleHesapla(Data);
  TButton(Sender).Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.Button3Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  HesaplaV2(Data);
  TButton(Sender).Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.Button4Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  HesaplaV3(Data);
  TButton(Sender).Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.Button6Click(Sender: TObject);
begin
  Memo1.Clear;
  Stopwatch := TStopwatch.StartNew;
  HesaplaV4(Data);
  TButton(Sender).Caption := IntToStr(Stopwatch.ElapsedMilliseconds) + ' ms';
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  SetLength(Data, 1000000);
  for I := Low(Data) to High(Data) do
    Data[I] := Random(10000);
end;

end.

Test.zip

Merakımdan soruyorum örnek bu projeyi breakpoint koyup cpu penceresini de açıp oradaki assembly kodlarını kodlarımızda kullansak daha performanslı olurmu?

[JavaCiva]

hesapla v4.0 çok iyi bizde uygulamamızda bunu kullanmaya karar verdik.
emeğiniz için teşekkürler

[kimimben]

Merakımdan soruyorum örnek bu projeyi breakpoint koyup cpu penceresini de açıp oradaki assembly kodlarını kodlarımızda kullansak daha performanslı olurmu?

Merakınız çok güzel, ama şahsım adına beni aşan konular olduğu için, afaki konuşmanın doğru olacağını düşünmüyorum.
O sebeble bir başkası belki bizi aydınlatabilir.