Spoiler Alert<\/em> The analysis creates a model that is close, but isn’t 100% confident.<\/p>\n Movie Information was provided from three websites, Internet Movie Database, referred to as IMDB<\/a>, Rotten Tomatoes<\/a>, and Box Office Mojo<\/a><\/p>\n IMDB and Rotten Tomatoes websites allow for general public to submit their opinion on a given movie. However there is no validation on if the person submitting the opinion actually saw the movie or the opinion is completely unsolicited. The reviews are not limited to one country, and the reviews are not limited by age. Review collection is not conducted in a scientific manner, and it amounts to a popularity opinion poll. The collection is limited to general population who have internet access, visited the aforementioned website(s), and are aware that they can submit a review for a specific movie.<\/p>\n With that said it is advisable that the results can not be generalized to the entire general movie-going population. The analysis will not try to establish a causal relationship between the variables as there was no random assignment for explanatory and response variables.<\/p>\n An archived version of movie informational data was used. Movie Information Source<\/a><\/p>\n A brief description of the fields used in the analysis are listed in the following section.<\/p>\n Create the following calculated columns: Non feature films removed from the observations: 63<\/strong><\/p>\n Exploratory data analysis will look at the calculated fields that were created in the data processing step:<\/p>\n Additionally I added the other variables that have binomial values for comparisons.<\/p>\n binominal variables<\/strong><\/p>\n A summary tables of all variables that have a binomial value.<\/p>\n <\/p>\n The average score delta shows the percentage difference between the two groups for each of the variables. The results are showing that the variables, best_pic_nom(43.38%), best_pic_win(40.78%), best_dir_win(16.33%), and is_drama(17.94%) have the largest delta in the audience average score metric.<\/p>\n I would anticipate the model will use these variables in the prediction of the audience score.<\/p>\n <\/p>\n The calculated fields created in the data processing step:<\/p>\n The variables, is_drama and oscar_season are anticipated to have more value to the model than mpaa_rating_r or summer_season.<\/p>\n <\/p>\n Bayesian Model Averaging<\/strong><\/p>\n Assumption: significance level of 0.05<\/p>\n In the summary table, Model 1 is using only 2 variables, imdb rating and critics_score. The posterior probability for the model is 0.1938.<\/p>\n After calculating the credible intervals for the regression coefficients the results are: <\/p>\n The MCMC diagnostic plot shows if the Markov chain has converged; the quantities should be the same and appear on the line. There appears to be one exception, which isn’t a concern.<\/p>\n In the residuals there appears to be an issue. The residuals should be scattered randomly around the zero line. It seems that constant variability condition hasn’t been met. I am not surprised since it would be logical to assume that the imdb_rating which is obtained in a similar fashion as audience_score might be causing the issue.<\/p>\n The model probabilities plot appears normal.<\/p>\n Model complexity shows how increasing variables changes the Bayes factor. Models with greater than 2 variables appear to be able to predict outcomes.<\/p>\n On the inclusion probabilities, it is clearly only imdb_rating and critics_score that are about the 0.5 value.<\/p>\n For the prediction, I choose the 2016 movie Hidden Figures<\/a>.<\/p>\n
\nPart 1: Data<\/h2>\n
Data Set Source<\/h3>\n
Load packages<\/h3>\n
# load standard packages in R\nlibrary(dplyr)\nlibrary(ggplot2)\nlibrary(plotly)\nlibrary(BAS)\nlibrary(MASS)\n<\/code><\/pre>\nLoad data<\/h3>\n
# data provided for the rubric\nload(\"movies.Rdata\")\n<\/code><\/pre>\nData Dictionary<\/h3>\n
\n\n
\n \n<\/th>\n field names<\/th>\n field types<\/th>\n field description<\/th>\n calculated field<\/th>\n<\/tr>\n<\/thead>\n \n 2<\/td>\n feature_film<\/td>\n char<\/td>\n Is movie a feature film<\/td>\n Y<\/td>\n<\/tr>\n \n 3<\/td>\n is_drama<\/td>\n char<\/td>\n Genre of the movie is Drama<\/td>\n Y<\/td>\n<\/tr>\n \n 4<\/td>\n runtime<\/td>\n int<\/td>\n Runtime of movie in minutes<\/td>\n N<\/td>\n<\/tr>\n \n 5<\/td>\n mpaa_rating_r<\/td>\n char<\/td>\n MPAA rating is R<\/td>\n Y<\/td>\n<\/tr>\n \n 6<\/td>\n thtr_rel_year<\/td>\n int<\/td>\n Year the movie is released in theaters<\/td>\n N<\/td>\n<\/tr>\n \n 7<\/td>\n oscar_season<\/td>\n char<\/td>\n Month movie is release in theaters in October, November, or December<\/td>\n Y<\/td>\n<\/tr>\n \n 8<\/td>\n summer_season<\/td>\n char<\/td>\n Month movie is release in theaters in May, June, July, August<\/td>\n Y<\/td>\n<\/tr>\n \n 9<\/td>\n imdb_rating<\/td>\n int<\/td>\n Rating on IMDB. Rating on IMDB on a scale of 1-10; 10 being highest. http:\/\/www.imdb.com<\/a><\/td>\n N<\/td>\n<\/tr>\n \n 10<\/td>\n imdb_num_votes<\/td>\n int<\/td>\n Number of votes on IMDB<\/td>\n N<\/td>\n<\/tr>\n \n 11<\/td>\n critics_score<\/td>\n int<\/td>\n Critics score on Rotten Tomatoes<\/td>\n N<\/td>\n<\/tr>\n \n 12<\/td>\n best_pic_nom<\/td>\n char<\/td>\n Whether or not the movie was nominated for a best picture Oscar: yes, no<\/td>\n N<\/td>\n<\/tr>\n \n 13<\/td>\n best_pic_win<\/td>\n char<\/td>\n Whether or not the movie won a best picture Oscar: yes, no<\/td>\n N<\/td>\n<\/tr>\n \n 14<\/td>\n best_actor_win<\/td>\n char<\/td>\n Whether or not one of the main actors in the movie ever won an Oscar: yes, no<\/td>\n N<\/td>\n<\/tr>\n \n 15<\/td>\n best_actress_win<\/td>\n char<\/td>\n Whether or not one of the main actresses in the movie ever won an Oscar: yes, no<\/td>\n N<\/td>\n<\/tr>\n \n 16<\/td>\n best_dir_win<\/td>\n char<\/td>\n Whether or not the director of the movie ever won an Oscar: yes, no<\/td>\n N<\/td>\n<\/tr>\n \n 17<\/td>\n top200_box<\/td>\n int<\/td>\n Whether or not the movie is in the Top 200 Box Office list on BoxOfficeMojo<\/td>\n N<\/td>\n<\/tr>\n \n 18<\/td>\n audience_score<\/td>\n int<\/td>\n Audience score on Rotten Tomatoes<\/td>\n N<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n
\nPart 2: Data Processing<\/h2>\n
Create Calculated Columns<\/h3>\n
\n+ feature_film: Use the variable title_type to assign yes or no if title_type == \u201cFeature Film\u201d
\n+ is_drama: use the variable genre, assign yes or no if genre == \u201cDrama\u201d
\n+ mpaa_rating_r: use the variable mpaa_rating, assign yes or no if mpaa_rating == \u201cR\u201d
\n+ oscar_season: use the variable thtr_rel_month, if value is in 10,11,12 assign yes, otherwise no.
\n+ summer_season: use the variable thtr_rel_month, if value is in 5,6,7,8 assign yes, otherwise no.<\/p>\n# add feature_film variable\nmovies <- movies %>% mutate(feature_film = \n as.factor(if_else(title_type == \"Feature Film\", \"Yes\" , \"No\")))\n\n# add is_drama variable\nmovies <- movies %>% mutate(mpaa_rating_r = as.factor(if_else(mpaa_rating == \"R\", \"Yes\" ,\"No\")))\n\n# add is_drama variable\nmovies <- movies %>% mutate(is_drama = as.factor(if_else(genre == \"Drama\", \"Yes\" ,\"No\")))\n\n# add oscar_season variable\nmovies <- movies %>% mutate(oscar_season = \n as.factor(if_else(between(thtr_rel_month, 10,12), \"Yes\" , \"No\")))\n\n# add summer_season variable\nmovies <- movies %>% mutate(summer_season = \n as.factor(if_else(between(thtr_rel_month, 5,8), \"Yes\" , \"No\")))\n<\/code><\/pre>\nSubsetting the Data<\/h3>\n
\n
\n
# 1. Select applicable columns for analysis\nmovies_subset <- movies %>% dplyr::select(runtime, thtr_rel_year ,imdb_rating\n ,imdb_num_votes ,critics_score ,top200_box\n ,best_pic_nom ,best_pic_win ,best_actor_win \n ,best_actress_win ,best_dir_win\n ,audience_score\n ,feature_film ,is_drama ,mpaa_rating_r \n ,oscar_season ,summer_season\n )\n#2. remove the obs with NA values\nmovies_subset <- na.omit(movies_subset)\n<\/code><\/pre>\nRemove observations<\/h3>\n
\n
#count of observations being removed\nnon_feature_films <- sum(movies$title_type != \"Feature Film\" | movies$genre == \"Documentary\")\n# remove observations from the dataset\nmovies_subset <- movies_subset %>% filter(movies_subset$feature_film == \"Yes\")\n<\/code><\/pre>\n
\nPart 3: Exploratory data analysis<\/h2>\n
\n
Summary Statistics:<\/h4>\n
movies_subset %>% dplyr::select(top200_box,best_pic_nom,best_pic_win\n ,best_actor_win,best_actress_win,best_dir_win\n ,is_drama,mpaa_rating_r, oscar_season\n , summer_season) %>% summary()\n<\/code><\/pre>\n## top200_box best_pic_nom best_pic_win best_actor_win best_actress_win\n## no :576 no :569 no :584 no :500 no :521 \n## yes: 15 yes: 22 yes: 7 yes: 91 yes: 70 \n## best_dir_win is_drama mpaa_rating_r oscar_season summer_season\n## no :548 No :290 No :274 No :415 No :397 \n## yes: 43 Yes:301 Yes:317 Yes:176 Yes:194\n<\/pre>\n
\n\n
\n \ntop200_box<\/th>\n count<\/th>\n avg_score<\/th>\n avg_score_delta<\/th>\n<\/tr>\n<\/thead>\n \n no<\/td>\n 576<\/td>\n 60.09896<\/td>\n -19.37<\/td>\n<\/tr>\n \n yes<\/td>\n 15<\/td>\n 74.53333<\/td>\n 24.02<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n \n\n
\n \nbest_pic_nom<\/th>\n count<\/th>\n avg_score<\/th>\n avg_score_delta<\/th>\n<\/tr>\n<\/thead>\n \n no<\/td>\n 569<\/td>\n 59.50439<\/td>\n -30.26<\/td>\n<\/tr>\n \n yes<\/td>\n 22<\/td>\n 85.31818<\/td>\n 43.38<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n \n\n
\n \nbest_pic_win<\/th>\n count<\/th>\n avg_score<\/th>\n avg_score_delta<\/th>\n<\/tr>\n<\/thead>\n \n no<\/td>\n 584<\/td>\n 60.17466<\/td>\n -28.97<\/td>\n<\/tr>\n \n yes<\/td>\n 7<\/td>\n 84.71429<\/td>\n 40.78<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n \n\n
\n \nbest_actor_win<\/th>\n count<\/th>\n avg_score<\/th>\n avg_score_delta<\/th>\n<\/tr>\n<\/thead>\n \n no<\/td>\n 500<\/td>\n 60.06600<\/td>\n -4.14<\/td>\n<\/tr>\n \n yes<\/td>\n 91<\/td>\n 62.65934<\/td>\n 4.32<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n \n\n
\n \nbest_actress_win<\/th>\n count<\/th>\n avg_score<\/th>\n avg_score_delta<\/th>\n<\/tr>\n<\/thead>\n \n no<\/td>\n 521<\/td>\n 60.04223<\/td>\n -5.62<\/td>\n<\/tr>\n \n yes<\/td>\n 70<\/td>\n 63.61429<\/td>\n 5.95<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n \n\n
\n \nbest_dir_win<\/th>\n count<\/th>\n avg_score<\/th>\n avg_score_delta<\/th>\n<\/tr>\n<\/thead>\n \n no<\/td>\n 548<\/td>\n 59.75547<\/td>\n -14.04<\/td>\n<\/tr>\n \n yes<\/td>\n 43<\/td>\n 69.51163<\/td>\n 16.33<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n \n\n
\n \nis_drama<\/th>\n count<\/th>\n avg_score<\/th>\n avg_score_delta<\/th>\n<\/tr>\n<\/thead>\n \n No<\/td>\n 290<\/td>\n 55.40345<\/td>\n -15.21<\/td>\n<\/tr>\n \n Yes<\/td>\n 301<\/td>\n 65.34219<\/td>\n 17.94<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n \n\n
\n \nmpaa_rating_r<\/th>\n count<\/th>\n avg_score<\/th>\n avg_score_delta<\/th>\n<\/tr>\n<\/thead>\n \n No<\/td>\n 274<\/td>\n 59.32117<\/td>\n -3.47<\/td>\n<\/tr>\n \n Yes<\/td>\n 317<\/td>\n 61.45426<\/td>\n 3.60<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n \n\n
\n \noscar_season<\/th>\n count<\/th>\n avg_score<\/th>\n avg_score_delta<\/th>\n<\/tr>\n<\/thead>\n \n No<\/td>\n 415<\/td>\n 59.65783<\/td>\n -4.35<\/td>\n<\/tr>\n \n Yes<\/td>\n 176<\/td>\n 62.36932<\/td>\n 4.55<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n \n\n
\n \nsummer_season<\/th>\n count<\/th>\n avg_score<\/th>\n avg_score_delta<\/th>\n<\/tr>\n<\/thead>\n \n No<\/td>\n 397<\/td>\n 60.55416<\/td>\n 0.45<\/td>\n<\/tr>\n \n Yes<\/td>\n 194<\/td>\n 60.28351<\/td>\n -0.45<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n \n
\nPart 4: Modeling<\/h2>\n
Modeling Method<\/h4>\n
\n
# generate the model\n\nmovies_subset_model <- movies_subset %>% dplyr::select(runtime, thtr_rel_year ,imdb_rating\n ,imdb_num_votes ,critics_score ,top200_box\n ,best_pic_nom ,best_pic_win ,best_actor_win \n ,best_actress_win ,best_dir_win\n ,audience_score\n ,is_drama ,mpaa_rating_r \n ,oscar_season ,summer_season\n )\n\nmovies_model = bas.lm(audience_score ~., data = movies_subset_model, prior = \"BIC\"\n ,modelprior = uniform() ,method = \"MCMC\"\n ,MCMC.iterations = 50000\n )\n<\/code><\/pre>\n\n\n
\n \n<\/th>\n P(B != 0 | Y)<\/th>\n model 1<\/th>\n model 2<\/th>\n model 3<\/th>\n model 4<\/th>\n model 5<\/th>\n<\/tr>\n<\/thead>\n \n Intercept<\/td>\n 1.00000<\/td>\n 1.0000<\/td>\n 1.0000000<\/td>\n 1.0000000<\/td>\n 1.0000000<\/td>\n 1.0000000<\/td>\n<\/tr>\n \n runtime<\/td>\n 0.22832<\/td>\n 0.0000<\/td>\n 1.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n thtr_rel_year<\/td>\n 0.10710<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n imdb_rating<\/td>\n 0.99986<\/td>\n 1.0000<\/td>\n 1.0000000<\/td>\n 1.0000000<\/td>\n 1.0000000<\/td>\n 1.0000000<\/td>\n<\/tr>\n \n imdb_num_votes<\/td>\n 0.06308<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n critics_score<\/td>\n 0.83678<\/td>\n 1.0000<\/td>\n 1.0000000<\/td>\n 1.0000000<\/td>\n 1.0000000<\/td>\n 1.0000000<\/td>\n<\/tr>\n \n top200_boxyes<\/td>\n 0.04844<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n best_pic_nomyes<\/td>\n 0.11190<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n best_pic_winyes<\/td>\n 0.04154<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n best_actor_winyes<\/td>\n 0.14526<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 1.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n best_actress_winyes<\/td>\n 0.12862<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 1.0000000<\/td>\n<\/tr>\n \n best_dir_winyes<\/td>\n 0.06868<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n is_dramaYes<\/td>\n 0.04888<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n mpaa_rating_rYes<\/td>\n 0.19296<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 1.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n oscar_seasonYes<\/td>\n 0.08030<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n summer_seasonYes<\/td>\n 0.08898<\/td>\n 0.0000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n 0.0000000<\/td>\n<\/tr>\n \n BF<\/td>\n NA<\/td>\n 1.0000<\/td>\n 0.2940317<\/td>\n 0.2275911<\/td>\n 0.1986676<\/td>\n 0.1526816<\/td>\n<\/tr>\n \n PostProbs<\/td>\n NA<\/td>\n 0.2017<\/td>\n 0.0566000<\/td>\n 0.0434000<\/td>\n 0.0419000<\/td>\n 0.0333000<\/td>\n<\/tr>\n \n R2<\/td>\n NA<\/td>\n 0.7251<\/td>\n 0.7269000<\/td>\n 0.7267000<\/td>\n 0.7265000<\/td>\n 0.7263000<\/td>\n<\/tr>\n \n dim<\/td>\n NA<\/td>\n 3.0000<\/td>\n 4.0000000<\/td>\n 4.0000000<\/td>\n 4.0000000<\/td>\n 4.0000000<\/td>\n<\/tr>\n \n logmarg<\/td>\n NA<\/td>\n -3278.5884<\/td>\n -3279.8124782<\/td>\n -3280.0686152<\/td>\n -3280.2045328<\/td>\n -3280.4678110<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n # summary coefficent\nconfint(coefficients(movies_model))\n<\/code><\/pre>\n## 2.5% 97.5% beta\n## Intercept 5.960184e+01 6.127487e+01 6.046531e+01\n## runtime -7.670914e-02 0.000000e+00 -1.227545e-02\n## thtr_rel_year -6.566192e-02 0.000000e+00 -5.982874e-03\n## imdb_rating 1.341579e+01 1.646231e+01 1.484804e+01\n## imdb_num_votes -5.147476e-08 2.055815e-06 2.716804e-07\n## critics_score 0.000000e+00 1.079631e-01 6.012133e-02\n## top200_boxyes 0.000000e+00 0.000000e+00 8.887782e-02\n## best_pic_nomyes -9.782284e-03 4.768328e+00 4.324454e-01\n## best_pic_winyes 0.000000e+00 0.000000e+00 -1.311505e-02\n## best_actor_winyes -2.716195e+00 0.000000e+00 -2.967139e-01\n## best_actress_winyes -2.646017e+00 0.000000e+00 -2.714538e-01\n## best_dir_winyes -1.609243e+00 1.183877e-01 -1.190107e-01\n## is_dramaYes 0.000000e+00 7.519898e-02 3.044855e-02\n## mpaa_rating_rYes -2.255332e+00 0.000000e+00 -3.116354e-01\n## oscar_seasonYes -1.257636e+00 2.031528e-03 -9.153999e-02\n## summer_seasonYes 0.000000e+00 1.314042e+00 1.059002e-01\n## attr(,\"Probability\")\n## [1] 0.95\n## attr(,\"class\")\n## [1] \"confint.bas\"\n<\/pre>\n
\n+95% probability audience_score value will increase by 1.35 to 1.64 for every point increase for the imdb_rating.<\/p>\nModel Performance Review<\/h4>\n
diagnostics(movies_model)\n<\/code><\/pre>\n<\/p>\n
plot(movies_model)\n<\/code><\/pre>\n<\/p>\n
\nPart 5: Prediction<\/h2>\n