Flytte værdier i array (push?)

Jeg vil tro at det bedste var ikke at flytte data men bruge din buffer som en cirkulaer buffer.

Men eller maa du kunne bruge:
  http://www.delphibasics.co.uk/RTL.asp?Name=Move

Du kan bruge Move();

Move(MinArray[1],MinArray[0],Length(MinArray)-1);

Nå, move er jo også det som arne_v´s link beskriver

Jeg ville straks kaste mig over en liste som TObjectList eller TStack. Det betyder dog at du skal have et objekt i stedet for en byte (hvis det skal være pænt). Den kommer her:

TByteData = clas
private
  fValue: byte;
public
  constructor Create(aValue: byte);
  property Value: byte read fValue;
end;

Bruger du TStack er proceduren denne (fStack bliver her tænkt oprettet og slettet sammen med programmet):

  fStack.Push(TByteData.Create(24));

og når du vil have tingene tilbage igen er det

var
  ByteData: TByteData;
begin
  ByteData := fStack.Pop as TByteData;
  eVaerdi.Text := IntToStr(ByteData.Value);
  ByteData.Free;
end;

Du kan vistnok også kontrollere stakkens størrelse (til 101 styk ligesom din array).

Med en TObjectList er det lidt det samme, men her behøver du ikke frigive TByteData; det klarer listen selv når du fjerner der derfra.

En lille oversigt over listerne i Delphi:

http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/devwin32/vptworkingwithlists_xml.html

I eksemplet ovenfor var det nok smartere at bruge TObjectStack i stedet for TStack

Umiddelbart lyder det som om at der er brug for en queue og ikke en stack !?!?

Jeg tror iøvrigt stadigvæk at en cirkulær buffer kunne være en løsning.

I ContNrs-unitten ligger der også en TQueue (og en TObjectQueue).

Det mtj111 efterlyser er dog, i mine øjne, en TStack. Han nævner selv pop og push.

... men igen. Det kommer an på om han har lyst til at prøve kræfter med klasserne eller vil holde det i en effektiv array. Han kunne pakke den simple array ind i en klasse og opnå det samme:

const
  MaxStack = 100;

TMyStack = class
private
  fStack: array[1..MaxStack] of byte;
  findex: integer;
public
  property Count: integer read fIndex;
  procedure Push(aValue: byte);
  function Pop: byte;
end;

procedure TMyStack.Push(aValue: byte);
begin
  if fIndex = MaxStack then
    raise Exception.Create('Stakken er fuld');
  inc(fIndex);
  fStack[fIndex] := aValue;
end;

function TMyStack.Pop: byte;
begin
  if fIndex = 0 then
    raise Exception.Create('Stakken er tom');
  result := fStack[fIndex];
  dec(fIndex);
end;

Hvis man flytter arrayets elementer en plads bagud og indsaetter paa hoeheste plads, saa er det FIFO og dermed en queue.

Hej

Puha, hvor er der mange måder at gøre det på :)

Det nemmeste (og det jeg har prøvet) er indtil videre move-funktionen, men den vil ikke helt som jeg vil.

Det jeg eftersøger er en pænere måde at lave følgende på:
for i := Low(MinArray) to High(MinArray)-1 do
  MinArray[i] := MinArray[i+1];

og eftersom hvad jeg kan læse og forstå om move-funktionen, burde den gøre det samme. Problemet er bare, at
  Move(MinArray[1],MinArray[0],Length(MinArray)-1);
kun flytter de ca. 25 første elementer i MinArray bagud - og det undrer mig en smule.

Lille update:
Hvis jeg skriver 500 i stedet for Length(MinArray)-1, så virker det (bortset fra en fejl i programmet når det afsluttes, hvilket jeg går ud fra skyldes at 500 er for stort)

Hvilket tal skal jeg bruge, når MinArray er defineret som Array[0..100] of Integer;?

Og nu fandt jeg ud af det :)
Length() fungerer åbenbart ikke som I de ældre versioner (jeg bruger Delphi 2005), så man skal bruge SizeOf(MinArray) i stedet


