Sierpinski Triangle

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.

Sierpinski Carpet

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

References

http://mathworld.wolfram.com/SierpinskiSieve.html