6

I am creating triangular arrays similar to Pascal's triangle. In an answer to this post, J.M. gives the following code:

triangularArrayLayout[triArray_List, opts___] := Module[{n = Length[triArray]}, 
  Graphics[MapIndexed[
         Text[Style[#1, Large], {Sqrt[3] (n - 1 + #2.{-1, 2}), 3 (n - First[#2] + 1)}/2] &,
           triArray, {2}], opts]]

Executing the following code generates the array of values:

triangularArrayLayout[Table[StirlingS2[n, k], {n, 0, 5}, {k, 0, n}]]

I want to do something similar. Currently, this is what I have:

enter image description here

Sorry the code is small. It's essentially the same code as J.M.'s.

My triangle is an array of zeros and ones, generated by the function F[n,k] which returns $0$ or $1$.

I want to turn it into something like this:

enter image description here

Where each $1$ in my array is surrounded by a black box, and each $0$ is surrounded by white space. How can I do this?

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574

2 Answers2

8

A purely textual way of making a Sierpinski triangle from a Pascal triangle is as follows.

sierpinski[depth_] :=
  Module[{nmax = 2^depth},
    Column[
      StringJoin[Sequence[#]] & /@
        Map[
          If[OddQ[#], "\[FilledSquare]", " "] &, 
          Table[Binomial[n, k], {n, 0, nmax - 1}, {k, 0, n}], 
          {-1}],
      Center,
      Spacings -> -.5]]

sierpinski[5]

sierpinski

Update

After giving the matter some thought I came up with this version:

Clear[sierpinski]
sierpinski[depth_] :=
  Module[{nmax = 2^depth},
    Column[
      Row /@
        Map[
          If[OddQ[#], "\[FilledSquare]", Invisible[\[FilledSquare]]] &, 
          Table[Binomial[n, k], {n, 0, nmax - 1}, {k, 0, n}], 
          {-1}],
      Center,
      Spacings -> -.45]]

sierpinski[5]

sierpinski

Although not spectacular, I think the improvement in the spacing made by using Row and Invisible is worthwhile, and the revised code has the advantage of being a little simpler than the original. Reducing the negative vertical spacing helped, too.

m_goldberg
  • 107,779
  • 16
  • 103
  • 257
6
ClearAll[pascalMod2]
pascalMod2 = Graphics[{EdgeForm[White], 
     Table[MapIndexed[{Mod[Binomial[i, #2[[1]] - 1], 2] /. {1 -> Black, 0 -> White},
          Rectangle[{#, -i}]} &, Range[-i/2, i/2]], {i, 0, 2^# - 1}]}, ##2] &;

Examples:

pascalMod2[4, ImageSize -> 1 -> 20]

enter image description here

pascalMod2[6]

enter image description here

pascalMod2[8, ImageSize -> 1 -> 2]

enter image description here

Update: Adding optional arguments to play with various stylings:

ClearAll[pascalMod2b]
pascalMod2b[n_, rr_: 0, cf_: Automatic, tc_: Automatic, 
   fs_: Automatic][opts : OptionsPattern[]] := Graphics[{EdgeForm[White], 
  Table[MapIndexed[Module[{b = Binomial[i, #2[[1]] - 1]},
     {Mod[b, 2] /. {1 -> (cf /. Automatic -> (Black &))@b, 0 -> White}, 
      Rectangle[{#, -i}, RoundingRadius -> rr], 
      Text[Style[b, fs /. Automatic -> 12, (tc /. Automatic -> (Opacity[0] &))@b],
          {#, -i} + .5]}] &, Range[-i/2, i/2]], 
    {i, 0, 2^n - 1}]}, opts]

Examples:

pascalMod2b[3][Frame -> True, FrameTicks -> None]

enter image description here

pascalMod2b[3][Frame -> True, FrameTicks -> None] /. 
 Rectangle[a_, ___] :> Translate[SSSTriangle[1, 1, 1], a + .5]

enter image description here

pascalMod2b[3, 0, Automatic, Mod[#, 2] /. {0 -> Black, 1 -> White} &][
 Frame -> True, FrameTicks -> None]

enter image description here

pascalMod2b[3, .5, RandomColor[] &, 
   Mod[#, 2] /. {0 -> Black, 1 -> White} &][Frame -> True, FrameTicks -> None]

enter image description here

% /. Rectangle[a_, ___] :> Polygon[CirclePoints[a + .5, .5, 6]]

enter image description here

kglr
  • 394,356
  • 18
  • 477
  • 896