How to play with Facebook data inside Mathematica?

Question

I saw this post from Wolfram here and I would like to know how to import facebook data into Mathematica.

Answer 1

I have made some time ago Mathematica code to play with my Facebook graph inside it. The code extracts your Facebook friends, photos and relationships, and constructs a PDF file that you can click in your friend's picture to open their Facebook and see they relations. The result is like this:

And the zoom in PDF is great, see:

The notebook is here.

To use it, you to have to get access to your friends' data. You need to be logged into Facebook and get one access token. The URL is here. Below is the code:

(*Get friends name and facebook code*)
getFriendsList[]:=Rule@@@Import["https://graph.facebook.com/me/friends?access_token="<>token,"JSON"][[1,2,All,All,2]]

(*Get your friends photo link and sex*)
{cName,cPhotoLink,cSex,cCode}=Range[4];
getFriendsData[fList_]:=Module[{url,query,friendsData,fListString},
    fListString=conv2StringList[fList[[All,1]]];
    url = "https://api.facebook.com/method/fql.query?access_token="<>token<>"&query=";
    query=url<>"SELECT uid, name, sex,pic_square FROM user WHERE uid in "<>fListString<>"&format=JSON";
    query=StringReplace[query," "-> "%20"];
    friendsData=Import[query,"JSON"][[All,All,-1]]
]

(*Get friends pairs connections*)
getFriendsPairsPart[fList1_,fList2_]:=Module[{url,query1,friendsPairs,friendsStr1,firendsStr2},
    friendsStr1=conv2StringList[fList1];
    firendsStr2=conv2StringList[fList2];
    url = "https://api.facebook.com/method/fql.query?access_token="<>token<>"&query=";
    query1=url<>"SELECT uid1, uid2 FROM friend WHERE uid1 in "<>friendsStr1<>"and uid2 in"<>firendsStr2<>"&format=JSON";
    query1=StringReplace[query1," "-> "%20"];
    friendsPairs=Import[query1,"JSON"];
    friendsPairs=(Sort/@friendsPairs)//Union
]

