Recent

Author Topic: Minkowski Island: Fill color/back color Problems  (Read 2700 times)

Boleeman

  • Sr. Member
  • ****
  • Posts: 471
Minkowski Island: Fill color/back color Problems
« on: April 08, 2024, 03:22:22 pm »
Created a Minkowski Island fractal

Read about it here https://mathworld.wolfram.com/MinkowskiSausage.html 
and here https://en.wikipedia.org/wiki/Minkowski_sausage


It's basically a square Quadratic Koch curve.

Can't figure out why its messing up at recursion levels greater than 3.
Thought it may be a round of error, seeings as it happens at higher recursion level but cant trace it.
Noticed that when I resize the form at level 4 that gap changes. So perhaps its a scaling problem.

Some Graphic GURU advice is needed.
« Last Edit: April 09, 2024, 05:36:43 am by Boleeman »

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2220
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Minkowski Island: Problems at higher levels
« Reply #1 on: April 08, 2024, 03:36:07 pm »
By watching pictures, the left image does do those strokes to compensate the missing space to paint full element so my guess is that at initial the value for length for each stroke is calculated wrong.
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Martin_fr

  • Administrator
  • Hero Member
  • *
  • Posts: 9986
  • Debugger - SynEdit - and more
    • wiki
Re: Minkowski Island: Problems at higher levels
« Reply #2 on: April 08, 2024, 04:49:38 pm »
Maybe rounding errors. E.g. you keep summing up floats, and compare against x. But the floats will never reach x.

For example
Code: Pascal  [Select][+][-]
  1. program Project1;
  2. var
  3.   a: double;
  4. begin
  5.   a := 2.0;
  6.   while a <> 0 do begin
  7.     a := a - 2 / 5;
  8.     writeln(a);
  9.   end;
  10. end.

will continue running. Because 2/5 is rounded in binary, and not exactly 0.4

So, maybe something like that?

Use "SameValue()" from unit math.

tetrastes

  • Sr. Member
  • ****
  • Posts: 491
