19
$\begingroup$

Many art websites allow the user to zoom into an image to see it at high resolution by using image tiles. It is great on the website, but presents problems if one wishes to compile a complete high resolution picture from these tiles. I am currently using the following:

mOMA[name_, catalogueNumber_] := 
With[{src = 
Import[StringJoin["http://www.moma.org/collection/works/", 
  ToString[catalogueNumber], "?locale=en"], "Source"]}, 
With[{aa = 
 StringReplace[
  StringReplace[
   StringDrop[
    StringTake[src, 
     StringPosition[src, "allZoomBounds"][[1, 1]] - 11], 
    StringPosition[src, "allImageTiles"][[1, 2]] + 2], 
   "/media/" -> "http://www.moma.org/media/"], "]]" -> ","]}, 
With[{bb = StringDrop[aa, (Last@StringPosition[aa, "[["])[[2]]]}, 
With[{cc = {Length@StringPosition[bb, "["], Length@bb}}, 
 With[{dd = 
    StringReplace[StringReplace[bb, "[" -> ""], "]" -> ""]}, 
  With[{ee = StringPosition[dd, ","][[All, 1]]}, 
   With[{ccc = {Length@ee/(cc[[1]] + 1), (cc[[1]] + 1)}}, 
    With[{d1 = StringReplace[bb, "[" -> ""]}, 
     With[{d2 = Length@StringPosition[d1, "]"][[All, 1]] + 1}, 
      With[{cccc = {(Length@ee)/d2, d2}}, 
       With[{ff = 
          StringReplace[
             StringReplace[
              StringDrop[StringTake[dd, ee[[#]]], 
               If[# == 1, 0, ee[[# - 1]] + 1]], "\"" -> ""], 
             "," -> ""] & /@ Range@(Times @@ ccc)}, 
        With[{img = {ff, cccc}}, 
         With[{imgim = Import[#] & /@ img[[1]]}, 
          Rasterize[
           ImageAssemble[
            Table[imgim[[#]] & /@ (x + 
                img[[2, 1]] Range[0, img[[2, 2]] - 1]), {x, 1, 
              img[[2, 1]]}]], ImageResolution -> 100, 
           ImageSize -> 600]
          ]]]]]]]]]]]]] 

which works with something like mOMA[Picasso_Minotauromachy _ 1935, 60110], but seems like an awful lot of fiddling to isolate & ImageAssemble relevant image tiles (which on the MOMA site are sandwiched between allImageTiles and allZoomBounds in the source code). Is there a more straightforward way, eg with Cases and "XMLObject", or similar?

Update

In response to requested edits below, the following is the basis of the code:

With[{src = Import[StringJoin["http://www.moma.org/collection/works/", 
ToString[60110], "?locale=en"], "Source"]}, 
StringReplace[StringReplace[StringDrop[StringTake[src, StringPosition[src, 
"allZoomBounds"][[1, 1]] - 11], StringPosition[src, "allImageTiles"][[1, 2]] 
+ 2], "/media/" -> "http://www.moma.org/media/"], "]]" -> ","]]

with the rest of the code botched together to isolate each tile (each http string is a tile).

I agree that the code above, as presented is rather unreadable, with a load of nested With arguments that probably don't help. I will do my best to format appropriately, but am giving basic info in update for now, to hopefully clarify things a bit.

Update 2

Using @belisarus' code, thithe following works for the specific image request from @bills in the comments

With[{aa = ToExpression@Most[StringDrop[#, 2] & /@StringCases[
Import["https://vangoghmuseum-assetserver.appspot.com/tiles?id=\
4820945634066432", "Text"], Shortest["url" ~~ a : __ ~~ "},"] -> a]]},
Rasterize[ImageAssemble[Table[Import@# &@aa[[x + 15*#]], {x, 1, 15}] & /@   
Range[0, 9]], ImageResolution -> 100, ImageSize -> 600]]

... still working on generalisation.

Generalisation

doc = d0364V1968;
pollard = With[{num = StringReplace[StringReplace[StringReplace[StringCases[
Import[StringJoin["http://www.vangoghmuseum.nl/en/collection/", 
ToString[doc]], "Text"], Shortest["tiles?id=" ~~ a : __ ~~ "data"] -> a], 
"\"" -> ""], "\n" -> ""], " " -> ""][[1]]},
With[{aa = 
  Import[StringJoin[
    "https://vangoghmuseum-assetserver.appspot.com/tiles?id=", 
    num], "Text"]}, 
With[{x = 
   Max@ToExpression@
     StringReplace[
      StringDrop[#, 3] & /@ (StringTake[#, 5] & /@ 
         StringCases[aa, Shortest["x" ~~ a : __ ~~ "},"]]), 
      "," -> ""]},
With[{y = 
    Max@ToExpression@
      StringReplace[
       StringDrop[#, 3] & /@ (StringTake[#, 5] & /@ 
          StringCases[aa, Shortest["y" ~~ a : __ ~~ "},"]]), 
       "," -> ""]},
With[{bb = 
     ToExpression@
      Most[StringDrop[#, 2] & /@ 
        StringCases[aa, Shortest["url" ~~ a : __ ~~ "},"] -> a]]},
   Rasterize[ImageAssemble[
    Table[Import@# &@bb[[xx + (x + 1)*#]], {xx, 1, x + 1}] & /@ 
     Range[0, y - 1]], ImageResolution -> 100, ImageSize -> 600]
   ]]]]]

Disclaimer

Please read the terms of use for images from each website before assembling large image sizes from tiles (hence the use of Rasterize and setting appropriate ImageResolution).

$\endgroup$
  • 4
    $\begingroup$ This might be related. $\endgroup$ – bobthechemist Aug 20 '15 at 11:28
  • 7
    $\begingroup$ Martin, do you think you could format the code in such a way that it is human-readable (i.e. add indents, new lines)? As it is now, I cannot even begin to make any sense of it. $\endgroup$ – MarcoB Aug 20 '15 at 11:48
  • 1
    $\begingroup$ Naming the variables "dd", "cccc", and so on is really not helping, either. $\endgroup$ – Patrick Stevens Aug 20 '15 at 12:01
  • 3
    $\begingroup$ Not to be that guy, but is this content public domain? $\endgroup$ – Scott Baker Aug 20 '15 at 21:19
  • 4
    $\begingroup$ @ScottSEA If the painting itself is old enough, then I believe this is fine in the USA: photo.stackexchange.com/questions/54787/… But this legal stuff can be complicated, so just take my link as a starting point for research. If a museum make a high quality digital reproduction of a painting, and the painting itself is public domain, then the reproduction cannot be copyrighted in the USA. In other countries it may be different. $\endgroup$ – Szabolcs Aug 21 '15 at 8:41
18
$\begingroup$

MoMA

res= {1,2,3..} is the resolution.Use res = -1 for the max available resolution, but beware of a shipload of lawyers, middle managers, telephone sanitisers and hairdressers that may try to prosecute you if you use a value greater than 1,

moma[catalogueNumber_, res_] := 
  Module[{m = "http://www.moma.org", src, sj, rep, exp, a},
  rep = {"]" -> "}", "[" -> "{"};
  exp = Shortest["allImageTiles =" ~~ a : __ ~~ ";"] -> a;
  src = Import[StringJoin[m, "/collection/works/", ToString@catalogueNumber], "Source"];
  sj = Map[Import[m <> #] &, (ToExpression@
                         StringReplace[StringCases[src, exp], rep])[[1,1,res]], {2}];
  ImageAssemble@Transpose@sj]

moma[60110, 1]

Mathematica graphics

$\endgroup$
  • $\begingroup$ thank you - much clearer! & well done for deciphering my awful unreadable code!! :) $\endgroup$ – martin Aug 20 '15 at 15:13
  • $\begingroup$ @martin I didn't :) I just took a look at the input and output ;D $\endgroup$ – Dr. belisarius Aug 20 '15 at 15:16
  • $\begingroup$ much more sensible! ;) $\endgroup$ – martin Aug 20 '15 at 15:18
  • 1
    $\begingroup$ @belisarius -- This is an amazing piece of detective work! Can you see how to modify the calls to import the highest resolution images from the Van Gogh museum... for instance, from here: vangoghmuseum.nl/en/collection/d0364V1968 $\endgroup$ – bill s Aug 20 '15 at 16:51
  • 1
    $\begingroup$ @martin Working on it. It can be done in a cleaner way $\endgroup$ – Dr. belisarius Aug 20 '15 at 19:52
13
$\begingroup$

Van Gogh Museum

Here is the same for the tiles structure of the Van Gogh Museum at @bills' request. Note that the structure is completely different. I preserved the same resolution convention:

vanInTheSkyWithLucy[catalog_, res_] := 
 Module[{i, df, zooms, c, maxXY, t}, 
  i = Import["http://www.vangoghmuseum.nl/en/collection/" <> catalog, "XMLObject"];
  df = First@  Cases[i, XMLElement[__, {___, "data-url" -> a__, ___}, ___] -> a, ∞];
  zooms = Reverse["levels" /. Import[df, "JSON"]];
  If [$VersionNumber >= 10,
     c = Cases[#, {"x" -> x_, "y" -> y_, "url" -> u_} :>{x, y,  u},∞],
     c = Cases[#, {"url" -> u_, "x" -> x_, "y" -> y_} :>{x, y,  u},∞]] &@zooms[[res]];
  maxXY = Max /@ (Transpose[c][[;; 2]]) + 1;
  t = ConstantArray[1, Reverse@maxXY];
  (t[[#[[2]] + 1, #[[1]] + 1]] = #[[3]]) & /@ c;
  ImageAssemble@Map[Import, t, {2}]]

vanInTheSkyWithLucy["d0364V1968", 1]

Mathematica graphics

Warning The code works differently on V9 and V10, so I added a version check.Thanks lot to @bills for the debugging! Apparently the JSON import works differently.

$\endgroup$
  • $\begingroup$ I encounter a problem in running your code above, c is an empty set, and so the Transpose in maxXY gives an error. That is the right picture though, so it is very close! $\endgroup$ – bill s Aug 20 '15 at 22:38
  • $\begingroup$ @belisarius I get an error on this one too ... $\endgroup$ – martin Aug 20 '15 at 23:27
  • 1
    $\begingroup$ @belisarius quit kernel & am getting ImageAssemble[ConstantArray[1, 2 $Failed]] $\endgroup$ – martin Aug 20 '15 at 23:33
  • $\begingroup$ @bills I can't repro the problem here. Care to help me to debug it? $\endgroup$ – Dr. belisarius Aug 20 '15 at 23:33
  • 1
    $\begingroup$ @martin The "difficult" thing is doing it in mathematica. Any good web crawler will do it for you almost automatically. I would just add a disclaimer. The rest is scientific curiosity $\endgroup$ – Dr. belisarius Aug 21 '15 at 5:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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