getFriendsPairs[friendsList_]:=Module[{groupsComb,groupsCompLen,maxUsers=100,friendsPairs,i=1},
    SetSharedVariable[i];

    groupsComb=Partition[friendsList[[All,1]],maxUsers,maxUsers,1,{}];
    groupsComb=Subsets[groupsComb,{2}];
    groupsCompLen=Length[groupsComb];

    Print["Extracting Connections"];
    Print[Dynamic@mrtProgressBar[i,groupsCompLen]];
    friendsPairs=Flatten[ParallelMap[(i++;getFriendsPairsPart@@#)&,groupsComb],1];
    friendsPairs=UndirectedEdge@@@friendsPairs[[All,All,2]];
    friendsPairs=Union[Sort/@friendsPairs];
    Print[Row@{"Connections number: ", Length@friendsPairs}];
    friendsPairs
]

(*Get friends photos*)
getFriendsPhotos[friendsData_]:=Module[{append,friends,photos,page,i=1,tabImg={}},
    SetSharedVariable[i];
    SetSharedVariable[tabImg];
    Print["Extracting user pictures:"];
    Print[Dynamic@mrtProgressBar[i,Length[friendsData]]];
    Print[Dynamic@GraphicsGrid[If[Length[tabImg]==0,{{""}},Partition[tabImg,10,10,1,{}]],ImageSize->200]];

    append[data_Image]:=Module[{},
        If[Length[tabImg]>100,tabImg={}];
        AppendTo[tabImg,data];
        data
    ];
    (*CloseKernels[];LaunchKernels[8];*)
    photos=ParallelMap[(i++;{append[Import[#[[cPhotoLink]]]],ToString[#[[cCode]]]})&,friendsData];
    Print[Row@{"Photo's number: ",Length[photos]}];
    photos
]

adjustPhotos[friendsPhotos_,friendsPairs_]:=Module[{friends,photosSel,graph,page},
    graph=Graph@friendsPairs;
    friends=VertexList@graph;
    page=PageRankCentrality[graph,0.1];
    page=Rescale[page,{0,Max[page]},{0.1,0.9}];
    page=Rule@@@Transpose[{friends,page}];
    photosSel=Select[friendsPhotos,MemberQ[friends,#[[2]]]&];
    (#[[2]]-> Hyperlink[Magnify[ #[[1]],#[[2]]]/.page,"http://www.facebook.com/profile.php?id="<>#[[2]]])&/@photosSel
]

(*Plot Facebook graph*)
createGraph[friendsPairs_,friendsPhotosForVertex_]:=Module[{g1,g2,g3,label},

    g1=Graph[friendsPairs,
        VertexShape-> friendsPhotosForVertex,
        VertexSize->5,
        EdgeStyle-> Opacity[0]];

    g2=Graph[friendsPairs,
        VertexSize->0,
        EdgeStyle->Thickness[0.0001]];

    label=Graphics[{Style[Text["by Rodrigo Murta\nwww.rodrigomurta.com"],Blue]},ImageSize-> 100];

    g3=Show[g2,g1,label,ImageSize-> 3000]
]

(*Execute code*)
createMyFacebookPDF[]:=Module[{myFacebookGraph},

    SetDirectory[NotebookDirectory[]];
    Print["Extracting friends data"];
    friendsList=getFriendsList[];
    friendsData=getFriendsData[friendsList];
    friendsPairs=getFriendsPairs[friendsList];
    friendsPhotos=getFriendsPhotos[friendsData];
    photosForVertice=adjustPhotos[friendsPhotos,friendsPairs];
    Print["Creating GraphPlot"];
    myFacebookGraph=createGraph[friendsPairs,photosForVertice]
    Print["Creating PDF"];
    Export["myFacebookGraph.pdf",myFacebookGraph];
    Print["PDF Created!"];
]//Quiet
(*quiet to avoid uni core msg*)

(*Other Funcitons*)
mrtProgressBar[var_,total_]:=Row[{ProgressIndicator[var,{0,total}]," ",Row[{NumberForm[100. var/total,{\[Infinity],2}],"%"}],"% ",var}]
conv2StringList[list_]:=StringReplace[ToString[list],{"{"-> "(","}"-> ")"," "-> ""}]

To execute the code, replace the token string below with your token and go on! Don't forget to save the notebook before executing, it uses the notebook path, so it must be saved.

token="AAACEdEose0cBADkiImZBYQ4Tvr2e27m4g27ZB7uYylxHYZBO6nDJb9HYlJqYsXZA4av77aR7HJv3ZBCWeBpd7p1HOtTBmVOZAW5EdwgHkYeQZDZD";
createMyFacebookPDF[]

The code is mine and it's for free. If you want to use it, just give me credit.

Answer 2

It might make sense to try to import the data from WolframAlpha, seeing as how they've gone to the trouble to set it up. Unfortunately, the support for doing so is a bit disappointing, as it can't be accessed directly through Mathematica. I imagine that a future version will support this but, for the time being, this is available only via WolframAlpha Pro's data download.

For example, my Facebook Report includes a "Friends' hometown's" pod. After a little fiddling with the pod options to get the data I want, I can click on the "Data download" button and request the data in "CDF [computable data]" format to get the following:

cityData = {{{{"city", "number of friends"}, {"Bexley, Ohio", 
      21}, {"Columbus, Ohio", 10}, {"Asheville, North Carolina", 
      8}, {"Atlanta, Georgia", 2}, {"Charlotte, North Carolina", 
      2}, {"Hendersonville, North Carolina", 
      2}, {"Winston\[Hyphen]Salem, North Carolina", 
      2}, {"Barnesville, Ohio", 1}, {"Beavercreek, Ohio", 
      1}, {"Belpre, Ohio", 1}, {"Bethesda, Maryland", 
      1}, {"Black Mountain, North Carolina", 1}, {"Buffalo, New York",
       1}, {"Cashiers, North Carolina", 1}, {"Durham, North Carolina",
       1}, {"East Haven, Connecticut", 
      1}, {"Fayetteville, North Carolina", 
      1}, {"Fort Collins, Colorado", 1}, {"Gainesville, Georgia", 
      1}, {"Greensboro, North Carolina", 1}, {"Helena, Montana", 
      1}, {"Hull, Massachusetts", 1}, {"Kalispell, Montana", 
      1}, {"Keene, New Hampshire", 1}, {"Kenly, North Carolina", 
      1}, {"Kitty Hawk, North Carolina", 
      1}, {"Lancaster, South Carolina", 1}, {"Lexington, Kentucky", 
      1}, {"Marion, Ohio", 1}, {"New York City, New York", 
      1}, {"Oakland, California", 1}, {"Oak Ridge, Tennessee", 
      1}, {"Pittsboro, North Carolina", 
      1}, {"Raleigh, North Carolina", 
      1}, {"Randleman, North Carolina", 1}, {"Roswell, Georgia", 
      1}, {"Saratoga Springs, New York", 1}, {"Shelbyville, Kentucky",
       1}, {"Sylvania, Ohio", 1}, {"The Woodlands, Texas", 
      1}, {"Thurmond, West Virginia", 1}, {"Valdese, North Carolina", 
      1}, {"Virginia Beach, Virginia", 1}, {"Waterloo, Iowa", 
      1}, {"Weaverville, North Carolina", 1}}, {{"city", 
      "number of friends"}, {"Nenzing, Vorarlberg", 1}}}, 
   "46 cities , 19 states , 2 countries"};

That's actual data that I can use in Mathematica now. For example:

cities = Rest[cityData[[1, 1]]];
Show[{
  CountryData["UnitedStates", {"Shape", "Equirectangular"}],
  Graphics[Select[Table[
   {PointSize[city[[2]]^0.4/150], Tooltip[
     Point[Reverse@CityData[StringSplit[city[[1]], ", "], "Coordinates"]],
   city]},
 {city, cities}], FreeQ[#, Point[Missing["NotAvailable"]]] &]]
}]

It's a bit tricky to get data out of the very cool "Friends network" pod, since the "CDF [computable data]" choice returns nothing. Instead, if we select "CDF [full ouput]", we get an image, but that image is in Mathematica Graphics format which allows us to extract some information. The "image" in the input below is exactly that output. Examining the image in InputForm reveals that there is a Line primitive that contains edge information defining the graph.

Let's transform the edges into a Graph and compute something semi-interesting about the graph. I guess the GraphDiameter of the largest connected component tells us how far removed two of my friends can be in that component.

edges = UndirectedEdge @@@ edges;
graph = Graph[edges]
GraphDiameter[Subgraph[graph,
  First[ConnectedComponents[graph]]]]

Here's an image using GraphPlot, which seems to allow a bit finer control of the output. In particular, I don't see a way to access the "RepulsiveForcePower" suboption of the "SpringElectricalEmbedding" drawing method.

Clear[size];
talliedVertices = Sort[Tally[Sequence @@@ edges]];
total = Total[Last /@ talliedVertices];
sizes = (size[#[[1]]] = #[[2]]) & /@ talliedVertices;
maxSize = Max[sizes];
edges = Rule @@@ edges;
GraphPlot[edges, Method -> {"SpringElectricalEmbedding",
  "RepulsiveForcePower" -> -2},
  EdgeRenderingFunction -> ({Gray, Opacity[0.2], Line[#1]} &),
  VertexRenderingFunction -> ( {
  PointSize[size[#2]^(1/2)/(10 maxSize)], Point[#1]} &)]