How can I make Sierpinski triangle? [duplicate]

Question

I want to make Sierpinski triangle with method of random points.

Choose p(0) inside the triangle and p(n+1)=1/2{p(n)+ one of it's vertex}

I tried

RSolve[p[n+1]==0.5p[n]+0.5RandomChoice{{0,0},{1,0},{1,1}},p[n],n]

but it didn't work.

it doesn't have to be a regular triangle..

please help me

Answer 1

RSolve is for symbolic solution of recurrence equations and is obviously inappropriate here. How could you get a closed form solution when there is a random term present?

Use NestList.

pts = N@CirclePoints[3];

Graphics[
 {AbsolutePointSize[1], 
  Point@NestList[(# + RandomChoice[pts])/2 &, {0, 0}, 10000]}
 ]

Answer 2

If you are in version 11.1,I will suggest to use SierpinskiMesh

Graphics[MeshPrimitives[SierpinskiMesh[5], 1]]

Answer 3

You can use Pascal's triangle mod 2, e.g.:

f[a_] := {a[[1]]}~Join~
  Table[a[[i - 1]] + a[[i + 1]], {i, 2, Length[a] - 1}]~Join~{a[[-1]]}
pt[n_] := NestList[f, Table[0, n]~Join~{1}~Join~Table[0, n], n - 1]

where internal 0 just used for padding.

Visualizing:

Mod[pt[1000], 2] // ArrayPlot

Or you can use CellularAutomaton with rule 90:

CellularAutomaton[90, {{1}, {0}}, 1000] // ArrayPlot

To illustrate 3 random points and a random starting position:

sg[n_] := Module[{pts = RandomReal[1, {4, 2}], p, ic, f},
  {p, ic} = {Most@pts, pts[[-1]]};
  f = NestList[Mean[{#, RandomChoice[p]}] &, ic, n];
  Graphics[{Black, PointSize[0.04], Point[p], Purple, Point[ic], Red, 
    PointSize[0.01], Point[f]}]
  ]

e.g.:

Grid[Partition[Table[sg[10000], 9], 3], Frame -> All]

Answer 4

Sierpinski Triangle $—$ A Transformational Approach

The starting point for producing a Sierpinski triangle of order n is a single black triangle. This is the order zero triangle.

The transformations that produce a Sierpinski triangle of order n from one of order (n-1) first shrink the one of order (n-1) to half its size and then fill in the vacated space with two translated copies of the shrunken triangle.

shrink := ScalingTransform[{.5, .5}];
copy1 := TranslationTransform[starter[[1, 2]]/2];
copy2 := TranslationTransform[starter[[1, 3]]/2];

Given an object representing a Sierpinski triangle of order n, produce and return another of order (n+1).

sierpinskiPts[pts : {{{_, _}, {_, _}, {_, _}} ..}] :=
  Module[{stage1},
    stage1 = Map[shrink, Flatten[pts, 1], {-2}]; 
    Partition[Flatten[{stage1, copy1 @ stage1, copy2 @ stage1}, 1], 3]];

Produce and return a representation of a Sierpinski triangle of order n. The representation is cached as a down value as a side effect.

sierpinski[n_Integer?Positive] := (sierpinski[n] = sierpinskiPts[sierpinski[n - 1]])

Unit tests

Starting with an equilateral triangle

Initialization. The 2nd line of code clears out any previously cached triangles.

starter = {{{0., 0.}, {1./2, Sqrt[3.]/2}, {1., 0.}}};
DownValues[sierpinski] = Last[DownValues[sierpinski]];
sierpinski[1] = sierpinskiPts[starter];

An order 3 Sierpinski triangle.

Graphics[Polygon[sierpinski[3]], Frame -> True]

Starting with a right triangle

starter = {{{0., 0.}, {0., 1.}, {1., 0.}}};
DownValues[sierpinski] = Last[DownValues[sierpinski]];
sierpinski[1] = sierpinskiPts[starter];

An order 4 Sierpinski triangle.

Graphics[Polygon[sierpinski[4]], Frame -> True]

Reference

Chaos and Fractals (Springer-Verlag, February 2004) by Heinz-Otto Peitgen, Hartmut Jürgens, Dietmar Saupe.

The ideas that went into this answer are very close to and inspired by those explored in the sections of the reference devoted to the MRCM (Multiple Reduction Copy Machine).