The Guests of the Graham Norton Show

Sick, lying on the sofa trying to pass an evening. I found myself in desperate need of something easy to watch as I waited for the headache, sore throat and fever to leave me. Of the shows I did want to watch, all are shows I watch with my girlfriend. Even sick, I don’t think I could get away with that level of betrayl!

So I put of Graham Norton. As my girlfriend describes it, “It’s okay if you miss a bit”. Perfect for when you’re half dozing.

Nicole Kidman was the first guest on this weeks show. At the start, she says “I think I’ve been on here the most of anyone”. That was like drugs to a sniffer dog, even to my tired mind. Now that I’m feeling a little better, let’s see if we can answer it.

Wikipedia has a page detailing every episode and it’s guests. We can extract the information from this to get our data for analysis.

library(rvest)
library(purrr)
library(dplyr)
library(stringr)
library(tidyr)
library(ggplot2)
library(lubridate)

page <- read_html("https://en.wikipedia.org/wiki/List_of_The_Graham_Norton_Show_episodes")

#list all of the selectors
selector_guests <- ".summary"
selector_episode_no <- ".vevent td:nth-child(2)"
selector_overall_episode_no <- ".vevent th"
selector_air_date <- ".vevent td:nth-child(4)"

selectors <- c(air_date = selector_air_date, 
               guests = selector_guests, 
               episode_no = selector_episode_no, 
               overall_episode_no = selector_overall_episode_no)

# Create general function to extract text from page
extract_graham_norton <- function(site, selector) {
  site %>% html_nodes(selector) %>% html_text()
}

lists_mania <- map_df(selectors, ~extract_graham_norton(page, .x))

df <- bind_cols(lists_mania)

head(df)

We have the data in it’s rough form, but we’ll need to extract the names into something we can work with. Currently they are in the form of “guest1, guest2, … and guest3”. We’ll need to split the string on "," and "and", then unnest our new datadframe to create a record for every guest on the show

tidy_df <- df %>%
  filter(guests != "Compilation show") %>%
  mutate(air_date_tidy = str_extract(air_date, "(.{1,2}\\W[A-z]+\\W\\d{4})") %>% dmy(),
         guests = str_split(guests, ",|\\band\\b")) %>%
  tidyr::unnest() %>%
  mutate(guests = str_to_lower(guests) %>% str_replace_all("pilot|\\(|\\)", "") %>% str_trim())

#filename <- paste("output-data/", "graham-norton-guests_", Sys.Date(), ".csv", sep = "")
#write.csv(tidy_df, file = filename)

head(tidy_df)

Our data is now fit for purpose. Is Nicole Kidman the most common guest on the show? Let’s check the top 5


tidy_df %>%
  count(guests) %>%
  arrange(desc(n)) %>%
  top_n(5, n)

She’s no where near! How many times has she been on the show?

tidy_df %>%
  filter(guests =="nicole kidman") %>%
  count()

Bonus

Histogram of Guest frequency

tidy_df %>%
  count(guests) %>%
  ggplot(aes(x = n)) + geom_histogram(binwidth = 1)

Number of distinct Guests

nrow(tidy_df)

tidy_df %>%
  mutate(guests = str_trim(guests) %>% str_to_lower()) %>%
  distinct(guests) %>%
  count()

Number of Guests Per Epidsode

tidy_df %>%
  count(overall_episode_no) %>%
  arrange(desc(n))

tidy_df %>%
  filter(overall_episode_no == 206)


tidy_df %>%
  count(overall_episode_no) %>%
  ggplot(aes(x = overall_episode_no, y = n)) + geom_point()


tidy_df %>%
  count(air_date_tidy) %>%
  ggplot(aes(x = air_date_tidy, y = n)) + geom_point()
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQojIFRoZSBHdWVzdHMgb2YgdGhlIEdyYWhhbSBOb3J0b24gU2hvdw0KDQpTaWNrLCBseWluZyBvbiB0aGUgc29mYSB0cnlpbmcgdG8gcGFzcyBhbiBldmVuaW5nLiBJIGZvdW5kIG15c2VsZiBpbiBkZXNwZXJhdGUgbmVlZCBvZiBzb21ldGhpbmcgZWFzeSB0byB3YXRjaCBhcyBJIHdhaXRlZCBmb3IgdGhlIGhlYWRhY2hlLCBzb3JlIHRocm9hdCBhbmQgZmV2ZXIgdG8gbGVhdmUgbWUuIE9mIHRoZSBzaG93cyAgSSBkaWQgd2FudCB0byB3YXRjaCwgYWxsIGFyZSBzaG93cyBJIHdhdGNoIHdpdGggbXkgZ2lybGZyaWVuZC4gRXZlbiBzaWNrLCBJIGRvbid0IHRoaW5rIEkgY291bGQgZ2V0IGF3YXkgd2l0aCB0aGF0IGxldmVsIG9mIGJldHJheWwhDQoNClNvIEkgcHV0IG9mIEdyYWhhbSBOb3J0b24uIEFzIG15IGdpcmxmcmllbmQgZGVzY3JpYmVzIGl0LCAiSXQncyBva2F5IGlmIHlvdSBtaXNzIGEgYml0Ii4gUGVyZmVjdCBmb3Igd2hlbiB5b3UncmUgaGFsZiBkb3ppbmcuDQoNCk5pY29sZSBLaWRtYW4gd2FzIHRoZSBmaXJzdCBndWVzdCBvbiB0aGlzIHdlZWtzIHNob3cuIEF0IHRoZSBzdGFydCwgc2hlIHNheXMgIkkgdGhpbmsgSSd2ZSBiZWVuIG9uIGhlcmUgdGhlIG1vc3Qgb2YgYW55b25lIi4gVGhhdCB3YXMgbGlrZSBkcnVncyB0byBhIHNuaWZmZXIgZG9nLCBldmVuIHRvIG15IHRpcmVkIG1pbmQuIE5vdyB0aGF0IEknbSBmZWVsaW5nIGEgbGl0dGxlIGJldHRlciwgbGV0J3Mgc2VlIGlmIHdlIGNhbiBhbnN3ZXIgaXQuDQoNCltXaWtpcGVkaWEgaGFzIGEgcGFnZSBkZXRhaWxpbmcgZXZlcnkgZXBpc29kZSBhbmQgaXQncyBndWVzdHNdKGh0dHBzOi8vZW4ud2lraXBlZGlhLm9yZy93aWtpL0xpc3Rfb2ZfVGhlX0dyYWhhbV9Ob3J0b25fU2hvd19lcGlzb2RlcykuIFdlIGNhbiBleHRyYWN0IHRoZSBpbmZvcm1hdGlvbiBmcm9tIHRoaXMgdG8gZ2V0IG91ciBkYXRhIGZvciBhbmFseXNpcy4NCg0KDQoNCmBgYHtyfQ0KbGlicmFyeShydmVzdCkNCmxpYnJhcnkocHVycnIpDQpsaWJyYXJ5KGRwbHlyKQ0KbGlicmFyeShzdHJpbmdyKQ0KbGlicmFyeSh0aWR5cikNCmxpYnJhcnkoZ2dwbG90MikNCmxpYnJhcnkobHVicmlkYXRlKQ0KDQpwYWdlIDwtIHJlYWRfaHRtbCgiaHR0cHM6Ly9lbi53aWtpcGVkaWEub3JnL3dpa2kvTGlzdF9vZl9UaGVfR3JhaGFtX05vcnRvbl9TaG93X2VwaXNvZGVzIikNCg0KI2xpc3QgYWxsIG9mIHRoZSBzZWxlY3RvcnMNCnNlbGVjdG9yX2d1ZXN0cyA8LSAiLnN1bW1hcnkiDQpzZWxlY3Rvcl9lcGlzb2RlX25vIDwtICIudmV2ZW50IHRkOm50aC1jaGlsZCgyKSINCnNlbGVjdG9yX292ZXJhbGxfZXBpc29kZV9ubyA8LSAiLnZldmVudCB0aCINCnNlbGVjdG9yX2Fpcl9kYXRlIDwtICIudmV2ZW50IHRkOm50aC1jaGlsZCg0KSINCg0Kc2VsZWN0b3JzIDwtIGMoYWlyX2RhdGUgPSBzZWxlY3Rvcl9haXJfZGF0ZSwgDQogICAgICAgICAgICAgICBndWVzdHMgPSBzZWxlY3Rvcl9ndWVzdHMsIA0KICAgICAgICAgICAgICAgZXBpc29kZV9ubyA9IHNlbGVjdG9yX2VwaXNvZGVfbm8sIA0KICAgICAgICAgICAgICAgb3ZlcmFsbF9lcGlzb2RlX25vID0gc2VsZWN0b3Jfb3ZlcmFsbF9lcGlzb2RlX25vKQ0KDQojIENyZWF0ZSBnZW5lcmFsIGZ1bmN0aW9uIHRvIGV4dHJhY3QgdGV4dCBmcm9tIHBhZ2UNCmV4dHJhY3RfZ3JhaGFtX25vcnRvbiA8LSBmdW5jdGlvbihzaXRlLCBzZWxlY3Rvcikgew0KICBzaXRlICU+JSBodG1sX25vZGVzKHNlbGVjdG9yKSAlPiUgaHRtbF90ZXh0KCkNCn0NCg0KbGlzdHNfbWFuaWEgPC0gbWFwX2RmKHNlbGVjdG9ycywgfmV4dHJhY3RfZ3JhaGFtX25vcnRvbihwYWdlLCAueCkpDQoNCmRmIDwtIGJpbmRfY29scyhsaXN0c19tYW5pYSkNCg0KaGVhZChkZikNCmBgYA0KDQoNCldlIGhhdmUgdGhlIGRhdGEgaW4gaXQncyByb3VnaCBmb3JtLCBidXQgd2UnbGwgbmVlZCB0byBleHRyYWN0IHRoZSBuYW1lcyBpbnRvIHNvbWV0aGluZyB3ZSBjYW4gd29yayB3aXRoLiBDdXJyZW50bHkgdGhleSBhcmUgaW4gdGhlIGZvcm0gb2YgImd1ZXN0MSwgZ3Vlc3QyLCAuLi4gYW5kIGd1ZXN0MyIuIFdlJ2xsIG5lZWQgdG8gc3BsaXQgdGhlIHN0cmluZyBvbiAgYCIsImAgYW5kIGAiYW5kImAsIHRoZW4gdW5uZXN0IG91ciBuZXcgZGF0YWRmcmFtZSB0byBjcmVhdGUgYSByZWNvcmQgZm9yIGV2ZXJ5IGd1ZXN0IG9uIHRoZSBzaG93DQoNCmBgYHtyfQ0KdGlkeV9kZiA8LSBkZiAlPiUNCiAgZmlsdGVyKGd1ZXN0cyAhPSAiQ29tcGlsYXRpb24gc2hvdyIpICU+JQ0KICBtdXRhdGUoYWlyX2RhdGVfdGlkeSA9IHN0cl9leHRyYWN0KGFpcl9kYXRlLCAiKC57MSwyfVxcV1tBLXpdK1xcV1xcZHs0fSkiKSAlPiUgZG15KCksDQogICAgICAgICBndWVzdHMgPSBzdHJfc3BsaXQoZ3Vlc3RzLCAiLHxcXGJhbmRcXGIiKSkgJT4lDQogIHRpZHlyOjp1bm5lc3QoKSAlPiUNCiAgbXV0YXRlKGd1ZXN0cyA9IHN0cl90b19sb3dlcihndWVzdHMpICU+JSBzdHJfcmVwbGFjZV9hbGwoInBpbG90fFxcKHxcXCkiLCAiIikgJT4lIHN0cl90cmltKCkpDQoNCiNmaWxlbmFtZSA8LSBwYXN0ZSgib3V0cHV0LWRhdGEvIiwgImdyYWhhbS1ub3J0b24tZ3Vlc3RzXyIsIFN5cy5EYXRlKCksICIuY3N2Iiwgc2VwID0gIiIpDQojd3JpdGUuY3N2KHRpZHlfZGYsIGZpbGUgPSBmaWxlbmFtZSkNCg0KaGVhZCh0aWR5X2RmKQ0KYGBgDQoNCk91ciBkYXRhIGlzIG5vdyBmaXQgZm9yIHB1cnBvc2UuIElzIE5pY29sZSBLaWRtYW4gdGhlIG1vc3QgY29tbW9uIGd1ZXN0IG9uIHRoZSBzaG93PyBMZXQncyBjaGVjayB0aGUgdG9wIDUNCg0KDQpgYGB7cn0NCg0KdGlkeV9kZiAlPiUNCiAgY291bnQoZ3Vlc3RzKSAlPiUNCiAgYXJyYW5nZShkZXNjKG4pKSAlPiUNCiAgdG9wX24oNSwgbikNCg0KDQpgYGANCg0KU2hlJ3Mgbm8gd2hlcmUgbmVhciEgSG93IG1hbnkgdGltZXMgaGFzIHNoZSBiZWVuIG9uIHRoZSBzaG93Pw0KDQpgYGB7cn0NCnRpZHlfZGYgJT4lDQogIGZpbHRlcihndWVzdHMgPT0ibmljb2xlIGtpZG1hbiIpICU+JQ0KICBjb3VudCgpDQoNCg0KYGBgDQoNCg0KDQojIyBCb251cw0KDQoNCiMjIyBIaXN0b2dyYW0gb2YgR3Vlc3QgZnJlcXVlbmN5DQpgYGB7cn0NCnRpZHlfZGYgJT4lDQogIGNvdW50KGd1ZXN0cykgJT4lDQogIGdncGxvdChhZXMoeCA9IG4pKSArIGdlb21faGlzdG9ncmFtKGJpbndpZHRoID0gMSkNCg0KYGBgDQoNCg0KIyMjIE51bWJlciBvZiBkaXN0aW5jdCBHdWVzdHMNCg0KYGBge3J9DQpucm93KHRpZHlfZGYpDQoNCnRpZHlfZGYgJT4lDQogIG11dGF0ZShndWVzdHMgPSBzdHJfdHJpbShndWVzdHMpICU+JSBzdHJfdG9fbG93ZXIoKSkgJT4lDQogIGRpc3RpbmN0KGd1ZXN0cykgJT4lDQogIGNvdW50KCkNCmBgYA0KDQojIyMgTnVtYmVyIG9mIEd1ZXN0cyBQZXIgRXBpZHNvZGUNCg0KYGBge3J9DQp0aWR5X2RmICU+JQ0KICBjb3VudChvdmVyYWxsX2VwaXNvZGVfbm8pICU+JQ0KICBhcnJhbmdlKGRlc2MobikpDQoNCnRpZHlfZGYgJT4lDQogIGZpbHRlcihvdmVyYWxsX2VwaXNvZGVfbm8gPT0gMjA2KQ0KDQoNCnRpZHlfZGYgJT4lDQogIGNvdW50KG92ZXJhbGxfZXBpc29kZV9ubykgJT4lDQogIGdncGxvdChhZXMoeCA9IG92ZXJhbGxfZXBpc29kZV9ubywgeSA9IG4pKSArIGdlb21fcG9pbnQoKQ0KDQoNCnRpZHlfZGYgJT4lDQogIGNvdW50KGFpcl9kYXRlX3RpZHkpICU+JQ0KICBnZ3Bsb3QoYWVzKHggPSBhaXJfZGF0ZV90aWR5LCB5ID0gbikpICsgZ2VvbV9wb2ludCgpDQpgYGANCg==