10
$\begingroup$

I want to make a picture grid of all Nobel Laureates in physics using mathematica. Later I wanna print this picture grid on a big wall!

The first thought I came up with is to exploit the powerful wolfram free format. But I encountered many difficulties.

  1. image resolution

for example

enter image description here

There is one problem, the resolution(dpi) of the image is quite low. How to get a high dpi image using free format.

  1. How to get all Nobel Laureates in physics?

I tried "all Nobel Laureates in physics" and "Nobel Laureates in physics from 1901 to 2015" both failed

  1. I also want the birth and death date of each Nobel Laureates

to sum up I want a list of data like this

{...,{1921,Albert Einstein,"14 March 1879","18 April 1955",image_of_Einstein},....}

With this data list, I can later create a picture grid using Mathematica command, with each image labeled with name and year information


Another possible way

If it is hard to be realized using Wolfram Knowledge. Another possible way, I now think probably better is to grab data from www.nobelprize.org, with full list of all Nobel Laureates in physics, and all essential information of each Nobel Laureates. For example on this page about Einstein. There is even "Prize motivation" which is also what I want.

enter image description here

However, again, using mathematica to grab data on webpage is something I don't know how to do.

$\endgroup$
11
$\begingroup$

Here's something to get you started down to path of scraping the somewhat larger individual pictures from the Nobel website:

links = Import[
   "https://www.nobelprize.org/nobel_prizes/physics/laureates/index.html?images=yes", "Hyperlinks"];

individualpagelinks =
  Select[
   links,
   StringMatchQ[
    "https://www.nobelprize.org/nobel_prizes/physics/laureates/" ~~ NumberString ~~ "/" ~~ name__ ~~ "-facts.html"]
   ];

postcardpictures =
  StringCases[
     individualpagelinks,
     "https://www.nobelprize.org/nobel_prizes/physics/laureates/" ~~ year : NumberString ~~ "/" ~~ name__ ~~ "-facts.html"
      :>
      "https://www.nobelprize.org/nobel_prizes/physics/laureates/" <> year <> "/" <> name <> "_postcard.jpg"
     ] // Flatten // DeleteDuplicates;

Import /@ postcardpictures[[1 ;; 5]]

sample pictures


I found it easier to extract the rationale for the prizes from the Wikipedia table of Nobel Prize winners in physics:

wikidata = Import[
             "https://en.wikipedia.org/wiki/List_of_Nobel_laureates_in_Physics", 
             "Data"
           ];
Cases[
  wikidata,
  {year_, name_, _, rationale_}
  :>
  {year, StringDelete[rationale, {Whitespace ~~ "[" ~~ NumberString ~~ "]", "\""}]},
  Infinity
][[2 ;; -2]]

(* Out: 
{
 {1901, "in recognition of the extraordinary services he has rendered by the discovery of the remarkable rays subsequently named after him"}, 
 {1902, "in recognition of the extraordinary service they rendered by their researches into the influence of magnetism upon radiation phenomena"}, 
...
}
*)

Some manual cleanup will be necessary here: the somewhat naive method I proposed is confused by nested tables...

$\endgroup$
  • $\begingroup$ Thank you MarcoB. Learned a lot from your answer! $\endgroup$ – matheorem May 13 '16 at 14:50
5
$\begingroup$

Using jSoupLink:

<< jSoupLink`
ParseHTML[
  "https://www.nobelprize.org/nobel_prizes/physics/laureates/1921/einstein-facts.html",
  ".laureate_info_wrapper p",
  "text"
  ] // TableForm

Mathematica graphics

It is possible to be more precise:

ParseHTML[
 "https://www.nobelprize.org/nobel_prizes/physics/laureates/1921/einstein-facts.html",
 "span[itemprop=birthDate]",
 "text"
 ]
{"14 March 1879"}

I don't intend to explain how I figure out the CSS rules but there are a lot of things you can do quite easily with this jSoupLink if you know how. You could write a script that starts from this directory of Nobel Prizes and recursively collect data from all laureates, for example.

$\endgroup$
  • $\begingroup$ Thank you very much C.E! To looking into the source of html is really helpful. I also found importing link with option "XMLObject" realizes similar effect as jSoupLink $\endgroup$ – matheorem May 13 '16 at 14:53
  • $\begingroup$ @matheorem Importing HTML as symbolic XML is the traditional approach, but parsing symbolic XML with Cases and patterns is cumbersome. CSS rules are far superior and that is what jSoupLink allows for. $\endgroup$ – C. E. May 13 '16 at 18:38
  • $\begingroup$ I regret that I didn't try "jSoupLink" last night. I was reluctant to install an external package. But I tried now, "jSoupLink" is really handy and powerful in extracting html data. Thank you very much for your package ! $\endgroup$ – matheorem May 14 '16 at 6:10
  • $\begingroup$ However there is a issue. I tried to use ParseHTML in my getData. But found ParallelMap is not working, though Map is working. $\endgroup$ – matheorem May 14 '16 at 6:11
  • $\begingroup$ You can try this ParallelMap[ StringSplit[ ParseHTML[#, ".laureate_info_wrapper p", "text"], {",", ":"}] &, individualpagelinks[[1 ;; 4]]] It will give errors. But Map works. It seems that something wrong with StringSplit, because if I remove StringSplit, then ParallelMap is working $\endgroup$ – matheorem May 14 '16 at 7:33
3
$\begingroup$

Thanks to MarcoB and C. E. From them I learned how to deal with HTML contents using Mathematica.

I now summerize my final approach below (it is a bit long, so I make it an answer).

In this approach, I use information all from www.nobelprize.org and mathematica features that are all built-in.

individualpagelinks is a list of all Nobel Laureates information page hyperlinks(I learned from MarcoB)

links = DeleteDuplicates@
   Import["https://www.nobelprize.org/nobel_prizes/physics/laureates/\
index.html?images=yes", "Hyperlinks"];
individualpagelinks = 
  Select[links, 
   StringMatchQ[
    "https://www.nobelprize.org/nobel_prizes/physics/laureates/" ~~ 
     NumberString ~~ "/" ~~ __ ~~ "-facts.html"]];

To fetch essential information on "...-facts.html". The key is to import with option "XMLObject". like this

Import[individualpagelinks[[1]], "XMLObject"]

To know which expression contains the information you want, just Ctrl+F and search, for example search "birth" in the output cell, and you can find XMLElement["span", {"itemprop" -> "birthDate"}, {"9 March 1959"}] contains the information

Then use Cases to get all information you need.

In getData, The order of information: image, year, given name, family name, birth date, birth place, death date, death place, prize motivation, fields(if it exists)

Clear[getData];
getData[link_] := Module[{data},
  data = Import[link, "XMLObject"];
  {Import[StringReplace[link, "-facts.html" -> "_postcard.jpg"]],
   StringTrim /@ {StringCases[link, NumberString][[1]],
     Cases[data, 
       XMLElement["span", {"itemprop" -> "givenName"}, {x_}] -> x, 
       Infinity][[1]],
     Cases[data, 
       XMLElement["span", {"itemprop" -> "familyName"}, {x_}] -> x, 
       Infinity][[1]],
     Cases[data, {XMLElement["strong", {}, {"Born:"}], ___}, 
       Infinity][[1, 3, -1, 1]],
     StringSplit[
      Cases[data, {XMLElement["strong", {}, {"Born:"}], ___}, 
        Infinity][[1, -1]], ","],
     Sequence@
      If[tmp = 
        Cases[data, {XMLElement["strong", {}, {"Died:"}], ___}, 
         Infinity]; tmp =!= {},
       {tmp[[1, 3, -1, 1]], StringSplit[tmp[[1, -1]], ","]}, "live"],
     Cases[
       data, {XMLElement["strong", {}, {"Prize motivation:"}], x_} -> 
        x, Infinity][[1]],
     If[tmp = 
       Cases[data, {XMLElement["strong", {}, {"Field:"}], x_} -> x, 
        Infinity]; tmp =!= {}, tmp[[1]], Nothing]}}]

labeledPicture label image with year, name, country of birth

labeledPicture[dataEntry_] := Labeled[dataEntry[[1]],
  Column[{dataEntry[[2, 1]], 
    dataEntry[[2, 2]] <> " " <> dataEntry[[2, 3]], 
    " (" <> dataEntry[[2, 5, -1]] <> ")"}, "Center"]]

Here is an example with recent 10 Nobel Laureates in physics

data = ParallelMap[getData, individualpagelinks[[1 ;; 10]]];
Grid[Partition[labeledPicture /@ data, 5, 5, {1, 1}, {}]]

This will give

enter image description here

$\endgroup$

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.