#NO CHANGES NEEDEDset.seed(1)library(knitr)library(broom)library(ggplot2)library(plyr)library(corrplot)library(caret)library(gridExtra)library(scales)library(Rmisc)library(randomForest)library(psych)library(xgboost)library(rpart)library(rpart.plot)library(randomForest)library(tidyverse)theme_set(theme_minimal())# 1. Disable the broken uv temp stuffSys.setenv(RETICULATE_UV_ENABLED ="0")# 2. Tell reticulate the full path to your real Python 3.13.2reticulate::use_python("C:/Users/casti/AppData/Local/Programs/Python/Python313/python.exe", required =TRUE)# 3. Restart R session inside RStudio#.rs.restartR()library(reticulate)datasets <-import("datasets")# Load the datasetds <- datasets$load_dataset("supersam7/apartment_apps")df <- ds["train"]$to_pandas() # or ds$train$to_pandas() also worksdf <- df[-1]head(df)
Your assistant has provided you with these code templates.
#This function will calculate the log-liklihood based on a Poisson model for the number of applicantsLLfunction <-function(targets, predicted_values){ p_v_zero <-ifelse(predicted_values <=0, 0, predicted_values) p_v_pos <-ifelse(predicted_values <=0, 0.000001 ,predicted_values)return(sum(targets*log(p_v_pos)) -sum(p_v_zero))}print("loglikelihood")LLfunction(test$applicants,predictions)
This code creates a scatter plot, a box plot, and a histogram.
#create a boxplotggplot(df, aes(as.factor(applicants),VARIABLE)) +geom_boxplot()#create a scatterplotggplot(df,aes(applicants,VARIABLE)) +geom_point()#create a histogramggplot(df,aes(VARIABLE)) +geom_histogram()#create a bar plotggplot(df, aes(VARIABLE)) +geom_bar(stat ="count")
Shows the average number of applicants across factor levels.
#Average number of health applicants per unitdf %>%group_by(VARIABLE) %>%summarise(average_num_applicants =sum(applicants*num_units)/sum(num_units) )
Converts variables to numeric or factor while also setting the base reference level to the value which has the most observations.
##Convert to factor and set factor levelsdf <- df %>%mutate(VARIABLE =fct_infreq(as.character(VARIABLE))#Using Base Rdf$VARIABLE =fct_infreq(as.character(df$VARIABLE))#Convert to numericdf <- df %>%mutate(VARIABLE =fct_infreq(as.characterVARIABLE))#Using Base Rdf$VARIABLE =as.numeric(df$VARIABLE)
Task 1 - Examine the target variable and number of units
applicants sale_price num_units year_sold
Min. :0.000 Min. : 34900 Min. :1.000 Min. :2007
1st Qu.:2.000 1st Qu.:129600 1st Qu.:1.000 1st Qu.:2008
Median :4.000 Median :163000 Median :2.000 Median :2009
Mean :3.633 Mean :181069 Mean :2.685 Mean :2009
3rd Qu.:5.000 3rd Qu.:214375 3rd Qu.:4.000 3rd Qu.:2010
Max. :7.000 Max. :755000 Max. :5.000 Max. :2011
month_sold overall_qual total_sq_feet gr_liv_area
Min. : 1.000 Min. : 1.000 Min. : 311 Min. : 261.6
1st Qu.: 5.000 1st Qu.: 5.000 1st Qu.:3193 1st Qu.:2139.6
Median : 6.000 Median : 6.000 Median :3528 Median :2547.0
Mean : 6.329 Mean : 6.082 Mean :3510 Mean :2511.2
3rd Qu.: 8.000 3rd Qu.: 7.000 3rd Qu.:3852 3rd Qu.:2852.3
Max. :12.000 Max. :10.000 Max. :5171 Max. :4273.5
tot_bathrooms lot_area exter_qual full_bath
Min. :1.000 Min. : 465.9 Min. :2.00 Min. :0.000
1st Qu.:3.000 1st Qu.: 3725.6 1st Qu.:3.00 1st Qu.:2.000
Median :3.000 Median : 4138.8 Median :3.00 Median :4.000
Mean :2.952 Mean : 4070.4 Mean :3.39 Mean :3.115
3rd Qu.:3.000 3rd Qu.: 4529.0 3rd Qu.:4.00 3rd Qu.:4.000
Max. :8.000 Max. :10271.5 Max. :5.00 Max. :6.000
central_air garage_type_attchd garage_type_basment garage_type_builtIn
Length:1430 Min. :0.0000 Min. :0.00000 Min. :0.00000
Class :character 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000
Mode :character Median :1.0000 Median :0.00000 Median :0.00000
Mean :0.5888 Mean :0.01329 Mean :0.06084
3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.0000 Max. :1.00000 Max. :1.00000
garage_type_detchd garage_type_no_garage NeighborhoodBrDale
Min. :0.0000 Min. :0.00000 Min. :0.00000
1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.0000 Median :0.00000 Median :0.00000
Mean :0.2699 Mean :0.05664 Mean :0.01119
3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.0000 Max. :1.00000 Max. :1.00000
neighborhood_brk_side neighborhood_clear_cr neighborhood_collg_cr
Min. :0.00000 Min. :0.00000 Min. :0.0000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.0000
Median :0.00000 Median :0.00000 Median :0.0000
Mean :0.04056 Mean :0.01958 Mean :0.1049
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.0000
Max. :1.00000 Max. :1.00000 Max. :1.0000
neighborhood_crawfor neighborhood_edwards neighborhood_gilbert
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.03566 Mean :0.06853 Mean :0.05524
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_idottrr neighborhood_meadowv neighborhood_mitchel
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.02587 Mean :0.01189 Mean :0.03427
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_n_ames neighborhood_n_ridge neighborhood_n_ridge_hghts
Min. :0.0000 Min. :0.00000 Min. :0.00000
1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.0000 Median :0.00000 Median :0.00000
Mean :0.1573 Mean :0.02867 Mean :0.05385
3rd Qu.:0.0000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.0000 Max. :1.00000 Max. :1.00000
neighborhood_n_w_ames neighborhood_old_town neighborhood_sawyer
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.05105 Mean :0.07902 Mean :0.05175
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_sawyer_w neighborhood_somerst neighborhood_stone_br
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.04126 Mean :0.06014 Mean :0.01748
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_swisu neighborhood_timber neighborhood_veenker
Min. :0.00000 Min. :0.00000 Min. :0.000000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.000000
Median :0.00000 Median :0.00000 Median :0.000000
Mean :0.01748 Mean :0.02657 Mean :0.007692
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.000000
Max. :1.00000 Max. :1.00000 Max. :1.000000
neighborhood_saleprice
Min. :101389
1st Qu.:136902
Median :181841
Mean :180909
3rd Qu.:198518
Max. :331835
applicants sale_price num_units year_sold
Min. :0.000 Min. : 34900 Min. :1.000 Min. :2007
1st Qu.:2.000 1st Qu.:129600 1st Qu.:1.000 1st Qu.:2008
Median :4.000 Median :163000 Median :2.000 Median :2009
Mean :3.633 Mean :181069 Mean :2.685 Mean :2009
3rd Qu.:5.000 3rd Qu.:214375 3rd Qu.:4.000 3rd Qu.:2010
Max. :7.000 Max. :755000 Max. :5.000 Max. :2011
month_sold overall_qual total_sq_feet gr_liv_area
Min. : 1.000 Min. : 1.000 Min. : 311 Min. : 261.6
1st Qu.: 5.000 1st Qu.: 5.000 1st Qu.:3193 1st Qu.:2139.6
Median : 6.000 Median : 6.000 Median :3528 Median :2547.0
Mean : 6.329 Mean : 6.082 Mean :3510 Mean :2511.2
3rd Qu.: 8.000 3rd Qu.: 7.000 3rd Qu.:3852 3rd Qu.:2852.3
Max. :12.000 Max. :10.000 Max. :5171 Max. :4273.5
tot_bathrooms lot_area exter_qual full_bath
Min. :1.000 Min. : 465.9 Min. :2.00 Min. :0.000
1st Qu.:3.000 1st Qu.: 3725.6 1st Qu.:3.00 1st Qu.:2.000
Median :3.000 Median : 4138.8 Median :3.00 Median :4.000
Mean :2.952 Mean : 4070.4 Mean :3.39 Mean :3.115
3rd Qu.:3.000 3rd Qu.: 4529.0 3rd Qu.:4.00 3rd Qu.:4.000
Max. :8.000 Max. :10271.5 Max. :5.00 Max. :6.000
central_air garage_type_attchd garage_type_basment garage_type_builtIn
Length:1430 Min. :0.0000 Min. :0.00000 Min. :0.00000
Class :character 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000
Mode :character Median :1.0000 Median :0.00000 Median :0.00000
Mean :0.5888 Mean :0.01329 Mean :0.06084
3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.0000 Max. :1.00000 Max. :1.00000
garage_type_detchd garage_type_no_garage NeighborhoodBrDale
Min. :0.0000 Min. :0.00000 Min. :0.00000
1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.0000 Median :0.00000 Median :0.00000
Mean :0.2699 Mean :0.05664 Mean :0.01119
3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.0000 Max. :1.00000 Max. :1.00000
neighborhood_brk_side neighborhood_clear_cr neighborhood_collg_cr
Min. :0.00000 Min. :0.00000 Min. :0.0000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.0000
Median :0.00000 Median :0.00000 Median :0.0000
Mean :0.04056 Mean :0.01958 Mean :0.1049
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.0000
Max. :1.00000 Max. :1.00000 Max. :1.0000
neighborhood_crawfor neighborhood_edwards neighborhood_gilbert
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.03566 Mean :0.06853 Mean :0.05524
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_idottrr neighborhood_meadowv neighborhood_mitchel
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.02587 Mean :0.01189 Mean :0.03427
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_n_ames neighborhood_n_ridge neighborhood_n_ridge_hghts
Min. :0.0000 Min. :0.00000 Min. :0.00000
1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.0000 Median :0.00000 Median :0.00000
Mean :0.1573 Mean :0.02867 Mean :0.05385
3rd Qu.:0.0000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.0000 Max. :1.00000 Max. :1.00000
neighborhood_n_w_ames neighborhood_old_town neighborhood_sawyer
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.05105 Mean :0.07902 Mean :0.05175
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_sawyer_w neighborhood_somerst neighborhood_stone_br
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.04126 Mean :0.06014 Mean :0.01748
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_swisu neighborhood_timber neighborhood_veenker
Min. :0.00000 Min. :0.00000 Min. :0.000000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.000000
Median :0.00000 Median :0.00000 Median :0.000000
Mean :0.01748 Mean :0.02657 Mean :0.007692
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.000000
Max. :1.00000 Max. :1.00000 Max. :1.000000
neighborhood_saleprice
Min. :101389
1st Qu.:136902
Median :181841
Mean :180909
3rd Qu.:198518
Max. :331835
# ... your plots ...# FIXED: Keep the original columns, just ADD the logged versionsdf <- df %>%mutate(log_rel_price =log(sale_price / neighborhood_saleprice),log_sale_price =log(sale_price)# DO NOT drop sale_price or neighborhood_saleprice here! )
applicants sale_price num_units year_sold
Min. :0.000 Min. : 34900 Min. :1.000 Min. :2007
1st Qu.:2.000 1st Qu.:129600 1st Qu.:1.000 1st Qu.:2008
Median :4.000 Median :163000 Median :2.000 Median :2009
Mean :3.633 Mean :181069 Mean :2.685 Mean :2009
3rd Qu.:5.000 3rd Qu.:214375 3rd Qu.:4.000 3rd Qu.:2010
Max. :7.000 Max. :755000 Max. :5.000 Max. :2011
month_sold overall_qual total_sq_feet gr_liv_area
Min. : 1.000 Min. : 1.000 Min. : 311 Min. : 261.6
1st Qu.: 5.000 1st Qu.: 5.000 1st Qu.:3193 1st Qu.:2139.6
Median : 6.000 Median : 6.000 Median :3528 Median :2547.0
Mean : 6.329 Mean : 6.082 Mean :3510 Mean :2511.2
3rd Qu.: 8.000 3rd Qu.: 7.000 3rd Qu.:3852 3rd Qu.:2852.3
Max. :12.000 Max. :10.000 Max. :5171 Max. :4273.5
tot_bathrooms lot_area exter_qual full_bath central_air
Min. :1.000 Min. : 465.9 Min. :2.00 Min. :0.000 yes:1335
1st Qu.:3.000 1st Qu.: 3725.6 1st Qu.:3.00 1st Qu.:2.000 no : 95
Median :3.000 Median : 4138.8 Median :3.00 Median :4.000
Mean :2.952 Mean : 4070.4 Mean :3.39 Mean :3.115
3rd Qu.:3.000 3rd Qu.: 4529.0 3rd Qu.:4.00 3rd Qu.:4.000
Max. :8.000 Max. :10271.5 Max. :5.00 Max. :6.000
garage_type_attchd garage_type_basment garage_type_builtIn garage_type_detchd
Min. :0.0000 Min. :0.00000 Min. :0.00000 Min. :0.0000
1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.0000
Median :1.0000 Median :0.00000 Median :0.00000 Median :0.0000
Mean :0.5888 Mean :0.01329 Mean :0.06084 Mean :0.2699
3rd Qu.:1.0000 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:1.0000
Max. :1.0000 Max. :1.00000 Max. :1.00000 Max. :1.0000
garage_type_no_garage NeighborhoodBrDale neighborhood_brk_side
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.05664 Mean :0.01119 Mean :0.04056
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_clear_cr neighborhood_collg_cr neighborhood_crawfor
Min. :0.00000 Min. :0.0000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.00000
Median :0.00000 Median :0.0000 Median :0.00000
Mean :0.01958 Mean :0.1049 Mean :0.03566
3rd Qu.:0.00000 3rd Qu.:0.0000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.0000 Max. :1.00000
neighborhood_edwards neighborhood_gilbert neighborhood_idottrr
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.06853 Mean :0.05524 Mean :0.02587
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_meadowv neighborhood_mitchel neighborhood_n_ames
Min. :0.00000 Min. :0.00000 Min. :0.0000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.0000
Median :0.00000 Median :0.00000 Median :0.0000
Mean :0.01189 Mean :0.03427 Mean :0.1573
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.0000
Max. :1.00000 Max. :1.00000 Max. :1.0000
neighborhood_n_ridge neighborhood_n_ridge_hghts neighborhood_n_w_ames
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.02867 Mean :0.05385 Mean :0.05105
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_old_town neighborhood_sawyer neighborhood_sawyer_w
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.07902 Mean :0.05175 Mean :0.04126
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_somerst neighborhood_stone_br neighborhood_swisu
Min. :0.00000 Min. :0.00000 Min. :0.00000
1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.:0.00000
Median :0.00000 Median :0.00000 Median :0.00000
Mean :0.06014 Mean :0.01748 Mean :0.01748
3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.:0.00000
Max. :1.00000 Max. :1.00000 Max. :1.00000
neighborhood_timber neighborhood_veenker neighborhood_saleprice
Min. :0.00000 Min. :0.000000 Min. :101389
1st Qu.:0.00000 1st Qu.:0.000000 1st Qu.:136902
Median :0.00000 Median :0.000000 Median :181841
Mean :0.02657 Mean :0.007692 Mean :180909
3rd Qu.:0.00000 3rd Qu.:0.000000 3rd Qu.:198518
Max. :1.00000 Max. :1.000000 Max. :331835
log_rel_price log_sale_price sale_price_per_sqft bath_pr_sqft
Min. :-1.19109 Min. :10.46 Min. :0.0001087 Min. :0.0002562
1st Qu.:-0.18330 1st Qu.:11.77 1st Qu.:0.0002471 1st Qu.:0.0006980
Median :-0.03704 Median :12.00 Median :0.0002804 Median :0.0008476
Mean :-0.03482 Mean :12.02 Mean :0.0002850 Mean :0.0008319
3rd Qu.: 0.11353 3rd Qu.:12.28 3rd Qu.:0.0003160 3rd Qu.:0.0010070
Max. : 1.33727 Max. :13.53 Max. :0.0009952 Max. :0.0032157
student_apt
Min. :0.0000
1st Qu.:0.0000
Median :0.0000
Mean :0.2455
3rd Qu.:0.0000
Max. :1.0000
#NO CHANGES NEEDED#Calculate the Number of Units for each garage typedf %>% dplyr::select(num_units,contains("garage")) %>%gather(feature,value,-num_units) %>%group_by(feature) %>%summarise(total_units=sum(num_units*value))
#NO CHANGES NEEDED#Calculate the Number of Units for each neighborhooddf %>% dplyr::select(num_units,contains("neighborhood")) %>%gather(feature,value,-num_units) %>%group_by(feature) %>%summarise(total_units=sum(num_units*value))
You do not need to check the neighborhood columns as your assistent has already verified that these are correct for all properties.
Task 5 - Select GLM parameters
No code is provided
Task 6 - Fit a GLM
#NO CHANGES NEEDED#Create training and test setsindex <-createDataPartition(y = df$applicants, p =0.8, list = F)train <- df %>% dplyr::slice(index)
Warning: Slicing with a 1-column matrix was deprecated in dplyr 1.1.0.
test <- df %>% dplyr::slice(-index)train_x <- train[,-1]train_y <- train$applicants#standardize to be between 0 and 1train_number_of_units <- train$num_units/sum(train$num_units)test_x <- test[,-1]test_y <- test$applicants#standardize to be between 0 and 1test_number_of_units <- test$num_units/sum(test$num_units)
#the base (reference) level for neighborhood is the one with the most observations#the base (reference) level for garage is the one with the most observations# Create the log_sale_price variabletrain <- train %>%mutate(log_sale_price =log(sale_price))test <- test %>%mutate(log_sale_price =log(sale_price))#Fit a GLM#Do not use the offset or weight variables as predictors. Remove them from the formula (as the below is doing)#Type ?family into the R console to see options for FAMILYglm <-glm( applicants ~ . +offset(log(num_units)) - neighborhood_n_ames - garage_type_attchd - num_units - log_sale_price, data = train,family =poisson(link ="log"))AIC(glm)
#You can verify that both models return the same predictionsapp_count <-predict(glm, type="response", newdata = test)app_frequency <-predict(glm2, type="response", newdata = test)*test$num_unitshead(app_count)
#THE ONLY CHANGES NEEDED#1. Replace "WEIGHT_VARIABLE" with the weight variable that you used for the GLM#2. In the "lasso_formula" below, use your formula from task 6#3. Use the same FAMILY from task 6. Type ?glmnet into the console to read the possible optionslasso_formula <- applicants ~ . +offset(log(num_units)) - neighborhood_n_ames - garage_type_attchd - num_units - log_sale_price lasso_x_train <-model.matrix(lasso_formula, data = train)lasso_x_test <-model.matrix(lasso_formula, data = test)control <-trainControl(method="cv", number=15)lassoGrid <-expand.grid(alpha =1, lambda =seq(0.0001,0.01,by =0.0005))#Fit a lasso and inspect the variables which have zero coefficients.#Note that the glmnet library only allows the identity link functionlasso <-train(x = lasso_x_train, y = train_y, method ='glmnet', family ="poisson",trControl = control, tuneGrid = lassoGrid) #This code gets the coefficients from the LASSO which are zerolasso_results <-varImp(lasso,scale=F)lasso_coefficients <- lasso_results$importance#Show the coefficients which are zerovariables_with_zeros <-colnames(lasso_x_train)[which(lasso_coefficients$Overall==0)]print("Variables with Coefficients of Zero:")
The following code sets up a decision tree using all the variables in the dataframe. Each tree uses only 20% of the records. The number of units are used as the weights.
#make predictionstree1_pred <-predict(tree1, newdata = test, type ="vector")tree2_pred <-predict(tree2, newdata = test, type ="vector")tree3_pred <-predict(tree3, newdata = test, type ="vector")tree4_pred <-predict(tree4, newdata = test, type ="vector")tree5_pred <-predict(tree5, newdata = test, type ="vector")tree6_pred <-predict(tree6, newdata = test, type ="vector")tree7_pred <-predict(tree7, newdata = test, type ="vector")tree8_pred <-predict(tree8, newdata = test, type ="vector")#UPDATE THIS FORMULA TO PERFORM BAGGINGtrees_pred <- (tree1_pred + tree2_pred + tree3_pred+ tree4_pred+ tree5_pred+ tree6_pred+ tree7_pred+ tree8_pred)/8LLfunction <-function(targets, predicted_values){ p_v_zero <-ifelse(predicted_values <=0, 0, predicted_values) p_v_pos <-ifelse(predicted_values <=0, 0.000001 ,predicted_values)return(sum(targets*log(p_v_pos)) -sum(p_v_zero))}# "targets" is a vector containing the actual values for the target variable# "predicted_values" is a vector containing the predicted values for the target variableLLfunction(test$applicants, trees_pred)
[1] 343.9751
LLfunction(test$applicants, tree1_pred)
[1] 264.3733
Task 10 - Measure the variable importance with a Random Forest
#This function will calculate the log-liklihood based on a Poisson model for the number of applicantsLLfunction <-function(targets, predicted_values){ p_v_zero <-ifelse(predicted_values <=0, 0, predicted_values) p_v_pos <-ifelse(predicted_values <=0, 0.000001, predicted_values)return(sum(targets*log(p_v_pos)) -sum(p_v_zero))}print("loglikelihood")