Elenco lineare veloce che esclude i duplicati
https://stackoverflow.com/questions/6350547
-
28-10-2019 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
RussianDomanda
Ho il codice seguente:
procedure TCellBlock.GeneratePtoQ;
var
x,y: integer;
i: integer;
Change: cardinal;
begin
i:= 0;
//Walk the grid of changed (alive) cells
for x:= GridMaxX downto 1 do begin
for y:= GridMaxY downto 1 do begin
if Active[cIndexP][x, y] then begin
Active[cIndexP][x,y]:= false;
//Put active items on the stack.
ToDo[i]:= x shl 16 or y;
Inc(i);
end; {if}
end; {for y}
end; {for x}
while i > 0 do begin
Dec(i);
y:= ToDo[i] and $FFFF;
x:= ToDo[i] shr 16;
//Calculate the cell, Change = (oldval XOR newval)
Change:= Grid[x,y].GeneratePtoQ;
//Mark the cells in the grid that need to be recalculated next generation.
Active[cIndexQ][x,y]:= Active[cIndexQ][x,y] or (Change <> 0);
Active[cIndexQ][x+1,y+1]:= Active[cIndexQ][x+1,y+1] or ((Change and $cc000000) <> 0);
Active[cIndexQ][x+1,y]:= Active[cIndexQ][x+1,y] or ((Change and $ff000000) <> 0);
Active[cIndexQ][x,y+1]:= Active[cIndexQ][x,y+1] or ((Change and $cccccccc) <> 0);
end; {while}
end;
Quanto sopra è uno snippet di codice di un programma di test che calcola Conway Game of Life.
Il codice deve essere il più veloce possibile. E a questo scopo sto provando approcci diversi.
Cammina attraverso una griglia di cellule attive, sembra vedere quali cellule sono attive e mette quelle su uno stack.
Successivamente elabora gli elementi sullo stack e vede quali celle sono cambiate.
Se una cella ha modificato, aggiorna le modifiche alla griglia per la prossima generazione.
Conservo celle in cardinali a 32 bit (4 bit y, 8 bit x) e le generazioni p (pari) sono compensato 1,1 pixel rispetto alle generazioni Q (ODD), in questo modo devo solo tenere conto di 3 vicini anziché invece di 8.
Domanda
Voglio sbarazzarmi della griglia, voglio solo affrontare lo stack.
Come si implementa uno stack che elimina i duplicati?
Nota che deve esserlo più velocemente possibile E non sono sopra a usare trucchi sporchi per ottenerlo.
Soluzione 4
Ci ho pensato e penso di avere una soluzione.
qualche sfondo
Ecco come sono i dati in memoria
00 A 08 B 10 18 The bits of Individual int32's are layout like this:
01 | 09 | 11 19 00 04 08 0C 10 14 18 1C // N-Mask: $33333333
02 | 0A | 12 1A 01 05 09 0D 11 15 19 1D // S-Mask: $cccccccc
03 | 0B | 13 1B 02 06 0A 0E 12 16 1A 1E // W-Mask: $000000ff
04 | 0C | 14 1C 03 07 0B 0F 13 17 1B 1F // E-Mask: $ff000000
05 | 0D | 15 1D //SE-Mask: $cc000000
06 | 0E | 16 1E //NW-Mask: $00000033
07 V 0F V 17 1F I can mask of different portions if need be.
-- Figure A: Grid -- -- Figure B: cell -- -- Table C: masks --
Non ho deciso le dimensioni del blocco, ma questa è l'idea generale.
Anche le generazioni sono chiamate P, vengono chiamate generazioni dispari Q.
Sono sfalsati in questo modo
+----------------+<<<<<<<< P 00 04 08 0C //I use a 64K lookup
|+---------------|+ 01 05* 09* 0D //table to lookup
|| || 02 06* 0A* 0E //the inner* 2x2 bits from
|| || 03 07 0B 0F //a 4x4 grid.
+----------------+| //I need to do 8 lookups for a 32 bit cell
+----------------+<<<<<<<< Q
- Figure D: Cells are staggered - -- Figure E: lookup --
In questo modo quando si generano P -> Q, Devo solo guardare P stesso e i suoi vicini S, Se, E, invece di tutti e 8 i vicini, idem per Q -> P. Devo solo guardare Q stesso e i suoi vicini N, NW e W.
Si noti inoltre che lo sbalorditivo mi fa risparmiare tempo a tradurre il risultato della ricerca, perché devo fare meno mutamento per mettere in atto i risultati.
Quando mi avvolgo attraverso una griglia (Figura A) Cammino attraverso le celle (Figura B) Nell'ordine mostrato nella Figura A. Sempre in ordine strettamente crescente in un ciclo P e sempre in ordine decrescente in un Cycle Q.
In effetti, il ciclo Q funziona esattamente nell'ordine opposto dal ciclo P, questo accelera le cose riutilizzando la cache il più possibile.
Voglio minimizzare il più possibile utilizzando i puntatori, perché i puntatori non possono essere previsti e non sono accessibili in sequenza (saltano dappertutto) Quindi voglio usare array, pile e code il più possibile.
Quali dati fanno per tenere traccia di
Devo tenere traccia delle solo celle che cambiano. Se una cella (che è un INT32) non cambia da una generazione all'altra, la rimuovo dalla considerazione.
Questo è ciò che fa il codice nella domanda. Usa una griglia per tenere traccia delle modifiche, ma voglio usare un pila, non una griglia; e io solo Voglio affrontare le cellule attive Non voglio sapere sulle cellule stabili o morte.
Qualche background sui dati
Notare come la cellula stessa è sempre monotonicamente in aumento. Come è il suo vicino s-s-s, così come E e Se-Neighbor. Posso usare queste informazioni per imbrogliare.
La soluzione
Uso uno stack per tenere traccia della cella stessa e del suo vicino S e una coda per tenere traccia del suo vicino E e Se e quando ho finito mi unisco i due.
Supponiamo che nella griglia le seguenti celle vengano attive dopo che le ho calcolate:
00, 01, 08 and 15
I make the following two stacks:
stack A stack B
00 08 a) -A: Cell 00 itself in stack A and its E-neighbor in B
01 09 a) Cell 00's S neighbor in stack A and its SE-n'bor in B
02 0A b) -B: Cell 01 is already in the stack, we only add S/SE
08 10 c) -C: Cell 08 goes into the stack as normal
09 11 c) We'll sort out the merge later.
15 1D d) -D: Cell 15 and neighbors go on as usual.
16 1E d)
Now I push members from stack A and B onto a new stack C so that stack C has
no duplicates and it strictly increasing:
Here's the pseudo code to process the two queues:
a:= 0; b:= 0; c:=0;
while not done do begin
if stack[a] <= stack[b] then begin
stack[c]:= stack[a]; inc(a); inc(c);
if stack[a] = stack[b] then inc(b);
end
else begin
stack[c]:= stack[b]; inc(b); inc(c);
end;
end; {while}
E ancora meglio
Non devo effettivamente fare i due stack e la fusione come due passaggi separati, se faccio A uno stack e B Una coda, posso fare il secondo passaggio descritto nel codice pseudo e nella costruzione delle due pile in un solo passaggio.
Nota
Poiché una cella cambia il suo bordo S, E o SE non è necessario cambiare, ma posso verificare che usando le maschere nella Tabella C e aggiungi solo le celle che devono davvero controllare nella prossima generazione all'elenco.
Benefici
- Usando questo schema, devo solo attraversare uno Immergiti con cellule attive durante il calcolo delle cellule, quindi non perdo tempo a guardare cellule morte o inattive.
- Faccio solo accessi alla memoria sequenziale, massimizzando l'utilizzo della cache.
- Costruire lo stack con nuove modifiche per le generazioni successive richiede solo una coda temporanea in più, che elaboro in ordine strettamente sequenziale.
- Non faccio smistamento e il minimo dei confronti.
- Non devo tenere traccia dei vicini di ogni singola cella (int32), devo solo tenere traccia dei vicini (S, E, SE, N, W, NW) Delle griglie, questo riduce al minimo la memoria.
- Non ho bisogno di tenere traccia dello stato delle celle, ho solo bisogno di contare le cellule morte (una cellula è morta, perché era morta prima o perché è cambiato in morti. Tutte le celle attive sono nel mio stack Todo, questo risparmia tempo di contabilità e spazio di memoria.
- L'algoritmo funziona in o (n) tempo in cui (n) è il numero di attivo cellule, esclude cellule morte, cellule stabili e cellule che oscillano con il periodo 2.
- Ho avuto solo a che fare con i cardinali a 32 bit, che è molto più veloce che usare INT16.
Altri suggerimenti
Se ho capito cosa ti chiedevi, lo stack non avesse valori di duplicazione. Non sono una persona di Delphi, ma se fosse Java creerei un albero di hashmap/ mappa e aggiungere ogni valore alla mappa e prima di aggiungerlo allo stack che controlla se è già nell'hash. Puoi anche aggiungere tutti i valori dell'hash iteralo ma perderai l'ordine dell'hash.
Personalmente adotto un approccio completamente diverso. Per prima cosa non vedo come non devi tenere conto di tutti i vicini solo a causa dell'utilizzo di un ottimo 1,1 e poi dubito che i trucchi bibiti rendono l'algoritmo molto più velocemente (spesso è il contrario, ma poi potrebbe BE MEM LAWIDTHE BANDA VINCIUTA IN TE CASAMENTE VINCIAMO Un po ')
Quindi sceglierei solo l'unica cosa che dovrebbe portare di gran lunga il più grande guadagno delle prestazioni: rendere il multithread dell'algoritmo. Nel nostro mondo di Quad/Hex/Octacores che si preoccupano di alcuni aumenti di prestazioni di pochi percento mentre sprecare il 300% o più sembra sciocco. Quindi, se ignorassimo le griglie attive e controllassimo tutti i campi, l'algoritmo sarebbe banale con un ottimo ridimensionamento, soprattutto perché si potrebbe facilmente vettorializzare l'algoritmo, ma poi non è particolarmente funzionante efficiente, quindi proverei alcuni approcci multithreading e Algoritmo che porta solo le celle attive in conto.
Prima invece di sbarazzarsi della griglia, lo raddoppierei: un SRC e una griglia DEST - che vengono scambiati ogni round. Nessun blocco per accedere alla griglia necessaria, non devi preoccuparti di aggiornare i campi e nessuna voci stantii (importante per il multithreading che vogliamo usare la cache dopo tutto).
Ora la soluzione più semplice sarebbe quella di utilizzare una sorta di struttura di elenco simultanea (non ho idea delle librerie Delphi) per le celle attive e lasciare che ogni thread rubino da essa e aggiunga nuove celle attive a un'altra. Con una buona implementazione senza blocchi di una coda simultanea (fondamentalmente qualunque sia la sostituzione di questo è a Delphi) o qualcosa di simile potrebbe essere abbastanza bello e semplice. Per una prestazione migliore invece di aggiungere singoli nodi all'elenco, penserei di aggiungere interi pezzi all'elenco, diciamo in dimensioni di circa 10 - più lavoro con meno sovraccarico ma se facciamo i blocchi troppo grandi perdiamo il parallelismo.
Posso pensare ad altre soluzioni come dare a ogni thread un elenco di celle attive da lavorare (o più esattamente un elenco per tutti e offset diversi) ma quindi dobbiamo fare tra ogni Run Raccolta tutte le nuove voci (non molta sincronizzazione in alto ma alcuni copia ) in un elenco - vale la pena provare, presumo.
Se il tuo obiettivo è la velocità (e solo la velocità). Ci sono alcuni trucchi che possono accelerare molto le cose. La mia implementazione del gioco della vita di Conway usa quei trucchi per renderlo più veloce. Si noti che è molto costoso in memoria.
- Ogni cella è un oggetto
- Ogni oggetto cella contiene le sue coordinate x/y
- Ogni oggetto cellulare contiene un contatori "live" del numero di vicini vivi. (Quando una cella accende/si spegne, avvisò il suo vicino in modo che aggiornino i loro contatori.
- Per far funzionare #3, quando viene calcolata la generazione successiva, le celle non vengono attivate/spenta immediatamente. Sono invece impilati in un elenco fino a quando tutte le celle non vengono calcolate.
- Ogni cella ha un contatore che indica quale sia l'ultima generazione su cui sono cambiati. Che evitano di calcolare la stessa cellula due volte. (La mia alternativa allo stack che elimina i duplicati)
- L'elenco di n. 5 viene riutilizzato nella generazione successiva, poiché solo i vicini di una cella che sono cambiati sulla generazione precedente possono cambiare su quello attuale.
Ci sono alcuni dei trucchi che uso per accelerare la generazione. Alcuni dei trucchi elencati qui ti porteranno molto di più rispetto all'implementazione multithreading. Ma usare sia quelli che MultithRead otterranno la massima prestazione possibile.
Per quanto riguarda l'argomento multithread, leggi la voce di Voo.
Principalmente @Ken, il completa sourcecode per il programma di test:
Si noti che il 99,9% delle volte è speso nella visualizzazione, perché non ho fatto nulla per ottimizzarlo.
Ho creato una nuova app SDI-Main e ho pubblicato il codice in questo e perché sono pigro non mi sono preoccupato di rinominare o ridipingere alcun controllo.
File di progetto: sdiapp.dpr
program Sdiapp;
uses
Forms,
SDIMAIN in 'SDIMAIN.pas'; {Form1}
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Modulo principale: sdimain.pas
unit SDIMAIN;
interface
uses Windows, Classes, Graphics, Forms, Controls, Menus,
Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, ImgList, StdActns,
ActnList, ToolWin;
{--------------------------------------------
p and q are bit arrays of 16x16 bits, grouped
as in 8 int32's as follows
P00 P04 P08 P0c P10 P14 P18 P1c
P01 P05 P09 P0d P11 P15 P19 P1d
P02 P06 P0a P0e P12 P16 P1a P1e
P03 P07 P0b P0f P13 P17 P1b P1f
|
+----> The bits per int32 are grouped as follows
The int32's are grouped as follows
P0 P1
P2 P3
P4 P5
P6 P7
P and Q are staggered as follows:
+---------------------------------+ <---- P
| +-------------------------------|-+ <----Q
| | | |
| | | |
... ...
| | | |
+-|-------------------------------+ |
+---------------------------------+
Generations start counting from 0,
all even generations are stored in P.
all odd generations are stored in Q.
When generating P->Q, the S, SE and E neighbors are checked.
When generating Q->P, the N, NW and W neighbors are checked.
The westernmost P edge in a grid is stored inside that grid.
Ditto for all easternmost Q edges.
--------------------------------------------}
const
cClearQState = $fffffff0;
cClearPState = $fffff0ff;
cIndexQ = 1;
cIndexP = 0;
ChangeSelf = 0;
ChangeNW = 1;
ChangeW = 2;
ChangeN = 3;
ChangeSE = 1;
ChangeE = 2;
ChangeS = 3;
const
//A Grid is 128 x 128 pixels.
GridSizeX = 512 div 8; //should be 128/8, 1024 for testing.
GridSizeY = GridSizeX * 2; //32 totaal: 16x32x4bytes = 2048 x 2 (p+q) = 4k per block.
GridMaxX = GridSizeX - 1;
GridMaxY = GridSizeY - 1;
NumberOfCells = GridSizeX * GridSizeY;
CellSizeX = 8;
CellSizeY = 4;
CellMaxX = CellSizeX - 1;
CellMaxY = CellSizeY - 1;
type
TUnit = Cardinal;
TBytes = array[0..3] of byte;
TChange = array[0..3] of boolean;
type
TCellBlock = class;
TFlags = record
case boolean of
true: (whole: cardinal);
false: (part: array[0..3] of byte);
end;
//TActiveList = array[0..GridMaxX, 0..GridMaxY] of boolean;
//TActive = array[0..1] of TActiveList;
TToDoList = array[-1..NumberOfCells] of cardinal; //Padding on both sides.
TNewRow = TFlags;
PCell = ^TCell;
TCell = record
public
p: TUnit;
q: TUnit;
procedure SetPixel(x,y: integer; InP: Boolean = true);
function GeneratePtoQ: cardinal; inline;
function GenerateQtoP: cardinal; inline;
end;
//A grid contains pointers to an other grid, a unit or nil.
//A grid can contain grids (and nils) or units (and nils), but not both.
PGrid = ^TGrid;
TGrid = array[0..GridMaxX,0..GridMaxY] of TCell;
TCellBlock = class(TPersistent)
private
FHasCells: boolean;
FLevel: integer;
FGrid: TGrid;
ToDoP: TToDoList;
ToDoQ: TToDoList;
PCount: integer;
QCount: integer;
FParent: TCellBlock;
FMyX,FMyY: integer;
N,W,NW: TCellBlock;
S,E,SE: TCellBlock;
procedure GeneratePtoQ; virtual;
procedure GenerateQtoP; virtual;
procedure UpdateFlagsPtoQ; virtual;
procedure UpdateFlagsQtoP; virtual;
procedure Generate; virtual;
procedure Display(ACanvas: TCanvas); virtual;
procedure SetPixel(x,y: integer);
property Grid: TGrid read FGrid write FGrid;
public
constructor Create(AParent: TCellBlock);
destructor Destroy; override;
property Parent: TCellBlock read FParent;
property HasCells: boolean read FHasCells;
property Level: integer read FLevel;
property MyX: integer read FMyX;
property MyY: integer read FMyY;
end;
TCellParent = class(TCellBlock)
private
procedure GeneratePtoQ; override;
procedure GenerateQtoP; override;
//procedure Display(Startx,StartY: integer; ACanvas: TCanvas); override;
public
constructor CreateFromChild(AChild: TCellBlock; ChildX, ChildY: integer);
constructor CreateFromParent(AParent: TCellParent);
destructor Destroy; override;
end;
type
TForm1 = class(TForm)
ToolBar1: TToolBar;
ToolButton9: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ActionList1: TActionList;
FileNew1: TAction;
FileOpen1: TAction;
FileSave1: TAction;
FileSaveAs1: TAction;
FileExit1: TAction;
EditCut1: TEditCut;
EditCopy1: TEditCopy;
EditPaste1: TEditPaste;
HelpAbout1: TAction;
StatusBar: TStatusBar;
ImageList1: TImageList;
Image1: TImage;
Timer1: TTimer;
Label1: TLabel;
procedure FileNew1Execute(Sender: TObject);
procedure FileSave1Execute(Sender: TObject);
procedure FileExit1Execute(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FileOpen1Execute(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
private
MyBlock: TCellBlock;
MyBitmap: TBitmap;
BitmapData: array[0..1024,0..(1024 div 32)] of integer;
procedure InitLookupTable;
procedure RestartScreen;
public
{ Public declarations }
end;
var
Form1: TForm1;
const
cLiveCell = $88888888;
cLiveVerticalP = $40404040;
cLiveVerticalQ = $04040404;
cLiveTop = $00000088;
cLiveBottom = $88000000;
cLivePCorner = $00000040;
cLiveQCorner = $04000000;
cUnstableCell = $22222222;
cUnstableVerticalP = $10101010;
cUnstableVerticalQ = $01010101;
cUnstableTop = $00000022;
cUnstableBottom = $22000000;
cUnstablePCorner = $00000010;
cUnstableQCorner = $01000000;
cAllDead = $00000000;
cAllLive = $ffffffff;
cLiveRow = $8;
cLive2x2 = $4;
cUnstableRow = $2;
cUnstable8x4 = $22;
cUnstable2x2 = $1;
cUnstable2x4 = $11;
cStateMask: array [0..7] of cardinal =
($fffffff0, $ffffff0f, $fffff0ff, $ffff0fff, $fff0ffff, $ff0fffff, $f0ffffff, $0fffffff);
var
LookupTable: array[0..$FFFF] of byte;
Generation: int64;
implementation
uses about, sysutils, clipbrd, Math;
{$R *.dfm}
type
bool = longbool;
procedure getCPUticks(var i : int64);
begin
asm
mov ECX,i;
RDTSC; //cpu clock in EAX,EDX
mov [ECX],EAX;
mov [ECX+4],EDX;
end;
end;
function IntToBin(AInt: integer): string;
var
i: integer;
begin
i:= SizeOf(AInt)*8;
Result:= StringOfChar('0',i);
while (i > 0) do begin
if Odd(AInt) then Result[i]:= '1';
AInt:= AInt shr 1;
Dec(i);
end; {while}
end;
constructor TCellBlock.Create(AParent: TCellBlock);
begin
inherited Create;
FParent:= AParent;
ToDoQ[-1]:= $ffffffff;
ToDoP[-1]:= $ffffffff;
end;
destructor TCellBlock.Destroy;
begin
inherited Destroy;
end;
procedure TCell.SetPixel(x: Integer; y: Integer; InP: Boolean = true);
var
Mask: cardinal;
Offset: Integer;
begin
//0,0 is the topleft pixel, no correction for p,q fase.
x:= x mod 8;
y:= y mod 4;
Offset:= x * 4 + y;
Mask:= 1 shl Offset;
if (InP) then p:= p or Mask else q:= q or Mask;
end;
procedure TCellBlock.SetPixel(x: Integer; y: Integer);
var
GridX, GridY: integer;
x1,y1: integer;
i: integer;
begin
x:= x + (GridSizeX div 2) * CellSizeX;
y:= y + (GridSizeY div 2) * CellSizeY;
if Odd(Generation) then begin
Dec(x); Dec(y);
QCount:= 0;
end
else PCount:= 0;
GridX:= x div CellSizeX;
GridY:= y div CellSizeY;
if (GridX in [0..GridMaxX]) and (GridY in [0..GridMaxY]) then begin
Grid[GridX,GridY].SetPixel(x,y);
i:= 0;
for x1:= 1 to GridMaxX-1 do begin
for y1:= 1 to GridMaxY-1 do begin
case Odd(Generation) of
false: begin
ToDoP[i]:= (x1 shl 16 or y1);
Inc(PCount);
end;
true: begin
ToDoQ[i]:= (x1 shl 16 or y1);
Inc(QCount);
end;
end; {case}
Inc(i);
end; {for y}
end; {for x}
end; {if}
end;
//GeneratePtoQ
//This procedure generates the Q data and QState-flags
//using the P-data and PState-flags.
procedure TCellBlock.Generate;
begin
if Odd(Generation) then GenerateQtoP
else GeneratePtoQ;
Inc(Generation);
end;
const
MaskS = $cccccccc;
MaskE = $ff000000;
MaskSE = $cc000000;
procedure TCellBlock.GeneratePtoQ;
var
x,y: integer;
i: integer;
Change: cardinal;
ToDoA: TToDoList;
ToDoB: TToDoList;
A, B: integer;
done: boolean;
Address: cardinal;
begin
i:= 0;
A:= 0; B:= 0;
ToDoA[-1]:= $ffffffff;
ToDoB[-1]:= $ffffffff;
while (i < PCount) do begin
y:= ToDoP[i] and $FFFF;
x:= ToDoP[i] shr 16;
Inc(i);
if (x = GridMaxX) or (y = GridMaxY) then continue; //Skip the loop.
Change:= Grid[x,y].GeneratePtoQ;
if (Change <> 0) then begin
Address:= (x shl 16 or y);
if ToDoA[A-1] <> Address then begin
ToDoA[A]:= Address; Inc(A);
end;
if (Change and MaskS) <> 0 then begin
ToDoA[A]:= Address + 1;
Inc(A);
end; {if S changed}
if ((Change and MaskE) <> 0) then begin
Address:= Address + (1 shl 16);
if ToDoB[B-1] <> Address then begin
ToDoB[B]:= Address;
Inc(B);
end;
if ((Change and MaskSE) <> 0) then begin
ToDoB[B]:= Address + 1;
Inc(B);
end; {if SE changed}
end; {if E changed}
end; {if whole cell changed}
end; {while}
ToDoA[A]:= $ffffffff;
ToDoB[B]:= $ffffffff;
ToDoB[B+1]:= $ffffffff;
a:= 0; b:= 0; QCount:= 0;
Done:= (ToDoA[a] = $ffffffff) and (ToDoB[b] = $ffffffff);
while not done do begin
if ToDoA[a] <= ToDoB[b] then begin
ToDoQ[QCount]:= ToDoA[a]; inc(a); inc(QCount);
if ToDoA[a] = ToDoB[b] then inc(b);
end
else begin
ToDoQ[QCount]:= ToDoB[b]; inc(b); inc(QCount);
end;
Done:= (ToDoA[a] = $ffffffff) and (ToDoB[b] = $ffffffff);
end; {while}
end;
const
MaskN = $33333333;
MaskW = $000000ff;
MaskNW = $00000033;
procedure TCellBlock.GenerateQtoP;
var
x,y: integer;
i: integer;
Change: cardinal;
ToDoA: TToDoList;
ToDoB: TToDoList;
A, B: integer;
done: boolean;
Address: cardinal;
begin
i:= 0;
A:= 0; B:= 0;
ToDoA[-1]:= $ffffffff;
ToDoB[-1]:= $ffffffff;
while (i < QCount) do begin
y:= ToDoQ[i] and $FFFF;
x:= ToDoQ[i] shr 16;
Inc(i);
if (x = 0) or (y = 0) then Continue; //Skip the rest of the loop.
Change:= Grid[x,y].GenerateQtoP;
if (Change <> 0) then begin
Address:= (x shl 16 or y);
if ToDoA[A-1] <> Address then begin
ToDoA[A]:= Address; Inc(A);
end;
if (Change and MaskN) <> 0 then begin
ToDoA[A]:= Address - 1;
Inc(A);
end; {if N changed}
if ((Change and MaskW) <> 0) then begin
Address:= Address - (1 shl 16);
if ToDoB[B-1] <> Address then begin
ToDoB[B]:= Address;
Inc(B);
end;
if ((Change and MaskNW) <> 0) then begin
ToDoB[B]:= Address - 1;
Inc(B);
end; {if NW changed}
end; {if W changed}
end; {if whole cell changed}
end; {while}
ToDoA[A]:= $ffffffff;
ToDoB[B]:= $ffffffff;
ToDoB[B+1]:= $ffffffff;
a:= 0; b:= 0; PCount:= 0;
Done:= (ToDoA[a] = $ffffffff) and (ToDoB[b] = $ffffffff);
while not done do begin
if ToDoA[a] <= ToDoB[b] then begin
ToDoP[PCount]:= ToDoA[a]; inc(a); inc(PCount);
if ToDoA[a] = ToDoB[b] then inc(b);
end
else begin
ToDoP[PCount]:= ToDoB[b]; inc(b); inc(PCount);
end;
Done:= (ToDoA[a] = $ffffffff) and (ToDoB[b] = $ffffffff);
end; {while}
end;
(*
procedure TCellBlock.GenerateQtoP;
var
x,y: integer;
i: integer;
Change: cardinal;
begin
i:= 0;
for x:= 0 to GridMaxX - 1 do begin
for y:= 0 to GridMaxY -1 do begin
if Active[cIndexQ][x, y] then begin
Active[cIndexQ][x, y]:= false;
ToDo[i]:= x shl 16 or y;
Inc(i);
end; {if}
end; {for y}
end; {for x}
while i > 0 do begin
Dec(i);
y:= ToDo[i] and $FFFF;
x:= ToDo[i] shr 16;
Change:= Grid[x,y].GenerateQtoP;
Active[cIndexP][x,y]:= Active[cIndexP][x,y] or (Change <> 0);
Active[cIndexP][x-1,y-1]:= Active[cIndexP][x-1,y-1] or ((Change and $00000033) <> 0);
Active[cIndexP][x-1,y]:= Active[cIndexP][x-1,y] or ((Change and $000000ff) <> 0);
Active[cIndexP][x,y-1]:= Active[cIndexP][x,y-1] or ((Change and $33333333) <> 0);
end; {while}
end; (**)
procedure TCellBlock.UpdateFlagsPtoQ;
begin
//nog in te vullen.
end;
procedure TCellBlock.UpdateFlagsQtoP;
begin
//nog in te vullen
end;
function TCell.GeneratePtoQ: cardinal;
var
NewQ: cardinal;
Change: cardinal;
const
Mask1 = $f;
Mask2 = $ff;
Mask4 = $ffff;
Row1Mask = $33333333; //0011-0011-0011-0011-0011-0011-0011-0011
Row2Mask = $cccccccc; //1100-1100-1100-1100-1100-1100-1100-1100
function MakeNewBrick(p0,p1,p2,p3: cardinal): cardinal; inline;
var
Row1, Row2: cardinal;
begin
//Generate new Brick using a 2x2 grid of bricks ordered like:
//p0 p1
//p2 p3
//First row inside P0
if (p0 <> 0) then Row1:=
LookupTable[p0 and $ffff] or
LookupTable[(p0 shr 8) and $ffff] shl 8 or
LookupTable[(p0 shr 16)] shl 16 or
LookupTable[(p0 shr 24) or (p1 and $ff) shl 8] shl 24
else Row1:= LookupTable[(p1 and $ff) shl 8] shl 24;
(**)
p0:= ((p0 and $cccccccc)) or ((p2 and $33333333));
p1:= ((p1 and $cc)) or ((p3 and $33));
if (p0 <> 0) then Row2:=
LookupTable[p0 and $ffff] or
LookupTable[(p0 shr 8) and $ffff] shl 8 or
LookupTable[(p0 shr 16)] shl 16 or
LookupTable[(p0 shr 24) or ((p1 and $ff) shl 8)] shl 24
else Row2:= LookupTable[(p1 and $ff) shl 8] shl 24;
Result:= (Row1 and Row1Mask) or (Row2 and Row2Mask);
end;
begin
NewQ:= MakeNewBrick(Self.p, PGrid(@Self)^[1,0].p, PGrid(@Self)^[0,1].p, PGrid(@Self)^[1,1].p);
Result:= NewQ xor q;
q:= NewQ;
end;
function TCell.GenerateQtoP: cardinal;
var
Offset: integer;
NewP: cardinal;
Change: cardinal;
const
Row1Mask = $33333333; //0011-0011-0011-0011-0011-0011-0011-0011
Row2Mask = $cccccccc; //1100-1100-1100-1100-1100-1100-1100-1100
function MakeNewBrick(q0,q1,q2,q3: cardinal): cardinal; inline;
var
Row1, Row2: cardinal;
begin
//Generate new Brick using a 2x2 grid of bricks ordered like:
//q3 q2
//q1 q0
if (q0 <> 0) then Row1:=
LookupTable[(q0 shr 16)] shl 26 or
LookupTable[(q0 shr 8 ) and $ffff] shl 18 or
LookupTable[(q0 ) and $ffff] shl 10 or
LookupTable[((q0 and $ff) shl 8) or (q1 shr 24)] shl 2
else Row1:= LookupTable[(q1 shr 24)] shl 2;
(*
q0:= ((q0 and $33333333) shl 2) or ((q2 and $cccccccc) shr 2);
q1:= ((q1 and $33000000) shl 2) or ((q3 and $cc000000) shr 2);
if (q0 <> 0) then Row2:=
LookupTable[(q0 shr 16) and $ffff] shl 24 or
LookupTable[(q0 shr 8) and $ffff] shl 16 or
LookupTable[(q0 ) and $ffff] shl 8 or
LookupTable[((q0 and $ff) shl 8) or (q1 shr 24)]
else Row2:= LookupTable[(q1 shr 24)];
(**)
q0:= ((q0 and $33333333)) or ((q2 and $cccccccc));
q1:= ((q1 and $33000000)) or ((q3 and $cc000000));
if (q0 <> 0) then Row2:=
LookupTable[(q0 shr 16)] shl 22 or
LookupTable[(q0 shr 8) and $ffff] shl 14 or
LookupTable[(q0 ) and $ffff] shl 6 or
LookupTable[((q0 and $ff) shl 8) or (q1 shr 24)] shr 2
else Row2:= LookupTable[(q1 shr 24)] shr 2;
Result:= (Row1 and Row2Mask) or (Row2 and Row1Mask);
end;
begin
Offset:= -1;
NewP:= MakeNewBrick(Self.q, PGrid(@Self)^[Offset,0].q, PGrid(@Self)^[0,Offset].q, PGrid(@Self)^[Offset, Offset].q);
Result:= NewP xor P;
P:= NewP;
end;
procedure TCellBlock.Display(ACanvas: TCanvas);
var
GridX,GridY: integer;
//Offset: integer;
procedure DisplayCell(ACell: TCell);
var
x,y,x1,y1: integer;
Row, Mask: integer;
DoPixel: boolean;
Offset: integer;
DrawOffset: integer;
InP: boolean;
begin
DrawOffset:= (Generation and 1);
InP:= not(Odd(Generation));
for y:= 0 to CellMaxY do begin
for x:= 0 to CellMaxX do begin
//if (x = 0) or (y = 0) then ACanvas.Pixels[GridX*16+x+Offset,GridY*16+y+Offset]:= clBtnFace;
//0,0 is the topleft pixel, no correction for p,q fase.
x1:= x mod 8;
y1:= y mod 4;
Offset:= x1 * 4 + y1;
Mask:= 1 shl Offset;
if (InP) then DoPixel:= (ACell.p and Mask) <> 0
else DoPixel:= (ACell.q and Mask) <> 0;
if DoPixel then ACanvas.Pixels[GridX*CellSizeX+x+DrawOffset, GridY*CellSizeY+y+DrawOffset]:= clBlack;
end; {for x}
end; {for y}
end; (**)
begin
ACanvas.Rectangle(-1,-1,1000,1000);
FillChar(Form1.BitmapData, SizeOf(Form1.BitmapData), #0);
for GridY:= 0 to GridMaxY do begin
for GridX:= 0 to GridMaxX do begin
if Int64(Grid[GridX, GridY]) <> 0 then begin
DisplayCell(Grid[GridX,GridY]);
end;
end;
end;
end;
//--------------------------------------
//A Parent is every layer above the ground level
//the tree grows from the bottom up.
//A new parent is placed on top of the last one and
//always has one and only one child to start with, from there
//the tree grows down again.
constructor TCellParent.CreateFromChild(AChild: TCellBlock; ChildX: Integer; ChildY: Integer);
begin
inherited Create(nil);
end;
constructor TCellParent.CreateFromParent(AParent: TCellParent);
begin
inherited Create(AParent);
end;
destructor TCellParent.Destroy;
begin
inherited Destroy;
end;
procedure TCellParent.GeneratePtoQ;
begin
end;
procedure TCellParent.GenerateQtoP;
begin
end;
//The bitmap for the lookup table is as follows:
// 0 2 4 6
// +----+
// 1 |3 5| 7
// 8 |A C| E
// +----+
// 9 B D F
// The inner 2x2 cells are looked up.
// so 0241358AC make up bit 3 etc.
procedure TForm1.InitLookupTable;
const
//Masks for normal order.
MaskNW = $0757; //0000-0111-0101-0111
MaskSW = $0EAE; //0000-1110-1010-1110
MaskNE = $7570; //0111-0101-0111-0000
MaskSE = $EAE0; //1110-1010-1110-0000
//Bitlocations for normal order
BitNW = $0020; //0000-0000-0010-0000
BitSW = $0040; //0000-0000-0100-0000
BitNE = $0200; //0000-0020-0000-0000
BitSE = $0400; //0000-0100-0000-0000
//Lookup table also has a shifted order. here the bottom half of the N word
//and the top half of the south word combine.
//Like so:
// 2 6 A E
// 3 7 B F
// 0 4 8 C
// 1 5 9 D
//Mask for split order.
Mask2NW = $0D5D; // 0000-1101-0101-1101
Mask2SW = $0BAB; // 0000-1011-1010-1011
Mask2NE = $D5D0; // 1101-0101-1101-0000
Mask2SE = $BAB0; // 1011-1010-1011-0000
//Bitlocations for split order
Bit2NW = $0080; // 0000-0000-1000-0000
Bit2SW = $0010; // 0000-0000-0001-0000
Bit2NE = $0800; // 0000-1000-0000-0000
Bit2SE = $0100; // 0000-0001-0000-0000
ResultNW = $01;
ResultSW = $02;
ResultNE = $10;
ResultSE = $20;
Result2NW = $04;
Result2SW = $08;
Result2NE = $40;
Result2SE = $80;
var
i: integer;
iNW, iNE, iSW, iSE: cardinal;
Count: integer;
ResultByte: byte;
function GetCount(a: integer): integer;
var
c: integer;
begin
Result:= 0;
for c:= 0 to 15 do begin
if Odd(a shr c) then Inc(Result);
end; {for c}
end; {GetCount}
begin
//Fill the normal lookup.
for i:= 0 to $ffff do begin
ResultByte:= 0;
iNW:= i and MaskNW;
Count:= GetCount(iNW);
case Count of //count excluding bit itself
3: ResultByte:= ResultNW;
2: if ((i and BitNW) <> 0) then ResultByte:= ResultNW;
end;
iSW:= i and MaskSW;
Count:= GetCount(iSW);
case Count of
3: ResultByte:= ResultByte or ResultSW;
2: if ((i and BitSW) <> 0) then ResultByte:= ResultByte or ResultSW;
end;
iNE:= i and MaskNE;
Count:= GetCount(iNE);
case Count of
3: ResultByte:= ResultByte or ResultNE;
2: if ((i and BitNE) <> 0) then ResultByte:= ResultByte or ResultNE;
end;
iSE:= i and MaskSE;
Count:= GetCount(iSE);
case Count of
3: ResultByte:= ResultByte or ResultSE;
2: if ((i and BitSE) <> 0) then ResultByte:= ResultByte or ResultSE;
end;
LookupTable[i]:= ResultByte;
end; {for i}
//Fill the shifted lookup.
for i:= 0 to $ffff do begin
ResultByte:= 0;
iNW:= i and Mask2NW;
Count:= GetCount(iNW);
case Count of //count excluding bit itself
3: ResultByte:= Result2NW;
2: if ((i and Bit2NW) <> 0) then ResultByte:= Result2NW;
end;
iSW:= i and Mask2SW;
Count:= GetCount(iSW);
case Count of
3: ResultByte:= ResultByte or Result2SW;
2: if ((i and Bit2SW) <> 0) then ResultByte:= ResultByte or Result2SW;
end;
iNE:= i and Mask2NE;
Count:= GetCount(iNE);
case Count of
3: ResultByte:= ResultByte or Result2NE;
2: if ((i and Bit2NE) <> 0) then ResultByte:= ResultByte or Result2NE;
end;
iSE:= i and Mask2SE;
Count:= GetCount(iSE);
case Count of
3: ResultByte:= ResultByte or Result2SE;
2: if ((i and Bit2SE) <> 0) then ResultByte:= ResultByte or Result2SE;
end;
LookupTable[i]:= LookupTable[i] or ResultByte;
end; {for i} (**)
end;
procedure TForm1.RestartScreen;
begin
MyBlock.Free;
MyBlock:= TCellBlock.Create(nil);
//MyBlock.SetPixel(5,7);
//MyBlock.SetPixel(6,7);
//MyBlock.SetPixel(7,7);
//MyBlock.SetPixel(7,6);
//MyBlock.SetPixel(6,5);
MyBlock.SetPixel(10,0);
MyBlock.SetPixel(11,0);
MyBlock.SetPixel(9,1);
MyBlock.SetPixel(10,1);
MyBlock.SetPixel(10,2);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Assigned(MyBlock) then begin
MyBlock.Generate;
MyBlock.Display(Image1.Canvas);
end;
end;
procedure TForm1.ToolButton4Click(Sender: TObject);
begin
if Assigned(MyBlock) then begin
MyBlock.Generate;
MyBlock.Display(Image1.Canvas);
end;
end;
procedure TForm1.FileNew1Execute(Sender: TObject);
begin
InitLookupTable;
FillChar(BitmapData, SizeOf(BitmapData), #0);
MyBitmap:= TBitmap.Create;
MyBitmap.SetSize(1024,1024);
MyBitmap.PixelFormat:= pf1bit;
MyBitmap.Monochrome:= true;
//MyBitmap.Handle:= CreateBitmap(1000,1000,1,2,nil);
Generation:= 0;
RestartScreen;
MyBlock.Display(Image1.Canvas);
//if (Sender = FileNew1) then Timer1.Enabled:= not(Timer1.Enabled);
end;
procedure TForm1.FileOpen1Execute(Sender: TObject);
var
i,a: integer;
start, eind: int64;
Diff: double;
LowDiff: double;
begin
LowDiff:= MaxInt;
for a:= 0 to 10 do begin
FileNew1Execute(Sender);
GetCPUTicks(start);
for i:= 0 to 1000 do begin
MyBlock.Generate;
end;
GetCPUTicks(eind);
//Label1.Caption:= IntToStr(Eind - Start);
Diff:= Eind - start;
LowDiff:= Min(Diff, LowDiff);
Label1.Caption:= Format('%10.0n',[lowdiff]) + ' CPU cycles per 1,000 generations';
Clipboard.AsText:= Label1.Caption;
end; {for a}
MyBlock.Display(Image1.Canvas);
end;
procedure TForm1.FileSave1Execute(Sender: TObject);
begin
Timer1.Enabled:= not(Timer1.Enabled);
end;
procedure TForm1.FileExit1Execute(Sender: TObject);
begin
Close;
end;
initialization
Generation:= 0;
end.
StackOverflow non mi consente di pubblicare il file del modulo a causa di un limite di dimensioni, ma spero che tu possa gestirti senza.
