## More Tupperware

This is post is motivated by a question on Mathematica Stackexchange and the interesting link posted in the question. My previous post had subtle errors. This allowed me to play with the higher resolution self referential formula:

g[x_, y_] :=

Boole[Mod[Floor[Floor[y/61] 2^(-61 x - Mod[y, 61])], 2] == 1]

w[nu_] := ArrayPlot[Table[g[j, k], {k, nu + 60, nu, -1}, {j, 0, 375}]]

btupf[s_] := Module[{i, m, r},

i = Rasterize[s, ImageSize -> {376, 61}];

m = Map[Boole[Max@# < 1] &, ImageData[i], {2}]; r = 61 FromDigits[Flatten[Reverse@Transpose[m]], 2]; ArrayPlot[Table[g[j, k], {k, r + 60, r, -1}, {j, 0, 375}]]]

`btupn[s_] := Module[{i, m, r}, i = Rasterize[s, ImageSize -> {376, 61}];`

m = Map[Boole[Max@# < 1] &, ImageData[i], {2}];

r = 61 FromDigits[Flatten[Reverse@Transpose[m]], 2]]

Here `g`

is the function, `w `

plots a given number,

`btupf`

allows you to put in text, convert to number and array plot, `btupn`

gives you the number.

So ` w[nn]`

where `nn`

is this number yields:

## Why Some Say The Moon

It has been a challenging time recently and I have been plagued by ill health…in spare time I have been musing with `TimelinePlot`

,

I still vividly remember watching the lunar landing on a black and white television…despite the grainy image and the staccato noisy audio I was transfixed.

## Tupper-ware

I particularly enjoyed a Numberphile video on the”everything formula”. Well here is a version of my tupper number:

10863073715080204906841374744817870686017991652471808478614429324955090671

29438251181615100031499425215408982583164877324535761283139840521296005040

31360524655562687211280130028399893118045121796015094250844818624778631078

72981939769966210871228064281785763761146932169138082985217088594080562295

37546337291561618284716976212986394441886696136661981542340085562415246492

12721838470511199078533181750124932100952254283927665003938152391834859900

76871547601110832975908601693268743079629420352988718065924114415309278644

9332931313946066944

Here is my first attempt at coding (unfortunately wordpress does not correctly process my code tag, hence the image):

`tupf`

produces the array plot and `tupn`

the number. The above number was produced using `tupn[Style["u b p d q n",20]]`

…not perfect but fun.

## Pleasure in the Small Things

Today I reached 20k on Mathematica Stackexchange. This is a small thing, even undeserved and an over-rating and of only interest to me, it brought my pleasure to be part of this creative and vibrant community. Peace to all.

## Down the Rabbit Hole

Inspired by the Fibonacci clock I extended the idea:

The left is year (not Fibonacci related), the middle the month and day, the right the original Fibonacci clock with edges black for am and orange for pm.

The translation:

## Rabbits and Clocks

This post is inspired by a tweet from Clifford Pickover regarding Fibonacci clock.

I sought to simulate this clock. Note the pattern for a given times is not unique for the most part but this adds interest to changing patterns.

Here is the code of my attempt:

sc = Rectangle @@@ {{{2, 3}, {3, 4}}, {{2, 4}, {3, 5}}, {{0, 3}, {2,

5}}, {{0, 0}, {3, 3}}, {{3, 0}, {8, 5}}};

h[n_] := Module[{tu},

tu = Tuples[{0, 1}, 5];

Pick[tu, {1, 1, 2, 3, 5}.# == n & /@ tu]];

m[n_] := Module[{tu},

tu = Tuples[{0, 5}, 5];

Pick[tu, {1, 1, 2, 3, 5}.# == n & /@ tu]];

m[0] := {{0, 0, 0, 0, 0}};

h[0] := {{0, 0, 0, 0, 0}};

rh = # -> h[#] & /@ Range[0, 12];

rm = # -> m[#] & /@ Range[0, 55, 5];

col = {0 -> White, 1 -> Red, 5 -> Green, 6 -> Blue};

clck[hr_, mn_] := Module[{ch, cm, cl},

ch = RandomChoice[hr /. rh];

cm = RandomChoice[mn /. rm];

cl = (ch + cm) /. col;

Graphics[Prepend[Riffle[cl, sc], EdgeForm[Black]]]

]

tm = Rest@Tuples[{Range[0, 12], Range[0, 55, 5]}];

clcanim =

Column /@

Thread[{clck @@@ tm,

Row[{#1, ":", IntegerString[#2, 10, 2]}] & @@@ tm}];

The animation was made from `clcanim`

## Wrap Around

I came across this puzzle in a tweet from Clifford Pickover.

I enjoyed tried trying to visualize approach: