# A short exploration of the featured contributors

GROUPS:
 Sander Huisman 17 Votes 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!
1 year ago
15 Replies
 Sander Huisman 1 Vote @Vitaliy Kaurov You're the random sample, haha!
1 year ago
 Daniel Lichtblau 2 Votes I'd swear I've seen that face before. I think it was in a post office...
1 year ago
 Sander Huisman 2 Votes @Daniel Lichtblau @Vitaliy Kaurov You mean this? Overlay[{out[[3, "Avatar"]], Style["WANTED", 20, Red]}, Alignment -> {Center, Top}] 
1 year ago
 Daniel Lichtblau 3 Votes That's the one! Where do I get to claim the reward?
1 year ago
 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.
1 year ago
 What should the weights be? Number of featured posts? Sqrt of that? Log thereof?
1 year ago
 Anton Antonov 1 Vote I would say log or square root. Also, I guess, some image outliers (say, that are not faces) have to be removed...
1 year ago
 I already use FindFaces already to align/crop them, and to get rid of avatar without a face (Szabolcs for example).
1 year ago
 Anton Antonov 1 Vote Right, I should have read your code more carefully. (Cool post, BTW, +1.)
1 year ago
 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...
1 year ago
 Vitaliy Kaurov 1 Vote 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.
1 year ago
 Moderation Team 1 Vote - 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!
 Sander Huisman 3 Votes BarChart[{1}]