Message Boards Message Boards

GROUPS:

Mister Rogers' Sweater Colors

Posted 2 years ago
4348 Views
|
2 Replies
|
9 Total Likes
|

If you (like me) are both a data geek and a Fred-Rogers-raised child of the 70's, you probably caught Owen Phillips's nice piece of cardigan-centric data science yesterday — Every Color Of Cardigan Mister Rogers Wore From 1979–2001. He posted his R code for scraping and visualizing the data on GitHub, but I wanted to see if I could improve slightly on that dataset and post something that other Wolfram Language users could tinker with. With a little bit of experimentation, I found that I could generate a nice little dataset with two lines of code. First, a function that takes an episode number, finds the original air date (on Tim Lybarger's excellent neighborhoodarchive.com), and turns it into a DateObject:

epDate[ep_] := 
 Cases[Import[
    "http://www.neighborhoodarchive.com/mrn/episodes/" <> ep <> 
     "/index.html", "FullData"], {"Air Date", date_} :> 
    DateObject[date], Infinity][[1]]

And second, some code that scrapes episode numbers and approximate sweater colors out of a neighborhoodarchive.com blog post (archived by the Internet Archive), then uses the previous function to get an air date for each episode (and sweater):

sweats = Dataset[<|"EpisodeNumber" -> First@#, 
      "Date" -> epDate@First@#, 
      "SweaterColor" -> Last@#|> & /@ (Cases[
       Import["https://web.archive.org/web/20110525014454/http:\
//neighborhoodarchive.blogspot.com/2011/05/sweater-colors.html", 
        "XMLObject"], 
       XMLElement[
         "td", {"colspan" -> "1", "rowspan" -> "1", 
          "bgcolor" -> col__}, {XMLElement[
           "div", {"align" -> "center", 
            "class" -> "style8"}, {ep___}]}] :> 
        Rule[ep, RGBColor@col], Infinity] //. 
      XMLElement[_, _, {episode_}] :> episode)];

To save others the trouble of scraping and regenerating all this data, I went an extra step and submitted a new ResourceObject to the Wolfram Data Repository (Mister Rogers' Sweater Colors), so you can immediately grab it and start producing interesting visualizations and analyses...

Grid[With[{data = 
    Row[Sort[#]] & /@ 
     Normal[GroupBy[
        ResourceData[
         "Mister Rogers' Sweater Colors"], #Date["Year"] &][[All, All,
        "SweaterColor"]]]}, Transpose[{Keys[data], Values[data]}]], 
 Alignment -> {Left, Center}]

enter image description here

2 Replies

Two more, since I just can't stop tinkering with this data:

LinearGradientImage across all individual sweater colors, in order:

ImageResize[
 LinearGradientImage[
  Normal@SortBy[ResourceData["Mister Rogers' Sweater Colors"], 
     "Date"][All, "SweaterColor"]], {800, 200}]

enter image description here

First blend all colors for each year, then apply LinearGradientImage to the blended colors:

ImageResize[
 LinearGradientImage[
  Normal@(Blend /@ 
     Values@GroupBy[
        ResourceData[
         "Mister Rogers' Sweater Colors"], #Date["Year"] &][[All, All,
         "SweaterColor"]])], {800, 200}]

enter image description here

enter image description here - Congratulations! This post is now a Staff Pick! Thank you for your wonderful contributions. Please, keep them coming!

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