I recently looked at IMDb ratings for Robert De Niro movies, finding slight evidence for a dip in ratings in his third act. I noted then that the data were subject to all kinds of selection biases, and that even in a perfect world would only reflect the ratings of movies that De Niro was in, not of his individual performance. I speculated that older actors might no longer be offered parts in good movies. This is something that can be explored via the IMDb mirror at my disposal, but only very weakly: if actors 'stopped caring' after a certain age, or declined in abilities, or even if IMDb raters simply liked movies with more young people, one might see the same patterns in the data. Despite these caveats, let us press on.

That struts and frets his hour upon the stage

First, I collect all movies which are not marked as Documentary in the data, and which have a production year between 1965 and 2015, and have at least 250 votes on IMDb. This does present a selection bias towards better movies in the earlier period we will have to correct for. I then collect actors and actresses with a known date of birth who have featured in at least 30 of these films. I bring them into R via dplyr, and then subselect to observations where the actor was between 18 and 90 in the production year of the film. This should look like a lot of blah blah blah, but you can follow along at home if you have the mirror, which you can install yourself.

library(RMySQL)
library(dplyr)
library(knitr)
# get the connection and set to UTF-8 (probably not necessary here)
dbcon <- src_mysql(host='0.0.0.0',user='moe',password='movies4me',dbname='IMDB',port=23306)
capt <- dbGetQuery(dbcon$con,'SET NAMES utf8')
# genre information
movie_genres <- tbl(dbcon,'movie_info') %>%
  inner_join(tbl(dbcon,'info_type') %>% 
    filter(info %regexp% 'genres') %>%
    select(info_type_id),
    by='info_type_id') 
# get documentary movies;
doccos <- movie_genres %>% 
    filter(info %regexp% 'Documentary') %>%
    select(movie_id)
# language information
movie_languages <- tbl(dbcon,'movie_info') %>%
  inner_join(tbl(dbcon,'info_type') %>% 
    filter(info %regexp% 'languages') %>%
    select(info_type_id),
    by='info_type_id') 
# get movies with English
unnerstandit <- movie_languages %>% 
    filter(info %regexp% 'English') %>%
    select(movie_id)
# movies which are not documentaries, have some English, filtered by production year
movies <- tbl(dbcon,'title') %>%
  select(-imdb_index,-ttid,-md5sum) %>%
  anti_join(doccos,by='movie_id') %>%
  inner_join(unnerstandit,by='movie_id') %>%
  filter(production_year >= 1965,production_year <= 2015)
# votes for all movies, filtered by having enough votes
vote_info <- tbl(dbcon,'movie_votes') %>% 
  select(movie_id,votes,vote_mean,vote_sd,vote_se) %>%
  filter(votes >= 250)
# join the two together
mvotes <- inner_join(movies,vote_info,by='movie_id')
# acts in relation
# inner join with subselected movies
acts_in <- tbl(dbcon,'cast_info') %>%
  inner_join(tbl(dbcon,'role_type') %>% 
    filter(role %regexp% 'actor|actress'),
    by='role_id') %>%
  select(person_id,movie_id,nr_order) %>%
  inner_join(movies %>% select(movie_id),by='movie_id')
# use acts in to find players in >= 30 films
many_films <- acts_in %>% 
  group_by(person_id) %>%
  summarize(count=n()) %>%
  ungroup() %>%
  filter(count >= 30)
# get actors with many films
good_actors <- tbl(dbcon,'name') %>%
  select(person_id,name,gender,dob) %>%
  filter(!is.na(dob)) %>%
  inner_join(many_films,by='person_id')
# join the good actors with acts-in 
# with mvotes.
bigdata <- good_actors %>%
  inner_join(acts_in %>% inner_join(mvotes,by='movie_id'),by='person_id') %>%
  collect(n=Inf) 
# get birth year
library(lubridate)
bigdata <- bigdata %>%
  mutate(dob=as.Date(dob)) %>%
  mutate(yob=year(dob)) %>%
  mutate(actor_age = production_year - yob) %>%
  filter(actor_age >= 18) %>%
  filter(actor_age < 90) %>%
  mutate(ageish = cut(actor_age,breaks=c(0,seq(25,65,by=5),100),right=FALSE))

I put the data in a google sheet so you can all play along at home. Here is a look at the data:

bigdata %>%
  select(name,gender,dob,title,production_year,actor_age,votes,vote_mean,vote_sd) %>%
  head(10) %>%
  kable()
name gender dob title production_year actor_age votes vote_mean vote_sd
Getty, Balthazar m 1975-01-22 #Horror 2015 40 1198 3.85 2.74
Hutton, Timothy m 1960-08-16 #Horror 2015 55 1198 3.85 2.74
Lyonne, Natasha f 1979-04-04 #Horror 2015 36 1198 3.85 2.74
Manning, Taryn f 1978-11-06 #Horror 2015 37 1198 3.85 2.74
Sevigny, Chlo f 1974-11-18 #Horror 2015 41 1198 3.85 2.74
Sapienza, Al m 1956-07-31 #Lucky Number 2015 59 302 6.50 2.85
Tarantina, Brian m 1959-03-27 #Lucky Number 2015 56 302 6.50 2.85
Benrubi, Abraham m 1969-10-04 #Stuck 2014 45 430 5.55 2.16
De Paul, Vincent m 1968-09-02 #Stuck 2014 46 430 5.55 2.16
Moore, Joel David m 1977-09-25 #Stuck 2014 37 430 5.55 2.16