Re: Minkowski Island: Problems at higher levels
« Reply #3 on: April 08, 2024, 07:05:24 pm »
Try this
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons,
  9.   StdCtrls, Spin, Math;
  10.  
  11. type
  12.  
  13.   TPointSingle = record
  14.     X: single;
  15.     Y: single;
  16.   end;
  17.  
  18.   { TForm1 }
  19.  
  20.   TForm1 = class(TForm)
  21.     Label1: TLabel;
  22.     Label2: TLabel;
  23.     PaintBox1: TPaintBox;
  24.     Panel1: TPanel;
  25.     seDepth: TSpinEdit;
  26.     seLinewidth: TSpinEdit;
  27.     procedure PaintBox1Paint(Sender: TObject);
  28.     procedure seDepthChange(Sender: TObject);
  29.     procedure seLinewidthChange(Sender: TObject);
  30.   private
  31.    Initiator: array of TPointSingle;
  32.    ScaleFactor: Single;
  33.    GeneratorDTheta: array of Single;
  34.    procedure DrawSnowflake(ACanvas: TCanvas; depth: Integer);
  35.    procedure DrawSnowflakeEdge(ACanvas: TCanvas; depth: Integer; var p1: TPointSingle;
  36.   theta: Single; dist: Single);
  37.   public
  38.  
  39.   end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.  
  44. implementation
  45.  
  46. {$R *.lfm}
  47.  
  48. procedure TForm1.DrawSnowflakeEdge(ACanvas: TCanvas; depth: Integer; var p1: TPointSingle;
  49.   theta: Single; dist: Single);
  50. var
  51.   i: Integer;
  52.   p2: TPointSingle;
  53.   ip1, ip2: TPoint;
  54. begin
  55.   if depth = 0 then
  56.   begin
  57.     p2.X := p1.X + (dist * Cos(theta + Pi / 2));
  58.     p2.Y := p1.Y + (dist * Sin(theta + Pi / 2));
  59.  
  60.     ip1.X := Trunc(p1.X + 0.5);      // Because  "banker's rounding" is not what I was taught in University
  61.     ip1.Y := Trunc(p1.Y + 0.5);
  62.     ip2.X := Trunc(p2.X + 0.5);
  63.     ip2.Y := Trunc(p2.Y + 0.5);
  64.     ACanvas.Line(ip1, ip2);
  65.     p1 := p2;
  66.     Exit;
  67.   end;
  68.  
  69.   dist := dist / Sqrt(5.0);
  70.   for i := 0 to High(GeneratorDTheta) do
  71.   begin
  72.     theta := theta + GeneratorDTheta[i];
  73.     DrawSnowflakeEdge(ACanvas, depth - 1, p1, theta, dist);
  74.   end;
  75. end;
  76.  
  77. procedure TForm1.DrawSnowflake(ACanvas: TCanvas; depth: Integer);
  78. var
  79.   i: Integer;
  80.   p1, p2: TPointSingle;
  81.   dx, dy, length, theta: Single;
  82. begin
  83.   Canvas.Clear;
  84.  
  85.   for i := 1 to High(Initiator) do
  86.   begin
  87.     p1 := Initiator[i - 1];
  88.     p2 := Initiator[i];
  89.  
  90.     dx := p2.X - p1.X;
  91.     dy := p2.Y - p1.Y;
  92.     length := Sqrt(dx * dx + dy * dy);
  93.     theta := ArcTan2(dy, dx);
  94.     DrawSnowflakeEdge(ACanvas, depth, p1, theta, length);
  95.   end;
  96. end;
  97.  
  98. procedure TForm1.PaintBox1Paint(Sender: TObject);
  99. var
  100.   MinDimension: Integer;
  101. begin
  102.  
  103.   SetLength(Initiator, 0);
  104.   SetLength(GeneratorDTheta, 0);
  105.  
  106.   // Ensure Initiator array is properly initialized
  107.   if Length(Initiator) < 5 then
  108.     SetLength(Initiator, 5);
  109.  
  110.  
  111.   MinDimension := Min(PaintBox1.Width, PaintBox1.Height);
  112.   MinDimension := MinDimension - 300;
  113.  
  114.   if Length(Initiator) >= 5 then // Ensure Initiator array has enough elements
  115.   begin
  116.     {Initiator[0] := Point(Round((PaintBox1.Width - MinDimension) / 2), Round((PaintBox1.Height - MinDimension) / 2));
  117.     Initiator[1] := Point(Round((PaintBox1.Width + MinDimension) / 2), Round((PaintBox1.Height - MinDimension) / 2));
  118.     Initiator[2] := Point(Round((PaintBox1.Width + MinDimension) / 2), Round((PaintBox1.Height + MinDimension) / 2));
  119.     Initiator[3] := Point(Round((PaintBox1.Width - MinDimension) / 2), Round((PaintBox1.Height + MinDimension) / 2));
  120.     Initiator[4] := Initiator[0];}
  121.     Initiator[0].X := (PaintBox1.Width - MinDimension) / 2;
  122.     Initiator[0].Y := (PaintBox1.Height - MinDimension) / 2;
  123.     Initiator[1].X := (PaintBox1.Width + MinDimension) / 2;
  124.     Initiator[1].Y := (PaintBox1.Height - MinDimension) / 2;
  125.     Initiator[2].X := (PaintBox1.Width + MinDimension) / 2;
  126.     Initiator[2].Y := (PaintBox1.Height + MinDimension) / 2;
  127.     Initiator[3].X := (PaintBox1.Width - MinDimension) / 2;
  128.     Initiator[3].Y := (PaintBox1.Height + MinDimension) / 2;
  129.     Initiator[4] := Initiator[0];
  130.   end;
  131.  
  132.   ScaleFactor := 1 / Sqrt(5);
  133.   GeneratorDTheta := nil;
  134.   SetLength(GeneratorDTheta, 3);
  135.   GeneratorDTheta[0] := -ArcTan(1 / 2);
  136.   GeneratorDTheta[1] := Pi / 2;
  137.   GeneratorDTheta[2] := -Pi / 2;
  138.  
  139.   // Redraw the snowflake with the adjusted level
  140.   DrawSnowflake(PaintBox1.Canvas, seDepth.Value);
  141. end;
  142.  
  143. procedure TForm1.seDepthChange(Sender: TObject);
  144. begin
  145.   PaintBox1.Invalidate;
  146. end;
  147.  
  148. procedure TForm1.seLinewidthChange(Sender: TObject);
  149. begin
  150.   PaintBox1.Canvas.Pen.Width := seLinewidth.Value;
  151.   PaintBox1.Invalidate;
  152. end;
  153.  
  154. end.