Vil der være nogen mærkbar hastighedsforskel mellem en array og move-funktionen i forhold til jeres andre løsningsforslag? Jeg har kun brug for ca. 100 værdier (i Array'et), så det er vel begrænset hvor meget andre løsningsforslag er hurtigere?

arne: Det er som man tolker det. Jeg mener det kan være begge, men når mtj111 nævner "pop" og "push" tænker jeg altså på en stak.

mtj111: Hvis du kigger på det eksempel jeg lavede, så behøver der slet ikke flyttes noget. Hvis ellers eksemplet er korrekt synes jeg det er en elegant og simpel løsning - hvis altså det er en stak du vil have.

En ordentlig stak kode som illusterer mulighederne:

program queue;

{$APPTYPE CONSOLE}

uses
  ShareMem, Contnrs, SysUtils, Windows;

const
  SIZE = 100;

type
  Data = array[0..SIZE] of Byte;

type
  ITest = interface(IInterface)
            procedure Add(v : Byte);
            function Get() : Data;
            function GetName() : String;
            property Name : String read GetName;
          end;
  Mover = class(TInterfacedObject, ITest)
            private
              buf : Data;
              ix : Integer;
            public
              constructor Create;
              procedure Add(v : Byte);
              function Get() : Data;
              function GetName() : String;
          end;
  Wrapper = class(TObject)
              private
                val : Byte;
              public
                constructor Create(v : Byte);
                property Value : Byte read val;
            end;
  Container1 = class(TInterfacedObject, ITest)
                private
                  q : TObjectQueue;
                public
                  constructor Create;
                  procedure Add(v : Byte);
                  function Get() : Data;
                  destructor Destroy; override;
                  function GetName() : String;
              end;
  Container2 = class(TInterfacedObject, ITest)
                private
                  q : TQueue;
                public
                  constructor Create;
                  procedure Add(v : Byte);
                  function Get() : Data;
                  destructor Destroy; override;
                  function GetName() : String;
              end;
  Circular = class(TInterfacedObject, ITest)
              private
                buf : Data;
                ix : Integer;
              public
                constructor Create;
                procedure Add(v : Byte);
                function Get() : Data;
                function GetName() : String;
            end;

constructor Mover.Create();

begin
  ix := 0;
end;

procedure Mover.Add(v: Byte);

begin
  if ix < SIZE then begin
    buf[ix] := v;
    Inc(ix);
  end else begin
    Move(buf[1], buf[0], SIZE);
    buf[SIZE] := v;
  end;
end;

function Mover.Get() : Data;

begin
  Get := buf;
end;

function Mover.GetName() : String;

begin
  GetName := 'Moving for each Add';
end;

constructor Wrapper.Create(v : Byte);

begin
  val := v;
end;

constructor Container1.Create();

begin
  q := TObjectQueue.Create;
end;

procedure Container1.Add(v: Byte);

var
  tmp : Wrapper;

begin
  if q.Count > SIZE then begin
    tmp := Wrapper(q.Pop);
    tmp.Destroy;
  end;
  q.Push(Wrapper.Create(v));
end;

function Container1.Get() : Data;

var
  res : Data;
  i : Integer;
  tmp : Wrapper;

begin
  for i := 0 to SIZE do begin
    tmp := Wrapper(q.Pop);
    res[i] := tmp.Value;
    tmp.Destroy;
  end;
  Get := res;
end;

destructor Container1.Destroy;

begin
  q.Destroy;
  inherited;
end;

function Container1.GetName() : String;

begin
  GetName := 'Using builtin TObjectQueue';
end;

constructor Container2.Create();

begin
  q := TQueue.Create;
end;

procedure Container2.Add(v: Byte);

begin
  if q.Count > SIZE then begin
    q.Pop;
  end;
  q.Push(Pointer(v));
end;

function Container2.Get() : Data;

var
  res : Data;
  i : Integer;

begin
  for i := 0 to SIZE do begin
    res[i] := Byte(q.Pop);
  end;
  Get := res;
end;

destructor Container2.Destroy;

begin
  q.Destroy;
  inherited;
end;

function Container2.GetName() : String;

begin
  GetName := 'Using builtin TQueue';
end;

constructor Circular.Create();

begin
  ix := 0;
end;

procedure Circular.Add(v: Byte);

begin
  buf[ix] := v;
  ix := (ix + 1) mod (SIZE + 1);
end;

function Circular.Get() : Data;

var
  res : Data;
  i : Integer;

begin
  for i := 0 to SIZE + 1 do begin
    res[i] := buf[(ix + i) mod (SIZE + 1)];
  end;
  Get := res;
end;

function Circular.GetName() : String;

begin
  GetName := 'Just circling around';
end;

procedure Test(impl : ITest);

var
  i : Integer;
  tmp : Data;
  t1, t2 : Integer;

begin
  t1 := GetTickCount;
  for i := 0 to 1234567 do begin
    impl.Add(i);
  end;
  t2 := GetTickCount;
  tmp := impl.Get;
  writeln(impl.Name);
  write('result: ');
  for i := 0 to SIZE do begin
    write(' ', tmp[i]);
  end;
  writeln;
  writeln('time: ', t2 - t1);
end;

var
  impl_1 : Mover;
  impl_2 : Container1;
  impl_3 : Container2;
  impl_4 : Circular;

begin
  impl_1 := Mover.Create;
  Test(impl_1);
  impl_1.Destroy;
  impl_2 := Container1.Create;
  Test(impl_2);
  impl_2.Destroy;
  impl_3 := Container2.Create;
  Test(impl_3);
  impl_3.Destroy;
  impl_4 := Circular.Create;
  Test(impl_4);
  impl_4.Destroy;
end.

PS: Jeg kan kun få det til at virke med FPC. Delphi 7 PE og Turbo Delphi 2006 hænger i et eller andet memory/ekstern DLL problem.

arne: Mon ikke gråspurvene er ved at være rædde? Kanonkuglerne flyver i alt fald gennem luften nu. Du giver i alt fald ikke op. MTJ111 skal have en cirkulær liste.

Det kan da godt være at gråspurvene er ved at være lidt nevøse.

Men det var en god lejlighed for mig til at prøve lidt OOP i Delphi.

Og så fandt jeg iøvrigt ud af at TQueue og TObjectQueue tilsyneladende er array backed og ikke double linked list backed. Hvilket overrasker mig en del.

Du tænker på TPointerList? Du er ikke den eneste der er overrasket (er vist kommet til at kalde den en dobbeltkædet liste et eller andet sted); men når man tænker over løsningen er den ret effektiv - men afgjort med et strøg af noget ur-paskalsk'.

Troede ikke den var begrænset til 2 mia. linjer.

Hvad betyder "backed"?

backed by = understøttet af

Jeg har ikke kigget på source code, men bare konstateret udfra hvor langsom TQueue er så må den bruge et array og ikke en dobbelt linked liste.

TList er en array[0..maxInt div $f] of pointer (hvorfor har de ikke  brugt shr 1 i stedet for div?). Hvordan kan den være langsom? Uanset om du har en dobbeltkædet liste eller en array, skal tingene oprettes. En TList opretter efter behov i klumper (a la 16 linjer) og der er ikke fiflen med pointere der peger den ene eller anden vej.

A: array
B: double linked liste

indsæt i enden:
A = assignment
B = sætte 2 pointere

slet i starten:
A = move alle elementer (undtagen det første)
B = sætte 2 pointere

array og double linked liste er ca. lige hurtige til:
  insert i enden
  slet i enden
  gennemløb

array er hurtigere end double linked liste til:
  finde element nummer n

double linked liste er hurtigere end array til:
  slet undtagen i enden
  insert undtagen i enden

Da man i en queue fjerner i den modsatte ende af hvor man indsætter, så var en double linke dlit mere logisk end et array.

program queue;

{$APPTYPE CONSOLE}

uses
  ShareMem, Contnrs, SysUtils, Windows;

const
  SIZE = 100;

type
  Data = array[0..SIZE] of Byte;

type
  ITest = interface(IInterface)
            procedure Add(v : Byte);
            function Get() : Data;
            function GetName() : String;
            property Name : String read GetName;
          end;
  Mover = class(TInterfacedObject, ITest)
            private
              buf : Data;
              ix : Integer;
            public
              constructor Create;
              procedure Add(v : Byte);
              function Get() : Data;
              function GetName() : String;
          end;
  Wrapper = class(TObject)
              private
                val : Byte;
              public
                constructor Create(v : Byte);
                property Value : Byte read val;
            end;
  Container1 = class(TInterfacedObject, ITest)
                private
                  q : TObjectQueue;
                public
                  constructor Create;
                  procedure Add(v : Byte);
                  function Get() : Data;
                  destructor Destroy; override;
                  function GetName() : String;
              end;
  Container2 = class(TInterfacedObject, ITest)
                private
                  q : TQueue;
                public
                  constructor Create;
                  procedure Add(v : Byte);
                  function Get() : Data;
                  destructor Destroy; override;
                  function GetName() : String;
              end;
  Circular = class(TInterfacedObject, ITest)
              private
                buf : Data;
                ix : Integer;
              public
                constructor Create;
                procedure Add(v : Byte);
                function Get() : Data;
                function GetName() : String;
            end;
  PElement = ^Element;
  Element = record
              val : Byte;
              next : PElement;
              prev : PElement;
            end;
  DoubleLinkedList = class(TInterfacedObject, ITest)
                      private
                        n : Integer;
                        head : PElement;
                        tail : PElement;
                      public
                        constructor Create;
                        procedure Add(v : Byte);
                        function Get() : Data;
                        function GetName() : String;
                    end;

constructor Mover.Create();

begin
  ix := 0;
end;

procedure Mover.Add(v: Byte);

begin
  if ix < SIZE then begin
    buf[ix] := v;
    Inc(ix);
  end else begin
    Move(buf[1], buf[0], SIZE);
    buf[SIZE] := v;
  end;
end;

function Mover.Get() : Data;

begin
  Get := buf;
end;

function Mover.GetName() : String;

begin
  GetName := 'Moving for each Add';
end;

constructor Wrapper.Create(v : Byte);

begin
  val := v;
end;

constructor Container1.Create();

begin
  q := TObjectQueue.Create;
end;

procedure Container1.Add(v: Byte);

var
  tmp : Wrapper;

begin
  if q.Count > SIZE then begin
    tmp := Wrapper(q.Pop);
    tmp.Destroy;
  end;
  q.Push(Wrapper.Create(v));
end;

function Container1.Get() : Data;

var
  res : Data;
  i : Integer;
  tmp : Wrapper;

begin
  for i := 0 to SIZE do begin
    tmp := Wrapper(q.Pop);
    res[i] := tmp.Value;
    tmp.Destroy;
  end;
  Get := res;
end;

destructor Container1.Destroy;

begin
  q.Destroy;
  inherited;
end;

function Container1.GetName() : String;

begin
  GetName := 'Using builtin TObjectQueue';
end;

constructor Container2.Create();

begin
  q := TQueue.Create;
end;

procedure Container2.Add(v: Byte);

begin
  if q.Count > SIZE then begin
    q.Pop;
  end;
  q.Push(Pointer(v));
end;

function Container2.Get() : Data;

var
  res : Data;
  i : Integer;

begin
  for i := 0 to SIZE do begin
    res[i] := Byte(q.Pop);
  end;
  Get := res;
end;

destructor Container2.Destroy;

begin
  q.Destroy;
  inherited;
end;

function Container2.GetName() : String;

begin
  GetName := 'Using builtin TQueue';
end;

constructor Circular.Create();

begin
  ix := 0;
end;

procedure Circular.Add(v: Byte);

begin
  buf[ix] := v;
  ix := (ix + 1) mod (SIZE + 1);
end;

function Circular.Get() : Data;

var
  res : Data;
  i : Integer;

begin
  for i := 0 to SIZE + 1 do begin
    res[i] := buf[(ix + i) mod (SIZE + 1)];
  end;
  Get := res;
end;

function Circular.GetName() : String;

begin
  GetName := 'Just circling around';
end;

constructor DoubleLinkedList.Create;

begin
  n := 0;
end;

procedure DoubleLinkedList.Add(v : Byte);

var
  tmp : PElement;

begin
  new(tmp);
  tmp^.val := v;
  if n = 0 then begin
    tmp^.next := nil;
    tmp^.prev := nil;
    head := tmp;
    tail := tmp;
    Inc(n);
  end else if n <= SIZE then begin
    tmp^.next := nil;
    tmp^.prev := tail;
    tail^.next := tmp;
    tail := tmp;
    Inc(n);
  end else begin
    tmp^.next := nil;
    tmp^.prev := tail;
    tail^.next := tmp;
    tail := tmp;
    tmp := head^.next;
    dispose(head);
    head := tmp;
    head^.prev := nil;
  end;
end;

function DoubleLinkedList.Get() : Data;

var
  res : Data;
  ix : Integer;
  curr, tmp : PElement;

begin
  curr := head;
  ix := 0;
  while curr <> nil do begin
    res[ix] := curr^.val;
    Inc(ix);
    tmp := curr;
    curr := curr^.next;
    dispose(tmp);
  end;
  Get := res;
end;

function DoubleLinkedList.GetName() : String;

begin
  GetName := 'My own double linked list';
end;

procedure Test(impl : ITest);

var
  i : Integer;
  tmp : Data;
  t1, t2 : Integer;

begin
  t1 := GetTickCount;
  for i := 0 to 1234567 do begin
    impl.Add(i);
  end;
  t2 := GetTickCount;
  tmp := impl.Get;
  writeln(impl.Name);
  write('result: ');
  for i := 0 to SIZE do begin
    write(' ', tmp[i]);
  end;
  writeln;
  writeln('time: ', t2 - t1);
end;

var
  impl_1 : Mover;
  impl_2 : Container1;
  impl_3 : Container2;
  impl_4 : Circular;
  impl_5 : DoubleLinkedList;

begin
  impl_1 := Mover.Create;
  Test(impl_1);
  impl_1.Destroy;
  impl_2 := Container1.Create;
  Test(impl_2);
  impl_2.Destroy;
  impl_3 := Container2.Create;
  Test(impl_3);
  impl_3.Destroy;
  impl_4 := Circular.Create;
  Test(impl_4);
  impl_4.Destroy;
  impl_5 := DoubleLinkedList.Create;
  Test(impl_5);
  impl_5.Destroy;
end.


giver:


Moving for each Add
result:  35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 8
5 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
129 130 131 132 133 134 135
time: 31
Using builtin TObjectQueue
result:  35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 8
5 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
129 130 131 132 133 134 135
time: 484
Using builtin TQueue
result:  35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 8
5 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
129 130 131 132 133 134 135
time: 187
Just circling around
result:  35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 8
5 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
129 130 131 132 133 134 135
time: 32
My own double linked list
result:  35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 8
5 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
129 130 131 132 133 134 135
time: 78


Og det er altså ikke fordi at min double linked liste på nogen måde er genial.

Men algoritmen er fundamentalt bedre end brug af array til en queue.

Måske kunne man komme et stykke vej med et par indeks-variable i kø-klassen (en der markerer start og en til slut) - og en uheldig lejlighedsvis oprydning. TQueue er ikke beregnet til store mængder data. De har nok været forhippet på at skulle nedarve fra et eller andet fremfor at gøre det pænt og effektivt.

TStack er helt OK for der flyttes ingenting.

Man kunne godt fuske lidt.

Men TQueue burde have været lavet som en double linked liste, så den kunne bruges til store data mængder også.

Array er perfekt til TStack.

Okay, det sidste forstod jeg ikke så meget af :P

Men jeg har valgt blot at blive ved move-funktionen :) Den fungerer fint til mit brug.

