6
$\begingroup$

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?

$\endgroup$
  • $\begingroup$ Sounds as if you where actually interested in CellularAutomaton... $\endgroup$ – Henrik Schumacher Mar 2 at 22:45
7
$\begingroup$

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.

| improve this answer | |
$\endgroup$
  • $\begingroup$ Thank you. Do you know how I might adjust your code so that the triangle's boxes are all evenly spaced? $\endgroup$ – Descartes Before the Horse Mar 4 at 20:49
  • 1
    $\begingroup$ @DescartesBeforetheHorse. I have added code that I hope addresses the issue you raise in your comment. $\endgroup$ – m_goldberg Mar 4 at 22:04
5
$\begingroup$
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

| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.