Boleeman

  • Sr. Member
  • ****
  • Posts: 471
Re: Minkowski Island: Problems at higher levels
« Reply #4 on: April 09, 2024, 03:41:48 am »
Thanks tetrastes.

Looks like the issue was using point and rounding.
I looked at breaking down into x and y point locations, but I was still rounding to get rid of extended value error.

Using Initiator[0].X  and Initiator[0].Y type syntax without the rounding was what I was completely missing.

Also was good to know about:
    ip1.X := Trunc(p1.X + 0.5);      // Because  "banker's rounding" is not what I was taught in University
    ip1.Y := Trunc(p1.Y + 0.5);
    ip2.X := Trunc(p2.X + 0.5);
    ip2.Y := Trunc(p2.Y + 0.5);

Noticed now when resizing the form, the fractal resizes well.

Thanks once again for your great help.


Boleeman

  • Sr. Member
  • ****
  • Posts: 471
Re: Minkowski Island: Problems at higher levels
« Reply #5 on: April 09, 2024, 05:31:02 am »
I tried setting the fill color of the fractal with a TColorbutton called cbFillcolor and the backcolor of Paintabox1 with a TColorbutton called cbBackcolor but I could not get that to work.

Usually its simple to do for a TPaintbox, but don't know why it did not change colors.

Here is the complete code:

