Al tratar de reproducir la trama de Tupper auto-referencial de la fórmula (documento original está disponible aquí) con Mathematica me he enfrentado a dificultades inesperadas.
Primero de todos, el algoritmo no dar la imagen que se muestra y que se vio obligado a encontrar el camino correcto por mí mismo (código de 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}],
ImagePadding -> None, PlotRangePadding -> None]
Pero incluso después de esto puedo obtener artefactos en la parte inferior de la imagen producida. Por qué sucede esto? Es este un error en la descripción original o en mi mente? La imagen correcta puede ser producido por el siguiente código (donde sh puede ser cualquier número racional de la forma 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}],
ImagePadding -> None, PlotRangePadding -> None]
Y yo también no puede descodificar el k directamente en una imagen de la manera correcta. Aquí está mi código:
g=Graphics[Raster[Transpose@
(Partition[IntegerDigits[k/17,2]/.{1->0,0->1},17])],
ImagePadding->None,PlotRangePadding->None]
¿Qué estoy haciendo mal?
EDITAR:
He encontrado una forma de decodificar la constante k. El problema era que el original de la representación binaria de los datos codificados de la imagen fue truncado cuando la conversión al número debido a una caída ceros a la izquierda. También debemos tener en cuenta que el Tupper codificado píxeles negros como "1" y los píxeles blancos como "0". Así que necesitamos a la almohadilla de la representación binaria de k con "1" en el principio. Aquí está la solución (para Mathematica 7+):
Image[Transpose[
Reverse@Partition[Reverse[1 - IntegerDigits[k/17, 2]], 17, 17, 1,
1]], Magnification -> 4]
Aquí también es más elegante de código para conspirar Tupper de la función:
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]
