Volvo-bilar: EDA och Regressionsmodell
Zakariyae Mokhtari
Inledning
Den här rapporten utforskar försäljningspriser för begagnade Volvo-bilar från Blocket. Syftet är att kombinera Exploratory Data Analysis (EDA) med prediktiv modellering för att identifiera de faktorer som påverkar priset mest, samt skapa tillförlitliga modeller för att förutsäga priser.
Importera och förbehandla data
url <- "https://github.com/siffror/Regressionsmodellering_R_Bilannonser/raw/main/R_Volvo_data_bilar.xlsx"
temp <- tempfile(fileext = ".xlsx")
download.file(url, temp, mode = "wb")
data <- read_excel(temp)## New names:
## • `` -> `...16`
## • `` -> `...17`
## • `` -> `...18`
## • `` -> `...19`
## • `` -> `...20`EDA: Visualisering och sammanfattning
str(data)## tibble [851 × 20] (S3: tbl_df/tbl/data.frame)
## $ Försäljningspris: chr [1:851] "23000" "89500" "274800" "369500" ...
## $ Säljare : chr [1:851] "Privat" "Företag" "Företag" "Företag" ...
## $ Bränsle : chr [1:851] "Miljöbränsle/Hybrid" "Miljöbränsle/Hybrid" "Miljöbränsle/Hybrid" "Miljöbränsle/Hybrid" ...
## $ Växellåda : chr [1:851] "Manuell" "Automat" "Automat" "Automat" ...
## $ Miltal : chr [1:851] "28664" "25100" "18850" "5761" ...
## $ Modellår : num [1:851] 2007 2011 2021 2022 2008 ...
## $ Biltyp : chr [1:851] "Halvkombi" "Kombi" "SUV" "SUV" ...
## $ Drivning : chr [1:851] "Tvåhjulsdriven" "Tvåhjulsdriven" "Tvåhjulsdriven" "Tvåhjulsdriven" ...
## $ Hästkrafter : chr [1:851] "126" "232" "198" "214" ...
## $ Färg : chr [1:851] "Grå" "Vit" "Svart" "Grå" ...
## $ Motorstorlek : chr [1:851] "1798" "2521" "1969" "1477" ...
## $ Datum_i_trafik : POSIXct[1:851], format: "2007-01-29" "2011-03-16" ...
## $ Märke : chr [1:851] "Volvo" "Volvo" "Volvo" "Volvo" ...
## $ Modell : chr [1:851] "C30" "V70" "XC60" "XC40" ...
## $ Region : chr [1:851] "Blekinge" "Blekinge" "Blekinge" "Blekinge" ...
## $ ...16 : logi [1:851] NA NA NA NA NA NA ...
## $ ...17 : logi [1:851] NA NA NA NA NA NA ...
## $ ...18 : logi [1:851] NA NA NA NA NA NA ...
## $ ...19 : logi [1:851] NA NA NA NA NA NA ...
## $ ...20 : num [1:851] NA NA NA NA NA NA NA 1 NA NA ...summary(data)## Försäljningspris Säljare Bränsle Växellåda
## Length:851 Length:851 Length:851 Length:851
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## Miltal Modellår Biltyp Drivning
## Length:851 Min. :1972 Length:851 Length:851
## Class :character 1st Qu.:2012 Class :character Class :character
## Mode :character Median :2018 Mode :character Mode :character
## Mean :2016
## 3rd Qu.:2021
## Max. :2025
##
## Hästkrafter Färg Motorstorlek
## Length:851 Length:851 Length:851
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## Datum_i_trafik Märke Modell
## Min. :1972-01-20 00:00:00.00 Length:851 Length:851
## 1st Qu.:2012-01-31 18:00:00.00 Class :character Class :character
## Median :2017-06-24 12:00:00.00 Mode :character Mode :character
## Mean :2015-09-15 11:24:10.24
## 3rd Qu.:2021-03-29 00:00:00.00
## Max. :2024-10-15 00:00:00.00
## NA's :7
## Region ...16 ...17 ...18 ...19
## Length:851 Mode:logical Mode:logical Mode:logical Mode:logical
## Class :character NA's:851 NA's:851 NA's:851 NA's:851
## Mode :character
##
##
##
##
## ...20
## Min. :1
## 1st Qu.:1
## Median :1
## Mean :1
## 3rd Qu.:1
## Max. :1
## NA's :850colSums(is.na(data))## Försäljningspris Säljare Bränsle Växellåda
## 0 0 0 0
## Miltal Modellår Biltyp Drivning
## 0 0 0 0
## Hästkrafter Färg Motorstorlek Datum_i_trafik
## 0 0 46 7
## Märke Modell Region ...16
## 0 0 0 851
## ...17 ...18 ...19 ...20
## 851 851 851 850Struktur och transformation
colnames(data) <- make.names(colnames(data)) # Kolumnnamn görs till giltiga R-namn
data <- data %>%
select(-starts_with("...")) %>% #tomma kolumner tas bort
mutate(
Försäljningspris = as.numeric(gsub("[^0-9]", "", Försäljningspris)),
Miltal = as.numeric(gsub("[^0-9]", "", Miltal)),
Hästkrafter = as.numeric(gsub("[^0-9]", "", Hästkrafter)),
Motorstorlek = as.numeric(gsub("[^0-9]", "", Motorstorlek)),
Bränsle = str_to_title(as.character(Bränsle)) %>% as.factor(), # Gör om bränsle till faktor kategorisk variabel
Växellåda = as.factor(Växellåda)
) # konvertera kolumner till rätt datatyperggplot(data, aes(x = Försäljningspris)) +
geom_histogram(binwidth = 25000, fill = "steelblue", color = "white") +
scale_x_continuous(labels = comma) +
labs(title = "Fördelning av försäljningspris", x = "Pris (kr)", y = "Antal bilar")
library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutplot_ly(data = data, x = ~Miltal, y = ~`Försäljningspris`, type = "scatter", mode = "markers") %>%
layout(title = "Försäljningspris i relation till miltal",
xaxis = list(title = "Miltal"),
yaxis = list(title = "Försäljningspris (kr)"))## Warning: Ignoring 1 observationsggplot(data, aes(x = Modellår)) +
geom_histogram(binwidth = 1, fill = "steelblue", color = "white") +
theme_minimal()
### Jag ville se hur pris och körsträcka varierar mellan olika
årsmodeller. Därför grupperade jag datan på Modellår, räknade antal
bilar, snittpris och snitt-miltal per år – och sorterade så det nyaste
kommer överst.”
data %>%
group_by(Modellår) %>%
summarise(Antal = n(), MedelPris = mean(Försäljningspris, na.rm = TRUE), MedelMiltal = mean(Miltal, na.rm = TRUE)) %>%
arrange(desc(Modellår))## # A tibble: 45 × 4
## Modellår Antal MedelPris MedelMiltal
## <dbl> <int> <dbl> <dbl>
## 1 2025 22 569086. 578.
## 2 2024 35 489166. 2350.
## 3 2023 59 464454. 5424.
## 4 2022 82 389990. 7776.
## 5 2021 72 327033. 10502.
## 6 2020 55 311825. 11816.
## 7 2019 51 283408. 12407.
## 8 2018 53 267408. 16699.
## 9 2017 48 216542. 14251.
## 10 2016 40 186825 17615.
## # ℹ 35 more rowsboxplotar för att se hur försäljningspriserna varierar mellan olika faktorer
ggplot(data, aes(x = Bränsle, y = Försäljningspris)) +
geom_boxplot(fill = "lightgreen") +
scale_y_continuous(labels = comma)
ggplot(data, aes(x = Växellåda, y = Försäljningspris)) +
geom_boxplot(fill = "skyblue") +
scale_y_continuous(labels = comma)
ggplot(data, aes(x = reorder(Region, Försäljningspris, median), y = Försäljningspris)) +
geom_boxplot(fill = "lightcoral") +
coord_flip() +
scale_y_continuous(labels = comma) +
labs(title = "Prisvariation mellan regioner", x = "Region", y = "Pris") +
theme_minimal()
🔢 Modellering: Träning och test
set.seed(123 ) # För reproducerbarhet, samma uppdelning varje gång koden körs.
train_index <- createDataPartition(data$Försäljningspris, p = 0.8, list = FALSE)
train_data <- data[train_index, ]
test_data <- data[-train_index, ] # testdata på osedda data
train_data$logPris <- log(train_data$Försäljningspris)
test_data$logPris <- log(test_data$Försäljningspris)
#Log-transformerar priset i både tränings- och testdata:
#Dämpar effekten av extremt höga priser
#Stabiliserar varians
#Gör datan mer normalfördelad (bättre för linjär regression)📈 Modell 1 – Numeriska variabler
options(scipen = 999) # ← bra kod: Undviker vetenskaplig notation!
model_log <- lm(logPris ~ Miltal + Modellår + Hästkrafter + Motorstorlek, data = train_data)
summary(model_log)##
## Call:
## lm(formula = logPris ~ Miltal + Modellår + Hästkrafter + Motorstorlek,
## data = train_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.6443 -0.1187 0.0352 0.1598 3.5336
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -135.556302012 7.240406572 -18.722 < 0.0000000000000002 ***
## Miltal -0.000029992 0.000002318 -12.938 < 0.0000000000000002 ***
## Modellår 0.073124960 0.003578115 20.437 < 0.0000000000000002 ***
## Hästkrafter 0.002099220 0.000276380 7.595 0.000000000000109 ***
## Motorstorlek 0.000113767 0.000060420 1.883 0.0602 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4793 on 639 degrees of freedom
## (38 observations deleted due to missingness)
## Multiple R-squared: 0.7725, Adjusted R-squared: 0.7711
## F-statistic: 542.4 on 4 and 639 DF, p-value: < 0.00000000000000022options(scipen = 999)
pred_log <- predict(model_log, newdata = test_data) # prediktera logaritmerade priser
pred <- exp(pred_log) # exponentiera eller avloggar för att få tillbaka till försäljningspris i kr
pred[pred < 0] <- 0 # sätt negativa värden till 0 bara säkerhets skull
postResample(pred, test_data$Försäljningspris) # Jämför förutsägelser med verkliga priser på testdatan, och räknar ut RMSE, R² och MAE## RMSE Rsquared MAE
## 61759.5686664 0.8824247 41610.3267430Modell 2 – Med faktorer
options(scipen = 999)
model2 <- lm(logPris ~ Miltal + Modellår + Hästkrafter + Motorstorlek + Bränsle + Växellåda, data = train_data)
summary(model2)##
## Call:
## lm(formula = logPris ~ Miltal + Modellår + Hästkrafter + Motorstorlek +
## Bränsle + Växellåda, data = train_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.8569 -0.1253 0.0259 0.1604 3.4906
##
## Coefficients:
## Estimate Std. Error t value
## (Intercept) -101.151185368 8.152643783 -12.407
## Miltal -0.000030037 0.000002249 -13.356
## Modellår 0.056238938 0.004020016 13.990
## Hästkrafter 0.002823763 0.000408556 6.912
## Motorstorlek -0.000127116 0.000080511 -1.579
## BränsleDiesel 0.159571302 0.048028698 3.322
## BränsleEl -0.392355481 0.243139964 -1.614
## BränsleMiljöbränsle/Hybrid -0.112929424 0.075325104 -1.499
## VäxellådaManuell -0.360519074 0.051559184 -6.992
## Pr(>|t|)
## (Intercept) < 0.0000000000000002 ***
## Miltal < 0.0000000000000002 ***
## Modellår < 0.0000000000000002 ***
## Hästkrafter 0.00000000001169 ***
## Motorstorlek 0.114866
## BränsleDiesel 0.000944 ***
## BränsleEl 0.107089
## BränsleMiljöbränsle/Hybrid 0.134312
## VäxellådaManuell 0.00000000000687 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4538 on 635 degrees of freedom
## (38 observations deleted due to missingness)
## Multiple R-squared: 0.7974, Adjusted R-squared: 0.7948
## F-statistic: 312.3 on 8 and 635 DF, p-value: < 0.00000000000000022options(scipen = 999)
# Säkerställ att faktornivåerna i test_data matchar train_data
test_data$Bränsle <- factor(test_data$Bränsle, levels = levels(train_data$Bränsle))
test_data$Växellåda <- factor(test_data$Växellåda, levels = levels(train_data$Växellåda))
# Filtrera bort test-observationer med faktornivåer som inte finns i träningen
test_data <- test_data %>%
filter(!is.na(Bränsle), !is.na(Växellåda)) %>%
filter(Bränsle %in% levels(train_data$Bränsle), Växellåda %in% levels(train_data$Växellåda))
# Prediktion och back-transformering
pred_log2 <- predict(model2, newdata = test_data)
pred2 <- exp(pred_log2)
pred2[pred2 < 0] <- 0
# Modellutvärdering
postResample(pred2, test_data$Försäljningspris)## RMSE Rsquared MAE
## 57131.8306742 0.9033505 36670.8839190Visualisering av modeller
ggplot(data.frame(Verkligt = test_data$Försäljningspris, Prediktion = pred2),
aes(x = Verkligt, y = Prediktion)) +
geom_point(alpha = 0.6) +
geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
scale_x_continuous(labels = comma) +
scale_y_continuous(labels = comma)## Warning: Removed 9 rows containing missing values or values outside the scale range
## (`geom_point()`).
Diagnostik
options(scipen = 999)
shapiro.test(residuals(model2))##
## Shapiro-Wilk normality test
##
## data: residuals(model2)
## W = 0.62287, p-value < 0.00000000000000022bptest(model2)##
## studentized Breusch-Pagan test
##
## data: model2
## BP = 35.385, df = 8, p-value = 0.00002275durbinWatsonTest(model2)## lag Autocorrelation D-W Statistic p-value
## 1 0.02112962 1.955853 0.396
## Alternative hypothesis: rho != 0vif(model2)## GVIF Df GVIF^(1/(2*Df))
## Miltal 1.861638 1 1.364419
## Modellår 2.799305 1 1.673112
## Hästkrafter 3.536061 1 1.880442
## Motorstorlek 2.453535 1 1.566377
## Bränsle 5.336303 3 1.321925
## Växellåda 1.702078 1 1.304637par(mfrow = c(2, 2))
plot(model2)
par(mfrow = c(1, 1))# Beräkna residualer
residualer <- residuals(model2)
# Histogram + densitetskurva
ggplot(data.frame(residualer), aes(x = residualer)) +
geom_histogram(aes(y = ..density..), bins = 30, fill = "skyblue", color = "white") +
geom_density(color = "red", size = 1) +
labs(title = "Residualernas fördelning",
x = "Residualer", y = "Densitet") +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
cooksD <- cooks.distance(model2)
# Ritar graf
plot(cooksD, type = "h", main = "Cook's Distance", ylab = "Cook's Distance")
abline(h = 5 / nrow(train_data), col = "red", lty = 2)
# Hämtar topp 3 mest inflytelserika observationer
top <- order(cooksD, decreasing = TRUE)[1:3]
# Lägger till deras index i grafen
text(x = top, y = cooksD[top], labels = top, pos = 2, cex = 0.8, col = "blue")
# Sammanställ prestanda
resultat_df <- data.frame(
Modell = c("Modell 1 (endast numeriska)", "Modell 2 (med faktorer)"),
RMSE = c(postResample(pred, test_data$Försäljningspris)["RMSE"],
postResample(pred2, test_data$Försäljningspris)["RMSE"]),
R2 = c(postResample(pred, test_data$Försäljningspris)["Rsquared"],
postResample(pred2, test_data$Försäljningspris)["Rsquared"]),
MAE = c(postResample(pred, test_data$Försäljningspris)["MAE"],
postResample(pred2, test_data$Försäljningspris)["MAE"])
)
# Formatera värden snyggt
resultat_df <- resultat_df %>%
mutate(across(where(is.numeric), ~round(., 0))) # Avrunda till hela kr/tal
# Visa som tabell
knitr::kable(resultat_df, caption = "📋 Sammanställning av modellprestanda (testdata)")| Modell | RMSE | R2 | MAE |
|---|---|---|---|
| Modell 1 (endast numeriska) | 61760 | 1 | 41610 |
| Modell 2 (med faktorer) | 57132 | 1 | 36671 |
# Visa de tre mest inflytelserika observationerna
data[c(506, 489, 516), ]## # A tibble: 3 × 15
## Försäljningspris Säljare Bränsle Växellåda Miltal Modellår Biltyp Drivning
## <dbl> <chr> <fct> <fct> <dbl> <dbl> <chr> <chr>
## 1 687400 Företag Miljöbräns… Automat 0 2025 SUV Fyrhjul…
## 2 348800 Företag Miljöbräns… Automat 5674 2020 Kombi Fyrhjul…
## 3 534900 Företag El Automat 43 2025 SUV Tvåhjul…
## # ℹ 7 more variables: Hästkrafter <dbl>, Färg <chr>, Motorstorlek <dbl>,
## # Datum_i_trafik <dttm>, Märke <chr>, Modell <chr>, Region <chr>Slutsats
- Miltal har en stark negativ påverkan.
- Modellår och hästkrafter påverkar priset positivt.
- Bränsletyp och växellåda förbättrar modellens förklaringsgrad.
- Modell 2 är överlägsen Modell 1 enligt RMSE, MAE och R².
prediktion av en ny bil:
ny_bil <- data.frame(
Miltal = 6125,
Modellår = 2018,
Hästkrafter = 153,
Motorstorlek = 1969,
Bränsle = factor("Bensin", levels = levels(train_data$Bränsle)),
Växellåda = factor("Manuell", levels = levels(train_data$Växellåda))
)
log_pred <- predict(model2, newdata = ny_bil)
pris_pred <- exp(log_pred)
pris_pred## 1
## 158932.9# Det verkliga priest är 179 900 kr