I believe these are actual players and films. As a quick sanity check, over this sample I will compute the actors and actresses with the highest and lowest average IMDb ratings, giving the top 3 of both genders. Yes, this is a mean of a mean, get over it.

extv <- bigdata %>% 
  group_by(person_id,gender) %>%
  summarize(mean_rating=mean(vote_mean)) %>%
  ungroup() %>%
  arrange(mean_rating)
htop <- function(x,num=3) {
  rbind(head(x,num),tail(x,num))
}
extremes <- rbind(extv %>% filter(gender=='m') %>% htop(3),
    extv %>% filter(gender=='f') %>% htop(3)) %>%
    select(-gender) %>%
    inner_join(bigdata %>% 
      distinct(person_id,.keep_all=TRUE) %>% 
      select(person_id,gender,name,dob),by='person_id') %>%
    arrange(mean_rating) %>% 
    select(-person_id) %>%
    select(name,gender,mean_rating,dob)
extremes %>% 
  kable()
name gender mean_rating dob
Gabai, Richard m 4.13 1964-02-14
Rose, Felissa f 4.42 1969-05-23
Hagen, Ross m 4.43 1938-05-21
Zagarino, Frank m 4.44 1959-12-19
Lorraine, Suzi f 4.48 1978-02-15
Bauer, Michelle f 4.73 1958-10-01
Marshall, Mona f 6.61 1947-08-31
Otto, Miranda f 6.69 1967-12-16
Blanchett, Cate f 6.73 1969-05-14
Reed, Oliver m 6.91 1938-02-13
Parker, Trey m 6.93 1969-10-19
Chapman, Graham m 6.93 1941-01-08

I had hoped this would serve as a sanity check. Instead it reminds me that I have no business working in the film industry, as I have no idea who any of these people are. Luckily this is no longer a problem.

A tale told by an idiot.

Next I wanted to use regression analysis of some kind to determine whether older actors were associated with worse films. One problem is that the films are over-represented in this data. That is, we have 78537 rows of data but only 17200 films. If we perform vanilla regression, not only will we have correlated errors among our observations, they will be flat out duplicates.

Another problem is that we might want to adjust for an actor's overall career average rating (either as a fixed or random effect). And we might want to adjust for the production year to deal with potential biases among IMDb raters. If we do too much adjusting, we will get a grey goo that oozes silly t statistics.

To deal with the duplication, I randomly order the observations, then select unique films. I have done this with a few different random seeds and get essentially the same results, which are not shocking anyway. This quick hack of randomly selecting one actor or actress to represent a film is 'morally equivalent' to computing the average age of actors and actresses in each film, then regressing rating versus that average age. First the basic linear regression for an effect by age class:

# subselect
set.seed(123)
subdata <- bigdata %>%
  mutate(rord=rnorm(nrow(bigdata))) %>% 
  arrange(rord) %>% 
  distinct(movie_id,.keep_all=TRUE)
#model
mod0 <- lm(vote_mean ~ ageish,data=subdata)
print(summary(mod0))
## 
## Call:
## lm(formula = vote_mean ~ ageish, data = subdata)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -3.280 -0.413  0.117  0.547  2.601 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     6.04936    0.03267  185.15  < 2e-16 ***
## ageish[25,30)  -0.00539    0.04054   -0.13   0.8943    
## ageish[30,35)  -0.06633    0.03865   -1.72   0.0861 .  
## ageish[35,40)  -0.11516    0.03756   -3.07   0.0022 ** 
## ageish[40,45)  -0.11617    0.03719   -3.12   0.0018 ** 
## ageish[45,50)  -0.15156    0.03731   -4.06  4.9e-05 ***
## ageish[50,55)  -0.16924    0.03791   -4.46  8.1e-06 ***
## ageish[55,60)  -0.18676    0.03902   -4.79  1.7e-06 ***
## ageish[60,65)  -0.21037    0.04102   -5.13  3.0e-07 ***
## ageish[65,100) -0.17677    0.03891   -4.54  5.6e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.866 on 17190 degrees of freedom
## Multiple R-squared:  0.00472,    Adjusted R-squared:  0.0042 
## F-statistic: 9.06 on 9 and 17190 DF,  p-value: 8.63e-14

Note that these effects are for each age class, and not cumulative. So we see that by age 65, average IMDb ratings are maybe one sixth of a rating point lower than the baseline age, which is 18 through 24. These effects are 'significant', but very weak given all the biases.

A random effect model taking into account each actor's name is easy enough with lme4. We see a slightly stronger effect, perhaps a quarter of a rating point by retirement age:

library(lme4)
# fixed effects model
mod2 <- lmer(vote_mean ~ ageish + (1|name),data=subdata)
print(summary(mod2))
## Linear mixed model fit by REML ['lmerMod']
## Formula: vote_mean ~ ageish + (1 | name)
##    Data: subdata
## 
## REML criterion at convergence: 42587
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.191 -0.481  0.093  0.631  3.510 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  name     (Intercept) 0.122    0.349   
##  Residual             0.621    0.788   
## Number of obs: 17200, groups:  name, 2109
## 
## Fixed effects:
##                Estimate Std. Error t value
## (Intercept)      6.1060     0.0337  180.99
## ageish[25,30)   -0.0129     0.0392   -0.33
## ageish[30,35)   -0.0812     0.0381   -2.13
## ageish[35,40)   -0.1481     0.0374   -3.96
## ageish[40,45)   -0.1708     0.0373   -4.58
## ageish[45,50)   -0.2084     0.0376   -5.55
## ageish[50,55)   -0.2382     0.0384   -6.20
## ageish[55,60)   -0.2583     0.0396   -6.52
## ageish[60,65)   -0.2978     0.0416   -7.15
## ageish[65,100)  -0.2654     0.0404   -6.57
## 
## Correlation of Fixed Effects:
##             (Intr) a[25,3 a[30,3 a[35,4 a[40,4 a[45,5 a[50,5 a[55,6 a[60,6
## agsh[25,30) -0.779                                                        
## agsh[30,35) -0.826  0.695                                                 
## agsh[35,40) -0.855  0.708  0.752                                          
## agsh[40,45) -0.865  0.709  0.753  0.785                                   
## agsh[45,50) -0.862  0.702  0.748  0.777  0.791                            
## agsh[50,55) -0.850  0.690  0.735  0.764  0.776  0.781                     
## agsh[55,60) -0.826  0.668  0.711  0.740  0.753  0.754  0.753              
## agsh[60,65) -0.787  0.636  0.676  0.703  0.714  0.716  0.713  0.706       
## ags[65,100) -0.815  0.656  0.697  0.726  0.737  0.738  0.734  0.723  0.705

Nothing much changes when we add in production year as a random effect:

library(lme4)
# fixed effects model
mod3 <- lmer(vote_mean ~ ageish + (1|name) + (1|production_year),data=subdata)
print(summary(mod3))
## Linear mixed model fit by REML ['lmerMod']
## Formula: vote_mean ~ ageish + (1 | name) + (1 | production_year)
##    Data: subdata
## 
## REML criterion at convergence: 42579
## 
## Scaled residuals: 
##    Min     1Q Median     3Q    Max 
## -4.202 -0.481  0.094  0.628  3.582 
## 
## Random effects:
##  Groups          Name        Variance Std.Dev.
##  name            (Intercept) 0.12068  0.3474  
##  production_year (Intercept) 0.00206  0.0454  
##  Residual                    0.62035  0.7876  
## Number of obs: 17200, groups:  name, 2109; production_year, 51
## 
## Fixed effects:
##                Estimate Std. Error t value
## (Intercept)      6.1043     0.0345  176.91
## ageish[25,30)   -0.0126     0.0392   -0.32
## ageish[30,35)   -0.0777     0.0382   -2.04
## ageish[35,40)   -0.1428     0.0376   -3.80
## ageish[40,45)   -0.1615     0.0376   -4.30
## ageish[45,50)   -0.1971     0.0381   -5.17
## ageish[50,55)   -0.2228     0.0391   -5.70
## ageish[55,60)   -0.2417     0.0406   -5.95
## ageish[60,65)   -0.2791     0.0428   -6.52
## ageish[65,100)  -0.2357     0.0421   -5.60
## 
## Correlation of Fixed Effects:
##             (Intr) a[25,3 a[30,3 a[35,4 a[40,4 a[45,5 a[50,5 a[55,6 a[60,6
## agsh[25,30) -0.764                                                        
## agsh[30,35) -0.812  0.695                                                 
## agsh[35,40) -0.841  0.707  0.753                                          
## agsh[40,45) -0.851  0.706  0.753  0.787                                   
## agsh[45,50) -0.847  0.696  0.746  0.778  0.795                            
## agsh[50,55) -0.834  0.682  0.731  0.764  0.780  0.788                     
## agsh[55,60) -0.810  0.658  0.705  0.739  0.757  0.762  0.764              
## agsh[60,65) -0.771  0.624  0.670  0.702  0.719  0.725  0.725  0.721       
## ags[65,100) -0.791  0.636  0.684  0.719  0.738  0.745  0.745  0.737  0.723

Signifying nothing

In summary, there is a weak drop off in IMDb rating of movies associated with older actors, corresponding to maybe one fifth of a rating point on IMDb's 10 point scale. We cannot say whether this is due to declining opportunities, declining abilities, or some kind of 'rater bias', which is a notorious problem with IMDb ratings. (Although it feels a bit odd to state that raters only claim to not like movies with old people, or women, say, on IMDb, when in reality they actually like those movies. Perhaps, instead, young people who rate movies on IMDb really do prefer movies with more young people in them, and are inherently biased.) The effect seen here does not fully capture the apparent half point decline in De Niro's films seen previously, but the nominal standard errors on both of these effects are so large I would feel uncomfortable saying that De Niro is an unusual case.