MATH2349 Semester 2, 2018

Assignment 3

Required packages

library(dplyr)
library(readr)
library(foreign)
#library(gdata)
library(rvest)
library(tidyr)
#library(deductive)
#library(validate)
library(Hmisc)
library(stringr)
library(outliers)
library(MVN)
library(infotheo)
library(MASS)
#library(caret)
#library(MLR)
library(ggplot2)
library(knitr)

Executive Summary

In this assignment, 2 datasets relating to Film Criticism are joined together for analysis. The first dataset focusses on the Bechdel test; a measure of a film’s inclusion and representation of female characters. This dataset also includes various details about the film, such as budget and year of publication. The dataset was obtained from an article on the representation of women in film from the website FiveThirtyEight. The second dataset is of IMDB’s user review scores. This includes all films on IMDB with at least 10 votes. The datasets are merged, and each variable examined, cleaned and reformatted. Variables are examined for missing and invalid values, and new variables are created.

Data

The first dataset being used for this assignment is from an article published on FiveThirtyEight in 2017 entitled “The Dollar-And-Cents Case Against Hollywood’s Exclusion of Women” written by Walt Hickey. The dataset was taken from FiveThirtyEight’s GitHub under Creative Commons Attribution 4.0 International License.

The Bechdel test was proposed by comic artist Alice Bechdel in a work in her comic “Dykes to Wacth Out For” in 1985 to assess gender representation in films. The criteria of the test are as follows. The movie must contain at least two female characters. The two female characters must engage in dialogue with each other. The subject of this dialogue must not be a man. The Bechdel dataset contains a film’s title, year of first release, unique ID, and several fields on the film’s budget and gross, including normalisations to 2013 US Dollars. The test itself encoded in 3 different ways as well, including a simple binary, and a more granulary test which describes at which ‘level’ a film may fail the test. This dataset contains results of the test for 1794 movies.

The second dataset considered is IMDB’s user review score table. This was extracted directly from IMDB through thier Data Portal, in tsv.gz format. This table contains the average user review score for 870172 films and television shows, as well as the film’s IMDB id, a unique identifying code assigned by imdb. The datasets join logically on the IMDB id. Also included is the number of votes a movie received to attain its score.

IMDB Ratings Dataset

imdb <- read.table("title.ratings.tsv.gz",header = TRUE) #ratings for everything on imdb
str(imdb)

'data.frame':   870172 obs. of  3 variables:
 $ tconst       : Factor w/ 870172 levels "tt0000001","tt0000002",..: 1 2 3 4 5 6 7 8 9 10 ...
 $ averageRating: num  5.8 6.4 6.6 6.4 6.2 5.6 5.5 5.6 5.6 6.9 ...
 $ numVotes     : int  1416 167 1013 100 1712 87 571 1520 68 5073 ...

head(imdb)

Bechdel Test Data

bechdel <- read_csv("bechdel.csv")

Parsed with column specification:
cols(
  year = col_integer(),
  imdb = col_character(),
  title = col_character(),
  test = col_character(),
  clean_test = col_character(),
  binary = col_character(),
  budget = col_integer(),
  domgross = col_character(),
  intgross = col_character(),
  code = col_character(),
  `budget_2013$` = col_integer(),
  `domgross_2013$` = col_character(),
  `intgross_2013$` = col_character(),
  `period code` = col_integer(),
  `decade code` = col_integer()
)

str(bechdel)

Classes ‘tbl_df’, ‘tbl’ and 'data.frame':   1794 obs. of  15 variables:
 $ year          : int  2013 2012 2013 2013 2013 2013 2013 2013 2013 2013 ...
 $ imdb          : chr  "tt1711425" "tt1343727" "tt2024544" "tt1272878" ...
 $ title         : chr  "21 & Over" "Dredd 3D" "12 Years a Slave" "2 Guns" ...
 $ test          : chr  "notalk" "ok-disagree" "notalk-disagree" "notalk" ...
 $ clean_test    : chr  "notalk" "ok" "notalk" "notalk" ...
 $ binary        : chr  "FAIL" "PASS" "FAIL" "FAIL" ...
 $ budget        : int  13000000 45000000 20000000 61000000 40000000 225000000 92000000 12000000 13000000 130000000 ...
 $ domgross      : chr  "25682380" "13414714" "53107035" "75612460" ...
 $ intgross      : chr  "42195766" "40868994" "158607035" "132493015" ...
 $ code          : chr  "2013FAIL" "2012PASS" "2013FAIL" "2013FAIL" ...
 $ budget_2013$  : int  13000000 45658735 20000000 61000000 40000000 225000000 92000000 12000000 13000000 130000000 ...
 $ domgross_2013$: chr  "25682380" "13611086" "53107035" "75612460" ...
 $ intgross_2013$: chr  "42195766" "41467257" "158607035" "132493015" ...
 $ period code   : int  1 1 1 1 1 1 1 1 1 1 ...
 $ decade code   : int  1 1 1 1 1 1 1 1 1 1 ...
 - attr(*, "spec")=List of 2
  ..$ cols   :List of 15
  .. ..$ year          : list()
  .. .. ..- attr(*, "class")= chr  "collector_integer" "collector"
  .. ..$ imdb          : list()
  .. .. ..- attr(*, "class")= chr  "collector_character" "collector"
  .. ..$ title         : list()
  .. .. ..- attr(*, "class")= chr  "collector_character" "collector"
  .. ..$ test          : list()
  .. .. ..- attr(*, "class")= chr  "collector_character" "collector"
  .. ..$ clean_test    : list()
  .. .. ..- attr(*, "class")= chr  "collector_character" "collector"
  .. ..$ binary        : list()
  .. .. ..- attr(*, "class")= chr  "collector_character" "collector"
  .. ..$ budget        : list()
  .. .. ..- attr(*, "class")= chr  "collector_integer" "collector"
  .. ..$ domgross      : list()
  .. .. ..- attr(*, "class")= chr  "collector_character" "collector"
  .. ..$ intgross      : list()
  .. .. ..- attr(*, "class")= chr  "collector_character" "collector"
  .. ..$ code          : list()
  .. .. ..- attr(*, "class")= chr  "collector_character" "collector"
  .. ..$ budget_2013$  : list()
  .. .. ..- attr(*, "class")= chr  "collector_integer" "collector"
  .. ..$ domgross_2013$: list()
  .. .. ..- attr(*, "class")= chr  "collector_character" "collector"
  .. ..$ intgross_2013$: list()
  .. .. ..- attr(*, "class")= chr  "collector_character" "collector"
  .. ..$ period code   : list()
  .. .. ..- attr(*, "class")= chr  "collector_integer" "collector"
  .. ..$ decade code   : list()
  .. .. ..- attr(*, "class")= chr  "collector_integer" "collector"
  ..$ default: list()
  .. ..- attr(*, "class")= chr  "collector_guess" "collector"
  ..- attr(*, "class")= chr "col_spec"

head(bechdel)

Having Imported the data I checked the column formats. The read.table function used to open the tsv.gz file has given all values of the IMDB id as factors. Since every value of the variable is unique, a factor is inappropriate, and the value will be re-encoded as a character variable. The bechdel dataset has also made some questionable decisions in reading the data. Most values have been interperated as Character, aside from a few integers, which will be explored in the understand section.

Once the IMDB IDs are both encoded as character variables, the two datasets join naturally on this feature. I am performing an inner join, so that only rows contained in both datsets appear in the final data frame.

colnames(imdb) <- c("imdb_id","score","ratings")
imdb$imdb_id <- as.character(imdb$imdb_id)
df <- inner_join(bechdel, imdb, by = c("imdb" = "imdb_id"))
nrow(imdb)

[1] 870172

nrow(bechdel)

[1] 1794

nrow(df)

[1] 1791

It seems as though there are 3 films in the Bechdel dataset which are not found in the IMDB one. This is not a large amount, so we will be able to proceed. Out of interest, the below code shows us which films these are. Mismatch is a vector of logical values, which are true if the IMDB ID in the bechdel data frame is not found in the IMDB data frame. Then we filter out all of the rows in the Bechdel data set for which this value is false.

mismatch <- !(bechdel$imdb %in% df$imdb)
filter(bechdel, mismatch)

Understand

Now that we have joined the two datasets together, we will proceed to examine each feature. Str(df) will provide us an overview of each feature.

str(df)

Classes ‘tbl_df’, ‘tbl’ and 'data.frame':   1791 obs. of  17 variables:
 $ year          : int  2013 2012 2013 2013 2013 2013 2013 2013 2013 2013 ...
 $ imdb          : chr  "tt1711425" "tt1343727" "tt2024544" "tt1272878" ...
 $ title         : chr  "21 & Over" "Dredd 3D" "12 Years a Slave" "2 Guns" ...
 $ test          : chr  "notalk" "ok-disagree" "notalk-disagree" "notalk" ...
 $ clean_test    : chr  "notalk" "ok" "notalk" "notalk" ...
 $ binary        : chr  "FAIL" "PASS" "FAIL" "FAIL" ...
 $ budget        : int  13000000 45000000 20000000 61000000 40000000 225000000 92000000 12000000 13000000 130000000 ...
 $ domgross      : chr  "25682380" "13414714" "53107035" "75612460" ...
 $ intgross      : chr  "42195766" "40868994" "158607035" "132493015" ...
 $ code          : chr  "2013FAIL" "2012PASS" "2013FAIL" "2013FAIL" ...
 $ budget_2013$  : int  13000000 45658735 20000000 61000000 40000000 225000000 92000000 12000000 13000000 130000000 ...
 $ domgross_2013$: chr  "25682380" "13611086" "53107035" "75612460" ...
 $ intgross_2013$: chr  "42195766" "41467257" "158607035" "132493015" ...
 $ period code   : int  1 1 1 1 1 1 1 1 1 1 ...
 $ decade code   : int  1 1 1 1 1 1 1 1 1 1 ...
 $ score         : num  5.9 7.1 8.1 6.7 7.5 6.3 5.3 7.8 5.7 4.8 ...
 $ ratings       : int  67062 228358 550087 176462 75189 131490 183079 247112 31208 176837 ...

Based on the above output, we will make the below set of changes

Year - Leave as is. This could be changed to a date type, or we could even look for more information if the exact date of release becomes relevant to an investigation of the data.

Imdb - Renamed to imdb_id for clarity.

  colnames(df)[2] <- "imdb_id"

Title - Character makes sense, no data type change needed. Special characters have been escaped with ‘&’, so we will replace these with the actual characters.

sum(str_detect(df$title,"&"))

[1] 98

# 98 titles contain the '&' character
special_characters <- filter(df,str_detect(df$title,"&"))
head(special_characters$title)

[1] "21 & Over"                      "Ender's Game"                   "Hansel & Gretel: Witch Hunters" "Lee Daniels' The Butler"       
[5] "Pain & Gain"                    "The World's End"               

We can see a lot of ‘&’ and ‘'’ in these, which correspond to the ‘&’ and apostrophe characters respectively. I will replace these, and then determine whether any other special characters remain

  df$title <- str_replace(df$title, "&amp;","&")
  df$title <- str_replace(df$title, "&#39;","'")
  # since there are now legitimate ampersands, we will instead look for the pattern of a special character of the format '&XXX;'
  filter(df,str_detect(df$title,"&.+;"))

For the remaining titles, the following replacements are made.

  df$title <- str_replace(df$title, "&uuml;","ü")
  df$title <- str_replace(df$title, "&agrave","à")
  df$title <- str_replace(df$title, "&aring","å")
  df$title <- str_replace(df$title, "&auml","ä")

test - The result of the Bechdel test. This and Clean_test encode the same information

  df$test <- df$test %>% factor()
  df$clean_test <- df$clean_test %>% factor()
  levels(df$test)

 [1] "dubious"          "dubious-disagree" "men"              "men-disagree"     "notalk"           "notalk-disagree"  "nowomen"          "nowomen-disagree"
 [9] "ok"               "ok-disagree"     

  levels(df$clean_test)

[1] "dubious" "men"     "notalk"  "nowomen" "ok"     

The cleantest variable is easier to interpret, so we will drop the test variable and continue.

df$test <- NULL

It makes sense to give clean_test an ordering, as a movie in which there are female characters who do not talk could be considered more inclusive than one which does not contain any female characters at all.

  df$clean_test <- df$clean_test %>% factor(levels = c("nowomen","notalk","men","dubious","ok"),ordered = TRUE)

binary - The Bechdel test as a simple pass or fail. We will make this a logical value

  df$binary <- ifelse(df$binary=="PASS",TRUE,FALSE)

Finiancial Information - Budget has been read as an integer, and the domestic and international grosses have been read as character data type. These will all be converted into numerical data types.

  df$budget <- as.numeric(df$budget)
  df$`budget_2013$` <- as.numeric(df$`budget_2013$`)
  df$domgross <- as.numeric(df$domgross)

NAs introduced by coercion

  df$intgross <- as.numeric(df$intgross)

NAs introduced by coercion

  df$`domgross_2013$` <- as.numeric(df$`domgross_2013$`)

NAs introduced by coercion

  df$`intgross_2013$` <- as.numeric(df$`intgross_2013$`)

NAs introduced by coercion

This has introduced some NA values. This code will find the number of rows for which any of these values is NA.

  sum(is.na(df$domgross) 
      | is.na(df$intgross) 
      | is.na(df$`domgross_2013$`)
      | is.na(df$`intgross_2013$`)
      | is.na(df$budget)
      | is.na(df$`budget_2013$`))

[1] 18

Since this is a very small proportion of the dataset, we should be safe to simply drop these rows if needed. However, I will leave these as is for now, as the movies’ gross may not be the focus of our investigation.

code - used to subset the data for the article. This will be re-encoded as a factor, non-ordered.

  df$code <- as.factor(df$code)

Decade code - The initial values of these codes are not clear in their meanings. We will re-encode them into something more legible.

    str(df$`decade code` %>% as.factor)

 Factor w/ 3 levels "1","2","3": 1 1 1 1 1 1 1 1 1 1 ...

  head(filter(df,df$`decade code`==3)) #90s

  head(filter(df,df$`decade code`==2)) #2000s

  head(filter(df,df$`decade code`==1)) #2010's

The decade codes correspond to the 90’s, 2000’s and 2010’s in the order 3,2,1. We will recast these as an ordered factor, in chronological order.

  df$`decade code` <- factor(df$`decade code`, levels = c(3,2,1),labels = c("1990's","2000's","2010's"),ordered = TRUE)

Period Code - The meaning of this variable is not clear, but appears to have been used to subdivide the dataset for the FiveThirtyEight article. We will drop this variable for now.

df$`period code` <- NULL

Tidy & Manipulate Data I

Tidy data principles state that each row should correspond to a single observation, each column should correspond to a single variable and each type of observational unit should form a table. In this case our data conforms to these principles. * Each row represents a single film * Each column represents a single piece of information about a film * The table encodes a variety of information on a per-film basis. The Code variable could be interpreted as untidy, as it is a combination of the Year and Binary variables used to categorise films together. Since we already have this information, we can drop the variable rather than attempt to tidy it.

df$code <- NULL

Tidy & Manipulate Data II

I have chosen to firstly create a set of variables which encode the profitability of a film. The first of these will be the profit, which will be the total gross (domestic plus international) minus the film’s budget.

df$profit <- df$domgross + df$intgross - df$budget

To better compare films from different years, we should create some time insensitive measures of profit. Profit_2013 will make the same calculation based on the 2013 $US data values.

df$profit_2013 <- df$`domgross_2013$` + df$`intgross_2013$` - df$`budget_2013$`

Finally, to compare the profits of different films, it may be more instructive to assess them based on the ratio of gross to budget instead.

df$profit_ratio <- (df$domgross + df$intgross)/df$budget

Scan I

The text of the title column has already been cleaned up in an earlier section. First we will check for NA values.

colSums(is.na(df))

          year        imdb_id          title     clean_test         binary         budget       domgross       intgross   budget_2013$ domgross_2013$ 
             0              0              0              0              0              0             17             11              0             18 
intgross_2013$    decade code          score        ratings         profit    profit_2013   profit_ratio 
            11            179              0              0             17             18             17 

It was already established that there were a few NA values in the financial information, these can safely be worked around. The decade code is also missing a number of values.

head(filter(df, is.na(df$`decade code`)))

It seems like this is because there are some films from decades besides those encoded in the decade code.

filter(df, is.na(df$`decade code`)) %>% distinct(year)

There are films from the 1970’s and 1980’s in the dataset. Rather than redefining the factor levels to include these, we will make a more robust version of the decade value, in case we use this code again with a dataset that includes new decades in the future.

#Delete decade code
df$`decade code` <- NULL
# df$year %% 10 is the year mod 10, which will be the one's digit
df$decade <- df$year - (df$year %% 10)
distinct(df,df$decade)

#now reencode as a factor.
df$decade <- df$decade %>% factor(ordered = TRUE)
levels(df$decade)

[1] "1970" "1980" "1990" "2000" "2010"

Scan II

I will step through the outlier investigation with the budget variable first. Let’s take a look at the boxplot of the budget.

df$budget %>% boxplot(main = "Boxplot of Budget")

There are quite a lot of outliers towards the higher end of the dataset. Let’s now look at the z-scores

z.scores <- df$budget %>%  scores(type = "z")
z.scores %>% summary()

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
-0.9299 -0.6806 -0.3481  0.0000  0.3169  7.9025 

