How to resolve the algorithm Abelian sandpile model step by step in the Delphi programming language

Published on 12 May 2024 09:40 PM

How to resolve the algorithm Abelian sandpile model step by step in the Delphi programming language

Table of Contents

Problem Statement

Implement the Abelian sandpile model also known as Bak–Tang–Wiesenfeld model. Its history, mathematical definition and properties can be found under its wikipedia article. The task requires the creation of a 2D grid of arbitrary size on which "piles of sand" can be placed. Any "pile" that has 4 or more sand particles on it collapses, resulting in four particles being subtracted from the pile and distributed among its neighbors. It is recommended to display the output in some kind of image format, as terminal emulators are usually too small to display images larger than a few dozen characters tall. As an example of how to accomplish this, see the Bitmap/Write a PPM file task. Examples up to 2^30, wow! javascript running on web Examples:

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Abelian sandpile model step by step in the Delphi programming language

Source code in the delphi programming language

program Abelian_sandpile_model;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  Vcl.Graphics,
  System.Classes;

type
  TGrid = array of array of Integer;

function Iterate(var Grid: TGrid): Boolean;
var
  changed: Boolean;
  i: Integer;
  j: Integer;
  val: Integer;
  Alength: Integer;
begin
  Alength := length(Grid);
  changed := False;

  for i := 0 to High(Grid) do
    for j := 0 to High(Grid[0]) do
    begin
      val := Grid[i, j];
      if val > 3 then
      begin
        Grid[i, j] := Grid[i, j] - 4;

        if i > 0 then
          Grid[i - 1, j] := Grid[i - 1, j] + 1;

        if i < Alength - 1 then
          Grid[i + 1, j] := Grid[i + 1, j] + 1;

        if j > 0 then
          Grid[i, j - 1] := Grid[i, j - 1] + 1;

        if j < Alength - 1 then
          Grid[i, j + 1] := Grid[i, j + 1] + 1;
        changed := True;
      end;
    end;
  Result := changed;
end;

procedure Simulate(var Grid: TGrid);
var
  changed: Boolean;
begin
  while Iterate(Grid) do
    ;
end;

procedure Zeros(var Grid: TGrid; Size: Integer);
var
  i, j: Integer;
begin
  SetLength(Grid, Size, Size);
  for i := 0 to Size - 1 do
    for j := 0 to Size - 1 do
      Grid[i, j] := 0;
end;

procedure Println(Grid: TGrid);
var
  i, j: Integer;
begin
  for i := 0 to High(Grid) do
  begin
    Writeln;
    for j := 0 to High(Grid[0]) do
      Write(Format('%3d', [Grid[i, j]]));
  end;
  Writeln;
end;

function Grid2Bmp(Grid: TGrid): TBitmap;
const
  Colors: array[0..2] of TColor = (clRed, clLime, clBlue);
var
  Alength: Integer;
  i: Integer;
  j: Integer;
begin
  Alength := Length(Grid);

  Result := TBitmap.Create;
  Result.SetSize(Alength, Alength);

  for i := 0 to Alength - 1 do
    for j := 0 to Alength - 1 do
    begin
      Result.Canvas.Pixels[i, j] := Colors[Grid[i, j]];
    end;
end;

procedure Grid2P6(Grid: TGrid; FileName: TFileName);
var
  f: text;
  i, j, Alength: Integer;
  ppm: TFileStream;
  Header: AnsiString;
const
  COLORS: array[0..3] of array[0..2] of byte =
 //  R,   G,    B
((0   ,   0,    0),
 (255 ,   0,    0),
 (0   , 255,   0),
 (0   ,   0, 255));
begin
  Alength := Length(Grid);
  ppm := TFileStream.Create(FileName, fmCreate);
  Header := Format('P6'#10'%d %d'#10'255'#10, [Alength, Alength]);
  writeln(Header);
  ppm.Write(Tbytes(Header), Length(Header));

  for i := 0 to Alength - 1 do
    for j := 0 to Alength - 1 do
    begin
      ppm.Write(COLORS[Grid[i, j]], 3);
    end;
  ppm.Free;
end;

const
  DIMENSION = 10;

var
  Grid: TGrid;
  bmp: TBitmap;

begin
  Zeros(Grid, DIMENSION);
  Grid[4, 4] := 64;
  Writeln('Before:');
  Println(Grid);

  Simulate(Grid);

  Writeln(#10'After:');
  Println(Grid);

  // Output bmp
  with Grid2Bmp(Grid) do
  begin
    SaveToFile('output.bmp');
    free;
  end;

  // Output ppm
  Grid2P6(Grid, 'output.ppm');

  Readln;
end.


  

You may also check:How to resolve the algorithm Bitmap/Bresenham's line algorithm step by step in the XPL0 programming language
You may also check:How to resolve the algorithm Sierpinski triangle step by step in the Excel programming language
You may also check:How to resolve the algorithm Generator/Exponential step by step in the REXX programming language
You may also check:How to resolve the algorithm Comments step by step in the ACL2 programming language
You may also check:How to resolve the algorithm Hello world/Text step by step in the Python programming language