# Tupper's self-referential formula with Mathematica

When trying to reproduce the plot of Tupper's self-referential formula (original paper is available here) with Mathematica I have faced unexpected difficulties.

First of all, the algorithm does not give the image shown and I was forced to find the right way by myself (code for Mathematica):

k = 960939379918958884971672962127852754715004339660129306651505519271\
7028023952664246896428421743507181212671537827706233559932372808741443\
0789132596394133772348785773574982392662971551717371699516523289053822\
1612403238855866184013235585136048828693337902491454229288667081096184\
4960917051834540678277315517054053816273809676025656250169814820834187\
8316384911559022561000365235137034387446184837873723819822484986346503\
3159410054974700593138339226497249461751545728366702369745461014655997\
933798537483143786841806593422227898388722980000748404719;
tb = Table[
1/2 < Floor[
Mod[Floor[y/17]*2^(-17 Floor[x] - Mod[Floor[y], 17]), 2]], {y,
k + 17, k, -1}, {x, 106, 0, -1}];
g = Graphics[Raster[tb /. {True -> 0, False -> 1}],


But even after this I get artefacts on the bottom of the image produced. Why this happens? Is this an error in the original description or in my mind? The correct image can be produced by the following code (where sh may be any rational number of the form 1/n):

k = 960939379918958884971672962127852754715004339660129306651505519271\
7028023952664246896428421743507181212671537827706233559932372808741443\
0789132596394133772348785773574982392662971551717371699516523289053822\
1612403238855866184013235585136048828693337902491454229288667081096184\
4960917051834540678277315517054053816273809676025656250169814820834187\
8316384911559022561000365235137034387446184837873723819822484986346503\
3159410054974700593138339226497249461751545728366702369745461014655997\
933798537483143786841806593422227898388722980000748404719;
sh = 1;
tb = Table[
1/2 < Floor[
Mod[Floor[y/17]*2^(-17 Floor[x] - Mod[Floor[y], 17]), 2]], {y,
k + 17 - sh, k, -sh}, {x, 106 - sh, 0, -sh}];
g = Graphics[Raster[tb /. {True -> 0, False -> 1}],


And I also cannot decode the k directly into an image in the right way. Here is my code:

g=Graphics[Raster[Transpose@
(Partition[IntegerDigits[k/17,2]/.{1->0,0->1},17])],


What am I doing wrong?

## EDIT:

I have found a way to decode the constant k. The problem was that the original binary representation of the encoded image was truncated when converting to the number due to dropping leading zeros. We should also take into account that Tupper encoded black pixels as "1" and white pixels as "0". So we need to pad the binary representation of k with "1" at the start. Here is the solution (for Mathematica 7+):

Image[Transpose[
Reverse@Partition[Reverse[1 - IntegerDigits[k/17, 2]], 17, 17, 1,
1]], Magnification -> 4]


Here is also more elegant code for plotting Tupper's function:

Image[Table[
1 - Boole[
1/2 < Floor[
Mod[Floor[y/17] 2^(-17 Floor[x] - Mod[Floor[y], 17]), 2]]], {y,
k, k + 16}, {x, 105, 0, -1}], Magnification -> 4]

-

Thanks for the link. Now I see that Eric W. Weisstein faced difficulties too. But he does not explain what happens. He has found the same solution that contradicts original Tupper's descripton where the graph is computed "over [0,106] × [k,k+17]" (Weisstein replaced k with n). And he does not explain how the constant k can be directly decoded into the image. – Alexey Popkov Mar 15 '11 at 21:58