Sierpinski Triangle & Carpet
Sierpinski’s Triangle is the famous fractal pattern triangle - wherein the largest triangle is filled with an infinite number of smaller triangles down to the pixel. The beauty of the triangle is in its simplicity, which makes the triangle eye-catching yet understandable.
In this case, the visualisation was produced by generating an array in a loop, which took into consideration each individual part of the triangle and removing the relevant triangles to create a fractal effect. Similar to this was Sierpinski’s carpet, which utilised a square shape instead, producing an equally stunning fractal.
Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Module Carpet
Sub Main()
Using bmp As New Drawing.Bitmap(3000, 3000), graphics As Drawing.Graphics = Drawing.Graphics.FromImage(bmp)
Dim Squares, NewSquares As New Collections.Generic.List(Of Drawing.Rectangle)
Squares.Add(New Drawing.Rectangle(New Drawing.Point(0, 0), New Drawing.Size(3000, 3000)))
NewSquares.Add(New Drawing.Rectangle(New Drawing.Point(0, 0), New Drawing.Size(3000, 3000)))
For i = 0 To 4
For Each Item In Squares
Dim Height As Double = Item.Size.Height / 3
Dim Width As Double = Item.Size.Width / 3
Dim X As Double = Item.X
' The 9 Squares in current grid.
Dim Square1 As New Drawing.Rectangle(New Drawing.Point(Item.X, Item.Y), New Drawing.Size(Height, Width))
Dim Square2 As New Drawing.Rectangle(New Drawing.Point(Item.X, Item.Y + Height), New Drawing.Size(Height, Width))
Dim Square3 As New Drawing.Rectangle(New Drawing.Point(Item.X, Item.Y + 2 * Height), New Drawing.Size(Height, Width))
Dim Square4 As New Drawing.Rectangle(New Drawing.Point(Item.X + Width, Item.Y), New Drawing.Size(Height, Width))
Dim Hole As New Drawing.Rectangle(New Drawing.Point(Item.X + Width, Item.Y + Height), New Drawing.Size(Height, Width))
Dim Square6 As New Drawing.Rectangle(New Drawing.Point(Item.X + Width, Item.Y + 2 * Height), New Drawing.Size(Height, Width))
Dim Square7 As New Drawing.Rectangle(New Drawing.Point(Item.X + Width * 2, Item.Y), New Drawing.Size(Height, Width))
Dim Square8 As New Drawing.Rectangle(New Drawing.Point(Item.X + Width * 2, Item.Y + Height), New Drawing.Size(Height, Width))
Dim Square9 As New Drawing.Rectangle(New Drawing.Point(Item.X + Width * 2, Item.Y + 2 * Height), New Drawing.Size(Height, Width))
'Add new squares apart from hole, to iterate through
NewSquares.Remove(Item)
NewSquares.Add(Square1)
NewSquares.Add(Square2)
NewSquares.Add(Square3)
NewSquares.Add(Square4)
NewSquares.Add(Square6)
NewSquares.Add(Square7)
NewSquares.Add(Square8)
NewSquares.Add(Square9)
graphics.FillRectangle(Drawing.Brushes.White, Hole)
Next
For Each item In NewSquares
Squares.Add(item)
Next
'Update array
NewSquares.Clear()
Next
bmp.Save("SCarpet.bmp", Drawing.Imaging.ImageFormat.Bmp)
End Using
End Sub
End Module
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Module Sierpinski_Triangle
Sub Main()
Using bmp As New Drawing.Bitmap(1000, 1000), graphics As Drawing.Graphics = Drawing.Graphics.FromImage(bmp)
Dim Points As Drawing.Point() = {New Drawing.Point(500, 0), New Drawing.Point(1000, 1000), New Drawing.Point(0, 1000)}
graphics.FillPolygon(Drawing.Brushes.White, Points)
Dim Triangles As New System.Collections.Generic.List(Of Drawing.Point())
Triangles.Add(Points)
Dim NewTriangles As New System.Collections.Generic.List(Of Drawing.Point())
NewTriangles.Add(Points)
For i = 0 To 7
For Each item In Triangles
' Work out the hole based on three vertexs
Dim Vertex1 As New System.Drawing.Point((item(0).X + item(1).X) / 2, (item(0).Y + item(1).Y) / 2)
Dim Vertex2 As New System.Drawing.Point((item(1).X + item(2).X) / 2, (item(1).Y + item(2).Y) / 2)
Dim Vertex3 As New System.Drawing.Point((item(0).X + item(2).X) / 2, (item(0).Y + item(2).Y) / 2)
Dim Hole As Drawing.Point() = {Vertex1, Vertex2, Vertex3}
'Work out other three triangles
Dim Triangle1 As Drawing.Point() = {item(1), Vertex1, Vertex2}
Dim Triangle2 As Drawing.Point() = {item(2), Vertex2, Vertex3}
Dim Triangle3 As Drawing.Point() = {item(0), Vertex3, Vertex1}
'Add to array to be iterated over
NewTriangles.Remove(item)
NewTriangles.Add(Triangle1)
NewTriangles.Add(Triangle2)
NewTriangles.Add(Triangle3)
graphics.FillPolygon(Drawing.Brushes.Black, Hole)
Next
' Save Different steps
bmp.Save(i & ".bmp", Drawing.Imaging.ImageFormat.Bmp)
For Each item In NewTriangles
Triangles.Add(item)
Next
'Update array
NewTriangles.Clear()
Next
End Using
End Sub
End Module