Message Boards Message Boards

A short exploration of the featured contributors

enter image description here

Most of you have probably seen that some post that exemplify the power and breadth of the Wolfram language are selected as featured posts. I was wondering how many posts are there now, and some of the statistics behind it, so I wrote this small code that imports data from the web:

baseurl="http://community.wolfram.com";
featurelinkstring="/people?p_p_id=people_WAR_peopleportlet&p_p_lifecycle=0&p_p_state=normal&p_p_mode=view&p_p_col_id=column-1&p_p_col_pos=1&p_p_col_count=2&_people_WAR_peopleportlet_tabs1=All&_people_WAR_peopleportlet_orderVar=featured&_people_WAR_peopleportlet_delta=20&_people_WAR_peopleportlet_keywords=&_people_WAR_peopleportlet_advancedSearch=false&_people_WAR_peopleportlet_andOperator=true&_people_WAR_peopleportlet_resetCur=false&_people_WAR_peopleportlet_cur=`n`";
ClearAll[FeaturedLink,SimplifiedProfileLink,GetProfileDataFromPage,GetFeaturedPosts]
FeaturedLink[n_Integer]:=FeaturedLink[n]=StringTemplate[baseurl<>featurelinkstring][<|"n"->n|>]
SimplifiedProfileLink[url_String]:=FirstCase[URLFetch[url,"Headers"],{"Location",link_String}:>link,url,\[Infinity]]
SimplifiedProfileLink[x_]:=x
GetFeaturedPosts[profilelink_String]:=GetFeaturedPosts[profilelink]=Module[{list},
    list=FirstCase[Import[profilelink,"XMLObject"],XMLElement["div",{"class"->"content-wrapper staff-picks-content"},content__]:>content,Missing[],\[Infinity]];
    If[MissingQ[list],{},Cases[list,XMLElement["li",{},{XMLElement["a",{"shape"->"rect","href"->url_},{title_}]}]:>{title,baseurl<>url},\[Infinity]]]
]
GetProfileDataFromPage[url_String]:=GetProfileDataFromPage[url]=Module[{xml,out,names,avatarurl,profilelinks,featureposts},
    xml=Import[url,"XMLObject"];
    out=Cases[xml,XMLElement["tr",{"class"->"portlet-section-alternate results-row alt"|"portlet-section-body results-row"|"portlet-section-alternate results-row alt last"},___],\[Infinity]];
    names=FirstCase[#,XMLElement["span",{"class"->"user-name"},{name_}]:>StringTrim[name],Missing[],\[Infinity]]&/@out;
    avatarurl=FirstCase[#,XMLElement["img",{"class"->"avatar",___,"src"->u_},{}]:>baseurl<>u,Missing[],\[Infinity]]&/@out;
    profilelinks=FirstCase[#,XMLElement["a",{"shape"->"rect","href"->u_},{" ",XMLElement["span",{"class"->"user-profile-image"},{" "}]}]:>u,Missing[],\[Infinity]]&/@out;
    profilelinks=SimplifiedProfileLink/@profilelinks;
    featureposts=GetFeaturedPosts/@profilelinks;
    Association/@Transpose[Thread/@{"Name"->names,"AvatarURL"->avatarurl,"Avatar"->(Import/@avatarurl),"ProfileURL"->profilelinks,"NumberOfFeaturedPosts"->(Length/@featureposts),"FeaturedPosts"->featureposts}]
]

Then we can call these functions and get the information:

out = Join @@ (GetProfileDataFromPage[FeaturedLink[#]] & /@ Range[5]); (* currently 5 pages of featured contributors*)

This will return a big dataset, here a random sample:

Dataset[out[[3]]]

enter image description here

So we get a Association back with the various properties, including his (or her for other entries) featured posts:

enter image description here

We can now do some fun stuff with this dataset:

tmp=Values/@out[[All,{"Name","Avatar","FeaturedPosts"}]];
tmp[[All,3]]=Length/@tmp[[All,3]];
tmp=SortBy[tmp,Last];
imgs=ImageCrop[ImageResize[#,50],{50,50}]&/@tmp[[All,2]];
insets=MapThread[Inset[#1,{#3+1,#2},Center,{1.75,1.75}]&,{imgs,Range[Length[imgs]],tmp[[All,3]]}];
BarChart[tmp[[All,3]],
    BarOrigin->Left,
    ChartLabels->{tmp[[All,1]]},
    Frame->True,
    ImageSize->800,
    GridLines->Automatic,
    FrameStyle->Directive[GrayLevel[0.3],AbsoluteThickness[1]],
    PlotRangePadding->{{0,0},{-1,1}},
    PerformanceGoal->"Speed",
    PlotRange->{{0,50},Automatic},
    PlotLabel->Style["Number of featured posts per featured contributor",14,Black],
    ChartStyle->Directive[GrayLevel[0.7],EdgeForm[GrayLevel[0.4]]],
    BarSpacing->0.1,
    AspectRatio->4,
    Epilog->insets,
    FrameTicks->{{Automatic,Automatic},{Range[0,50,5],Range[0,50,5]}},
    FrameStyle->Black,
    FrameTicksStyle->Black
]

enter image description here

Clayton is the clear winner!

We can also look at the profile photos in more detail:

Magnify[out[[All, "Avatar"]], 0.5]

enter image description here

Let's find all the faces, and calculate the 'average' face:

ClearAll[GetFaces]
GetFaces[img_Image]:=With[{s=FindFaces[img]},ImageTrim[img,#]&/@s]
imgs=RemoveAlphaChannel/@ConformImages[Join@@(GetFaces/@out[[All,"Avatar"]]),{200,200}];
Image[Mean[ImageData/@imgs]]

enter image description here

Or a word-cloud of all the titles:

    WordCloud[StringRiffle[Join @@ out[[All, "FeaturedPosts", All, 1]], " "]]

enter image description here

Feel free to dig deeper!

POSTED BY: Sander Huisman
15 Replies

@Vitaliy Kaurov @Christopher Carlson @Sander Huisman Interesting to learn about the main authors who write amazing codes on the website (Wolfram Tweet-a-Program) https://twitter.com/wolframtap since 2014 until today ;)

POSTED BY: Silvia Torosyan

How many Featured Posts are there about how many Featured Posts there are?

BarChart[{1}]

enter image description here

POSTED BY: Sander Huisman

enter image description here - another post of yours has been selected for the Staff Picks group, congratulations ! We are happy to see you at the top of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!

POSTED BY: Moderation Team

Awesome post, @Sander, thanks! This is very timely and is sort of celebratory as we just surpassed 13,000 members. Excellent example of web data parsing.

POSTED BY: Vitaliy Kaurov

I'd swear I've seen that face before. I think it was in a post office...

POSTED BY: Daniel Lichtblau

@Daniel Lichtblau @Vitaliy Kaurov You mean this?

Overlay[{out[[3, "Avatar"]], Style["WANTED", 20, Red]}, Alignment -> {Center, Top}]

enter image description here

POSTED BY: Sander Huisman

That's the one! Where do I get to claim the reward?

POSTED BY: Daniel Lichtblau

I kind of disagree that the mean face was made with simple averaging. That gives wrong impressions (and deja-vu-s to Danny). A weighted face averaging is much more appropriate.

POSTED BY: Anton Antonov

What should the weights be? Number of featured posts? Sqrt of that? Log thereof?

POSTED BY: Sander Huisman

I would say log or square root. Also, I guess, some image outliers (say, that are not faces) have to be removed...

POSTED BY: Anton Antonov

I already use FindFaces already to align/crop them, and to get rid of avatar without a face (Szabolcs for example).

POSTED BY: Sander Huisman

Right, I should have read your code more carefully. (Cool post, BTW, +1.)

POSTED BY: Anton Antonov

Interestingly, your deja-vu might be right:

Nearest[out[[All, "Avatar"]] -> out[[All, "Name"]], meanface]

returns Daniel Lichtblau as the one with the most average face...

POSTED BY: Sander Huisman

@Vitaliy Kaurov You're the random sample, haha!

POSTED BY: Sander Huisman
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract