23
$\begingroup$

Inspired by the recent question about xkcd styled plots I started looking at xkcd again and I came across a comic titled Click and Drag. And if you do that, you start exploring a larger drawing. A much larger drawing. How large? I don't know, but I spent about half and hour exploring it before my arm wore out.

Now I want to see all the comic but I don't want to give myself RSI in the process. That leads me, finally, to my questions:

  • How can I use Mathematica to download the entire scrollable drawing?

  • How can it be assembled and stored? This will surely be a tremendously large image; what data formats does Mathematica support that can handle it?

  • Is it possible to navigate the image from within Mathematica?

In fairness people may ask "what have you tried" and I must say: nothing. Not long after posting I realized that the tiles are stored as PNG files with names that describe the location. This was also mentioned in the comments. This makes acquisition easier than I anticipated, and shifts the emphasis of this question to the second and third points.

$\endgroup$
20
  • 1
    $\begingroup$ While waiting for a solution, you can peek at the large drawing here. $\endgroup$
    – VLC
    Oct 1, 2012 at 14:33
  • $\begingroup$ You've seen the source, I presume? $\endgroup$ Oct 1, 2012 at 14:46
  • 2
    $\begingroup$ Yes, and I also think that Mathematica is probably the worst possible platform to do this in... I can't imagine the front-end not crashing 3 mins into the download process. $\endgroup$
    – rm -rf
    Oct 1, 2012 at 14:53
  • 1
    $\begingroup$ is it the same as xkcd-map.rent-a-geek.de/#10/1.0999/0.2005 $\endgroup$
    – chris
    Oct 1, 2012 at 15:02
  • 1
    $\begingroup$ A link to a version of this map in a different format was posted in GIS chat a couple weeks ago. (Well, it's a different interface anyway; I did not check the actual data source.) It's down right now (503 error), but for those who are curious, try research.geodan.nl/sites/xkcd a little later. $\endgroup$
    – whuber
    Oct 1, 2012 at 17:33

3 Answers 3

16
$\begingroup$

Comment

This was originally answered on Oct 2, 2012 using V8. The performance can be dramatically improved using V9's URLFetchAsynchronous, as now shown below.


Fortunately, we needn't download all the tiles at once. We can use Dynamic to set up a little pan-and-zoom explorer. The first load takes a bit and zooming out takes a bit. Panning and zooming into previously visited spots are pretty snappy since we cache the tile URLs.

xRad = 2; (* Number of tiles to add to the right and left of the center tile. *)
yRad = 1; (* Number of tiles to add above and below the center tile. *)
xPad = 0; (* Number of extra tiles to cache to the right and left for perfomance. *)
yPad = 0; (* Number of extra tiles to cache above and below for perfomance. *)

Clear[indices2xkcdTile, indices2xkcdTileRecord, center];

indices2xkcdTileURL[m_, n_, z_] := 
  "http://xkcd1.rent-a-geek.de/converted/" <> ToString[z] <> "-" <>
    ToString[n] <> "-" <> ToString[m] <> ".png";

redraw[m0_,n0_,z_] := Map[
  Function[mn,
    Module[{m,n},
      m=First[mn]; n=Last[mn];
      If[indices2xkcdTileRecord[m,n,z] =!="Done",
        indices2xkcdTileRecord[m,n,z]="Done";
        If[m<0 || m>2^z-1 || n<0 || n>2^z-1,
          indices2xkcdTile[m,n,z] = blue,
          URLFetchAsynchronous[indices2xkcdTileURL[m,n,z],
           If[#2 == "data", indices2xkcdTile[m,n,z] = 
              ImportString[FromCharacterCode[First[#3]]]]&]
        ]
      ]
    ]
  ],
  Table[{m,n},{m, m0-yRad-yPad, m0+yRad+yPad}, {n, n0-xRad-xPad, n0+xRad+xPad}],{2}];

blue = Image[Array[{0.2,0.2,1}&,{256,256}]];
waiting = Image[Array[0.8&,{256,256}]];
indices2xkcdTile[_,_,_] := waiting;
dynamicIndices2xkcdTile[m_,n_,z_] := Dynamic[Image[indices2xkcdTile[m, n, z],ImageSize->All]];

DynamicModule[{m0,n0,z},
 z = 10; m0 = 508; n0 = 512;
 center[10] = {m0,n0};
 redraw[m0,n0,z];
 redraw[Floor[m0/2],Floor[n0/2],9];
 Deploy[Panel[Column[{
     Dynamic[Grid[Table[dynamicIndices2xkcdTile[m,n,z], {m, m0-yRad, m0+yRad}, {n, n0-xRad, n0+xRad}],
       Spacings -> {0, 0}, Frame -> True]],
     Row[{"zoom: ",
       ButtonBar[{
         "+" :> If[z<10,
           center[z]=.;
           z = z + 1;
           {m0,n0} = center[z];
           redraw[m0,n0,z];
           If[z<9,
             redraw[center[z+1][[1]], center[z+1][[2]],z+1]]],
         "-" :> If[z>1,
           z = z - 1;
           m0 = Floor[m0/2];
           n0 = Floor[n0/2];
           center[z]={m0,n0};
           redraw[m0,n0,z];
           If[z>2,
             redraw[Floor[m0/2],Floor[n0/2],z-1]]]
         }],
       "                                 ",
       Grid[{
         {"", 
          Button["pan up", 
            m0 = m0-1;
            Do[
              center[zz] = {center[zz][[1]] - 2^(zz-z),center[zz][[2]]},
             {zz,z,10}
            ];
            redraw[m0,n0,z];
            If[z>2,
             redraw[Floor[m0/2],Floor[n0/2],z-1]];
            If[z<9,
             redraw[center[z+1][[1]], center[z+1][[2]],z+1]],
            ImageSize -> Automatic
          ], ""},
         {Button["pan left",
            n0=n0-1;
            Do[
              center[zz] = {center[zz][[1]],center[zz][[2]] - 2^(zz-z)},
             {zz,z,10}
            ];
            redraw[m0,n0,z];
            If[z>2,
             redraw[Floor[m0/2],Floor[n0/2],z-1]];
            If[z<9,
             redraw[center[z+1][[1]], center[z+1][[2]],z+1]],
            ImageSize -> Automatic], "",
          Button["pan right", 
            n0 = n0+1;
            Do[
              center[zz] = {center[zz][[1]],center[zz][[2]] + 2^(zz-z)},
             {zz,z,10}
            ];
            redraw[m0,n0,z];
            If[z>2,
             redraw[Floor[m0/2],Floor[n0/2],z-1]];
            If[z<9,
             redraw[center[z+1][[1]], center[z+1][[2]],z+1]],
            ImageSize -> Automatic]},
         {"", 
          Button["pan down", 
            m0 = m0+1;
            Do[
              center[zz] = {center[zz][[1]] + 2^(zz-z),center[zz][[2]]},
             {zz,z,10}
            ];
            redraw[m0,n0,z];
            If[z>2,
             redraw[Floor[m0/2],Floor[n0/2],z-1]];
            If[z<9,
             redraw[center[z+1][[1]], center[z+1][[2]],z+1]],
            ImageSize -> Automatic], ""}
         }]
       }]}, Alignment -> Center]]]]

enter image description here

$\endgroup$
4
  • $\begingroup$ More compactly: indices2xkcdTile[m_, n_, z_] := indices2xkcdTile[m, n, z] = Import[ToString[StringForm["http://xkcd1.rent-a-geek.de/converted/`3`-`2`-`1`.png", m, n, z]]] $\endgroup$ Oct 2, 2012 at 3:32
  • 2
    $\begingroup$ @J.M. Theo Gray always likes to say that everything is a one-liner in Mathematica, for a sufficiently long line. Personally, I'm a big fan of the intermediate definition. $\endgroup$ Oct 2, 2012 at 3:39
  • $\begingroup$ I suppose; I just thought it was profligate to have to call ToString[] thrice when you only need to do it once... $\endgroup$ Oct 2, 2012 at 3:45
  • $\begingroup$ Very nice! It would be even better with key events for arrow keys... $\endgroup$
    – Mr.Wizard
    Oct 2, 2012 at 9:10
5
$\begingroup$

You can download all the original tiles using the following functions. 404 and file not founds are handled gracefully. I'm avoiding displaying to the FE so as to lower the chances of crashing.

url[n1_Integer, d1_String, n2_Integer, d2_String] := 
    "http://imgs.xkcd.com/clickdrag/" <> ToString@n1 <> d1 <> ToString@n2 <> d2 <> ".png"

download[dir_String, url_String] := 
    With[{file = First@StringCases[url, Longest[___] ~~ "/" ~~ x__ :> x]},
        CheckAbort[
            Export[FileNameJoin[{dir, file}], 
                Quiet@Check[Import[url], Abort[], FetchURL::conopen]
            ], 
            ## &[]
        ]
    ]

download["/path/to/xkcd/dir", #] & /@ Flatten@Table[
    url[n1, d1, n2, d2], {n1, 99}, {d1, {"n", "s"}}, {n2, 99}, {d2, {"e", "w"}}]

The tiles are numbered neatly, so you can easily stitch them together to form the full-res image.

$\endgroup$
4
  • $\begingroup$ I'll update with a possible stitching routine when this darned thing finishes downloading. I gotta go now... $\endgroup$
    – rm -rf
    Oct 1, 2012 at 15:32
  • $\begingroup$ I came up with something very similar though I didn't try running the full thing. One thing I realized in the exercise is that I don't know how to simply download a file without Importing and Exporting it. I guess you don't know a way either? $\endgroup$
    – Mr.Wizard
    Oct 1, 2012 at 15:36
  • $\begingroup$ No, I don't know of a way in mma, but I guess any download function must import the data to read it and only then write to disk (unless it is a specialized tool like curl or wget). By not displaying to the FE, you bypass all the formatting process which takes a long time and kills the FE. $\endgroup$
    – rm -rf
    Oct 1, 2012 at 15:38
  • 1
    $\begingroup$ Alternatively: url[n1_Integer, d1_String, n2_Integer, d2_String] := ToString[StringForm["http://imgs.xkcd.com/clickdrag/`1``2``3``4`.png", n1, d1, n2, d2]] $\endgroup$ Oct 1, 2012 at 15:41
5
$\begingroup$

There's no easy way, it's a custom script that assembles the image out of individual slices, and it's written by someone who clearly didn't intend anyone to read it again (including himself).

  1. Reverse engineering. The script responsible is http://imgs.xkcd.com/clickdrag/1110.js, the image to be displayed is assembled in line 86 ($image=...). Scanning the line further reveals the image data to be <img ... src="http://imgs.xkcd.com/clickdrag/'+name+'.png" .../>; so what you're looking for is hidden in http://imgs.xkcd.com/clickdrag/, with some name.

    The name variable is defined in line 81, referring to tile_name(...), which is a function of some position (current image centre, I suppose). It first does something with some size array (possibly a pixel-to-picture-count conversion), and then returns return (y>=0?(y+1)+'s':-y+'n')+(x>=0?(x+1)+'e':-x+'w');. Stripping away the logical operators, the first parenthesis results in ys or yn with y being a number, depending on whether the initial number is positive. The second parenthesis is the same, except with w/e. This sounds a lot like geographical directions to me, and since the result is some kind of location this makes sense. Completing this interpretation, we can assume that the name parameter is calculated to be something along the lines of YnXe.

    Let's take it to a test and call http://imgs.xkcd.com/clickdrag/1n1e.png - bingo, it's the center image with the guy hanging on the balloon.

    What's left is finding out how far the whole thing goes in each direction. One possible way would be loading all pictures from -1000 to +1000 by brute force, but there must be some other way, since the script stops you from dragging the picture when you've reached the (far left) end. (Guess how I found out). The script has a line map_size=[(size[1]+size[3])*tilesize,(size[0]+size[2])*tilesize];, which is a 2-dimensional array of what is hopefully the x/y extension of the whole picture. This suggests that 1/3 are the extensions in n/s (or e/w), and 0/2 is the other direction. Let's give it a shot and call a couple of the extremes. 1n48e 2n48e (404!) 1n33w 1n34w (404!) - So it really extends 48 tiles east and 33 west, and not necessarily everything is filled up to the top/bottom.

    Taking everything together, we're looking to generate many filenames:

    t = Table[
          {x, y},
          {x, Union[Range[-33, 1], Range[1, 48]]},
          {y, Union[Range[1, 14], Range[-25, 1]]}
    ] // Flatten[#, 1] &;
    tupleToDir[{x_, y_}] := StringJoin @@ ToString /@ {Abs[x], If[x > 0, "e", "w"], Abs[y], If[y > 0, "n", "s"]}
    tupleToDir /@ t
    
    ==> {"33w25s", "33w24s", "33w23s", ... [3280 elements]}
    

    I may have the table order at some point, but some trial and error could fix that. Exercise to the reader etc.

  2. DDOS. I don't want hundreds of people sending 3280 requests to XKCD, therefore I'll stop here. If you really want to download the whole thing on your own, you'll have to write the explicit code yourself. The solution is basically mapping a "download corresponding image" function over the array shown above, replacing 404s with black/white placeholders, and then assembling the whole thing to a large composite. Seeing how large the picture is, this will take a huge amount of memory. Good luck! $\ddot\smile$

$\endgroup$
3
  • $\begingroup$ More compactly: t = Tuples[{Range[-33, 48], Range[-25, 14]}]; You seem to have swapped the places for north/south and east/west, tho. $\endgroup$ Oct 1, 2012 at 16:06
  • $\begingroup$ You gotta be careful to exclude coordinates with zeros in the ranges though. (Also I hope nobody puts my code to use, so I hereby declare the coordinate disorder a feature.) $\endgroup$
    – David
    Oct 1, 2012 at 20:48
  • $\begingroup$ In that case, Range[-33, 1] does include $0$, though. Maybe you intended Range[-33, -1]? $\endgroup$ Oct 1, 2012 at 23:55

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.