We can consider an outlier to be a value with a z-score greater than 3.

which(z.scores > 3)

 [1]    6   37   38   44   49   50   64   75   78   84  100  106  122  128  149  157  159  164  201  217  257  300  311  376  382  394  425  426  441  455  485
[32]  521  550  617  633  705  718  781  796  821  865  983 1443

length(which(z.scores > 3))

[1] 43

There are 43 such outliers. Let us remake the boxplot excluding these 43 films.

df$budget[-which(z.scores > 3)] %>% boxplot(main = "Budget, outliers removed")

df[which(z.scores>3),]

Now that we have eliminated the outliers from the data, we appear to have created more outliers in the reduced set, but the boxplot appears much more reasonable. Looking at the films included among the outliers, there are quite a few very significant films included, such as Titanic and Avatar. Removing the outliers seems like a poor choice. I have decided that the best approach is to leave the outliers in, and in the following section perform a binning transformation to group films into different budget groupings.

Now, we will quickly run through the same outlier investigation on the other financial variables.

par(mfrow = c(2,2))
df$domgross %>% boxplot(main = "Domestic Gross")
df$intgross %>% boxplot(main = "International Gross")

df$`domgross_2013$` %>% boxplot(main = "Domestic Gross ($US 2013)")
df$`intgross_2013$` %>% boxplot(main = "International Gross ($US 2013)")

To work with the z-scores, we will need to exclude the NA values found in these variables.

df.na_omit <- df %>% na.omit()
z.scores.dg <- df.na_omit$domgross %>% scores(type = "z")
z.scores.ig <- df.na_omit$intgross %>% scores(type = "z")
z.scores.dg13 <- df.na_omit$`domgross_2013$` %>%  scores(type = "z")
z.scores.ig13 <- df.na_omit$`intgross_2013$` %>%  scores(type = "z")
z.scores.dg %>% summary()

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
-0.8599 -0.6571 -0.3364  0.0000  0.3009  8.5968 

z.scores.ig %>% summary()

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
-0.7162 -0.5912 -0.3521  0.0000  0.1873 12.4949 

z.scores.dg13 %>% summary()

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
-0.7551 -0.5927 -0.3111  0.0000  0.2100 13.2996 

z.scores.ig13 %>% summary()

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
-0.6991 -0.5805 -0.3586  0.0000  0.1526 10.4677 

length(which(z.scores.dg > 3))

[1] 37

length(which(z.scores.ig > 3))

[1] 49

length(which(z.scores.dg13 > 3))

[1] 32

length(which(z.scores.ig13 > 3))

[1] 40

par(mfrow=c(1,2))
df$domgross %>% boxplot(main = "Domestic Gross")
df.na_omit$domgross[-which(z.scores.dg > 3)] %>% boxplot(main = "Outliers eliminated")

df$intgross %>% boxplot(main = "International Gross")
df.na_omit$intgross[-which(z.scores.ig > 3)] %>% boxplot(main = "Outliers eliminated")

df$`domgross_2013$` %>% boxplot(main = "Domestic Gross ($US 2013)")
df.na_omit$`domgross_2013$`[-which(z.scores.dg13 > 3)] %>% boxplot(main = "Outliers eliminated")

df$`intgross_2013$` %>% boxplot(main = "International Gross ($US 2013)")
df.na_omit$`intgross_2013$`[-which(z.scores.ig13 > 3)] %>% boxplot(main = "Outliers eliminated")

Aside from the financial information of the films, there is also the user ratings scores to investigate.

df$score %>% boxplot(main = "Viewer Review Scores")

hist(df$score, main = "Histogram of Viewer Scores")

df$score %>% summary()

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  2.200   6.200   6.800   6.758   7.400   9.300 

The user review score for these movies is quite positively skewed, but there is not any issue with outliers, or invalid values (such as those outside of the 1-10 range). In the next section we will normalise the review scores.

Transform

We will apply a transformation to normalise the movie scores about a mean of 0.

scores <- scale(df$score)
hist(scores)

This normalised score will be added to the data frame as score_norm

df$score_norm <- scores

We will also perform a binning transformation to the films based on their budgets. This will be an equal frequency binning, to split the films into 10 even categories. For comparison between films from different years, we will use the Budget 2013 USD value.

df$budget_binned <- discretize(df$`budget_2013$`, disc = "equalfreq", nbins = 10)

Now, we have arrived at our final data set, ready for analysis.