Message Boards Message Boards

A short exploration of the featured contributors

GROUPS:

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
Answer
7 months ago

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

POSTED BY: Sander Huisman
Answer
7 months ago

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

POSTED BY: Daniel Lichtblau
Answer
7 months ago

@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
Answer
7 months ago

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

POSTED BY: Daniel Lichtblau
Answer
7 months 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.

POSTED BY: Anton Antonov
Answer
7 months ago

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

POSTED BY: Sander Huisman
Answer
7 months ago

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
Answer
7 months ago

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
Answer
7 months ago

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

POSTED BY: Anton Antonov
Answer
7 months 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...

POSTED BY: Sander Huisman
Answer
7 months ago

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
Answer
7 months ago

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
Answer
7 months ago

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

POSTED BY: Christopher Carlson
Answer
7 months ago
BarChart[{1}]

enter image description here

POSTED BY: Sander Huisman
Answer
7 months ago

@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
Answer
7 months ago

Group Abstract Group Abstract