More Tupperware

July 11, 2015 Leave a comment

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,
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:

wptup

Categories: Mathematica

Why Some Say The Moon

June 22, 2015 Leave a comment

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

wpapollo01

 

 

wpapollo02

 

wpapollo03

 

wpapollo04

 

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.

Categories: Mathematica

Tupper-ware

May 30, 2015 Leave a comment

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):  
tupper
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.

Categories: Mathematica

Pleasure in the Small Things

May 14, 2015 Leave a comment


profile for ubpdqn on Stack Exchange, a network of free, community-driven Q&A sites

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.

Categories: Uncategorized

Down the Rabbit Hole

May 10, 2015 Leave a comment

Inspired by the Fibonacci clock  I extended the idea:

fc2a

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:

fc2

Categories: Uncategorized

Rabbits and Clocks

May 10, 2015 1 comment

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
fc

Categories: Uncategorized

Wrap Around

April 25, 2015 Leave a comment


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

I enjoyed tried trying to visualize approach:

cp

Categories: Uncategorized
Follow

Get every new post delivered to your Inbox.

Join 38 other followers