--- title: "Problem Set 4" author: '[YOUR NAME]' date: "Due Date: 2025-12-05" output: html_document: default pdf_document: default subtitle: Regression Analysis institute: Villanova University type: homeworks --- ```{r,include=F} knitr::opts_chunk$set(error=TRUE) ``` # Getting Set Up Open `RStudio` and create a new RMarkDown file (`.Rmd`) by going to `File -> New File -> R Markdown...`. Accept defaults and save this file as `[LAST NAME]_ps5.Rmd` to your `code` folder. Copy and paste the contents of this `.Rmd` file into your `[LAST NAME]_ps5.Rmd` file. Then change the `author: [Your Name]` to your name. All of the following questions should be answered in this `.Rmd` file. There are code chunks with incomplete code that need to be filled in. To submit, compile (i.e., `knit as pdf`) the completed problem set and upload the PDF file to Blackboard on Friday by midnight. Be sure to check your knitted PDF for mistakes before submitting! This problem set is worth 7 total points, plus 1 extra credit point. The point values for each question are indicated in brackets below. To receive full credit, you must have the correct code. In addition, some questions ask you to provide a written response in addition to the code. You will be deducted 1 point for each day late the problem set is submitted, and 1 point for failing to submit in the correct format (i.e., not knitting as a PDF). You are free to rely on whatever resources you need to complete this problem set, including lecture notes, lecture presentations, Google, your classmates...you name it. However, the final submission must be complete by you. There are no group assignments. *Note that the professor will not respond to Campuswire posts after 2PM on Friday, so don't wait until the last minute to get started!* **Good luck!** **If you collaborated with a colleague and/or used AI for any help on this problem set, document here.** Write the names of your classmates and/or upload a PDF of your AI prompt and output with your problem set: # Part 1: Maximizing Accuracy ## Question 0 Require `tidyverse` and load the [`fn_cleaned_final.Rds`](https://github.com/rweldzius/PSC4175/raw/main/static/data/fn_cleaned_final.Rds') data to an object called `fn`. ```{r} # INSERT CODE HERE ``` ## Question 1 [0.5 points] In this problem set, we are interested in developing a classifier that maximizes our accuracy for predicting Fortnite victories. To do so we will use both a linear probability model and a logit, and then compare their predictive accuracy. We will use two $X$ variables to predict the probability of winning: accuracy (`accuracy`), and head shots (`head_shots`). Our outcome variable of interest $Y$ is whether the player won the game (`won`). Start by **looking** at these variables. Why types of variables are they? How much missingness do they have? What do their univariate visualizations look like? Then create two multivariate visualizations of the relationship between `won` and each of the two $X$ variables one-by-one. Finally, use `geom_tile()` to create a heatmap of the three-way relationship, where quintiles of `accuracy` is on the x-axis, quintiles of `head_shots` is on the y-axis, and tiles are filled according to the average winning probability. (NB: look up what "quintile" means if you are not sure.) Is there anything surprising about this result? ```{r} # What types? # INSERT CODE HERE # How much missingness? # INSERT CODE HERE # Univariate # INSERT CODE HERE # Multivariate: one-by-one # INSERT CODE HERE # Multivariate: 3-dimensions # INSERT CODE HERE ``` > Write answer here ## Question 2 [1 point] Now let's run a linear model and evaluate it in terms of overall accuracy, sensitivity and specificity using a threshold of 0.5. Then, determine the threshold that maximizes both specificity and sensitivity. Finally, calculate the area under the curve (AUC). ```{r} require(...) # Require the scales package # Running linear model model_lm <- lm(formula = ..., # Define the regression equation data = ...) # Provide the dataset # Calculating accuracy, sensitivity, and specificity fn %>% mutate(prob_win = ...) %>% # Calculate the probability of winning mutate(pred_win = ...) %>% # Convert the probability to a 1 if the probability is greater than 0.5, or zero otherwise group_by(...) %>% # Calculate the total games by whether they were actually won or lost mutate(total_games = ...) %>% group_by(....) %>% # Calculate the number of games by whether they were actually won or lost, and by whether they were predicted to be won or lost summarise(nGames=...,.groups = 'drop') %>% mutate(prop = ...) %>% # Calculate the proportion of game by the total games ungroup() %>% mutate(accuracy = ...) # Calculate the overall accuracy # Create the sensitivity vs specificity plot toplot <- NULL # Instantiate an empty object for(thresh in seq(0,1,by = .025)) { toplot <- fn %>% mutate(prob_win = ...) %>% # Calculate the probability of winning mutate(pred_win = ...) %>% # Convert the probability to a 1 if the probability is greater than the given threshold, or zero otherwise group_by(...) %>% # Calculate the total games by whether they were actually won or lost mutate(total_games = ...) %>% group_by(...) %>% # Calculate the number of games by whether they were actually won or lost, and by whether they were predicted to be won or lost summarise(nGames=...,.groups = 'drop') %>% mutate(prop = ...) %>% # Calculate the proportion of game by the total games ungroup() %>% mutate(accuracy = ...) %>% # Calculate the overall accuracy mutate(threshold = ...) %>% # Record the threshold level bind_rows(toplot) # Add it to the toplot object } toplot %>% mutate(metric = ifelse(..., ifelse(...,...))) %>% # Using a nested ifelse() function, label each row as either Sensitivity (if the predicted win is 1 and the true win is 1), Specificity (if the predicted win is 0 and the true win is 0), or NA drop_na(...) %>% # Drop rows that are neither sensitivity nor specificity measures ggplot(aes(x = ...,y = ...,color = ...)) + # Visualize the Sensitivity and Specificity curves by putting the threshold on the x-axis, the proportion of all games on the y-axis, and coloring by Sensitivity or Specificity geom_...() + geom_vline(xintercept = ...) # Tweak the x-intercept to find the optimal threshold # Plot the AUC toplot %>% mutate(metric = ifelse(..., ifelse(...,...))) %>% # Using a nested ifelse() function, label each row as either Sensitivity (if the predicted win is 1 and the true win is 1), Specificity (if the predicted win is 0 and the true win is 0), or NA drop_na(...) %>% # Drop rows that are neither sensitivity nor specificity measures select(...) %>% # Select only the prop, metric, and threshold columns spread(...) %>% # Pivot the data to wide format using either spread() or pivot_wider(), where the new columns should be the metric arrange(...) %>% # Arrange by descending specificity, and then by sensitivity ggplot(aes(x = ..., # Plot 1 minus the Specificity on the x-axis y = ...)) + # Plot the Sensitivity on the y-axis geom_...() + xlim(...) + ylim(...) + # Expand the x and y-axis limits to be between 0 and 1 geom_abline(...) + # Add a 45-degree line using geom_abline() labs(x = '', # Add clear labels! (Make sure to indicate that this is the result of a linear regression model) y = '', title = '', subtitle = '') # Calculate the AUC require(...) # Require the tidymodels package forAUC <- fn %>% mutate(prob_win = ..., # Generate predicted probabilities of winning from our model truth = ...) %>% # Convert the outcome to a factor with levels c('1','0') select(truth,prob_win) # Select only the probability and true outcome columns roc_auc(data = forAUC, # Run the roc_auc() function on the dataset we just created truth, # Tell it which column contains the true outcomes prob_win) # Tell it which column contains our model's predicted probabilities ``` > Write answer here ## Question 3 [0.5 points] Now let's re-do the exact same work, except use a logit model instead of a linear model. Based on your analysis, which model has a larger AUC? ```{r} # INSERT CODE HERE ``` > Write answer here ## Question 4 [1 point] Use 100-fold cross validation with a 60-40 split to calculate the average AUC for both the linear and logit models. Which is better? ```{r} set.seed(123) cvRes <- NULL for(i in 1:100) { # Cross validation prep # INSERT CODE HERE # Training models mLM <- lm(...) mGLM <- glm(...) # Predicting models toEval <- test %>% mutate(mLMPreds = ..., # Calculate the probability of winning from the linear model mGLMPreds = ..., # Calculate the probability of winning from the logit truth = ...) # Convert the outcome to a factor with levels c('1','0') # Evaluating models rocLM <- roc_auc(...) %>% # Calculate the AUC for the linear model mutate(model = ...) %>% # Record the model type rename(auc = .estimate) # Rename to 'auc' rocGLM <- roc_auc(...) %>% # Calculate the AUC for the logit model mutate(model = ...) %>% # Record the model type rename(auc = .estimate) # Rename to 'auc' cvRes <- rocLM %>% bind_rows(rocGLM) %>% mutate(cvInd = i) %>% bind_rows(cvRes) } cvRes %>% group_by(model) %>% summarise(mean_auc = mean(auc)) ``` > Write answer here. ## Question 5 [1 point] Let's consider two possible $X$ variables which might help us predict whether a player wins a Fortnite match: `revives` and `eliminations`. `revives` counts the total number of times a player is brought back to life by a teammate. `eliminations` is a measure of how many times the player killed an opponent. Which variable do you think is more helpful for predicting whether a player wins a game of Fortnite? Why? > Write response here. Look at the data and provide univariate and multivariate visualizations of both variables. Make sure to think carefully about what types of variables these are, and justify your visualization choices accordingly! ```{r} # Look to determine variable types # INSERT CODE HERE # Univariate #1 # INSERT CODE HERE # Univariate #1 # INSERT CODE HERE # Multivariate (many different options will work) # INSERT CODE HERE ``` ## Question 7 [1 point] Let's test your intuition. Starting with the full data, calculate the AUC for both models. Then, using 100 cross validation with a logit model and a 60-40 split, calculate the AUC for the model which uses the variable you think is best, compared to the model you think is the worst. Pay attention to the things you need to change to use a logit model! Is your assumption from Q1 supported in the data? ```{r} # Require the tidymodels package # Running logit model #1 # INSERT CODE HERE # Running logit model #2 # INSERT CODE HERE # Calculate the AUC #1 # INSERT CODE HERE # Calculate the AUC #1 # INSERT CODE HERE # Calculate cross validation set.seed(123) cvRes <- NULL for(i in 1:100) { # Cross validation prep # INSERT CODE HERE # Training models # INSERT CODE HERE # Predicting models # INSERT CODE HERE # Evaluating models # INSERT CODE HERE # Binding data # INSERT CODE HERE } # Calculate overall mean AUC # INSERT CODE HERE # Visualize distribution of AUC by variable (optional) # INSERT CODE HERE # Calculate Proportion of time the "best" model is better than the "worst" (optional) # INSERT CODE HERE ``` > Write answer here ## Question 8 [1 point] Now let's run a kitchen sink model using a random forest (make sure to install and require the `ranger` package). Use the following $X$ variables: - `hits` - `assists` - `accuracy` - `head_shots` - `damage_to_players` - `eliminations` - `revives` - `distance_traveled` - `materials_gathered` - `mental_state` - `startTime` - `gameIdSession` Run it on the full data and use `importance = 'permutation'` to see which variables the random forest thinks are most important. Visualize these results with a barplot. Where do the variables you thought would be best and worst appear? ```{r} # Require ranger # INSERT CODE HERE # Run RF model with permutation-based importance calculation model_rf <- ranger(..., # Insert regression equation here ..., # Insert data here ...) # Set importance calculation here # Visualize variable importance results # First, create a toplot object toplot <- data.frame(vimp = ..., # Get variable importance values from model_rf vars = names(...)) # Get variable importance value names from model_rf # Second, visualize the results (make sure to reorder the variables in order of importance) # INSERT CODE HERE ``` > Write response her ## Question 9 [+1 point extra credit] For extra credit, we will use k-means clustering to see whether Fortnite players fall into different “play style” groups. Start by creating a new dataset with these variables: `accuracy`, `head_shots`, `eliminations`, `distance_traveled`, `materials_gathered`, and `won.` Remove any rows with missing values. Next, standardize the five play-style variables (everything except won) so they each have mean 0 and standard deviation 1. Then run a k-means model with 3 clusters using the standardized play-style variables. Add the cluster assignments back to your dataset using the `augment()` function from the `broom` package. Make at least one scatterplot showing the clusters (for example, plot accuracy vs. eliminations, with points colored by cluster). Finally, calculate the mean win rate and the number of players in each cluster. Write a few sentences describing what the clusters seem to represent (e.g., aggressive players, defensive players, etc.) and which group is most likely to win. ```{r} # INSERT CODE HERE ``` > Write your answer here.