Code: Pascal  [Select][+][-]
  1.  unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons,
  9.   StdCtrls, Spin, Math;
  10.  
  11. type
  12.  
  13.   TPointSingle = record
  14.     X: single;
  15.     Y: single;
  16.   end;
  17.  
  18.   { TForm1 }
  19.  
  20.   TForm1 = class(TForm)
  21.     cbLinecolor: TColorButton;
  22.     cbBackcolor: TColorButton;
  23.     cbFillcolor: TColorButton;
  24.     Label1: TLabel;
  25.     Label2: TLabel;
  26.     Label3: TLabel;
  27.     Label4: TLabel;
  28.     Label5: TLabel;
  29.     PaintBox1: TPaintBox;
  30.     Panel1: TPanel;
  31.     seDepth: TSpinEdit;
  32.     seLinewidth: TSpinEdit;
  33.     procedure cbFillcolorColorChanged(Sender: TObject);
  34.     procedure cbLinecolorColorChanged(Sender: TObject);
  35.     procedure cbBackcolorColorChanged(Sender: TObject);
  36.     procedure PaintBox1Paint(Sender: TObject);
  37.     procedure seDepthChange(Sender: TObject);
  38.     procedure seLinewidthChange(Sender: TObject);
  39.   private
  40.    Initiator: array of TPointSingle;
  41.    ScaleFactor: Single;
  42.    GeneratorDTheta: array of Single;
  43.    procedure DrawSnowflake(ACanvas: TCanvas; depth: Integer);
  44.    procedure DrawSnowflakeEdge(ACanvas: TCanvas; depth: Integer; var p1: TPointSingle;
  45.   theta: Single; dist: Single);
  46.    procedure FillSnowflake(ACanvas: TCanvas; CenterPoint: TPoint; depth: Integer; p1: TPointSingle;
  47.   theta: Single; dist: Single);
  48.   public
  49.  
  50.   end;
  51.  
  52. var
  53.   Form1: TForm1;
  54.  
  55. implementation
  56.  
  57. {$R *.lfm}
  58.  
  59. procedure TForm1.FillSnowflake(ACanvas: TCanvas; CenterPoint: TPoint; depth: Integer; p1: TPointSingle;
  60.   theta: Single; dist: Single);
  61. var
  62.   i: Integer;
  63.   p2: TPointSingle;
  64.   Points: array of TPoint;
  65. begin
  66.   if depth = 0 then
  67.     Exit;
  68.  
  69.   SetLength(Points, 5);
  70.  
  71.   for i := 1 to High(Initiator) do
  72.   begin
  73.     p1 := Initiator[i - 1];
  74.     p2 := Initiator[i];
  75.  
  76.     Points[0] := CenterPoint;
  77.     Points[1].X := Round(p1.X);
  78.     Points[1].Y := Round(p1.Y);
  79.     Points[2].X := Round(p2.X);
  80.     Points[2].Y := Round(p2.Y);
  81.     Points[3] := CenterPoint;
  82.     Points[4] := Points[1];
  83.  
  84.     ACanvas.Polygon(Points);
  85.   end;
  86. end;
  87.  
  88. procedure TForm1.DrawSnowflakeEdge(ACanvas: TCanvas; depth: Integer; var p1: TPointSingle;
  89.   theta: Single; dist: Single);
  90. var
  91.   i: Integer;
  92.   p2: TPointSingle;
  93.   ip1, ip2: TPoint;
  94. begin
  95.   if depth = 0 then
  96.   begin
  97.     p2.X := p1.X + (dist * Cos(theta + Pi / 2));
  98.     p2.Y := p1.Y + (dist * Sin(theta + Pi / 2));
  99.  
  100.     ip1.X := Trunc(p1.X + 0.5);      // Because  "banker's rounding" is not what I was taught in University
  101.     ip1.Y := Trunc(p1.Y + 0.5);
  102.     ip2.X := Trunc(p2.X + 0.5);
  103.     ip2.Y := Trunc(p2.Y + 0.5);
  104.     ACanvas.Line(ip1, ip2);
  105.     p1 := p2;
  106.     Exit;
  107.   end;
  108.  
  109.   dist := dist / Sqrt(5.0);
  110.   for i := 0 to High(GeneratorDTheta) do
  111.   begin
  112.     theta := theta + GeneratorDTheta[i];
  113.     DrawSnowflakeEdge(ACanvas, depth - 1, p1, theta, dist);
  114.   end;
  115. end;
  116.  
  117. procedure TForm1.DrawSnowflake(ACanvas: TCanvas; depth: Integer);
  118. var
  119.   i: Integer;
  120.   p1, p2: TPointSingle;
  121.   dx, dy, length, theta: Single;
  122. begin
  123.   ACanvas.Pen.Color := cbLinecolor.ButtonColor;
  124.  
  125.   for i := 1 to High(Initiator) do
  126.   begin
  127.     p1 := Initiator[i - 1];
  128.     p2 := Initiator[i];
  129.  
  130.     dx := p2.X - p1.X;
  131.     dy := p2.Y - p1.Y;
  132.     length := Sqrt(dx * dx + dy * dy);
  133.     theta := ArcTan2(dy, dx);
  134.     DrawSnowflakeEdge(ACanvas, depth, p1, theta, length);
  135.   end;
  136. end;
  137.  
  138. procedure TForm1.PaintBox1Paint(Sender: TObject);
  139. var
  140.   MinDimension: Integer;
  141. begin
  142.  
  143.   SetLength(Initiator, 0);
  144.   SetLength(GeneratorDTheta, 0);
  145.  
  146.   // Ensure Initiator array is properly initialized
  147.   if Length(Initiator) < 5 then
  148.     SetLength(Initiator, 5);
  149.  
  150.  
  151.   MinDimension := Min(PaintBox1.Width, PaintBox1.Height);
  152.   MinDimension := MinDimension - 300;
  153.  
  154.   if Length(Initiator) >= 5 then // Ensure Initiator array has enough elements
  155.   begin
  156.  
  157.     Initiator[0].X := (PaintBox1.Width - MinDimension) / 2;
  158.     Initiator[0].Y := (PaintBox1.Height - MinDimension) / 2;
  159.     Initiator[1].X := (PaintBox1.Width + MinDimension) / 2;
  160.     Initiator[1].Y := (PaintBox1.Height - MinDimension) / 2;
  161.     Initiator[2].X := (PaintBox1.Width + MinDimension) / 2;
  162.     Initiator[2].Y := (PaintBox1.Height + MinDimension) / 2;
  163.     Initiator[3].X := (PaintBox1.Width - MinDimension) / 2;
  164.     Initiator[3].Y := (PaintBox1.Height + MinDimension) / 2;
  165.     Initiator[4] := Initiator[0];
  166.   end;
  167.  
  168.   ScaleFactor := 1 / Sqrt(5);
  169.   GeneratorDTheta := nil;
  170.   SetLength(GeneratorDTheta, 3);
  171.   GeneratorDTheta[0] := -ArcTan(1 / 2);
  172.   GeneratorDTheta[1] := Pi / 2;
  173.   GeneratorDTheta[2] := -Pi / 2;
  174.  
  175.   DrawSnowflake(PaintBox1.Canvas, seDepth.Value);
  176. end;
  177.  
  178. procedure TForm1.cbLinecolorColorChanged(Sender: TObject);
  179. begin
  180. PaintBox1.Canvas.Pen.Color := cbLinecolor.ButtonColor;
  181. PaintBox1.Invalidate;
  182. end;
  183.  
  184. procedure TForm1.cbFillcolorColorChanged(Sender: TObject);
  185. begin
  186.  PaintBox1.Invalidate;
  187. end;
  188.  
  189. procedure TForm1.cbBackcolorColorChanged(Sender: TObject);
  190. begin
  191.   PaintBox1.Invalidate;
  192. end;
  193.  
  194. procedure TForm1.seDepthChange(Sender: TObject);
  195. begin
  196.   PaintBox1.Invalidate;
  197. end;
  198.  
  199. procedure TForm1.seLinewidthChange(Sender: TObject);
  200. begin
  201.   PaintBox1.Canvas.Pen.Width := seLinewidth.Value;
  202.   PaintBox1.Invalidate;
  203. end;
  204.  
  205. end.


