{"metadata":{"kernelspec":{"name":"ir","display_name":"R","language":"R"},"language_info":{"name":"R","codemirror_mode":"r","pygments_lexer":"r","mimetype":"text/x-r-source","file_extension":".r","version":"4.0.5"}},"nbformat_minor":4,"nbformat":4,"cells":[{"cell_type":"markdown","source":"# Introduction : \nThe problem we are interested in is to predict the house price in a more efficient and accurate way. In this notebook, I will try to adopt the **regression** and the more advanced **gradient boosting** method to find out the better way for solving this problem. Also, I will share some of my thoughts about features engineering and data pre-processing. I hope you may enjoy reading this notebook.","metadata":{}},{"cell_type":"code","source":"library(tidyverse)\nlibrary(rsample)\nlibrary(Metrics)\nlibrary(imputeMissings)\nlibrary(gbm)\nlibrary(ggcorrplot)\nlibrary(glmnet)\nlibrary(caret)\nlibrary(xgboost)\nlibrary(MASS)\nlibrary(car)\nlibrary(lightgbm)\n","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:32.507388Z","iopub.execute_input":"2022-07-12T18:00:32.534323Z","iopub.status.idle":"2022-07-12T18:00:32.559355Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"data <- read.table(\"../input/house-prices-advanced-regression-techniques/train.csv\", na.strings=c(\"\", \"NA\"), sep=\",\", header = TRUE)","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:32.561203Z","iopub.execute_input":"2022-07-12T18:00:32.562301Z","iopub.status.idle":"2022-07-12T18:00:32.629303Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"# 1) Data Pre-processing & Cleaning","metadata":{}},{"cell_type":"markdown","source":"Some of the features use NA to represent none, which will be improperly imputed and the level None of those catagorical factor disappears, so we need to **convert those NA value to a meaning None character**. Then, some features use number to represent different levels, so we need to **convert those fake numeric features to factor** to avoid confusion. After that, we could start **feature engineering** by summing the living area, counting number of bathroom, calculating the sale time of each houses, etc. These are features enginnering ideas are coming from my mind and the notebook I have read. Feel free to share your thought about engineering the featurs. Then, we can **filter out the meaningless and the engineered features** because we do not need them anymore. For instance, the features with over 10 levels are filtered out because they are too complicated and may not be helpful for predicting the Saleprice. Finally, I **impute all the missing value with either mean or mode and scaled all the numeric features for regression.**","metadata":{}},{"cell_type":"code","source":"# Obtain the features with NA that is meaningful and replace their NA with None\nNA_replace_data <- data[c(\"Alley\",\"BsmtQual\",\"BsmtCond\",\"BsmtExposure\",\"BsmtFinType1\",\n                \"BsmtFinType2\",\"FireplaceQu\",\"GarageQual\",\"GarageCond\",\n                \"GarageType\",\"GarageFinish\",\"PoolQC\", \"Fence\",\"MiscFeature\")]\nNA_replace_data[is.na(NA_replace_data )] <- \"None\"\n\n#Convert the catagorical features that were represented in numbers \ncata_replace_features <- c(\"OverallQual\",\"BedroomAbvGr\",\n                           \"KitchenAbvGr\",\"Fireplaces\",\n                           \"MSSubClass\",\"GarageCars\",\"Neighborhood\")\ndata[cata_replace_features] <- lapply(data[cata_replace_features], factor)\n\n#Assign variable of interest for further use \nPrice = data$SalePrice\n\n#Feature Engineering\ndata <- data%>%\n  mutate(Time_to_sold = (YrSold - YearBuilt),\n         Total_Living_Area = ( X1stFlrSF + X2ndFlrSF + \n                                TotalBsmtSF),\n         Total_Bathroom = factor(BsmtFullBath + (BsmtHalfBath/2)+\n           FullBath + (HalfBath/2)),\n         Yard_Area = OpenPorchSF + X3SsnPorch + EnclosedPorch + ScreenPorch +\n           WoodDeckSF)%>%\n#Filter out meaningless features and catagorical features with more than 10 levels\n\n  select_if(~nlevels(.) <= 10)%>%\n  dplyr::select(-c(YrSold, YearBuilt,GarageYrBlt,MoSold,Id,\n                   YearRemodAdd,SaleType,SaleCondition,Street,Utilities,\n                   SalePrice,colnames(NA_replace_data),HalfBath,FullBath,\n                   TotalBsmtSF,X2ndFlrSF,X1stFlrSF,OpenPorchSF,X3SsnPorch,\n                   EnclosedPorch,ScreenPorch,WoodDeckSF\n                    ))%>%\n#Attach the transformed NA data set \n  cbind(NA_replace_data)%>%\n#Convert all character type data to factor\n  mutate_if(is.character, factor)%>%\n#Data imputation\n  impute()\n\n#Scale all numeric data\nnumeric_scaled <- scale(select_if(data, is.numeric))\ncata <- select_if(data, is.factor)\ndata <- data.frame(numeric_scaled,cata,Price)\n","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:32.631242Z","iopub.execute_input":"2022-07-12T18:00:32.632357Z","iopub.status.idle":"2022-07-12T18:00:32.861463Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"# 2) Explore the data by Visualization","metadata":{}},{"cell_type":"code","source":"#Plot a density of price \nno_transform <- ggplot(data, aes(x = (Price)))+\n  geom_histogram(binwidth = 10000,fill = 'orange')+\n  labs(title = \"Price Distribution\")+\n  xlab(\"SalePrice\")+\n  ylab(\"Frequency\")+\n  theme(plot.title = element_text(hjust = 0.5))\n#Plot a density of log transformed price \ntransformed <- ggplot(data, aes(x = (log(Price+1))))+\n  geom_histogram(binwidth = 0.05,fill = 'orange')+\n  labs(title = \"Price Distribution\")+\n  xlab(\"Scaled SalePrice\")+\n  ylab(\"Frequency\")+\n  theme(plot.title = element_text(hjust = 0.5))\n#Combine two plots and compare the difference \ngridExtra::grid.arrange(no_transform,transformed,ncol=2)\n\n","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:32.863284Z","iopub.execute_input":"2022-07-12T18:00:32.864375Z","iopub.status.idle":"2022-07-12T18:00:33.514101Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"The plot shows the density of the **original price and a log-transformed price**. Since a skewed dependent variable violates the assumption of any regression analysis, we will need to log-transform the Saleprice","metadata":{}},{"cell_type":"code","source":"# Plot a correlation plot to check collinearity \ncorrelation <- cor(numeric_scaled)\nggcorrplot(correlation,   hc.order = TRUE, type = \"lower\", sig.level = 0.05, insig = \"blank\")\ndata <- data%>%\n  dplyr::select(-c(GarageArea,TotRmsAbvGrd,BsmtFinType1,BsmtFullBath,GrLivArea))\n\nnumeric_scaled <- select_if(data, is.numeric)\ncorrelation <- cor(numeric_scaled)\nggcorrplot(correlation,hc.order = TRUE, type = \"lower\", sig.level = 0.05, insig = \"blank\")","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:33.515964Z","iopub.execute_input":"2022-07-12T18:00:33.517112Z","iopub.status.idle":"2022-07-12T18:00:34.004097Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"**To avoid collinearity**, we plot a **correlation matrix** for the numeric features and filter out the strongly correlated independent variables. Besides, we discover the **Total Living Area has a strong correlation with the SalePrice**, so we should pay extra attention on this feature as it may help us to predict the Saleprice and **discover leverage point or outliers**. \n\nBefore plotting a scatter plot between Saleprice and Living Area, I **plot a boxplot of Overall Quality v.s Saleprice** to see if they are strongly correlated. If so, the Overall Quality catagorical factor may also help us discover **outliers**. \n\n","metadata":{}},{"cell_type":"code","source":"#Plot boxplots of Quality v.s Price \nggplot(data = data, aes( x = (log(Price)), y = OverallQual, fill = OverallQual))+\n  labs(title = \"GGplot by Quality\")+\n  geom_boxplot()+\n  labs(title = \"QQ-plot with outliers\")+\n  xlab(\"Scaled SalePrice\")\n\n#Find out the outliers from the boxplots and filter them out\noutliers <- boxplot(log(Price+1)~data$OverallQual, plot = F)$out\noutliers_pos <- which(log(Price+1) %in% outliers)\ndata <- data[-outliers_pos,]\nPrice <- Price[-outliers_pos]\n\n\n\n","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:34.005975Z","iopub.execute_input":"2022-07-12T18:00:34.007095Z","iopub.status.idle":"2022-07-12T18:00:34.559442Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"It turns out the Overall Quality has a **moderately strong correlation** between with Saleprice. The **medium of Saleprice increaes as the quality rating increaes**. Therefore, we can use the feature to **filter out the outliers**.","metadata":{}},{"cell_type":"code","source":"#Plot the same boxplots without outliers\nggplot(data = data, aes( x = (log(Price+1)), y = OverallQual, fill = OverallQual))+\n  labs(title = \"QQ-plot without outliers\")+\n  geom_boxplot()+\n  xlab(\"Scaled SalePrice\")\n\ndata <- data%>%\n    mutate(Price = Price)","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:34.561275Z","iopub.execute_input":"2022-07-12T18:00:34.562358Z","iopub.status.idle":"2022-07-12T18:00:35.021700Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Now, the boxplot looks **cleaner** with less outliers, and then we can plot a scatter plot between Saleprice and the Living Area.","metadata":{}},{"cell_type":"code","source":"#Plot the scatter plot of Price v.s Living Area in ft^2\nggplot(data, aes( x = Price, y = Total_Living_Area))+\n  labs(title = \"Saleprice v.s Living Area\")+\n  geom_point(aes(color = OverallQual))+\n  xlab(\"SalePrice\")\n\n","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:35.023674Z","iopub.execute_input":"2022-07-12T18:00:35.024849Z","iopub.status.idle":"2022-07-12T18:00:35.444519Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"The scatter plot **shows some variance, but the trend is obvious**. I belive most of the point falls within the trend, so there is no need to further filter out any data point. Out of curiorsity, I also plot a scatter plot between Saleprice and the outdoor area.","metadata":{}},{"cell_type":"code","source":"#Plot the scatter plot of Price v.s Outddor Area\nggplot(data, aes( x = Price, y = Yard_Area))+\n  labs(title = \"Saleprice v.s Outddor Area\")+\n  geom_point(aes(color = OverallQual))+\n  xlab(\"SalePrice\")","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:35.446384Z","iopub.execute_input":"2022-07-12T18:00:35.447496Z","iopub.status.idle":"2022-07-12T18:00:35.870448Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"Obviosuly, the **outdoor space may not help us a lot** because there is hardly any correlation between them. ","metadata":{}},{"cell_type":"markdown","source":"# 3) Model Selection by Cross Validation \n# Step-wise regression model","metadata":{}},{"cell_type":"markdown","source":"I use step-wise regression for **features selection** since there are too many features in this data set. ","metadata":{}},{"cell_type":"code","source":"# Try a step-wise regression\nmodel <- lm((log(Price+1)) ~ . , data = data)\nbase_model <- lm((log(Price+1)) ~ 1, data = data)\nstep = stepAIC(base_model,direction = \"forward\", scope=list(lower=base_model,upper=formula(model)),trace = F)\npar(mfrow=c(2,2))\nplot(step)\nstep_error <- sqrt(mean(step$residuals^2))","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:35.872805Z","iopub.execute_input":"2022-07-12T18:00:35.874136Z","iopub.status.idle":"2022-07-12T18:00:43.078554Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"However, the assumption check plot produced from the step-wise regression does not allow us to use regression for this problem because the two tails of qq-plot are off the fitted line. I still try ridge regression on this problem just for fun","metadata":{}},{"cell_type":"markdown","source":"# Ridge regression model","metadata":{}},{"cell_type":"code","source":"# Split the data into training and testing data\ndata_split <- initial_split(data,0.7)\ntraining <- training(data_split)\ntesting <- testing(data_split)\nx_testing <- testing%>%\n  dplyr::select(-c(Price))\ny_training <- training$Price\ny_testing <- testing$Price","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:43.080475Z","iopub.execute_input":"2022-07-12T18:00:43.081598Z","iopub.status.idle":"2022-07-12T18:00:43.110738Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"#One-hot code the training data\ncata_factor_train <- training%>%\n  select_if(is.factor)\ndummy <- dummyVars(\"~.\", data = cata_factor_train)\n\n#Conver the catagorical training data to matrix\ncata_matrix_train <- data.matrix(predict(dummy,newdata = cata_factor_train))\n\n#Convert the numeric training data to matrix \nnum_matrix_train <- training[,-1]%>%\n  select_if(is.numeric)%>%\n  as.matrix()\n\n#combine those two matrix and form a train matrix \ntrain_matrix <- data.matrix(cata_matrix_train,num_matrix_train)\n\n#Conduct the same process for testing data\ncata_factor_test <- testing%>%\n  select_if(is.factor)\ndummy <- dummyVars(\"~.\", data = cata_factor_test)\ncata_matrix <- data.matrix(predict(dummy,newdata = cata_factor_test))\n\nnum_matrix_test <- testing[,-1]%>%\n  select_if(is.numeric)%>%\n  as.matrix()\n\ntest_matrix <- data.matrix(cata_matrix,num_matrix_test)\n","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:43.112596Z","iopub.execute_input":"2022-07-12T18:00:43.113706Z","iopub.status.idle":"2022-07-12T18:00:43.291774Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"# Pre-set a range of lambdas for cross validation and parameter tuning \nlambdas <- 10^seq(2, -3, by = -.1)\ncv_ridge <- cv.glmnet(train_matrix, log(y_training+1), alpha = 0, lambda = lambdas)\n\n#assign the best lambdas to optimal \noptiaml <- min(cv_ridge$lambda)\n\n#fit a ridge regression using the optmal lambda\nridge_reg = glmnet(train_matrix, log(y_training+1), nlambda = ncol(train_matrix), alpha = 0, family = 'gaussian', lambda = optiaml)\n\n#Calculate the root mse for ridge regression\npredicted <- predict(ridge_reg,s = optiaml, test_matrix)\nactual <- log(y_testing+1)\nridge_error <- rmse(actual,predicted)","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:43.293644Z","iopub.execute_input":"2022-07-12T18:00:43.294712Z","iopub.status.idle":"2022-07-12T18:00:44.381269Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"**Let us try the more advanced algorithm - gradient boosting**. There are different type of gradient boosting, like extreme gradient boost and light gradient boost, and I would like to compare their performance and speed. First of all, we try to use the ordinary gradient boosting. Since there are many parameter to tune for such algorithm. We use the train() function to **train the model with different parameter by cross-validation . Then, we can use the best performance parameter for the ordinary gradient boosting, xtreme gradient boosting and the light gradient boosting later.**","metadata":{}},{"cell_type":"markdown","source":"\n# Gradient boost","metadata":{}},{"cell_type":"code","source":"options(warn = -1)\n# Set a table of parameter for tuning\ngbm_grid <- expand.grid(\n  n.trees = 1000,\n  interaction.depth = c(3, 5, 7),\n  shrinkage = c(.01,0.1,0.3),\n  n.minobsinnode = 10\n)\n\n#Set the cross validation \ngbm_ctrl <- trainControl(method = \"cv\", number = 5, search = \"grid\")\n\n#Use train() to evaluate the performance of each parameter using cross-validation\ngbm.fit <- train(Price ~ . , method = \"gbm\", distribution = \"gaussian\", \n                 data = data, trControl = gbm_ctrl,\n                 tuneGrid = gbm_grid,\n                 metric=\"RMSE\",\n                 verbose = F)\n\n\n\n","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:00:44.383095Z","iopub.execute_input":"2022-07-12T18:00:44.384182Z","iopub.status.idle":"2022-07-12T18:08:33.314992Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"#Present the parameter with best performance\ngbm.fit$bestTune\n\n# Fit gbm with the best parameter\ngbm_model <- gbm( Price ~., \n                  distribution = \"gaussian\",\n                  data = data,\n                  n.trees = 1000,\n                  shrinkage = 0.01,\n                  interaction.depth = 7,\n                  n.minobsinnode = 10,\n                  verbose = F,\n                  n.cores = NULL,\n                  cv = 5\n                  )\n\n#The error of gradient boost\ngb_error <- sqrt(min(gbm_model$cv.error))\n\n#Plot the performance graph\ngbm.perf(gbm_model, method = 'cv')\n\n#Plot the relative importance graph \nsummary(gbm_model,\n         cBars = 10,\n        method = relative.influence,\n        las = 2)","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:08:33.317782Z","iopub.execute_input":"2022-07-12T18:08:33.319428Z","iopub.status.idle":"2022-07-12T18:09:00.586848Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"I also plot a **relative importance plot** to show the relative importance of each features.","metadata":{}},{"cell_type":"markdown","source":"# Xtreme Gradient Boost","metadata":{}},{"cell_type":"markdown","source":"**Before adopting the xtreme gradient boost, we will need to change the data set to matrix, and use it to create a DMatrix object for xtreme gradient boost alogrithm.**","metadata":{}},{"cell_type":"code","source":"#Combine the two matrix into one and create a Xgb.Dmatrix object\ndata_matrix <- data.matrix(data)\nxgb_data_matrix <- xgb.DMatrix(data = data_matrix,label = Price)\n","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:09:00.588793Z","iopub.execute_input":"2022-07-12T18:09:00.589869Z","iopub.status.idle":"2022-07-12T18:09:00.614924Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"parm = list(booster = \"gbtree\", \n            objective = \"reg:squarederror\",\n            eta = 0.01, \n            gamma = 0,\n            max_depth = 3, \n            min_child_weight = 10, \n            subsample = 0.78, \n            colsample_bytree = 0.8,\n            n_estimators = 1000)\n\nxgbcv <- xgb.cv(params = parm, data = xgb_data_matrix, \n                nfold = 5, nrounds = 1000,\n                showsd = T, maximize = F, print_every_n = 100,\n                early_stopping_rounds = 500, metrics = list(\"rmse\"))\n\nxgb_error <- min(xgbcv$evaluation_log$test_rmse_mean)","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:09:00.617182Z","iopub.execute_input":"2022-07-12T18:09:00.618488Z","iopub.status.idle":"2022-07-12T18:09:05.493947Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"**The time taken for cross validation in xgb is noticably less than the ordinary gradient boost alogrithm**","metadata":{}},{"cell_type":"markdown","source":"**Before adopting the light gradient boost, we will need to change the data set to matrix, and use it to create a lgb.dataset object for light gradient boost alogrithm.**","metadata":{}},{"cell_type":"markdown","source":"# Light Gradient Boost","metadata":{}},{"cell_type":"code","source":"lgb_train_matrix <- lgb.Dataset(data_matrix, label = Price)\n\nlgb_param <- list(boosting = \"gbdt\",\n                  objective = \"regression\",\n                  learning_rate = 0.01,\n                  num_iterations = 1000,\n                  early_stopping_round = 500,\n                  max_depth = 7,\n                  num_leaves = 80,\n                  min_data_in_leaf = 10,\n                  min_gain_to_split = 10,\n                  bagging_fraction = 0.8,\n                  feature_fraction = 0.8)\n\nlgbcv <- lgb.cv(data = lgb_train_matrix,\n                        label = Price,\n                        params = lgb_param,\n                        nfold = 5L,\n                        metric = \"rmse\",\n                        verbose = 0\n  )\n\nlgb_error <- lgbcv$best_score","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:09:05.496581Z","iopub.execute_input":"2022-07-12T18:09:05.497786Z","iopub.status.idle":"2022-07-12T18:09:10.897624Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"**The time taken for cross validation in light gradient boost is also noticably less than the ordinary gradient boost alogrithm**","metadata":{}},{"cell_type":"markdown","source":"# 4) Model Selection ","metadata":{}},{"cell_type":"code","source":"Mse_performance <- data.frame(Method = c(\"GBM\",\n                                         \"Xtreme Gradient Boost\",\n                                         \"Light Gradient Boost\")\n                              \n                              ,RMSE = c(gb_error,xgb_error,lgb_error))\nggplot( data = Mse_performance, aes( x = Method, y = RMSE)) +\n  geom_bar(stat = \"identity\", fill=\"orange\", width = .4)+\n  labs(title = \"Performance of different MLs alogrithms\")+\n  theme(plot.title = element_text(hjust = 0.5))","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:09:10.900399Z","iopub.execute_input":"2022-07-12T18:09:10.901762Z","iopub.status.idle":"2022-07-12T18:09:11.082587Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"**Visualize the performance** of each gradient boost method. **It is obvious that the light gradient boost and xtreme gradient boost won on accuracy as well as time used.**","metadata":{}},{"cell_type":"code","source":"test <- read.table(\"../input/house-prices-advanced-regression-techniques/test.csv\", na.strings=c(\"\", \"NA\"), sep=\",\", header = TRUE)\nId <- test$Id\n\n# Obtain the features with NA that is meaningful and replace their NA with None\nNA_replace_data <- test[c(\"Alley\",\"BsmtQual\",\"BsmtCond\",\"BsmtExposure\",\"BsmtFinType1\",\n                \"BsmtFinType2\",\"FireplaceQu\",\"GarageQual\",\"GarageCond\",\n                \"GarageType\",\"GarageFinish\",\"PoolQC\", \"Fence\",\"MiscFeature\")]\nNA_replace_data[is.na(NA_replace_data )] <- \"None\"\n\n#Convert the catagorical features that were represented in numbers \ntest[cata_replace_features] <- lapply(test[cata_replace_features], factor)\n\n#Assign variable of interest for further use \nPrice = test$SalePrice\n\n#Filter out meaningless features and catagorical features with more than 10 levels\ntest <- test%>%\n  mutate(Time_to_sold = (YrSold - YearBuilt),\n         Total_Living_Area = ( X1stFlrSF + X2ndFlrSF + \n                                TotalBsmtSF),\n         Total_Bathroom = factor(BsmtFullBath + (BsmtHalfBath/2)+\n           FullBath + (HalfBath/2)),\n         Yard_Area = OpenPorchSF + X3SsnPorch + EnclosedPorch + ScreenPorch +\n           WoodDeckSF)%>%\n  select_if(~nlevels(.) <= 10)%>%\n  dplyr::select(-c(YrSold, YearBuilt,GarageYrBlt,MoSold,Id,\n                   YearRemodAdd,SaleType,SaleCondition,Street,Utilities\n                  ,colnames(NA_replace_data),HalfBath,FullBath,\n                   TotalBsmtSF,X2ndFlrSF,X1stFlrSF,OpenPorchSF,X3SsnPorch,\n                   EnclosedPorch,ScreenPorch,WoodDeckSF,GarageArea,TotRmsAbvGrd,\n                   BsmtFinType1,BsmtFullBath,GrLivArea\n                    ))%>%\n#Attach the transformed NA data set \n  cbind(NA_replace_data)%>%\n#Convert all character type data to factor\n  mutate_if(is.character, factor)%>%\n#Data imputation\n  impute()\n\n#Scale all numeric data\nnumeric_scaled <- as.matrix(scale(select_if(test, is.numeric)))\n\n#One-hot code all catagorical data\ncata <- select_if(test, is.factor)\n\n#Combine the two matrix into one and create a Xgb.Dmatrix object\ntest <- cbind(numeric_scaled,cata)\n\ntest <- data.matrix(test)","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:09:11.085424Z","iopub.execute_input":"2022-07-12T18:09:11.086832Z","iopub.status.idle":"2022-07-12T18:09:11.356645Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"# 5) Prediction","metadata":{}},{"cell_type":"code","source":"options(warn = -1)\nparm = list(booster = \"gbtree\", \n            objective = \"reg:squarederror\",\n            eta = 0.01, \n            gamma = 0.9,\n            max_depth = 7, \n            min_child_weight = 1, \n            subsample = 0.5, \n            colsample_bytree = 0.3,\n            n_estimators = 1000)\n\nxgb_model <- xgboost(params = parm, data = xgb_data_matrix, \n                nfold = 5, nrounds = xgbcv$best_iteration,\n                showsd = T, maximize = F, print_every_n = 10,verbose = F,\n                early_stopping_rounds = 50, metrics = list(\"rmse\"))\n\nSalePrice <- predict(xgb_model,newdata = test_Dmatrix)\n\nresult <- data.frame(Id,SalePrice)\n\nwrite_csv(result, \"house_price.csv\")","metadata":{"execution":{"iopub.status.busy":"2022-07-12T18:42:25.139535Z","iopub.execute_input":"2022-07-12T18:42:25.140817Z","iopub.status.idle":"2022-07-12T18:42:26.196392Z"},"trusted":true},"execution_count":null,"outputs":[]}]}