7004 Group Assignment (To be six)
Project Background
Electric vehicle technology is being upgraded, and infrastructure for charging is improving. Emerging electric vehicle manufacturers (such as Tesla) and traditional automobile manufacturers have further accelerated this transformation in the investment in electrification strategies. According to LLOPIS-Albert, Rubio and Valero (2021), many countries have proposed policies to encourage electric vehicles, including subsidies, tax incentives and regulations to restrict the use of fuel vehicles. Pressure (xue et al., 2021). However, due to differences in consumer preferences, charging anxiety caused by imperfect charging facilities, and the superiority of traditional fuel vehicles in long-distance driving, traditional fuel vehicles still have an irreplaceable position in the automobile market. Facing the rise of new energy vehicles, producers and managers are required to use more reasonable methods to respond to market changes, formulate more reasonable production and sales plans to respond to market demand, and accurately predict sales volume, which is very important to producers and managers. Automobile sales forecast can help auto manufacturers and auto dealers form a good inventory management system and formulate sales plans that meet the forecast according to car sales to better cope with market challenges.
Project objective
Based on the background and problem statement, combined with available data resources, this project proposes the following progressive project goals:
a. To identify temporal trends, regional differences, and demographic characteristics in automobile sales.
b. To establish a car sales and price forecasting model
c. To evaluate the performance of different machine learning methods on car sales prediction
Data pre-processing
import data
Import the data from csv file and use head() function to see the example data.
car_sales <- read.csv("Car Sales.xlsx - car_data.csv")
head(car_sales)## Car_id Date Customer.Name Gender Annual.Income
## 1 C_CND_000001 1/2/2022 Geraldine Male 13500
## 2 C_CND_000002 1/2/2022 Gia Male 1480000
## 3 C_CND_000003 1/2/2022 Gianna Male 1035000
## 4 C_CND_000004 1/2/2022 Giselle Male 13500
## 5 C_CND_000005 1/2/2022 Grace Male 1465000
## 6 C_CND_000006 1/2/2022 Guadalupe Male 850000
## Dealer_Name Company Model
## 1 Buddy Storbeck's Diesel Service Inc Ford Expedition
## 2 C & M Motors Inc Dodge Durango
## 3 Capitol KIA Cadillac Eldorado
## 4 Chrysler of Tri-Cities Toyota Celica
## 5 Chrysler Plymouth Acura TL
## 6 Classic Chevy Mitsubishi Diamante
## Engine Transmission Color Price.... Dealer_No
## 1 Double????Overhead Camshaft Auto Black 26000 06457-3834
## 2 Double????Overhead Camshaft Auto Black 19000 60504-7114
## 3 Overhead Camshaft Manual Red 31500 38701-8047
## 4 Overhead Camshaft Manual Pale White 14000 99301-3882
## 5 Double????Overhead Camshaft Auto Red 24500 53546-9427
## 6 Overhead Camshaft Manual Pale White 12000 85257-3102
## Body.Style Phone Dealer_Region
## 1 SUV 8264678 Middletown
## 2 SUV 6848189 Aurora
## 3 Passenger 7298798 Greenville
## 4 SUV 6257557 Pasco
## 5 Hatchback 7081483 Janesville
## 6 Hatchback 7315216 ScottsdaleData understanding
str(car_sales)## 'data.frame': 23906 obs. of 16 variables:
## $ Car_id : chr "C_CND_000001" "C_CND_000002" "C_CND_000003" "C_CND_000004" ...
## $ Date : chr "1/2/2022" "1/2/2022" "1/2/2022" "1/2/2022" ...
## $ Customer.Name: chr "Geraldine" "Gia" "Gianna" "Giselle" ...
## $ Gender : chr "Male" "Male" "Male" "Male" ...
## $ Annual.Income: int 13500 1480000 1035000 13500 1465000 850000 1600000 13500 815000 13500 ...
## $ Dealer_Name : chr "Buddy Storbeck's Diesel Service Inc" "C & M Motors Inc" "Capitol KIA" "Chrysler of Tri-Cities" ...
## $ Company : chr "Ford" "Dodge" "Cadillac" "Toyota" ...
## $ Model : chr "Expedition" "Durango" "Eldorado" "Celica" ...
## $ Engine : chr "Double????Overhead Camshaft" "Double????Overhead Camshaft" "Overhead Camshaft" "Overhead Camshaft" ...
## $ Transmission : chr "Auto" "Auto" "Manual" "Manual" ...
## $ Color : chr "Black" "Black" "Red" "Pale White" ...
## $ Price.... : int 26000 19000 31500 14000 24500 12000 14000 42000 82000 15000 ...
## $ Dealer_No : chr "06457-3834" "60504-7114" "38701-8047" "99301-3882" ...
## $ Body.Style : chr "SUV" "SUV" "Passenger" "SUV" ...
## $ Phone : int 8264678 6848189 7298798 6257557 7081483 7315216 7727879 6206512 7194857 7836892 ...
## $ Dealer_Region: chr "Middletown" "Aurora" "Greenville" "Pasco" ...summary(car_sales)## Car_id Date Customer.Name Gender
## Length:23906 Length:23906 Length:23906 Length:23906
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## Annual.Income Dealer_Name Company Model
## Min. : 10080 Length:23906 Length:23906 Length:23906
## 1st Qu.: 386000 Class :character Class :character Class :character
## Median : 735000 Mode :character Mode :character Mode :character
## Mean : 830840
## 3rd Qu.: 1175750
## Max. :11200000
## Engine Transmission Color Price....
## Length:23906 Length:23906 Length:23906 Min. : 1200
## Class :character Class :character Class :character 1st Qu.:18001
## Mode :character Mode :character Mode :character Median :23000
## Mean :28090
## 3rd Qu.:34000
## Max. :85800
## Dealer_No Body.Style Phone Dealer_Region
## Length:23906 Length:23906 Min. :6000101 Length:23906
## Class :character Class :character 1st Qu.:6746495 Class :character
## Mode :character Mode :character Median :7496198 Mode :character
## Mean :7497741
## 3rd Qu.:8248146
## Max. :8999579library(dplyr)##
## 载入程辑包：'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionglimpse(car_sales)## Rows: 23,906
## Columns: 16
## $ Car_id <chr> "C_CND_000001", "C_CND_000002", "C_CND_000003", "C_CND_0…
## $ Date <chr> "1/2/2022", "1/2/2022", "1/2/2022", "1/2/2022", "1/2/202…
## $ Customer.Name <chr> "Geraldine", "Gia", "Gianna", "Giselle", "Grace", "Guada…
## $ Gender <chr> "Male", "Male", "Male", "Male", "Male", "Male", "Male", …
## $ Annual.Income <int> 13500, 1480000, 1035000, 13500, 1465000, 850000, 1600000…
## $ Dealer_Name <chr> "Buddy Storbeck's Diesel Service Inc", "C & M Motors Inc…
## $ Company <chr> "Ford", "Dodge", "Cadillac", "Toyota", "Acura", "Mitsubi…
## $ Model <chr> "Expedition", "Durango", "Eldorado", "Celica", "TL", "Di…
## $ Engine <chr> "Double????Overhead Camshaft", "Double????Overhead Camsh…
## $ Transmission <chr> "Auto", "Auto", "Manual", "Manual", "Auto", "Manual", "M…
## $ Color <chr> "Black", "Black", "Red", "Pale White", "Red", "Pale Whit…
## $ Price.... <int> 26000, 19000, 31500, 14000, 24500, 12000, 14000, 42000, …
## $ Dealer_No <chr> "06457-3834", "60504-7114", "38701-8047", "99301-3882", …
## $ Body.Style <chr> "SUV", "SUV", "Passenger", "SUV", "Hatchback", "Hatchbac…
## $ Phone <int> 8264678, 6848189, 7298798, 6257557, 7081483, 7315216, 77…
## $ Dealer_Region <chr> "Middletown", "Aurora", "Greenville", "Pasco", "Janesvil…Data cleaning
Check the data set whether contain the NA/null/““/None value
a<-names(car_sales)
for(i in a){
print(paste(i,sum(car_sales[i] == "" | is.na(car_sales[i]) | is.null(car_sales[i]) | car_sales[i] == "None",which(car_sales[i]=="" | is.na(car_sales[i]) | is.null(car_sales[i])| car_sales[i] == "None"))))
}## [1] "Car_id 0"
## [1] "Date 0"
## [1] "Customer.Name 7566"
## [1] "Gender 0"
## [1] "Annual.Income 0"
## [1] "Dealer_Name 0"
## [1] "Company 0"
## [1] "Model 0"
## [1] "Engine 0"
## [1] "Transmission 0"
## [1] "Color 0"
## [1] "Price.... 0"
## [1] "Dealer_No 0"
## [1] "Body.Style 0"
## [1] "Phone 0"
## [1] "Dealer_Region 0"Replace the ““/None value with NA
for(i in a){
print(paste(i,sum(car_sales[i] == "" | is.na(car_sales[i]) | is.null(car_sales[i]) | car_sales[i] == "None",which(car_sales[i]=="" | is.na(car_sales[i]) | is.null(car_sales[i])| car_sales[i] == "None"))))
car_sales[!is.na(car_sales[i]) & car_sales[i] == "",i]<-NA
car_sales[!is.na(car_sales[i]) & car_sales[i] == "None",i]<-NA
}## [1] "Car_id 0"
## [1] "Date 0"
## [1] "Customer.Name 7566"
## [1] "Gender 0"
## [1] "Annual.Income 0"
## [1] "Dealer_Name 0"
## [1] "Company 0"
## [1] "Model 0"
## [1] "Engine 0"
## [1] "Transmission 0"
## [1] "Color 0"
## [1] "Price.... 0"
## [1] "Dealer_No 0"
## [1] "Body.Style 0"
## [1] "Phone 0"
## [1] "Dealer_Region 0"Drop the NA value
car_sales<-na.omit(car_sales)
for (i in a){
print(paste(i,sum(is.na(car_sales[i]))))
}## [1] "Car_id 0"
## [1] "Date 0"
## [1] "Customer.Name 0"
## [1] "Gender 0"
## [1] "Annual.Income 0"
## [1] "Dealer_Name 0"
## [1] "Company 0"
## [1] "Model 0"
## [1] "Engine 0"
## [1] "Transmission 0"
## [1] "Color 0"
## [1] "Price.... 0"
## [1] "Dealer_No 0"
## [1] "Body.Style 0"
## [1] "Phone 0"
## [1] "Dealer_Region 0"In the column named Engine the data have the character that computer can’t recognize, modify them in proper character
car_sales$Engine[car_sales$Engine == "Double????Overhead Camshaft"] <- "Double Overhead Camshaft"
head(car_sales$Engine)## [1] "Double Overhead Camshaft" "Double Overhead Camshaft"
## [3] "Overhead Camshaft" "Overhead Camshaft"
## [5] "Double Overhead Camshaft" "Overhead Camshaft"Transform the type of column named Date into the date format
library(lubridate)##
## 载入程辑包：'lubridate'## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, unioncar_sales$Date <- mdy(car_sales$Date)
head(car_sales$Date)## [1] "2022-01-02" "2022-01-02" "2022-01-02" "2022-01-02" "2022-01-02"
## [6] "2022-01-02"Exploratory Data Analysis(EDA)
Statistic automotive sales by month
statistic the car sales by month, use group methods.
library(lubridate)
car_sales$Month <- paste(year(car_sales$Date), month(car_sales$Date), sep = "-")
car_sales$Month <- ym(car_sales$Month)
car_sales_by_month <- car_sales %>%
group_by(car_sales$Month) %>%
summarise(
Count = n()
) %>%
ungroup()
car_sales_by_month <- car_sales_by_month %>%
arrange(`car_sales$Month`)
car_sales_by_month## # A tibble: 24 × 2
## `car_sales$Month` Count
## <date> <int>
## 1 2022-01-01 315
## 2 2022-02-01 320
## 3 2022-03-01 705
## 4 2022-04-01 800
## 5 2022-05-01 750
## 6 2022-06-01 690
## 7 2022-07-01 700
## 8 2022-08-01 810
## 9 2022-09-01 1475
## 10 2022-10-01 835
## # ℹ 14 more rowsgenerate histogram plot
library(ggplot2)
ggplot(car_sales_by_month, aes(x = `car_sales$Month`, y = Count)) +
geom_line(color= "skyblue") +
geom_point()+
geom_text(aes(label = Count), vjust = -0.5, size = 3) +
labs(title = "Car Sales by Month", x = "Month", y = "Counts") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, hjust = 1))+
scale_x_date(date_breaks = "1 month", date_labels = "%Y-%m")
Statistic automotive sales by Region
statistic the car sales by region
car_sales_by_region <- car_sales %>%
group_by(car_sales$Dealer_Region) %>%
summarise(
Count = n()
) %>%
ungroup()
car_sales_by_region <- car_sales_by_region %>%
arrange(`car_sales$Dealer_Region`)
car_sales_by_region## # A tibble: 7 × 2
## `car_sales$Dealer_Region` Count
## <chr> <int>
## 1 Aurora 3129
## 2 Austin 4135
## 3 Greenville 3128
## 4 Janesville 3821
## 5 Middletown 3128
## 6 Pasco 3131
## 7 Scottsdale 3433generate histogram plot
library(ggplot2)
ggplot(car_sales_by_region, aes(x = `car_sales$Dealer_Region`, y = Count)) +
geom_bar(stat = "identity", fill = "red") +
geom_text(aes(label = Count), vjust = -0.5, size = 3) +
labs(title = "Car Sales by Region", x = "Dealer Region", y = "Counts") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Statistic automotive sales by Model
statistic the car sales by model
car_sales_by_model <- car_sales %>%
group_by(car_sales$Model) %>%
summarise(
Count = n()
) %>%
ungroup()
car_sales_by_model <- car_sales_by_model %>%
arrange(`car_sales$Model`)
car_sales_by_model## # A tibble: 154 × 2
## `car_sales$Model` Count
## <chr> <int>
## 1 3-Sep 171
## 2 3000GT 303
## 3 300M 243
## 4 323i 260
## 5 328i 206
## 6 4Runner 58
## 7 5-Sep 39
## 8 528i 324
## 9 A4 102
## 10 A6 329
## # ℹ 144 more rowsgenerate box plot
boxplot(car_sales_by_model$Count,
main="Car Sales by Model",
col = "skyblue")
Statistic automotive sales by Body Style
statistic the car sales by Body Style
car_sales_by_body_style <- car_sales %>%
group_by(car_sales$Body.Style) %>%
summarise(
Count = n()
) %>%
ungroup()
car_sales_by_body_style <- car_sales_by_body_style %>%
arrange(`car_sales$Body.Style`)
car_sales_by_body_style## # A tibble: 5 × 2
## `car_sales$Body.Style` Count
## <chr> <int>
## 1 Hardtop 2970
## 2 Hatchback 6128
## 3 Passenger 3945
## 4 SUV 6374
## 5 Sedan 4488generate line plot
library(ggplot2)
ggplot(car_sales_by_body_style, aes(x = `car_sales$Body.Style`, y = Count)) +
geom_bar(stat = "identity", fill = "green") +
geom_text(aes(label = Count), vjust = -0.5, size = 3) +
labs(title = "Car Sales by Body Style", x = "Body Style", y = "Counts") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Statistic automotive sales by Car Company
statistic the car sales by Car Company
car_sales_by_car_company <- car_sales %>%
group_by(car_sales$Company) %>%
summarise(
Count = n()
) %>%
ungroup()
car_sales_by_car_company <- car_sales_by_car_company %>%
arrange(`car_sales$Company`)
car_sales_by_car_company## # A tibble: 30 × 2
## `car_sales$Company` Count
## <chr> <int>
## 1 Acura 689
## 2 Audi 468
## 3 BMW 790
## 4 Buick 439
## 5 Cadillac 652
## 6 Chevrolet 1819
## 7 Chrysler 1120
## 8 Dodge 1670
## 9 Ford 1614
## 10 Honda 708
## # ℹ 20 more rowsgenerate histogram plot
library(ggplot2)
ggplot(car_sales_by_car_company, aes(x = `car_sales$Company`, y = Count)) +
geom_bar(stat = "identity", fill = "purple") +
geom_text(aes(label = Count), vjust = -0.5, size = 3) +
labs(title = "Car Sales by Car Company", x = "Car Company", y = "Counts") +
theme_minimal()+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Car Transmission preference
statistic Car Transmission
car_sales_by_transmission <- car_sales %>%
group_by(car_sales$Transmission) %>%
summarise(
Count = n()
) %>%
ungroup()
car_sales_by_transmission <- car_sales_by_transmission %>%
arrange(`car_sales$Transmission`)
car_sales_by_transmission## # A tibble: 2 × 2
## `car_sales$Transmission` Count
## <chr> <int>
## 1 Auto 12570
## 2 Manual 11335generate histogram plot
library(ggplot2)
ggplot(car_sales_by_transmission, aes(x = `car_sales$Transmission`, y = Count,fill= `car_sales$Transmission`)) +
geom_bar(stat = "identity") +
geom_text(aes(label = Count), vjust = -0.5, size = 3) +
labs(title = "Car Sales by Transmission", x = "Transmission", y = "Counts") +
coord_flip()+
theme_minimal()
Car Engine preference
statistic Car Engine
car_sales_by_car_engine <- car_sales %>%
group_by(car_sales$Engine) %>%
summarise(
Count = n()
) %>%
ungroup()
car_sales_by_car_engine <- car_sales_by_car_engine %>%
arrange(`car_sales$Engine`)
car_sales_by_car_engine## # A tibble: 2 × 2
## `car_sales$Engine` Count
## <chr> <int>
## 1 Double Overhead Camshaft 12570
## 2 Overhead Camshaft 11335generate histogram plot
library(ggplot2)
ggplot(car_sales_by_car_engine, aes(x = `car_sales$Engine`, y = Count,fill= `car_sales$Engine`)) +
geom_bar(stat = "identity") +
geom_text(aes(label = Count), vjust = -0.5, size = 3) +
labs(title = "Car Sales by Car Engine", x = "Engine", y = "Counts") +
coord_flip()+
theme_minimal()
Modeling
Price($) Prediction
Training Preparation
Transform the category columns into numeric (Label Encoding)
sub_gender<-as.integer(as.factor(car_sales$Gender))
sub_company<-as.integer(as.factor(car_sales$Company))
sub_model<-as.integer(as.factor(car_sales$Model))
sub_transmission<-as.integer(as.factor(car_sales$Transmission))
sub_body<-as.integer(as.factor(car_sales$Body.Style))
sub_color<-as.integer(as.factor(car_sales$Color))
sub_region<-as.integer(as.factor(car_sales$Dealer_Region))generate new data set that modeling will be used
model_df <- data.frame(
Gender = sub_gender,
Annual_Income = car_sales$Annual.Income,
Company = sub_company,
Model = sub_model,
Transmission = sub_transmission,
Color = sub_color,
Price = car_sales$Price....,
Body_Style = sub_body,
Dealer_Region = sub_region
)
head(model_df)## Gender Annual_Income Company Model Transmission Color Price Body_Style
## 1 2 13500 9 61 1 1 26000 5
## 2 2 1480000 8 53 1 1 19000 5
## 3 2 1035000 5 57 2 3 31500 3
## 4 2 13500 28 34 2 2 14000 5
## 5 2 1465000 1 144 1 3 24500 2
## 6 2 850000 19 52 2 2 12000 2
## Dealer_Region
## 1 5
## 2 1
## 3 3
## 4 6
## 5 4
## 6 7Random Forest Regression
library(randomForest)## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.##
## 载入程辑包：'randomForest'## The following object is masked from 'package:ggplot2':
##
## margin## The following object is masked from 'package:dplyr':
##
## combinelibrary(caret)## 载入需要的程辑包：latticelibrary(dplyr)
set.seed(42)
train_indices <- createDataPartition(model_df$Price, p=0.8, list=FALSE)
train_data <- model_df[train_indices, ]
test_data <- model_df[-train_indices, ]
x_test <- test_data %>% select(-Price)
y_test <- test_data$Price
rf_model <- randomForest(Price ~ Annual_Income + Company + Model + Transmission + Color + Body_Style + Dealer_Region, data = train_data)
predictions <- predict(rf_model, x_test)
rf_rmse <- sqrt(mean((predictions - y_test)^2))
print(paste("Random Forest RMSE:", rf_rmse))## [1] "Random Forest RMSE: 9476.12303038849"plot_data <- data.frame(ActualPrice = y_test, PredictedPrice = predictions)
ggplot(plot_data, aes(x = ActualPrice, y = PredictedPrice)) +
geom_point(color = "green") +
geom_abline(intercept = 0, slope = 1, color = "red") +
ggtitle("Random Forest Predictions") +
xlab("Actual Price") +
ylab("Predicted Price") +
theme_minimal() 
Decision Tree Regression
library(rpart)
library(caret)
set.seed(42)
train_indices <- createDataPartition(model_df$Price, p=0.8, list=FALSE)
train_data <- model_df[train_indices, ]
test_data <- model_df[-train_indices, ]
x_test <- test_data %>% select(-Price)
y_test <- test_data$Price
rf_model <- rpart(Price ~ Annual_Income + Company + Model + Transmission + Color + Body_Style + Dealer_Region, data = train_data, method = "anova")
predictions <- predict(rf_model, x_test)
rf_rmse <- sqrt(mean((predictions - y_test)^2))
print(paste("Decision Tree RMSE:", rf_rmse))## [1] "Decision Tree RMSE: 14570.8669718086"plot_data <- data.frame(ActualPrice = y_test, PredictedPrice = predictions)
ggplot(plot_data, aes(x = ActualPrice, y = PredictedPrice)) +
geom_point(color = "green") +
geom_abline(intercept = 0, slope = 1, color = "red") +
ggtitle("Decision Tree Predictions") +
xlab("Actual Price") +
ylab("Predicted Price") +
theme_minimal() 
Monthly Sales Prediction
Training preparation
library(lubridate)
car_sales_by_month$Year <- year(car_sales_by_month$`car_sales$Month`)
car_sales_by_month$Month <- month(car_sales_by_month$`car_sales$Month`)
car_sales_by_month## # A tibble: 24 × 4
## `car_sales$Month` Count Year Month
## <date> <int> <dbl> <dbl>
## 1 2022-01-01 315 2022 1
## 2 2022-02-01 320 2022 2
## 3 2022-03-01 705 2022 3
## 4 2022-04-01 800 2022 4
## 5 2022-05-01 750 2022 5
## 6 2022-06-01 690 2022 6
## 7 2022-07-01 700 2022 7
## 8 2022-08-01 810 2022 8
## 9 2022-09-01 1475 2022 9
## 10 2022-10-01 835 2022 10
## # ℹ 14 more rowsLinear Regression
library(caret)
set.seed(42)
train_indices <- createDataPartition(car_sales_by_month$Count, p=0.8, list=FALSE)
train_data <- car_sales_by_month[train_indices, ]
test_data <- car_sales_by_month[-train_indices, ]
linear_model <- lm(Count ~ Year+Month, data=train_data)
summary(linear_model)##
## Call:
## lm(formula = Count ~ Year + Month, data = train_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -470.44 -174.93 35.71 187.46 403.36
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -480852.59 226485.68 -2.123 0.0487 *
## Year 237.88 111.98 2.124 0.0486 *
## Month 116.68 15.86 7.356 1.12e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 247.9 on 17 degrees of freedom
## Multiple R-squared: 0.7649, Adjusted R-squared: 0.7372
## F-statistic: 27.65 on 2 and 17 DF, p-value: 4.525e-06predictions <- predict(linear_model, test_data)
mse <- mean((predictions - test_data$Count)^2)
rmse <- sqrt(mse)
mse## [1] 89913.84rmse## [1] 299.8564Gradient Boosting Regression
library(gbm)## Loaded gbm 2.1.9## This version of gbm is no longer under development. Consider transitioning to gbm3, https://github.com/gbm-developers/gbm3set.seed(42)
train_indices <- createDataPartition(car_sales_by_month$Count, p=0.8, list=FALSE)
train_data <- car_sales_by_month[train_indices, ]
test_data <- car_sales_by_month[-train_indices, ]
gbm_model <- gbm(
Count ~ Year+Month,
data=train_data,
distribution = "gaussian",
n.minobsinnode = 1)
summary(gbm_model)
## var rel.inf
## Month Month 92.74097
## Year Year 7.25903predictions <- predict(gbm_model , test_data)## Using 100 trees...mse <- mean((predictions - test_data$Count)^2)
rmse <- sqrt(mse)
mse## [1] 41460.81rmse## [1] 203.6193Conclusion
Insight and Future Work
In conclusion, our analysis provided valuable insights into car sales patterns and demonstrated the effectiveness of various predictive models.And we identified the best models for price prediction and sales prediction respectively - Random Forest model and the Gradient Boosting model.Meanwhile,based on the above analysis results, we propose the following business recommendations.
1.In terms of pricing strategy, dealers can first adopt a dynamic pricing approach, adjusting prices based on seasonal trends and regional demand. For instance, considering the sales peak in September, offering promotional prices or incentives during this month can maximize sales.Secondly, a tiered pricing strategy can be implemented. For high-demand models, a premium pricing strategy can be employed. Conversely, for models with lower sales volumes, lowering prices might help increase their market share.
2. In inventory management, maintaining a certain stock level of popular models such as SUVs and sedans is crucial, especially in high-sales regions.
3. Regarding product development, as automatic transmissions and dual overhead camshaft engines are more popular, they should be more frequently incorporated into new designs. Additionally, customizing products to meet the specific tastes and demands of regional markets can be effective. For example, in regions where luxury cars are preferred, focusing on high-end models could be beneficial.
4.From a marketing perspective, targeted marketing strategies should be tailored to different regions. In high-sales areas, marketing activities should highlight popular models and features.
For future work, we plan to incorporate more features into our models, such as marketing spend, economic indicators, and customer demographics. Additionally, we aim to explore more advanced machine learning algorithms to further improve our prediction accuracy.