Så pointtid!
Arne_v og hrc: læg et svar :)

svar

mtj111: Hvis du har brug for en stak (FILO: først ind, sidst ud) behøver du slet ikke "move" noget. Du kan bruge den indbyggede TStack eller den helt simple løsning jeg lavede ovenfor (TMyStack).

.. og jeg tror (stadig) det er stakken du har brug for.

Hvis du har brug for en kø (FIFO: først ind, først ud) så er Arnes løsning meget effektiv.

Undskyld forsinkelsen!

Hvordan sætter man antallet af point op i dette spørgsmål? Jeg kan ikke længere finde "knappen" til det.

Du kan prøve om du kan øge pointene i boxene så de giver mere end hvad spørgsmålet oprindeligt lød på.

Hvis det ikke virker kan du oprette et separat point overførsels spørgsmål.

Eller du kan bare uddele de lovede point - meget af diskussionen var jo lidt off-topic.

Hej

Jeg synes det var on-topic nok, til at det burde belønnes.

Men da jeg ikke kan skrive flere points i tekstboksene (den siger blot "pointfejl" (eller noget i den dur) når jeg prøver at afgive dem), vil jeg bare give de lovede point.
Hvis der er nogen der føler sig snydt vedr. point, så siger de endelig bare til :)

Med venlig hilsen
Michael