Assignment 1 File
Due February 18, 2023
Problem Overview
The goal of this homework is hands-on practice with data exploration and cleaning, classification, and model selection. You will:
- Conduct basic exploratory analysis of a data set
- Develop linear and logistic regression models
- Interpret your models
- Partition your dataset and evaluate your models in terms of classification performance
The Assignment
The data in the accompanying file “dc_airbnb_file.csv” (posted on Canvas) contains data about 4936 Airbnb.com listings from the Washington, DC area. This is a small subset of the data that you will eventually use for the class project. The variables in this dataset should be self-explanatory but we have also provided a data dictionary.
Your task is to develop models to predict the target variable “high_booking_rate”, which labels whether a listing is popular (i.e. spends most of the time booked) or not.
Please answer the questions below clearly and concisely, providing tables or plots where applicable. Turn in a well-formatted compiled HTML document using R Markdown, containing clear answers to the questions and R code in the appropriate places.
RUBRIC: To receive a passing score on this assignment, you must do the following:
- Turn in a well-formatted compiled HTML document using R markdown.
- Provide clear answers to the questions and the correct R commands as necessary, in the appropriate places. You may answer up to three sub-questions incorrectly (i.e. incorrect R command; missing answer to question) and still receive a P on this assignment (for example, 1(a) counts as one sub-question).
- The entire document must be clear, concise, and readable.
Note that this assignment is somewhat open-ended and there are many ways to answer these questions. I don’t require that we have exactly the same answers in order for you to receive full credit.
airbnb <- read_csv("C:/Users/nanna/OneDrive/Desktop/dc_airbnb_hw1.csv") #read the dataset in R## Rows: 4936 Columns: 12
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): name, bed_type, cancellation_policy, cleaning_fee, price, property_...
## dbl (5): accommodates, bedrooms, beds, host_total_listings_count, high_booki...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.names(airbnb) #variables used in dataset## [1] "name" "accommodates"
## [3] "bed_type" "bedrooms"
## [5] "beds" "cancellation_policy"
## [7] "cleaning_fee" "host_total_listings_count"
## [9] "price" "property_type"
## [11] "room_type" "high_booking_rate"0: Example answer
What is the mean of the accommodates variable?
ANSWER: The mean number of people that can be accommodated in a listing in this dataset is 3.522893.
age_mean <- airbnb %>%
summarise(mean_accommodates = mean(accommodates))1: EDA and Data Cleaning
- Clean up and process some of the variables by doing the following (I recommend you do these in the order in which they are listed):
- For cancellation_policy, group “strict” and “super_strict_30” into “strict”
- Convert cleaning_fee and price into numbers
- Replace NAs in cleaning_fee and price with 0
- Replace NAs in other numerical variables with their mean
Hint: there are lots of ways to deal with cleaning_fee and price. I like the parse_number function from the readr library.
ANSWER TO QUESTION 1a HERE:
#PUT QUESTION 1a CODE HERE
# For cancellation_policy, group "strict" and "super_strict_30" into "strict"
airbnb <- airbnb %>%
mutate(cancellation_policy = ifelse(cancellation_policy %in% c("strict", "super_strict_30"), "strict", cancellation_policy))
# Convert cleaning_fee and price into numbers
# First ensure they are treated as characters
airbnb <- airbnb %>%
mutate(
cleaning_fee = parse_number(as.character(cleaning_fee)),
price = parse_number(as.character(price)))
# Replace NAs in cleaning_fee and price with 0
airbnb$cleaning_fee[is.na(airbnb$cleaning_fee)] <- 0
airbnb$price[is.na(airbnb$price)] <- 0
# Replace NAs in other numerical variables with their mean
airbnb <- airbnb %>%
mutate(across(c("accommodates", "bedrooms", "beds", "host_total_listings_count"), ~replace_na(.x, mean(.x, na.rm=TRUE))))# For cancellation_policy, group "strict" and "super_strict_30" into "strict"
airbnb <- airbnb %>%
mutate(cancellation_policy = ifelse(cancellation_policy %in% c("strict", "super_strict_30"), "strict", cancellation_policy))
summary(airbnb)## name accommodates bed_type bedrooms
## Length:4936 Min. : 1.000 Length:4936 Min. :0.000
## Class :character 1st Qu.: 2.000 Class :character 1st Qu.:1.000
## Mode :character Median : 3.000 Mode :character Median :1.000
## Mean : 3.523 Mean :1.297
## 3rd Qu.: 4.000 3rd Qu.:2.000
## Max. :16.000 Max. :8.000
## beds cancellation_policy cleaning_fee
## Min. : 1.000 Length:4936 Min. : 0.00
## 1st Qu.: 1.000 Class :character 1st Qu.: 5.00
## Median : 1.000 Mode :character Median : 35.00
## Mean : 1.821 Mean : 48.47
## 3rd Qu.: 2.000 3rd Qu.: 75.00
## Max. :16.000 Max. :500.00
## host_total_listings_count price property_type
## Min. : 0.00 Min. : 10.0 Length:4936
## 1st Qu.: 1.00 1st Qu.: 80.0 Class :character
## Median : 1.00 Median : 115.0 Mode :character
## Mean : 15.57 Mean : 154.3
## 3rd Qu.: 3.00 3rd Qu.: 175.0
## Max. :879.00 Max. :5150.0
## room_type high_booking_rate
## Length:4936 Min. :0.0000
## Class :character 1st Qu.:0.0000
## Mode :character Median :0.0000
## Mean :0.2508
## 3rd Qu.:1.0000
## Max. :1.0000- Create five new variables:
price_per_person is the nightly price per accommodates
has_cleaning_fee is YES if there is a cleaning fee, and NO otherwise
bed_category is “bed” if the bed_type is Real Bed and “other” otherwise
property_category has the following values:
- apartment if property_type is Apartment, Serviced apartment, Loft.
- hotel if property_type is Bed & Breakfast, Boutique hotel, Hostel.
- condo if property_type is Townhouse, Condominium.
- house if property_type is Bungalow, House.
- other, otherwise
make sure to convert property_category to a factor!
ppp_ind is 1 if the price_per_person is greater than the median for the property_category, and 0 otherwise
Hint: there are lots of ways to do the property_type variable, but case_when might be a useful function that’s part of the tidyverse.
ANSWER TO QUESTION 1b HERE:
library(dplyr)
# Create price_per_person variable
airbnb <- airbnb %>%
mutate(price_per_person = price / accommodates)
# Create has_cleaning_fee variable
airbnb <- airbnb %>%
mutate(has_cleaning_fee = if_else(cleaning_fee > 0, "YES", "NO"))
# Create bed_category variable
airbnb <- airbnb %>%
mutate(bed_category = if_else(bed_type == "Real Bed", "bed", "other"))
# Create property_category variable
airbnb <- airbnb %>%
mutate(property_category = case_when(
property_type %in% c("Apartment", "Serviced apartment", "Loft") ~ "apartment",
property_type %in% c("Bed & Breakfast", "Boutique hotel", "Hostel") ~ "hotel",
property_type %in% c("Townhouse", "Condominium") ~ "condo",
property_type %in% c("Bungalow", "House") ~ "house",
TRUE ~ "other"
))
airbnb$property_category <- as.factor(airbnb$property_category)
# Create ppp_ind variable
airbnb <- airbnb %>%
group_by(property_category) %>%
mutate(ppp_ind = if_else(price_per_person > median(price_per_person, na.rm = TRUE), 1, 0))
summary(airbnb)## name accommodates bed_type bedrooms
## Length:4936 Min. : 1.000 Length:4936 Min. :0.000
## Class :character 1st Qu.: 2.000 Class :character 1st Qu.:1.000
## Mode :character Median : 3.000 Mode :character Median :1.000
## Mean : 3.523 Mean :1.297
## 3rd Qu.: 4.000 3rd Qu.:2.000
## Max. :16.000 Max. :8.000
## beds cancellation_policy cleaning_fee
## Min. : 1.000 Length:4936 Min. : 0.00
## 1st Qu.: 1.000 Class :character 1st Qu.: 5.00
## Median : 1.000 Mode :character Median : 35.00
## Mean : 1.821 Mean : 48.47
## 3rd Qu.: 2.000 3rd Qu.: 75.00
## Max. :16.000 Max. :500.00
## host_total_listings_count price property_type
## Min. : 0.00 Min. : 10.0 Length:4936
## 1st Qu.: 1.00 1st Qu.: 80.0 Class :character
## Median : 1.00 Median : 115.0 Mode :character
## Mean : 15.57 Mean : 154.3
## 3rd Qu.: 3.00 3rd Qu.: 175.0
## Max. :879.00 Max. :5150.0
## room_type high_booking_rate price_per_person has_cleaning_fee
## Length:4936 Min. :0.0000 Min. : 0.6875 Length:4936
## Class :character 1st Qu.:0.0000 1st Qu.: 29.0000 Class :character
## Mode :character Median :0.0000 Median : 40.0000 Mode :character
## Mean :0.2508 Mean : 47.3192
## 3rd Qu.:1.0000 3rd Qu.: 55.0000
## Max. :1.0000 Max. :2575.0000
## bed_category property_category ppp_ind
## Length:4936 apartment:2685 Min. :0.0000
## Class :character condo : 558 1st Qu.:0.0000
## Mode :character hotel : 62 Median :0.0000
## house :1561 Mean :0.4899
## other : 70 3rd Qu.:1.0000
## Max. :1.0000- Convert the remaining character variables to factors
- bed_type
- cancellation_policy
- room_type
# Convert remaining character variables to factors
airbnb$bed_type <- as.factor(airbnb$bed_type)
airbnb$cancellation_policy <- as.factor(airbnb$cancellation_policy)
airbnb$room_type <- as.factor(airbnb$room_type)
summary(airbnb)## name accommodates bed_type bedrooms
## Length:4936 Min. : 1.000 Airbed : 31 Min. :0.000
## Class :character 1st Qu.: 2.000 Couch : 16 1st Qu.:1.000
## Mode :character Median : 3.000 Futon : 38 Median :1.000
## Mean : 3.523 Pull-out Sofa: 65 Mean :1.297
## 3rd Qu.: 4.000 Real Bed :4786 3rd Qu.:2.000
## Max. :16.000 Max. :8.000
## beds cancellation_policy cleaning_fee
## Min. : 1.000 flexible:1351 Min. : 0.00
## 1st Qu.: 1.000 moderate:1602 1st Qu.: 5.00
## Median : 1.000 strict :1983 Median : 35.00
## Mean : 1.821 Mean : 48.47
## 3rd Qu.: 2.000 3rd Qu.: 75.00
## Max. :16.000 Max. :500.00
## host_total_listings_count price property_type
## Min. : 0.00 Min. : 10.0 Length:4936
## 1st Qu.: 1.00 1st Qu.: 80.0 Class :character
## Median : 1.00 Median : 115.0 Mode :character
## Mean : 15.57 Mean : 154.3
## 3rd Qu.: 3.00 3rd Qu.: 175.0
## Max. :879.00 Max. :5150.0
## room_type high_booking_rate price_per_person
## Entire home/apt:3326 Min. :0.0000 Min. : 0.6875
## Private room :1472 1st Qu.:0.0000 1st Qu.: 29.0000
## Shared room : 138 Median :0.0000 Median : 40.0000
## Mean :0.2508 Mean : 47.3192
## 3rd Qu.:1.0000 3rd Qu.: 55.0000
## Max. :1.0000 Max. :2575.0000
## has_cleaning_fee bed_category property_category ppp_ind
## Length:4936 Length:4936 apartment:2685 Min. :0.0000
## Class :character Class :character condo : 558 1st Qu.:0.0000
## Mode :character Mode :character hotel : 62 Median :0.0000
## house :1561 Mean :0.4899
## other : 70 3rd Qu.:1.0000
## Max. :1.0000- Construct and report boxplots of price_per_person and log(price_per_person), broken up by values of high_booking_rate. Does it appear that there is a relationship between price_per_person and high_booking_rate? If so, what is the relationship?
ANSWER TO QUESTION 1d HERE:
library(ggplot2)
airbnb <- airbnb %>%
mutate(log_price_per_person = log(price_per_person))
ggplot(airbnb, aes(x = as.factor(high_booking_rate), y = price_per_person)) +
geom_boxplot() +
labs(title = "Boxplot of price_per_person by high_booking_rate",
x = "High Booking Rate",
y = "Price per Person")
ggplot(airbnb, aes(x = as.factor(high_booking_rate), y = log_price_per_person)) +
geom_boxplot() +
labs(title = "Boxplot of log(price_per_person) by high_booking_rate",
x = "High Booking Rate",
y = "Log(Price_per_Person)")
# A correlation seems to exist between price_per_person and high_booking_rate, as seen by the boxplots. As can be seen in the boxplots of log(price_per_person), listings with higher price_per_person typically have greater high_booking_rates. This implies that listings with greater prices per person can have a higher chance of receiving a lot of bookings.- Construct a two-way table of high_booking_rate by property_category. Does it appear that any property categories are particularly bad or good in terms of high booking rates?
(hint: prop.table might be especially helpful here)
ANSWER TO QUESTION 1e HERE:
# Create two-way table of high_booking_rate by property_category
booking_rate_table <- table(airbnb$high_booking_rate, airbnb$property_category)
# Convert counts to proportions
prop_booking_rate_table <- prop.table(booking_rate_table, margin = 1)
# Print the table
print(prop_booking_rate_table)##
## apartment condo hotel house other
## 0 0.544348296 0.104651163 0.013520822 0.323958897 0.013520822
## 1 0.542810985 0.138126010 0.009693053 0.293214863 0.016155089#We can see the percentages of high booking rates for each property category based on the two-way table of high booking rates by property type. In comparison to other property types, some may have a larger or lower percentage of high booking rates. For example, a larger percentage of "YES" in the "1" row for a certain property category means that listings in that category are probably going to have high booking rates. On the other hand, a larger percentage of "YES" in the "0" row indicates a lower likelihood of high booking rates for listings in that category of properties. If more investigation is needed to see if these differences are statistically significant, chi-square tests may be used.2: Linear Regression
- Train a linear regression to predict high_booking_rate using the variables listed below. Report the R^2.
- cancellation_policy
- cleaning_fee
- price_per_person
- ppp_ind
- has_cleaning_fee
- accommodates
- bed_category
- bedrooms
- beds
- host_total_listings_count
- property_category
ANSWER TO QUESTION 2a HERE:
# Load necessary library
airbnb$high_booking_rate <- as.numeric(as.character(airbnb$high_booking_rate))
model <- lm(high_booking_rate ~ cancellation_policy + cleaning_fee + price_per_person +
ppp_ind + has_cleaning_fee + accommodates + bed_category +
bedrooms + beds + host_total_listings_count + property_category, data = airbnb)
summary(model)##
## Call:
## lm(formula = high_booking_rate ~ cancellation_policy + cleaning_fee +
## price_per_person + ppp_ind + has_cleaning_fee + accommodates +
## bed_category + bedrooms + beds + host_total_listings_count +
## property_category, data = airbnb)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.0026 -0.2862 -0.1748 0.4317 0.9956
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.909e-01 2.112e-02 9.039 < 2e-16 ***
## cancellation_policymoderate 8.553e-02 1.581e-02 5.410 6.59e-08 ***
## cancellation_policystrict 6.877e-02 1.594e-02 4.316 1.62e-05 ***
## cleaning_fee -1.229e-03 1.899e-04 -6.470 1.08e-10 ***
## price_per_person -4.609e-04 1.404e-04 -3.283 0.001034 **
## ppp_ind -9.495e-02 1.387e-02 -6.847 8.47e-12 ***
## has_cleaning_feeYES 1.458e-01 1.732e-02 8.417 < 2e-16 ***
## accommodates 1.228e-02 5.994e-03 2.049 0.040545 *
## bed_categoryother -3.760e-02 3.488e-02 -1.078 0.281049
## bedrooms -8.041e-02 1.190e-02 -6.758 1.56e-11 ***
## beds 4.345e-02 8.964e-03 4.848 1.29e-06 ***
## host_total_listings_count -2.230e-04 7.144e-05 -3.122 0.001809 **
## property_categorycondo 6.576e-02 1.981e-02 3.320 0.000907 ***
## property_categoryhotel -1.661e-02 5.405e-02 -0.307 0.758573
## property_categoryhouse 4.977e-03 1.433e-02 0.347 0.728283
## property_categoryother -3.811e-03 5.109e-02 -0.075 0.940545
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4167 on 4920 degrees of freedom
## Multiple R-squared: 0.07898, Adjusted R-squared: 0.07617
## F-statistic: 28.13 on 15 and 4920 DF, p-value: < 2.2e-16- What is the predicted value of high_booking_rate for a listing with the following characteristics, and how would you interpret this prediction?
New Listing:
- cancellation_policy = super_strict_30
- cleaning_fee = $30
- price = $200
- accommodates = 4
- bed_type = Real Bed
- bedrooms = 3
- beds = 4
- host_total_listings_count = 1
- property_type = townhouse
Hint: you will have to do the same processing on this new listing as you applied to the main dataset, but feel free to do it by hand rather than using the same code as before.
ANSWER TO QUESTION 2b HERE:
library(dplyr)
# Assuming the median calculation has already been done and stored in a variable
median_ppp_condo <- median(airbnb$price_per_person[airbnb$property_category == "condo"], na.rm = TRUE)
logistic_model <- glm(high_booking_rate ~ cancellation_policy + cleaning_fee +
price_per_person + ppp_ind + has_cleaning_fee + accommodates +
bed_category + bedrooms + beds + host_total_listings_count +
property_category, data = airbnb, family = binomial)## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred# Create the new listing data frame and predict in one go
predicted_prob <- data.frame(
cancellation_policy = "strict",
cleaning_fee = 30,
price_per_person = 200 / 4,
accommodates = 4,
bed_type = "Real Bed",
bedrooms = 3,
beds = 4,
host_total_listings_count = 1,
property_category = "condo"
) %>%
mutate(
ppp_ind = as.integer(price_per_person > median_ppp_condo),
has_cleaning_fee = "YES",
bed_category = "bed",
cancellation_policy = as.factor(cancellation_policy),
bed_category = as.factor(bed_category),
property_category = as.factor(property_category)
) %>%
{predict(logistic_model, newdata = ., type = "response")}
# Output the predicted probability
predicted_prob## 1
## 0.3299597#The possibility that this new listing will have a high booking rate is estimated by the new_listing and is shown by the anticipated value of high_booking_rate. The anticipated likelihood that the listing will have a high booking rate in this instance is the forecasted value. In contrast, a lower expected value indicates a lower possibility of a high booking rate. A higher forecasted value indicates a higher probability.- Do you have any reservations about this predicted high_booking_rate? That is, would you feel sufficiently comfortable with this prediction in order to take some business action based on it? Why or why not?
ANSWER TO QUESTION 2c HERE: # I would not feel comfortable with this predection because the probability of high_booking_rate is below than 0.5 and it is not advised to relay on the probabilities but it is advisable to use the high_booking_rate as one of the inputs to make business decision.
3: Logistic Regression
- Train a Logistic Regression model using the same variables as in 2a. Report the AIC of your model.
Hint: don’t worry if you get a warning here…
ANSWER TO QUESTION 3a HERE:
log_model <- glm(high_booking_rate ~ cancellation_policy + cleaning_fee +
price_per_person + ppp_ind + has_cleaning_fee + accommodates +
bed_category + bedrooms + beds + host_total_listings_count +
property_category, data = airbnb, family = binomial)## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(log_model)##
## Call:
## glm(formula = high_booking_rate ~ cancellation_policy + cleaning_fee +
## price_per_person + ppp_ind + has_cleaning_fee + accommodates +
## bed_category + bedrooms + beds + host_total_listings_count +
## property_category, family = binomial, data = airbnb)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.978980 0.160907 -6.084 1.17e-09 ***
## cancellation_policymoderate 0.510296 0.093378 5.465 4.63e-08 ***
## cancellation_policystrict 0.444980 0.095816 4.644 3.42e-06 ***
## cleaning_fee -0.006897 0.001299 -5.308 1.11e-07 ***
## price_per_person -0.019105 0.002891 -6.608 3.91e-11 ***
## ppp_ind -0.053136 0.108611 -0.489 0.6247
## has_cleaning_feeYES 0.841786 0.107402 7.838 4.59e-15 ***
## accommodates 0.040726 0.035167 1.158 0.2468
## bed_categoryother -0.264513 0.208151 -1.271 0.2038
## bedrooms -0.399557 0.069183 -5.775 7.68e-09 ***
## beds 0.223325 0.050891 4.388 1.14e-05 ***
## host_total_listings_count -0.007824 0.003194 -2.449 0.0143 *
## property_categorycondo 0.349404 0.109380 3.194 0.0014 **
## property_categoryhotel 0.100804 0.352798 0.286 0.7751
## property_categoryhouse -0.052321 0.083447 -0.627 0.5307
## property_categoryother -0.140461 0.291836 -0.481 0.6303
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 5560.1 on 4935 degrees of freedom
## Residual deviance: 5082.6 on 4920 degrees of freedom
## AIC: 5114.6
##
## Number of Fisher Scoring iterations: 8# AIC of log_model is 5114.6- What is the coefficient for price_per_person? Provide a precise (numerical) interpretation of the coefficient.
ANSWER TO QUESTION 3b HERE: # In the linear regression model, the coefficient for price_per_person is -0.019105. With all other predictors held constant, this coefficient shows how the expected value of high booking rate would vary in response to a one-unit rise in the price_per_person variable.
#Exact numerical explanation of the coefficient: - Assuming all other factors stay constant, the expected value of high_booking_rate drops by around 0.0191 units for every unit rise in the price_per_person. After accounting for the impact of other model variables, the chance of a listing having a high booking rate would somewhat decline as the price per person increases.
- What is the coefficient for property_category = condo? Provide a precise (numerical) interpretation of this coefficient.
ANSWER TO QUESTION 3c HERE: # In the linear regression model, the coefficient for the property_categorycondo variable is 0.349404. When all other variables are held constant, this coefficient shows the variation in the expected value of `high booking rate for listings classified as “condo” relative to the reference category, which is often the baseline or the omitted category.
#Accurate numerical interpretation of the coefficient: - Listings classified as “condo” are expected to rise . The model predicts that, after adjusting for the impact of other variables, listings classified as “condo” will be more likely than listings in the reference category to have a high booking rate.
- Compute the predicted probability that the same listing as in #2b will have high_booking_rate = 1. Hint: you should use the predict function, but you need to specify type = “response” when predicting probabilities from logistic regression (otherwise, it will predict the value of logit). For example: predict(mymodel, newdata = mydata, type = “response”).
ANSWER TO QUESTION 3d HERE:
- If you were to pick one model to use for the purposes of explaining the relationship between the features and the target variable, which would it be, and why?
ANSWER TO QUESTION 3e HERE: # I would choose logistic regression because its value is between 0 and 1 and its value will not exceed 1. So it is easy to interpet the values.
4: Classification and Evaluation
- Set the random seed to 12345. Split the data into 70% training and 30% validation sets, retrain the linear and logistic regression models using the training data only, and report the resulting R^2 and AIC, respectively.
ANSWER TO QUESTION 4a HERE:
set.seed(12345)
# Assuming 'airbnb' is your dataset
# Split the data into 70% training and 30% validation sets
n_rows <- nrow(airbnb)
train_indices <- sample(1:n_rows, 0.7 * n_rows)
train_data <- airbnb[train_indices, ]
valid_data <- airbnb[-train_indices, ]
# Retrain linear regression model on training data
linear_model <- lm(high_booking_rate ~ cancellation_policy + cleaning_fee +
price_per_person + ppp_ind + has_cleaning_fee + accommodates +
bed_category + bedrooms + beds + host_total_listings_count +
property_category, data = train_data)
# Retrain logistic regression model on training data
logistic_model <- glm(high_booking_rate ~ cancellation_policy + cleaning_fee +
price_per_person + ppp_ind + has_cleaning_fee + accommodates +
bed_category + bedrooms + beds + host_total_listings_count +
property_category, data = train_data, family = binomial)
# Report R^2 for linear regression model on validation set
linear_r_squared <- summary(linear_model)$r.squared
cat("Linear Regression R^2 on Validation Set:", linear_r_squared, "\n")## Linear Regression R^2 on Validation Set: 0.08106124# Report AIC for logistic regression model on validation set
logistic_aic <- AIC(logistic_model)
cat("Logistic Regression AIC on Validation Set:", logistic_aic,"\n")## Logistic Regression AIC on Validation Set: 3585.261- Compute the RMSE in the training and validation sets for the linear model (do not do the classifications, just use the predicted score). Which RMSE is higher (training or validation), and does this make sense? Why or why not?
ANSWER TO QUESTION 4b HERE:
train_predictions <- predict(linear_model, newdata = train_data)
# RMSE on training set
train_rmse <- sqrt(mean((train_data$high_booking_rate - train_predictions)^2))
# Predictions on validation set
valid_predictions <- predict(linear_model, newdata = valid_data)
# RMSE on validation set
valid_rmse <- sqrt(mean((valid_data$high_booking_rate - valid_predictions)^2))
# Report RMSE for training and validation sets
cat("RMSE on Training Set:", train_rmse, "\n")## RMSE on Training Set: 0.4148109cat("RMSE on Validation Set:", valid_rmse,"\n")## RMSE on Validation Set: 0.4250136- For each model (both the linear and logistic regression models learned in the training data), display the confusion matrix resulting from using a cutoff of 0.5 to do the classifications in the validation data set.
ANSWER TO QUESTION 4c HERE:
cutoff <- 0.5
valid_linear_predictions <- predict(linear_model, newdata = valid_data)
valid_linear_predictions_binary <- ifelse(valid_linear_predictions >= cutoff, 1, 0)
conf_matrix_linear <- table(Actual = valid_data$high_booking_rate, Predicted = valid_linear_predictions_binary)
conf_matrix_linear## Predicted
## Actual 0 1
## 0 1100 5
## 1 373 3valid_logistic_predictions <- predict(logistic_model, newdata = valid_data, type = "response")
valid_logistic_predictions_binary <- ifelse(valid_logistic_predictions >= cutoff, 1, 0)
conf_matrix_logistic <- table(Actual = valid_data$high_booking_rate, Predicted = valid_logistic_predictions_binary)
conf_matrix_logistic## Predicted
## Actual 0 1
## 0 1081 24
## 1 348 28- Report the accuracy, TPR, and FPR using the two confusion matrices in 4c. Which model is the most accurate?
ANSWER TO QUESTION 4d HERE:
calculate_metrics <- function(conf_matrix) {
accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
tpr <- conf_matrix[2, 2] / sum(conf_matrix[2, ])
fpr <- conf_matrix[1, 2] / sum(conf_matrix[1, ])
return(c(Accuracy = accuracy, TPR = tpr, FPR = fpr))
}
metrics_linear <- calculate_metrics(conf_matrix_linear)
cat("Linear Regression Metrics:\n")## Linear Regression Metrics:print(metrics_linear)## Accuracy TPR FPR
## 0.744767049 0.007978723 0.004524887metrics_logistic <- calculate_metrics(conf_matrix_logistic)
cat("\nLogistic Regression Metrics:\n")##
## Logistic Regression Metrics:print(metrics_logistic)## Accuracy TPR FPR
## 0.74881837 0.07446809 0.02171946- For the more accurate model, compute the accuracy, TPR, and FPR using cutoffs of .4 and .6 in the validation data. Which cutoff has the highest accuracy, highest TPR, and highest FPR?
ANSWER TO QUESTION 4e HERE:
cutoffs <- c(0.4, 0.6)
calculate_metrics_cutoff <- function(predictions, actual, cutoff) {
predictions_binary <- ifelse(predictions >= cutoff, 1, 0)
conf_matrix <- table(Actual = actual, Predicted = predictions_binary)
metrics <- calculate_metrics(conf_matrix)
return(c(Cutoff = cutoff, metrics))
}
metrics_linear_04 <- calculate_metrics_cutoff(valid_linear_predictions, valid_data$high_booking_rate, 0.4)
metrics_linear_06 <- calculate_metrics_cutoff(valid_linear_predictions, valid_data$high_booking_rate, 0.6)
cat("Linear Regression Metrics (Cutoff = 0.4):\n")## Linear Regression Metrics (Cutoff = 0.4):print(metrics_linear_04)## Cutoff Accuracy TPR FPR
## 0.40000000 0.74544227 0.21010638 0.07239819cat("\nLinear Regression Metrics (Cutoff = 0.6):\n")##
## Linear Regression Metrics (Cutoff = 0.6):print(metrics_linear_06)## Cutoff Accuracy TPR FPR
## 0.6000000000 0.7461174882 0.0026595745 0.0009049774metrics_logistic_04 <- calculate_metrics_cutoff(valid_logistic_predictions, valid_data$high_booking_rate, 0.4)
metrics_logistic_06 <- calculate_metrics_cutoff(valid_logistic_predictions, valid_data$high_booking_rate, 0.6)
cat("\nLogistic Regression Metrics (Cutoff = 0.4):\n")##
## Logistic Regression Metrics (Cutoff = 0.4):print(metrics_logistic_04)## Cutoff Accuracy TPR FPR
## 0.4000000 0.7359892 0.2659574 0.1040724cat("\nLogistic Regression Metrics (Cutoff = 0.6):\n")##
## Logistic Regression Metrics (Cutoff = 0.6):print(metrics_logistic_06)## Cutoff Accuracy TPR FPR
## 0.6000000000 0.7461174882 0.0026595745 0.0009049774- In your opinion, which cutoff of the three (.4, .5, .6) yields the best results for this application? Explain your reasoning.
ANSWER TO QUESTION 4f HERE: # For both linear regression and logistic regression models, a cutoff of 0.6 yields the highest recall
#A cutoff of 0.6 greatly increases recall over smaller cutoffs, which may be preferred depending on the application even though it compromises precision.
#the default cutoff of 0.5 functions rather well, offering a decent trade-off between recall and precision.
#Among the three cutoffs, a cutoff of 0.4 often produces the least amount of precision.
#A cutoff of 0.6 seems to be the ideal option for this application, taking into account the trade-off between precision and recall. This is because it optimizes the F1 score, giving a good balance between correctly recognizing positive cases (high booking rate) and avoiding false positives.