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]]]

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

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
]

Clayton is the clear winner!

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

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

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]]

Or a word-cloud of all the titles:

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

Feel free to dig deeper!