Homework3_EK
2023-01-20
mydata <- read_excel("C:/Users/Eneja/Desktop/MVA/Electircal_Cars.xlsx")
head(mydata)## # A tibble: 6 × 9
## Brand Model `Capacity (kWh)` `Acceleration (sec)` TopSpeed (km…¹ Range…² Effic…³ Drive Price…⁴
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <dbl>
## 1 Opel Ampera-e 58 7.3 150 335 173 Fron… 42990
## 2 Renault Kangoo Maxi ZE 33 31 22.4 130 160 194 Fron… 0
## 3 Nissan Leaf 36 7.9 144 220 164 Fron… 29990
## 4 Audi e-tron Sportback 55 quattro 86.5 5.7 200 375 231 All … 0
## 5 Porsche Taycan Turbo S 83.7 2.8 260 390 215 All … 186336
## 6 Nissan e-NV200 Evalia 36 14 123 165 218 Fron… 43433
## # … with abbreviated variable names ¹`TopSpeed (km/h)`, ²`Range (km)`, ³`Efficiency (Wh/km)`, ⁴`PriceinGer (€)`colnames(mydata) <- c("Brand","Model","Capacity","Acceleration","Top_Speed","Range","Efficiency","Drive", "Price_Germany")mydata$DriveF <- factor(mydata$Drive,
levels = c( "Front Wheel Drive", "Rear Wheel Drive", "All Wheel Drive"),
labels = c("Front","Rear","All"))mydata1 <- mydata %>%
replace_with_na(replace = list(Price_Germany = c(0)))mydata1 <- tidyr::drop_na(mydata1)Description: - Brand: Vehicle manufacturer - Model: Vehicle model - Capacity: Battery storage capacity in kWh - Acceleration: time to reach 100 km/h in seconds - Top_Speed: Maximum travel speed in km/h - Range: Nominal value of maximal traveled distance in km - Efficiency: Ratio between capacity and range in Wh/km - Drive: type of drive front/rear/all wheel drive - Price_Germany: Estimated value of vehicle in Germany in € in 2022
Unit of observation: BEV car model in Germany in 2022
Sample size: 168 (without missing values)
Source of the data: Kaggle- Cheapest Electric Cars
The main goal of the data analysis is to see how variables like efficiency, acceleration, drive type and maximum range of BEV vehicle affect the price of the BEV car in Germany.
Definition of the regression model
Price_Germany will be dependant variable, while Efficiency, Acceleration, Maximum range and Drive Type of BEV vehicle will be independant variables. With a regression model we will try to explain the relationship between variables and determine how strong independant variables stated above affect dependant variable or the Price of the BEV vehicle in Germany.
One of the main attribute affecting a price of a BEV car as such is the available range, which means that the cost of a car increases by having larger battery meant for a longer range. Furthermore, the faster the acceleration, the more expensive the car due to high performance components.Furthermore, The higher the efficiency, the less energy we need to power our car. In other words, efficiency means achieving the same performance without consuming as much energy.(Skowron, 2019) When it comes to Drive Type, front an rear wheel is the most common and therefore the cheapest, while all wheel drive is considered most expensive.
mydata2 <- mydata1[ ,c(-1,-2,-3,-5,-8)]
mydata2$ID <- 1:nrow(mydata2)scatterplotMatrix(mydata2[c(-5,-6)],
smooth=FALSE)
rcorr(as.matrix(mydata2[, c(-5, -6)]))## Acceleration Range Efficiency Price_Germany
## Acceleration 1.00 -0.72 0.18 -0.56
## Range -0.72 1.00 -0.09 0.62
## Efficiency 0.18 -0.09 1.00 0.24
## Price_Germany -0.56 0.62 0.24 1.00
##
## n= 168
##
##
## P
## Acceleration Range Efficiency Price_Germany
## Acceleration 0.0000 0.0209 0.0000
## Range 0.0000 0.2695 0.0000
## Efficiency 0.0209 0.2695 0.0015
## Price_Germany 0.0000 0.0000 0.0015Based on correlation matrix we can see negative moderate correlation between Price of BEV vehicle and Acceleration. We can see positive strong correlation between Price of BEV vehicle and Range. We can also see weak positive correlation between Price of BEV vehicle and Efficiency.
reg1 <- lm(formula = Price_Germany ~ Efficiency + Acceleration + Range + DriveF , data = mydata2)
vif(reg1)## GVIF Df GVIF^(1/(2*Df))
## Efficiency 1.263059 1 1.123859
## Acceleration 3.947762 1 1.986898
## Range 2.079718 1 1.442123
## DriveF 3.065702 2 1.323221mean(vif(reg1))## [1] 1.769362We don’t see a problem with multicolinearity. Therefore, we will keep all the chosen variables. There is also no strong dependancy between explanatory variables.
mydata2$StdResid <- round(rstandard(reg1),3)
mydata2$CooksD <- round(cooks.distance(reg1),3)
hist(mydata2$StdResid,
xlab = "Std.residuals",
main = "Histogram of Standardized Residuals")
We have outliers on both sides of histogram (-3 max, 3 max)
shapiro.test(mydata2$StdResid)##
## Shapiro-Wilk normality test
##
## data: mydata2$StdResid
## W = 0.85382, p-value = 1.16e-11H0: Variable is normally distributed H1: Variable is not normally distributed Based on shapiro test we can reject null hypothesis (p<0.001).
hist(mydata2$CooksD,
xlab = "Cooks Distance",
main = "Histogram of Cooks Distance")
We have units with high impact since there is a huge break between 2 units.
head(mydata2[order(mydata2$StdResid),],7)## # A tibble: 7 × 8
## Acceleration Range Efficiency Price_Germany DriveF ID StdResid CooksD
## <dbl> <dbl> <dbl> <dbl> <fct> <int> <dbl> <dbl>
## 1 3 750 267 75000 All 55 -3.29 0.25
## 2 5 460 261 55000 All 54 -2.26 0.036
## 3 6.9 405 190 47000 All 67 -1.35 0.009
## 4 7 390 256 45000 Rear 53 -1.33 0.023
## 5 4.4 490 155 53560 All 166 -1.28 0.01
## 6 6.2 395 195 50000 All 68 -1.26 0.006
## 7 5.2 375 194 48900 All 135 -1.25 0.005head(mydata2[order(-mydata2$StdResid),],10)## # A tibble: 10 × 8
## Acceleration Range Efficiency Price_Germany DriveF ID StdResid CooksD
## <dbl> <dbl> <dbl> <dbl> <fct> <int> <dbl> <dbl>
## 1 2.9 380 220 187746 All 126 4.59 0.141
## 2 2.8 390 215 186336 All 3 4.52 0.127
## 3 10 575 104 149000 All 16 4.08 0.979
## 4 3.3 385 217 154444 All 125 3.09 0.052
## 5 3.2 400 209 153016 All 35 3.03 0.044
## 6 2.1 970 206 215000 All 17 2.99 0.421
## 7 3.3 405 210 138200 All 13 2.32 0.024
## 8 4.3 610 177 135529 All 140 1.54 0.019
## 9 3.2 660 167 140000 All 83 1.52 0.024
## 10 2.1 535 168 126990 All 115 1.51 0.013head(mydata2[order(-mydata2$CooksD),],10)## # A tibble: 10 × 8
## Acceleration Range Efficiency Price_Germany DriveF ID StdResid CooksD
## <dbl> <dbl> <dbl> <dbl> <fct> <int> <dbl> <dbl>
## 1 10 575 104 149000 All 16 4.08 0.979
## 2 2.1 970 206 215000 All 17 2.99 0.421
## 3 3 750 267 75000 All 55 -3.29 0.25
## 4 2.9 380 220 187746 All 126 4.59 0.141
## 5 2.8 390 215 186336 All 3 4.52 0.127
## 6 3.3 385 217 154444 All 125 3.09 0.052
## 7 3.2 400 209 153016 All 35 3.03 0.044
## 8 5 460 261 55000 All 54 -2.26 0.036
## 9 3.3 405 210 138200 All 13 2.32 0.024
## 10 3.2 660 167 140000 All 83 1.52 0.024We need to remove next outliers: ID 126, 125,55, 35, 3, 16, 17
mydata2 <- mydata2[c(-126,-125, -35, -55,-54,-3,-16,-17),]Reestimation of data
reg1 <- lm(formula = Price_Germany ~ Efficiency + Acceleration + Range + DriveF , data = mydata2)
mydata2$StdResid <- round(rstandard(reg1),3)mydata2$FittedValue <- scale(fitted(reg1))hist(mydata2$StdResid,
xlab = "Std.residuals",
main = "Histogram of Standardized Residuals")
head(mydata2[order(-mydata2$StdResid),],10)## # A tibble: 10 × 9
## Acceleration Range Efficiency Price_Germany DriveF ID StdResid CooksD FittedValue[,1]
## <dbl> <dbl> <dbl> <dbl> <fct> <int> <dbl> <dbl> <dbl>
## 1 3.3 405 210 138200 All 13 4.01 0.024 1.40
## 2 3.2 660 167 140000 All 83 3.23 0.024 2.13
## 3 4.3 610 177 135529 All 140 3.18 0.019 1.91
## 4 2.1 535 168 126990 All 115 3.03 0.013 1.54
## 5 4 375 189 106487 All 43 2.55 0.007 0.820
## 6 4 435 192 113008 All 44 2.48 0.005 1.21
## 7 2.6 455 198 116990 All 117 2.31 0.006 1.54
## 8 4.1 405 207 111842 All 124 2.30 0.005 1.28
## 9 6.2 640 168 106374 Rear 139 2.04 0.019 1.26
## 10 5.4 395 180 83520 Rear 112 1.86 0.009 0.152shapiro.test(mydata2$StdResid)##
## Shapiro-Wilk normality test
##
## data: mydata2$StdResid
## W = 0.93061, p-value = 5.382e-07H0: Variable is normally distributed H1: Variable is not normally distributed
Based on p-value errors are not normally distributed. However, since we have a large sample we will continue nonetheless.
vif(reg1)## GVIF Df GVIF^(1/(2*Df))
## Efficiency 1.454953 1 1.206214
## Acceleration 4.912444 1 2.216403
## Range 2.399369 1 1.548990
## DriveF 3.285052 2 1.346281mean(vif(reg1))## [1] 1.947475scatterplot(y=mydata2$StdResid, x=mydata2$FittedValue,
ylab = "Standardised residuals",
xlab = "Standardised fitted values",
regLine = TRUE,
boxplots = FALSE,
smooth = FALSE)
plot(reg1, 1)
The linear assumption is fulfilled, however we do have a problem with heteroscedasticity.
ols_test_breusch_pagan(reg1)##
## Breusch Pagan Test for Heteroskedasticity
## -----------------------------------------
## Ho: the variance is constant
## Ha: the variance is not constant
##
## Data
## -----------------------------------------
## Response : Price_Germany
## Variables: fitted values of Price_Germany
##
## Test Summary
## -------------------------------
## DF = 1
## Chi2 = 65.69938
## Prob > Chi2 = 5.252227e-16H0: There is homoscedasticity H1: There is heteroscedasticity
Based on p-value we cannot accept null hypothesis, therefore, we can claim that there is a problem with heteroscedasticity. We have to use lm_robust.
library(pastecs)
round(stat.desc(mydata2[, c(1,2,3,4)]), 2)## Acceleration Range Efficiency Price_Germany
## nbr.val 160.00 160.00 160.00 160.00
## nbr.null 0.00 0.00 0.00 0.00
## nbr.na 0.00 0.00 0.00 0.00
## min 2.10 95.00 144.00 18460.00
## max 15.00 660.00 281.00 140000.00
## range 12.90 565.00 137.00 121540.00
## sum 1274.30 52540.00 31021.00 8690323.00
## median 7.55 335.00 188.00 50000.00
## mean 7.96 328.38 193.88 54314.52
## SE.mean 0.23 8.32 2.53 1900.19
## CI.mean.0.95 0.46 16.43 4.99 3752.88
## var 8.52 11078.79 1020.77 577718387.47
## std.dev 2.92 105.26 31.95 24035.77
## coef.var 0.37 0.32 0.16 0.44The lowest amount of seconds to reach 100km/h (Acceleration) is 2.1 seconds, while the highest is 15 seconds.The minimum Range of BEV vehicle in this sample is 95 km, while the maximum Range is 660. The minimum of Efficiency is 144 Wh/km and the maximum is 281 Wh/km. Lastly, the minimum Price of BEV vehicle in Germany is 18460€ and maximum is 140000 km.
The average BEV car needs 7.96 seconds to reach 100km/h, has range of 328.38 km, efficiency of 193.88 Wh/km and it costs 54314.52€. 50% of BEV vehicles need more than 7.55 seconds to reach 100km/h, have higher range than 335 km, higher efficiency than 188 Wh/km and cost more than 50000€. The other 50% need the same or less seconds to reach 100km/h, have lower range, efficiency and cost less than 50000€.
The highest variablity according to coefficient of variance is for Price and the smallest for efficiency.
sum(mydata2[,5]=="Rear")## [1] 44In sample there are 44 BEV vehicles with Rear wheel drive.
sum(mydata2[,5]=="All")## [1] 52In sample there are 52 BEV vehicles with All wheel drive.
sum(mydata2[,5]=="Front")## [1] 64In sample there are 64 BEV vehicles with Front wheel drive.
reg2 <- lm_robust(formula = Price_Germany ~ Efficiency + Acceleration + Range + DriveF , data = mydata2)
summary(reg2)##
## Call:
## lm_robust(formula = Price_Germany ~ Efficiency + Acceleration +
## Range + DriveF, data = mydata2)
##
## Standard error type: HC2
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|) CI Lower CI Upper DF
## (Intercept) -31180.7 10848.45 -2.874 4.623e-03 -52611.70 -9749.7 154
## Efficiency 321.3 44.11 7.285 1.558e-11 234.19 408.5 154
## Acceleration -1761.5 976.96 -1.803 7.333e-02 -3691.52 168.4 154
## Range 109.1 23.87 4.569 9.989e-06 61.91 156.2 154
## DriveFRear -2954.3 2286.29 -1.292 1.982e-01 -7470.79 1562.3 154
## DriveFAll 6831.7 4328.07 1.578 1.165e-01 -1718.31 15381.8 154
##
## Multiple R-squared: 0.6532 , Adjusted R-squared: 0.6419
## F-statistic: 50.26 on 5 and 154 DF, p-value: < 2.2e-16Price_Germany = -31180.7 + 321.3 * Efficiency -1761.5 * Acceleration + 109.1 * Range - 2954.3 * DriveFRear + 6831.7 * DriveAll
Based on regression, we can see that variables like Efficiency and Range have p-values lower than 5%. We can reject null hypothesis for this specific variables, which indicates that they actually have an impact on Price. However, we cannot reject null hypothesis for Acceleration (p=0.09) and Drive Type.
According to R-squared, the linear effect of the chosen variables: Efficiency, Acceleration and Range explain 65% of the variability of the price of BEV car in Germany.
sqrt(summary(reg2)$r.squared)## [1] 0.8082019Multiple coefficient of correlation equals to 0.81, which means that linear relationship between Price of BEV vehicle in Germany and all four explanatory variables is strong.
Explanation of coefficients: If Efficiency is increased by 1 Wh/km then the Price of BEV vehicle in Germany on average increases for 321.3€ ceteris paribus (p < 0.001). If Range is increased by 1 km then the Price of BEV vehicle in Germany on average increases for 109.1€ ceteris paribus (p<0.001). We could not confirm that Acceleration and Drive Type affects Price of BEV vehicle in Germany because they are not statistically significant.
F-statistics: H0: RO_sq = 0 H1: RO_sq > 0
We can reject H0 at p < 0.001, which means that we found linear relationship between dependant variable and at least one explanatory variable.
Explanation for Dummy variables even though they are not statistically significant: On average Rear wheel drive have price that is lower by 2954.3€ compared to Front wheel drive given the values of the other explanatory variables. On average All wheel drive have price that is higher by 6831.7€ compared to Front wheel drive given the values of the other explanatory variables.