Home > Mathematica > More Tupperware

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

Advertisements
Categories: Mathematica
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: