Play with Bibliographic Data

I’ve got the publication list of a research institute. There are more than 1400 entries, exported in xml format from Endnote. As a data mining project, there are plenty of things you can do with the data. Let’s assume  we are interested in the relationships among researchers and groups. Can we check this out quickly in Mathematica?

First, extract the data:

in the xml, for each publication, the author list is stored as the following:

<authors>
<author>
  <style face="normal" font="default" size="100%">Paul, N.</style>
</author>
<author>
  <style face="normal" font="default" size="100%">Cao, B.</style>
</author>
… </authors>

xml = Import["Bib.xml"];

authors = Cases[xml, XMLElement["authors", _, authors_] -> authors, Infinity];

names = Flatten@Cases[#, XMLElement["author", _, {___, XMLElement["style", _, name_]}] –> name] & /@ authors;

What we get here is the lists of authors for each publication.

Let’ see the relationship between number of authors and number of publications.

Sort[Tally[Length[#] & /@ names], #1[[1]] < #2[[1]] &]

{{1, 265}, {2, 280}, {3, 320}, {4, 224}, {5, 94}, {6, 85}, {7,
  39}, {8, 22}, {9, 20}, {10, 14}, {11, 11}, {12, 14}, {13, 5}, {14,
  3}, {15, 5}, {18, 1}, {19, 1}, {20, 1}}

We can see that most of publications have no more than 4 authors.

Next step, we like to check out the internal relationships among authors. We need to generate a network for authors. For example, if a publication has 4 authors {A, B, C, D}, the network is defined as a circle:

Flatten@(Partition[Append[authors, authors[[1]]], 2, 1] /. {x_, y_} :> {x -> y})

{A -> B, B -> C, C -> D, D -> A}

For all the publications, we get the following network:

There are two large research groups inside this institute. Then re-draw the graph with top 10 contributors, it confirms the information.

No too bad with 10 minutes coding.

I will not release the notebook this time, since I may not have the right to distribute the data. Sorry about it.

Wikipedia Page Analysis

Wikipedia has lots of scientific information, however, due to its nature, it is still not considered as a research resource.  This doesn’t mean it has to be ignored. I have checked some pages related with various topics in GIS field. Most of them are well-written, the information are actually quite accurate, several contributors are the professionals in the field. In this post, I like to check some metadata information of  “Mathematica” Page on Wikipedia, it may gives us some ideas about its quality.

Tools we need: Mediawiki API and Mathematica. There are plenty examples on how to use Mediawiki api. Basic procedure is to use Import[queryurl,”XML”], then parse xml to get the information we need.

Page revision history:

(* import  contributor and timestamp *)

url = "http://en.wikipedia.org/w/api.php?action=query&prop=revisions&\
titles=Mathematica&rvprop=user|timestamp&rvlimit=500&redirects$rvuser&\
format=xml";

xml = Import[url, "XML"];
rawdata= Cases[xml, XMLElement["rev", w_, _] :> w, Infinity];
data = {"user", "timestamp"} /. rawdata;

 

 

This page is constantly revised, we probably can assume the information on “Mathematica” page is up-to-date.

The information on the contributors is also interesting.

 

We can dig out more information on the contributors:

(* import paged edited by each user *)

userpages[usr_] :=
  Module[{url, uxml, udata, unicase},
   url = "http://en.wikipedia.org/w/api.php?action=query&list=\
usercontribs&uclimit=500&format=xml&ucuser=" <> usr;
   uxml = Import[url, "XML"];
   udata = Cases[uxml, XMLElement["item", w_, _] :> w, Infinity];
   unicase = DeleteCases[Union["title" /. udata ],
     x_ /; (StringMatchQ[x, "User talk:" ~~ __] || StringMatchQ[x, "Talk:" ~~ __] || StringMatchQ[x, "User:" ~~ __])]; Map[usr -> # &, unicase]];

 

The common pages edited by these top5 contributors:

  

From the pages they have edited, they have worked on several topics closely related with Mathematica. This looks good, we may say they probably know what they are doing.

Update:

Download Wikipedia Notebook for the details.

View weighted graph with GraphPlot

Here is a simple example on how to customizing Graphplot. We like to use GraphPlot to visualize the number of people who commute into or out Monroe county from/to its neighbor counties.

g={{"Owen" -> "Monroe", 2813}, {"Greene" -> "Monroe",
  3788}, {"Lawrence" -> "Monroe", 4022}, {"Jackson" -> "Monroe",
  85}, {"Brown" -> "Monroe", 689}, {"Morgan" -> "Monroe",
  821}, {"Monroe" -> "Owen", 676}, {"Monroe" -> "Greene",
  207}, {"Monroe" -> "Lawrence", 679}, {"Monroe" -> "Brown",
  303}, {"Monroe" -> "Morgan", 617}}

vercoor={"Monroe" -> {-86.529, 39.1621}, "Owen" -> {-86.7642, 39.2868}, "Greene" -> {-86.9403, 39.0246},  "Lawrence" –> {  -86.4923,  38.8627}, "Jackson" -> {-86.0462, 38.8798},  "Brown" -> {-86.2382, 39.203}, "Morgan" -> {-86.4238, 39.4233}}

First try:

GraphPlot[g, VertexLabeling -> True, VertexCoordinateRules -> vercoor]

Using arrow to indicate in/out seems to be a good idea. We use EdgeRenderingFunction in second try:

GraphPlot[g, VertexLabeling -> True,
EdgeRenderingFunction -> (Arrow[#1, 0.05] &),
VertexCoordinateRules -> vercoor]

However, the labels on the edge is lost. We can handle it in EdgeRenderingFunction.

GraphPlot[g, VertexLabeling -> True,
EdgeRenderingFunction -> ({Text[#3, Mean[#1]], Arrow[#1, 0.05]} &),  VertexCoordinateRules -> vercoor]

The graph is still difficult to read, the commuting pattern isn’t clear at a glance. We further update EdgeRenderingFunction and use the line color and thickness to show the pattern.

GraphPlot[g,
EdgeRenderingFunction -> ({If[#2[[1]] == "Monroe", Red, Blue],
     AbsoluteThickness[0.5 + #3/500], Arrowheads[0.02 + #3/120000],  Arrow[#1, 0.05]} &), VertexLabeling -> True,
VertexCoordinateRules -> vercoor]

In the last try, we use VertexRenderingFunction to make the label more clear.

GraphPlot[g,
EdgeRenderingFunction -> ({If[#2[[1]] == "Monroe", Red, Blue],
     AbsoluteThickness[0.5 + #3/500], Arrowheads[0.02 + #3/120000], Arrow[#1, 0.06]} &), VertexLabeling -> True,
VertexCoordinateRules -> vercoor,
VertexRenderingFunction -> ({Text[Style[#2, 14, Bold], #2 /. vercoor, Background -> White]} &)]

Import the shapefile, then you get a map:

Tips: Customizing Graphplot

For a graph g, we like draw leaves in different style from nodes.


(* find leaves *)
leaves = Complement[g[[All, 2]], g[[All, 1]]];
TreePlot[g, VertexLabeling -> False, PlotStyle -> {Black}, VertexRenderingFunction -> (If[MemberQ[leaves, #2], {FaceForm[LightGray], EdgeForm[Black], Disk[#1, 0.15], Text[#2, #1]}, {FaceForm[White], EdgeForm[Black], Disk[#1, 0.15]}] &), AspectRatio -> 0.3]

The tip is in VertexRenderingFunction, Text[#2, #1], #2 means the label, #1 is coordinates.

Overlay GraphPlot on maps

GraphPlot is one of the most interesting and powerful function in Mathematica. Here comes up a simple demonstration to show how to overlay the Graph on top of the map. The key is to use VertexCoordinateRules option to place the each vertex in the right place.

The following graph is the adjacency graph for countries in South America.
Using the location of capital cities as vertex coordinates seems a good choice. So combining CountryData and CityData, the location list of {country->{lon, lat of capital city}} is created.

{{"Argentina" -> {-58.37, -34.61}, "Bolivia" -> {-68.15, -16.5}, "Brazil" -> {-47.91, -15.78}, "Chile" -> {-70.64, -33.46}, "Colombia" -> {-74.09, 4.63}, "Ecuador" -> {-78.5, -0.19}, "FrenchGuiana" -> {-52.34, 4.92}, "Guyana" -> {-58.16, 6.79}, "Paraguay" -> {-57.63, -25.3}, "Peru" -> {-77.05, -12.07}, "Suriname" -> {-55.2, 5.85}, "Uruguay" -> {-56.17, -34.87}, "Venezuela" -> {-66.93, 10.54}}

Redraw the graph with VertexCoordinateRules -> locationlist


Then show it with the map


It is kind of silly in certain way to overlap the adjacency graph on top of the map. However, the graph delivers the information more clearly, you can spot it immediately that Brazil has the largest number of neighbors in South America.

Leader of the world? again

Use the flags at the vertices of the graph.
VertexRenderingFunction -> (Inset[Show[CountryData[#2, "Flag"], ImageSize -> 30], #] &)

See the original.

Leader of the World?

The graphplot of all the countries with their major export partners.

GraphPlot[DeleteCases[Flatten[Thread[# -> CountryData[#, "ExportPartners"] /. _Missing :> {}] & /@ CountryData[]], _ -> {}], VertexLabeling -> True, MultiedgeStyle -> True, DirectedEdges -> True, Method -> HighDimensionalEmbedding]