# Blue Tiling

GROUPS:

The blue tiling is a limit periodic tiling and a substitution tiling, with simple permutation transformation properties at all orders of magnitude. In some ways it is a relative of the viererbaum or quadtree tiling. The colors in the blue palette are sampled from a digitization of Picasso's famous "The Old Guitarist".

## Colors

bgRep = {
0 -> Lighter@Gray,
x_ /; EvenQ[x] :> Darker@Gray,
x_ /; OddQ[x] :> Darker@Darker@Gray
};

colRep = {
a -> RGBColor[38/255, 132/255, 157/255],
b -> RGBColor[3/255, 78/255, 109/255],
c -> RGBColor[6/255, 52/255, 65/255],
d -> RGBColor[152/255, 208/255, 205/255],
e -> RGBColor[46/255, 78/255, 57/255],
f -> RGBColor[105/255, 126/255, 95/255],
"?" -> Yellow
};


## Basic Tile Geometry

HexagonStar = {Cos[# 2 Pi/6 + Pi/6], Sin[# 2 Pi/6 + Pi/6]} & /@
Range[6];

Annulus2[o_, n_, c_, bg_] := {c,
Disk[o + {Cos[n  2 Pi/6 + Pi/6], Sin[n 2 Pi/6 + Pi/6]}, .7,
{(n + 2 + 1/2)*2 Pi/6, (n + 4 + 1/2)*2 Pi/6}], bg,
Disk[o + {Cos[ n 2 Pi/6 + Pi/6], Sin[n 2 Pi/6 + Pi/6]}, .3,
{(n + 2 + 1/2)*2 Pi/6, (n + 4 + 1/2)*2 Pi/6}]
}

Bridge[o_, n_, c_] := {c,
Polygon[o + # & /@ (RotateLeft[HexagonStar, n][[{1, 2, 4, 5}]] /. {
a_, b_, e_, f_} :> {3/10 (b - a) + a,
3/10 (a - b) + b, 3/10 (f - e) + e,
3/10 (e - f) + f})]}

DepictHexagon[o_, i_, bg_, ct_, cb_, cc_] := {bg, EdgeForm[Thick],
Polygon[o + # & /@ HexagonStar],
MapThread[Annulus2[o, #1, #2, bg] &, {{i, i + 3}, {ct, cb}}],
Bridge[o, i, cc]}

DepictHexagon[o_, i_, bg_, c_] := {bg, EdgeForm[Thick],
Polygon[o + # & /@ HexagonStar],
Map[Annulus2[o, #, c, bg] &, {i, i + 2, i + 4}]}


## Generators

VertLabels[x_] := x /. {
0 -> {a, b, c, d, e, f},
y_ /; EvenQ[y] :> {c, f, e, b, a, d},
y_ /; OddQ[y] :> {e, d, a, f, c, b}}

hexRep = {
T[o_, i_, j_, cu_, cd_, cc_] :> {
T[3 o, 0, j, cu, cd, cc],
MapThread[
T[3 o + Sqrt[3] {Cos[#2 2 Pi/6], Sin[#2 2 Pi/6]}, #2, #2 +
1, #3, #4, #1] &,
{RotateRight[{cu, cc, cd, cd, cc, cu}, j],
Range[6], VertLabels[i], RotateRight[VertLabels[i]]}],
MapIndexed[
T[3 o +
3 {Cos[#2[[1]] 2 Pi/6 + Pi/6],
Sin[#2[[1]] 2 Pi/6 + Pi/6]}, #2[[1]], #1] &,
VertLabels[i]]},
T[o_, i_, cc_] :> {
T[3 o, i, cc], MapThread[
T[3 o + Sqrt[3] {Cos[#1 2 Pi/6], Sin[#1 2 Pi/6]}, #1, #1 +
1, #2, #3, cc] &,
{Range[6], {a, b, c, d, e, f},
RotateRight@{a, b, c, d, e, f}}],
MapIndexed[
T[3 o +
3 {Cos[#2[[1]] 2 Pi/6 + Pi/6],
Sin[#2[[1]] 2 Pi/6 + Pi/6]}, #2[[1]], #1] &,
{a, b, c, d, e, f}]}};

depictRep = {
T[o_, i_, j_, cu_, cd_, cc_] :>
DepictHexagon[o, j, i /. bgRep, cu /. colRep, cd /. colRep,
cc /. colRep] ,
T[o_, i_, c_] :>
DepictHexagon[o, i, 0 /. bgRep, c /. colRep]
};


## Print

Graphics[
T[{0, 0}, 2, 1, b, c, a] /. hexRep /. hexRep /. hexRep /. depictRep,
ImageSize -> 1000]


## Screencapture

It would also be possible to construct this tiling using the same sort of algorithm as in the Wolfram Demonstration above. That programming could lend itself quite naturally to interesting animations taking advantage of invariance under scale transformation / inflation. I haven't had the time or interest lately, maybe others will?

Answer
1 year ago
1 Reply
 Moderation Team 1 Vote - Congratulations! This post is now Staff Pick! Thank you for your wonderful contributions. Please, keep them coming! ( We have also placed a stripe of your beautiful pattern "Above the Fold" at the top to attract attention of readers. )
Answer
1 year ago