I could change the line color of the fractal.
« Last Edit: April 09, 2024, 05:34:31 am by Boleeman »

tetrastes

  • Sr. Member
  • ****
  • Posts: 491
Re: Minkowski Island: Fill color/back color Problems
« Reply #6 on: April 09, 2024, 10:21:00 am »
You call FillSnowflake nowhere, and don't use cbFillcolor.ButtonColor and cbBackcolor.ButtonColor.

Boleeman

  • Sr. Member
  • ****
  • Posts: 471
Re: Minkowski Island: Fill color/back color Problems
« Reply #7 on: April 09, 2024, 12:15:32 pm »
I made fillsnowflake like this:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.FillSnowflake(ACanvas: TCanvas; CenterPoint: TPoint; depth: Integer; p1: TPointSingle;
  2.   theta: Single; dist: Single);
  3. var
  4.   i: Integer;
  5.   p2: TPointSingle;
  6.   Points: array of TPoint;
  7. begin
  8.   if depth = 0 then
  9.     Exit;
  10.  
  11.   SetLength(Points, 5);
  12.  
  13.   for i := 1 to High(Initiator) do
  14.   begin
  15.     p1 := Initiator[i - 1];
  16.     p2 := Initiator[i];
  17.  
  18.     Points[0] := CenterPoint;
  19.     Points[1].X := Round(p1.X);
  20.     Points[1].Y := Round(p1.Y);
  21.     Points[2].X := Round(p2.X);
  22.     Points[2].Y := Round(p2.Y);
  23.     Points[3] := CenterPoint;
  24.     Points[4] := Points[1];
  25.  
  26.     ACanvas.Brush.Color := cbFillcolor.ButtonColor;
  27.     ACanvas.Polygon(Points);
  28.   end;
  29. end;      

and then I called it in procedure TForm1.PaintBox1Paint(Sender: TObject);

Code: Pascal  [Select][+][-]
  1. procedure TForm1.PaintBox1Paint(Sender: TObject);
  2. var
  3.   MinDimension: Integer;
  4. begin
  5.  
  6.   SetLength(Initiator, 0);
  7.   SetLength(GeneratorDTheta, 0);
  8.  
  9.   // Ensure Initiator array is properly initialized
  10.   if Length(Initiator) < 5 then
  11.     SetLength(Initiator, 5);
  12.  
  13.  
  14.   MinDimension := Min(PaintBox1.Width, PaintBox1.Height);
  15.   MinDimension := MinDimension - 300;
  16.  
  17.   if Length(Initiator) >= 5 then // Ensure Initiator array has enough elements
  18.   begin
  19.  
  20.     Initiator[0].X := (PaintBox1.Width - MinDimension) / 2;
  21.     Initiator[0].Y := (PaintBox1.Height - MinDimension) / 2;
  22.     Initiator[1].X := (PaintBox1.Width + MinDimension) / 2;
  23.     Initiator[1].Y := (PaintBox1.Height - MinDimension) / 2;
  24.     Initiator[2].X := (PaintBox1.Width + MinDimension) / 2;
  25.     Initiator[2].Y := (PaintBox1.Height + MinDimension) / 2;
  26.     Initiator[3].X := (PaintBox1.Width - MinDimension) / 2;
  27.     Initiator[3].Y := (PaintBox1.Height + MinDimension) / 2;
  28.     Initiator[4] := Initiator[0];
  29.   end;
  30.  
  31.   ScaleFactor := 1 / Sqrt(5);
  32.   GeneratorDTheta := nil;
  33.   SetLength(GeneratorDTheta, 3);
  34.   GeneratorDTheta[0] := -ArcTan(1 / 2);
  35.   GeneratorDTheta[1] := Pi / 2;
  36.   GeneratorDTheta[2] := -Pi / 2;
  37.  
  38.   DrawSnowflake(PaintBox1.Canvas, seDepth.Value);
  39.   FillSnowflake(PaintBox1.Canvas, Point(PaintBox1.Width div 2, PaintBox1.Height div 2), seDepth.Value, Initiator[0], 0, 0);
  40. end;                        


I also tried calling it recursively:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.FillSnowflake(ACanvas: TCanvas; CenterPoint: TPoint; depth: Integer;
  2.   p1: TPointSingle; theta: Single; dist: Single);
  3. var
  4.   i: Integer;
  5.   p2: TPointSingle;
  6.   Points: array of TPoint;
  7. begin
  8.   if depth = 0 then
  9.     Exit;
  10.  
  11.   SetLength(Points, 5);
  12.  
  13.   for i := 1 to High(Initiator) do
  14.   begin
  15.     p1 := Initiator[i - 1];
  16.     p2 := Initiator[i];
  17.  
  18.     Points[0] := CenterPoint;
  19.     Points[1].X := Round(p1.X);
  20.     Points[1].Y := Round(p1.Y);
  21.     Points[2].X := Round(p2.X);
  22.     Points[2].Y := Round(p2.Y);
  23.     Points[3] := CenterPoint;
  24.     Points[4] := Points[1];
  25.  
  26.     // Fill the region with the fill color
  27.     ACanvas.Brush.Color := cbFillcolor.ButtonColor; // Use the color from cbFillcolor
  28.     ACanvas.Polygon(Points);
  29.  
  30.     // Recursively fill the inner segments
  31.     p1.X := CenterPoint.X + (p1.X - CenterPoint.X) * ScaleFactor;
  32.     p1.Y := CenterPoint.Y + (p1.Y - CenterPoint.Y) * ScaleFactor;
  33.     p2.X := CenterPoint.X + (p2.X - CenterPoint.X) * ScaleFactor;
  34.     p2.Y := CenterPoint.Y + (p2.Y - CenterPoint.Y) * ScaleFactor;
  35.     FillSnowflake(ACanvas, CenterPoint, depth - 1, p1, theta, dist);
  36.   end;
  37. end;

Still get 1 square filled only.


 

TinyPortal © 2005-2018