Beadandó
Balázs Frigyes és Nagy Balázs Gábor
2023-12-03
knitr::opts_chunk$set(echo = TRUE)
set.seed(20231202)
# Könyvtárak
library(ggplot2)
library(earth)## Loading required package: Formula## Loading required package: plotmo## Loading required package: plotrix## Loading required package: TeachingDemoslibrary(caTools)
library(rpart)
library(rpart.plot)
library(randomForest)## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:ggplot2':
##
## marginlibrary(glmnet)## Loading required package: Matrix## Loaded glmnet 4.1-8library(fastDummies)## Thank you for using fastDummies!## To acknowledge our work, please cite the package:## Kaplan, J. & Schlegel, B. (2023). fastDummies: Fast Creation of Dummy (Binary) Columns and Rows from Categorical Variables. Version 1.7.1. URL: https://github.com/jacobkap/fastDummies, https://jacobkap.github.io/fastDummies/.library(earth)
library(caret)## Loading required package: latticelibrary(plotmo)
library(party)## Loading required package: grid## Loading required package: mvtnorm## Loading required package: modeltools## Loading required package: stats4## Loading required package: strucchange## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric## Loading required package: sandwichlibrary(partykit)## Loading required package: libcoin##
## Attaching package: 'partykit'## The following objects are masked from 'package:party':
##
## cforest, ctree, ctree_control, edge_simple, mob, mob_control,
## node_barplot, node_bivplot, node_boxplot, node_inner, node_surv,
## node_terminal, varimplibrary(mboost)## Loading required package: parallel## Loading required package: stabs##
## Attaching package: 'stabs'## The following object is masked from 'package:modeltools':
##
## parameters##
## Attaching package: 'mboost'## The following object is masked from 'package:partykit':
##
## varimp## The following object is masked from 'package:party':
##
## varimp## The following object is masked from 'package:glmnet':
##
## Cindex## The following object is masked from 'package:ggplot2':
##
## %+%library(plyr)##
## Attaching package: 'plyr'## The following object is masked from 'package:modeltools':
##
## emptylibrary(factoextra)## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary("FactoMineR")
# Adatok importálása
data <- read.csv(file = "tisztitott.csv")[,-c(1,2)]
data$Évjárat <- data$Évjárat |> as.numeric()
data$Műszakivizsgaérvényes<- data$Műszakivizsgaérvényes|> as.numeric()
data$VételárEUR <- data$VételárEUR |> as.numeric()
data$Vételár<- data$Vételár |> as.numeric()
data$Kmóraállás <- data$Kmóraállás |> as.numeric()
data$Szállíthatószemszáma <- data$Szállíthatószemszáma |> as.numeric()
data$Kmóraállás <- data$Kmóraállás|> as.numeric()
data$Csomagtartó <- data$Csomagtartó |> as.numeric()
data$Sajáttömeg <- data$Sajáttömeg |> as.numeric()
data$Hengerűrtartalom <- data$Hengerűrtartalom |> as.numeric()
data$Teljesítmény <- data$Teljesítmény|> as.numeric()
### faktorok
data$Állapot <- as.factor(data$Állapot)
data$Szín <- as.factor(data$Szín)
data$Klímafajtája<- as.factor(data$Klímafajtája)
data$Tető<- as.factor(data$Tető)
data$Kivitel<- as.factor(data$Kivitel)
data$Tető<- as.factor(data$Tető)
data$Üzemanyag<- as.factor(data$Üzemanyag)
data$Hajtás<- as.factor(data$Hajtás)
data$Sebességváltó<- as.factor(data$Sebességváltó)
data$Okmányokjellege<- as.factor(data$Okmányokjellege)
data$Hengerelrendezés<- as.factor(data$Hengerelrendezés)
data$Márka <- as.factor(data$Márka)
data$Modell<- as.factor(data$Modell)Adatok forrása, leíró statisztika
Adatok forrása
Adataink a hasznaltauto.hu online jármű hirdető felületről származnak, a megfigyelés október eleji. A scrapeléshez az Rvest csomagot (illetve Bash shellt) használtuk, ennek a kódja megtalálható a tömörített fileban, a markdownból a futási ideje (~4 óra) és nehéz beállítása miatt hagytuk ki, a részleteit emiatt nem is fejtjük ki jobban. (Kérdésekre szívesen válaszolunk az adatszerzéssel kapcsolatban is)
Leíró statisztika
Adatunk 80253 elemű, azonban ebből 69532 adatsorban van hiányzó adat. Azonban ezek többek között sok az olyan adathiány, amelyektől eltekinthetünk, mivel például az autó színe a változó (17224 darab üres mező).
Összesen 23 különböző attribútum érhető el az autókra, mivel ezek nagy része kategorikus változó (12 darab), így annak érdekében, hogy a modelleket belátható időn belül be tudjuk tanítani, csökkentünk a magyarázó változók számán. Így a következő változókat használtuk: vételár (magyarázott változó), autó állapota, évjárat változóból számított kor, kivitel, teljesítmény, üzemanyag típusa és kilóméteróra állása.
regrdata <- data[,c("Vételár","Állapot","Évjárat","Kivitel","Teljesítmény","Üzemanyag","Kmóraállás")]
regrdata$Kor <- 2023-regrdata$Évjárat
regrdata <- subset(regrdata, select = -Évjárat)
regrdata <- na.omit(regrdata)corrplot::corrplot(cor(regrdata[,sapply(regrdata,is.numeric)],use="pairwise.complete.obs"),method = "number")
Változók eloszlásai
Az eloszlások előtt elsőnek az összes változó felső és alsó 1-1%-ait kivettük, mivel adathibák és outlierek találhatóak köztük, amelyek torzítanák a becsléseinket.
outlier <- rep(F, nrow(regrdata))
outlier <- outlier | (regrdata$Vételár > quantile(regrdata$Vételár, 0.99)) | (regrdata$Vételár < quantile(regrdata$Vételár, 0.01))
outlier <- outlier | (regrdata$Kor> quantile(regrdata$Kor, 0.99)) | (regrdata$Kor< quantile(regrdata$Kor, 0.01))
outlier <- outlier | (regrdata$Kmóraállás> quantile(regrdata$Kmóraállás, 0.99)) | (regrdata$Kmóraállás< quantile(regrdata$Kmóraállás, 0.01))
outlier <- outlier | (regrdata$Teljesítmény> quantile(regrdata$Teljesítmény, 0.99)) | (regrdata$Teljesítmény< quantile(regrdata$Teljesítmény, 0.01))
regrdata <- regrdata[!outlier,]
sample <- sample.split(regrdata$Vételár, SplitRatio = .8)
data_train <- regrdata[sample,]
data_test <- regrdata[!sample,]Elsőnek a magyarázott változót, a vételárat írjuk le. Ennek és a vételár logaritmusának kiplotolását a következő ábrán láthatjuk:
a <- ggplot(regrdata, aes(Vételár))+ geom_histogram(fill="lightblue", bins= 30)+ theme_light()
b <- ggplot(regrdata, aes(log(Vételár)))+ geom_histogram(fill="lightgreen", bins= 30)+ theme_light()
cowplot::plot_grid(a,b, nrow = 2)
A vételár változó logaritmizálását azért csináltuk, mivel a változó láthatóan lognormális eloszlású.
a <- ggplot(regrdata, aes(Kor))+ geom_histogram(fill="mediumorchid1", bins= 30)+ theme_light()
b <- ggplot(regrdata, aes(Teljesítmény))+ geom_histogram(fill="skyblue", bins= 30)+ theme_light()
c <- ggplot(regrdata, aes(Kmóraállás))+ geom_histogram(fill="orange", bins= 30)+ theme_light()
cowplot::plot_grid(a,b,c,align = "v",nrow = 2)
A numerikus változóink leíró statisztikái a következőek:
psych::describe(cbind(data.frame(logVételÁr=log(regrdata$Vételár)),regrdata[,-c(2,3,5)]))## vars n mean sd median trimmed mad
## logVételÁr 1 74595 15.09 0.84 1.515e+01 15.12 0.95
## Vételár 2 74595 4909137.92 3746677.62 3.780e+06 4391784.59 3246894.00
## Teljesítmény 3 74595 139.82 53.64 1.310e+02 133.17 43.00
## Kmóraállás 4 74595 157726.12 98072.70 1.600e+05 155313.49 103782.00
## Kor 5 74595 10.33 6.49 1.000e+01 10.09 7.41
## min max range skew kurtosis se
## logVételÁr 12.59 1.659e+01 3.9900e+00 -0.27 -0.60 0.00
## Vételár 295000.00 1.599e+07 1.5695e+07 1.05 0.28 13718.02
## Teljesítmény 56.00 3.810e+02 3.2500e+02 1.35 2.34 0.20
## Kmóraállás 0.00 4.290e+05 4.2900e+05 0.17 -0.58 359.08
## Kor 0.00 3.400e+01 3.4000e+01 0.40 -0.11 0.02A kategorius változóink gyakoriságai a következőek:
summary(regrdata[,c(2,3,5)])## Állapot Kivitel Üzemanyag
## Kitűnő :21819 Ferdehátú :22244 Benzin :38124
## Megkímélt :18107 Kombi :14798 Dízel :31384
## Motorhibás : 0 Városi terepjáró (crossover):13684 Egyéb : 161
## Normál :24713 Sedan : 8391 Elektromos: 2119
## Sérülésmentes: 3563 Egyterű : 8372 Hibrid : 2807
## Újszerű : 6393 Coupe : 2374
## (Other) : 4732Modellek
Regressziók (lineáris, MARS, LASSO)
A regressziós modelleknél a nagy megfigyelésszám és az ehhez viszonyítottan kevés magyarázó változó miatt a tanító adathalmaz \(R^2\)-eit néztük.
Lineáris regresszió
Elsőnek egy egyszerű lineáris regressziót futtattunk le, annak érdekében, hogy legyen egy összehasonlítási pontunk.
linrg <- lm(log(Vételár) ~ ., data_train)
summary(linrg)##
## Call:
## lm(formula = log(Vételár) ~ ., data = data_train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5319 -0.1638 0.0033 0.1656 3.4965
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.476e+01 3.104e-01 47.567 < 2e-16 ***
## ÁllapotMegkímélt -6.865e-02 3.642e-03 -18.850 < 2e-16 ***
## ÁllapotNormál -1.387e-01 3.404e-03 -40.742 < 2e-16 ***
## ÁllapotSérülésmentes -1.370e-02 6.235e-03 -2.198 0.027957 *
## ÁllapotÚjszerű 2.601e-02 4.924e-03 5.282 1.28e-07 ***
## KivitelCabrio 7.900e-01 3.104e-01 2.545 0.010922 *
## KivitelCoupe 7.754e-01 3.104e-01 2.499 0.012473 *
## KivitelEgyéb 8.195e-01 3.144e-01 2.607 0.009140 **
## KivitelEgyterű 5.386e-01 3.103e-01 1.736 0.082651 .
## KivitelFerdehátú 5.049e-01 3.103e-01 1.627 0.103697
## KivitelKisbusz 1.157e+00 3.105e-01 3.725 0.000195 ***
## KivitelKombi 5.475e-01 3.103e-01 1.764 0.077664 .
## KivitelLépcsőshátú 6.066e-01 3.110e-01 1.951 0.051108 .
## KivitelPickup 9.256e-01 3.107e-01 2.979 0.002891 **
## KivitelSedan 6.047e-01 3.103e-01 1.949 0.051315 .
## KivitelSport 1.017e+00 3.169e-01 3.210 0.001328 **
## KivitelTerepjáró 9.956e-01 3.104e-01 3.207 0.001341 **
## KivitelVárosi terepjáró (crossover) 6.993e-01 3.103e-01 2.254 0.024227 *
## Teljesítmény 5.586e-03 2.737e-05 204.116 < 2e-16 ***
## ÜzemanyagDízel 1.298e-01 3.092e-03 41.963 < 2e-16 ***
## ÜzemanyagEgyéb -1.218e-01 2.731e-02 -4.460 8.22e-06 ***
## ÜzemanyagElektromos 2.266e-01 7.940e-03 28.536 < 2e-16 ***
## ÜzemanyagHibrid 3.043e-01 6.843e-03 44.478 < 2e-16 ***
## Kmóraállás -1.623e-06 2.002e-08 -81.045 < 2e-16 ***
## Kor -7.797e-02 2.874e-04 -271.309 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3103 on 60387 degrees of freedom
## Multiple R-squared: 0.863, Adjusted R-squared: 0.863
## F-statistic: 1.585e+04 on 24 and 60387 DF, p-value: < 2.2e-16Ahogyan azt láthatjuk, a lineáris modell tanító adatában az \(R^2\)-e 0.862952.
MARS modell
Második modellünk amelyet felhasználtunk a MARS modell volt, ezt az R EARTH csomagjával tettük. A modellhez ugyanazokat a változókat használtuk.
MARS <- earth(log(Vételár)~ ., regrdata, degree=2)
MARS |> summary()## Call: earth(formula=log(Vételár)~., data=regrdata, degree=2)
##
## coefficients
## (Intercept) 14.6098458
## ÁllapotNormál -0.0388802
## KivitelCabrio 0.2235579
## KivitelCoupe 0.1686843
## KivitelKisbusz 0.5812007
## ÜzemanyagDízel 0.0872137
## h(192-Teljesítmény) -0.0074201
## h(Teljesítmény-192) 0.0027639
## h(39395-Kmóraállás) -0.0000009
## h(Kmóraállás-39395) -0.0000013
## h(21-Kor) 0.0940723
## h(Kor-21) 0.0535288
## ÁllapotNormál * h(Kor-10) -0.0168334
## KivitelPickup * h(Kmóraállás-39395) 0.0000024
## KivitelTerepjáró * h(Kmóraállás-39395) 0.0000025
## KivitelVárosi terepjáró (crossover) * h(Kmóraállás-39395) 0.0000010
## h(192-Teljesítmény) * ÜzemanyagElektromos 0.0028313
## h(192-Teljesítmény) * ÜzemanyagHibrid 0.0042917
## h(73-Teljesítmény) * h(Kmóraállás-39395) -0.0000001
## h(Teljesítmény-73) * h(Kmóraállás-39395) 0.0000000
## h(Teljesítmény-192) * h(Kor-5) 0.0002317
## h(Teljesítmény-192) * h(5-Kor) -0.0008007
##
## Selected 22 of 23 terms, and 13 of 26 predictors
## Termination condition: RSq changed by less than 0.001 at 23 terms
## Importance: Kor, Teljesítmény, Kmóraállás, KivitelKisbusz, ÁllapotNormál, ...
## Number of terms at each degree of interaction: 1 11 10
## GCV 0.07242782 RSS 5395.006 GRSq 0.8962391 RSq 0.8963851A MARS modell \(R^2\)-e 0.8963851, amely nagyobb mint, a lineáris modellé.
LASSO modell
Harmadik modellünk a LASSO regresszió.
X <- as.matrix(dummy_cols(regrdata[ ,-1], remove_selected_columns = TRUE, remove_first_dummy = TRUE))
y <- log(regrdata$Vételár)
LASSO <- cv.glmnet(X, y)
plot(LASSO)
LASSO$lambda.1se## [1] 0.00709093coef(LASSO, lambda=LASSO$lambda.1se)## 27 x 1 sparse Matrix of class "dgCMatrix"
## s1
## (Intercept) 1.534514e+01
## Teljesítmény 5.619236e-03
## Kmóraállás -1.556149e-06
## Kor -7.819184e-02
## Állapot_Megkímélt -4.619969e-02
## Állapot_Motorhibás .
## Állapot_Normál -1.201279e-01
## Állapot_Sérülésmentes .
## Állapot_Újszerű 2.479541e-02
## Kivitel_Cabrio 1.450133e-01
## Kivitel_Coupe 1.413196e-01
## Kivitel_Egyéb .
## Kivitel_Egyterű -4.068761e-02
## Kivitel_Ferdehátú -7.882783e-02
## Kivitel_Kisbusz 5.076893e-01
## Kivitel_Kombi -3.061357e-02
## Kivitel_Lépcsőshátú .
## Kivitel_Mopedautó .
## Kivitel_Pickup 2.579605e-01
## Kivitel_Sedan .
## Kivitel_Sport 6.195548e-02
## Kivitel_Terepjáró 3.489329e-01
## Kivitel_Városi terepjáró (crossover) 9.679920e-02
## Üzemanyag_Dízel 1.039131e-01
## Üzemanyag_Egyéb .
## Üzemanyag_Elektromos 1.754859e-01
## Üzemanyag_Hibrid 2.644144e-01LASSO_legjobb <-glmnet(X, y, lambda=LASSO$lambda.1se)A LASSO modell \(R^2\)-e 0.8609098, amely kisebb mint, a lineáris modellé.
Fa modellek (Döntési fa és Véletlen erdő)
Döntési fa
fa <- rpart(Vételár~., data=data_train)
rpart.plot(fa)
predictions <- predict(fa, newdata = data_test)
actual_values <- data_test$Vételár
r_squared <- 1 - sum((actual_values - predictions)^2) / sum((actual_values - mean(actual_values))^2)
print(paste("R négyzet értéke:", round(r_squared, 4)))## [1] "R négyzet értéke: 0.7707"#parameter tuning
library(rpart)
library(caret)
ctrl <- trainControl(method = "cv", number = 10)
hyperparameters <- expand.grid(cp = seq(0.01, 0.1, by = 0.01))
tuned_model <- train(Vételár ~ ., data = data_train, method = "rpart",
trControl = ctrl, tuneGrid = hyperparameters)
print(tuned_model)## CART
##
## 60412 samples
## 6 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 54370, 54371, 54371, 54370, 54370, 54371, ...
## Resampling results across tuning parameters:
##
## cp RMSE Rsquared MAE
## 0.01 1778760 0.7781300 1276631
## 0.02 1889135 0.7495463 1356072
## 0.03 2120646 0.6845622 1588818
## 0.04 2237759 0.6484959 1674793
## 0.05 2331356 0.6176469 1758989
## 0.06 2407469 0.5933518 1826093
## 0.07 2426575 0.5871519 1838911
## 0.08 2635445 0.5130003 1987537
## 0.09 2635445 0.5130003 1987537
## 0.10 2635445 0.5130003 1987537
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was cp = 0.01.best_cp <- tuned_model$bestTune$cp
print(paste("Best cp:", best_cp))## [1] "Best cp: 0.01"best_tree <- rpart(Vételár ~ ., data = data_train, cp = best_cp)
rpart.plot(best_tree)
predictions <- predict(best_tree, newdata = data_test)
r_squared <- 1 - sum((actual_values - predictions)^2) / sum((actual_values - mean(actual_values))^2)
print(paste("R négyzet értéke:", round(r_squared, 4)))## [1] "R négyzet értéke: 0.7707"Véletlen erdő
A hosszú futási idő (40 perc) a hiperparaméterek változtatásával nem futtattunk több változatot.
rf <- randomForest(Vételár~., data=data_train, ntree=100, mtry=3)
varImpPlot(rf)
predictions <- predict(rf, newdata = data_test)
r_squared <- 1 - sum((actual_values - predictions)^2) / sum((actual_values - mean(actual_values))^2)
print(paste("R négyzet értéke:", round(r_squared, 4)))## [1] "R négyzet értéke: 0.9178"Boosting
Mivel az órán tanult Adaboost klasszifikációra használható, ezért mi egy másik Boosting algoritmust használtunk, ez az XGBoost.
library(xgboost)
y_train <- data_train$Vételár
X_train <- data_train[, !names(data_train) %in% "Vételár"]
y_test <- data_test$Vételár
X_test <- data_test[, !names(data_test) %in% "Vételár"]
X_train <- dummy_cols(X_train, remove_first_dummy=TRUE, remove_selected_columns=TRUE)
X_test <- dummy_cols(X_test, remove_first_dummy=TRUE, remove_selected_columns=TRUE)
xgb_model <- xgboost(data = as.matrix(X_train), label = y_train, objective = "reg:squarederror", nrounds = 100)## [1] train-rmse:4480770.331514
## [2] train-rmse:3287938.225187
## [3] train-rmse:2485471.018231
## [4] train-rmse:1963253.560027
## [5] train-rmse:1636788.309251
## [6] train-rmse:1436097.788973
## [7] train-rmse:1315285.090233
## [8] train-rmse:1241778.137132
## [9] train-rmse:1196307.870631
## [10] train-rmse:1169396.920723
## [11] train-rmse:1147233.458871
## [12] train-rmse:1134947.655309
## [13] train-rmse:1125887.737477
## [14] train-rmse:1117629.470827
## [15] train-rmse:1109648.732567
## [16] train-rmse:1105695.834390
## [17] train-rmse:1099302.897798
## [18] train-rmse:1096222.234558
## [19] train-rmse:1093395.321157
## [20] train-rmse:1088252.640441
## [21] train-rmse:1086051.142661
## [22] train-rmse:1082211.261864
## [23] train-rmse:1077708.889596
## [24] train-rmse:1073154.094029
## [25] train-rmse:1070232.988086
## [26] train-rmse:1064301.603889
## [27] train-rmse:1060882.343282
## [28] train-rmse:1058338.909580
## [29] train-rmse:1057195.026654
## [30] train-rmse:1051077.923803
## [31] train-rmse:1047473.926252
## [32] train-rmse:1042425.782987
## [33] train-rmse:1039290.122318
## [34] train-rmse:1038645.406163
## [35] train-rmse:1035994.735024
## [36] train-rmse:1034317.716694
## [37] train-rmse:1029842.837948
## [38] train-rmse:1026906.005597
## [39] train-rmse:1026197.842865
## [40] train-rmse:1025420.822940
## [41] train-rmse:1023125.692234
## [42] train-rmse:1019238.224015
## [43] train-rmse:1017032.499055
## [44] train-rmse:1013393.833606
## [45] train-rmse:1012293.105628
## [46] train-rmse:1011454.027158
## [47] train-rmse:1008019.094765
## [48] train-rmse:1004896.271264
## [49] train-rmse:1001613.441400
## [50] train-rmse:1000198.963806
## [51] train-rmse:998049.739519
## [52] train-rmse:996674.627714
## [53] train-rmse:993684.674081
## [54] train-rmse:991694.553222
## [55] train-rmse:989959.109052
## [56] train-rmse:988318.949313
## [57] train-rmse:987655.281141
## [58] train-rmse:985341.091657
## [59] train-rmse:984281.147010
## [60] train-rmse:983335.220793
## [61] train-rmse:981554.166090
## [62] train-rmse:980595.706983
## [63] train-rmse:978439.704963
## [64] train-rmse:977561.842420
## [65] train-rmse:975821.254846
## [66] train-rmse:974791.226643
## [67] train-rmse:973513.086189
## [68] train-rmse:972546.867516
## [69] train-rmse:970201.892105
## [70] train-rmse:968971.005433
## [71] train-rmse:968100.569446
## [72] train-rmse:965743.439661
## [73] train-rmse:964753.667678
## [74] train-rmse:964413.049385
## [75] train-rmse:963081.864014
## [76] train-rmse:960960.771090
## [77] train-rmse:959155.254702
## [78] train-rmse:957613.271775
## [79] train-rmse:955020.250670
## [80] train-rmse:953778.259101
## [81] train-rmse:953089.039276
## [82] train-rmse:952341.774358
## [83] train-rmse:950262.678117
## [84] train-rmse:949223.626318
## [85] train-rmse:948730.071863
## [86] train-rmse:948217.956079
## [87] train-rmse:948143.418489
## [88] train-rmse:947685.512561
## [89] train-rmse:945432.511001
## [90] train-rmse:943543.661990
## [91] train-rmse:941564.018805
## [92] train-rmse:939974.918825
## [93] train-rmse:939364.932918
## [94] train-rmse:938752.136662
## [95] train-rmse:937369.528811
## [96] train-rmse:936627.494251
## [97] train-rmse:936263.239565
## [98] train-rmse:934770.992295
## [99] train-rmse:933645.483208
## [100] train-rmse:932193.606544predictions <- predict(xgb_model, as.matrix(X_test))
r_squared <- 1 - sum((y_test - predictions)^2) / sum((y_test - mean(y_test))^2)
print(paste("R négyzet értéke a teszt adaton:", round(r_squared, 4)))## [1] "R négyzet értéke a teszt adaton: 0.9177"Főkomponens elemzés és Klaszterezés
Ennél a résznél a modellezésnél felhasznált változókon túl bevettünk olyan változókat is, amelyeknek nem feltétlen van gazdasági értelme, azonban nem akartunk kevés változót használni ezeknél a módszertanoknál.
Emellett a futásidő lerövidítése és az egyes függvények limitációi miatt (~60 ezernél nem működött az egyik klaszterező függvény) mindegyik algoritmust 1000-1000 elemszámú adattömbbel futtattuk le.
library(clustMixType)
pca_data<- data[,c(1,3,6,7,13,16,19,20)]
pca_data$Kor <-2023-pca_data$Évjárat
pca_data<-pca_data[,-c(2)] |> na.omit()
fokomp <- princomp(pca_data, cor=TRUE)
fokomp## Call:
## princomp(x = pca_data, cor = TRUE)
##
## Standard deviations:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
## 1.6971747 1.4787348 1.1358382 0.8466573 0.6169820 0.4955623 0.4268174 0.3428742
##
## 8 variables and 67722 observations.corrplot::corrplot(cor(pca_data,use="pairwise.complete.obs"),method = "number")
summary(fokomp)## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## Standard deviation 1.6971747 1.4787348 1.1358382 0.84665729 0.61698200
## Proportion of Variance 0.3600502 0.2733321 0.1612660 0.08960357 0.04758335
## Cumulative Proportion 0.3600502 0.6333823 0.7946484 0.88425194 0.93183528
## Comp.6 Comp.7 Comp.8
## Standard deviation 0.49556225 0.42681738 0.34287418
## Proportion of Variance 0.03069774 0.02277163 0.01469534
## Cumulative Proportion 0.96253303 0.98530466 1.00000000fokomp$loadings##
## Loadings:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
## Vételár 0.411 0.420 0.110 0.181 0.742 0.231
## Kmóraállás -0.591 0.712 0.329 0.157
## Szállíthatószemszáma -0.715 -0.645 -0.181 0.179
## Teljesítmény 0.526 -0.118 0.224 -0.162 0.415 -0.115 -0.669
## Csomagtartó 0.176 -0.620 0.755 -0.101
## Sajáttömeg 0.508 -0.167 -0.114 0.242 -0.783 -0.145
## Hengerűrtartalom 0.465 -0.327 0.172 -0.282 0.131 -0.292 0.682
## Kor -0.199 -0.569 -0.524 -0.147 0.570
##
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
## SS loadings 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000
## Proportion Var 0.125 0.125 0.125 0.125 0.125 0.125 0.125 0.125
## Cumulative Var 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000data_num <- data[,c(1,3,6,13)] |> scale()
data_klaszt<- as.data.frame(data_num)
data_klaszt$Állapot<- data$Állapot
data_klaszt$Kivitel<- data$Kivitel
data_klaszt$Üzemanyag<- data$Üzemanyag
data_klaszt<- data_klaszt[sample(1:nrow(data_klaszt), 1000, replace=F),]
klaszt_data<- as.data.frame(scale(pca_data))
klaszt_data<- klaszt_data[sample(1:nrow(klaszt_data), 1000, replace=F),]
data_num <- data_num |> as.data.frame()
# tul sok az adat, így csak az első 10000 elemet vesszük (futási idő miatt)
data_num<- data_num[sample(1:nrow(data_num), 1000, replace=F),] |> na.omit()
hier <- hclust(dist(data_num), method="ward.D")
plot(hier)
fviz_dend(hier, k=4)## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
#plotnak ilyen sok adatnál nincsen értelme
kkozep <- kmeans(data_num, centers=3)
kkozep## K-means clustering with 3 clusters of sizes 446, 383, 158
##
## Cluster means:
## Vételár Évjárat Kmóraállás Teljesítmény
## 1 -0.68583677 -0.8243406 0.6191788 -0.13180525
## 2 0.01093835 0.4673572 -0.2428082 -0.06070524
## 3 1.60287577 1.0856637 -1.0092397 0.50734004
##
## Clustering vector:
## 11988 34933 46788 31558 79289 17919 67457 54727 1270 43936 50931 70235 33554
## 1 2 2 1 3 3 1 2 1 2 2 2 2
## 59178 30754 7313 27156 37929 49093 57382 50852 51869 46495 14482 51086 43133
## 2 2 1 1 2 2 2 2 1 1 1 1 2
## 591 11573 18407 31360 77247 22356 29646 56118 20402 54892 42694 36671 58136
## 1 1 3 1 3 3 1 2 3 2 2 1 1
## 67347 47982 31277 56612 21027 6424 26576 11243 42757 20347 58875 40015 32528
## 2 2 1 2 3 1 1 1 2 3 2 1 2
## 66801 59777 1143 4984 54167 54129 78137 75065 49925 8791 6042 78352 36093
## 2 2 1 1 2 2 3 1 1 1 1 3 1
## 40935 61164 20956 51502 47986 9868 9102 26881 25141 56491 11205 19008 57784
## 1 2 3 2 2 1 1 1 1 2 1 3 2
## 11558 49441 76104 68570 58496 688 75614 24575 26153 19936 69245 13527 18036
## 1 2 2 3 2 1 1 1 1 3 2 1 3
## 21858 37045 12719 37094 40153 9661 427 58630 40789 34276 48805 1479 75709
## 3 2 1 2 2 1 1 2 2 2 1 1 1
## 75153 23728 10220 62597 55823 77516 51540 26097 56543 71351 69608 22505 40037
## 1 1 1 2 2 3 2 1 2 1 2 1 1
## 44716 1979 33057 40882 73226 32409 2614 9994 10118 52083 39848 23488 47536
## 1 1 1 2 3 1 1 1 1 2 1 3 2
## 59689 3583 33949 3401 7626 54332 15726 59914 40198 65228 2417 78653 35519
## 2 1 2 1 1 2 1 2 2 2 1 3 1
## 49588 78723 60553 44978 68321 25326 44349 36763 40887 24110 48078 54493 1662
## 2 3 2 1 1 1 2 1 1 1 1 1 1
## 48787 59557 18259 25813 23849 65191 9339 51561 73564 37252 17094 71596 37
## 2 2 3 1 1 2 1 2 3 2 3 1 3
## 20754 21686 35030 12639 65050 19652 6322 687 29177 50758 33401 74497 4688
## 3 3 2 1 2 3 1 1 2 2 1 1 1
## 70010 4498 23386 30331 1555 62679 56265 65935 55294 27017 9823 27339 51457
## 3 1 1 1 1 2 2 2 1 1 1 1 2
## 37024 65220 49290 73047 60815 37050 16398 78608 77125 45615 50348 52226 74872
## 2 2 2 3 1 2 3 3 3 2 2 2 1
## 32682 33710 52910 58814 4617 74134 15097 14938 14151 21645 41735 33597 68995
## 1 1 2 2 1 1 1 1 1 3 1 2 3
## 19792 45932 18420 65916 48270 1508 33074 20009 44548 55309 7608 7009 24267
## 3 2 3 2 2 1 2 3 1 1 1 1 1
## 10578 61525 50216 32370 30974 11713 42889 41057 78296 29373 7607 72017 43075
## 1 2 2 2 1 1 1 2 3 1 1 2 2
## 66910 78032 64130 73325 46359 26987 11765 56177 37471 75961 51114 39938 13501
## 2 3 2 1 1 1 1 1 1 2 2 1 1
## 31880 7600 60275 53231 28433 19270 56664 72838 43968 27925 35069 1877 50752
## 1 1 2 2 2 3 2 3 2 1 2 1 2
## 65880 1088 21081 72468 40380 40953 65471 66779 64703 37154 26218 41628 74775
## 2 1 3 3 2 2 2 2 2 1 1 2 1
## 33983 9967 37059 36552 10011 24859 23540 56430 7712 12452 54718 21305 25779
## 2 1 2 2 1 1 1 2 1 1 2 3 2
## 73081 33924 73787 47740 70492 6703 66744 69614 43653 69986 50267 60228 10504
## 3 2 3 1 3 1 2 2 1 3 2 2 1
## 13021 39333 42934 77621 45634 39628 60128 55362 5400 28655 552 37298 65498
## 1 2 2 3 2 1 2 2 1 1 1 1 2
## 77619 26927 36705 17656 19243 33642 79404 62027 67262 31317 3406 47985 50655
## 3 2 2 3 3 2 3 2 2 1 1 2 2
## 66114 39489 34441 30264 32632 27728 8151 60307 55954 43299 67492 10235 9735
## 2 1 2 1 2 2 1 2 2 2 1 1 1
## 619 20109 67400 17513 77176 18546 62323 66542 48517 30009 61580 75938 26984
## 1 3 1 3 3 3 2 2 2 1 2 2 1
## 23306 60347 3166 52461 3892 33809 48724 58146 39921 5342 33780 33608 4612
## 3 2 1 1 2 2 1 1 2 1 1 1 1
## 52764 277 18521 6727 54685 9768 179 45609 31136 13246 48188 36056 39202
## 1 1 3 1 1 1 1 1 1 1 2 1 2
## 73591 67897 33629 31332 10498 223 62514 49228 71188 40584 69458 23658 10372
## 3 1 1 1 1 1 2 2 1 2 2 1 1
## 29267 41527 73270 57492 69361 21702 36555 7149 73725 11760 4450 66703 12252
## 1 1 3 2 2 3 1 1 3 1 1 2 1
## 42636 49915 59675 74322 51332 7266 28978 79857 29073 5380 72303 22901 15349
## 2 2 2 1 2 1 1 3 1 1 3 3 1
## 27240 62467 40180 31525 56030 52533 66140 28527 44202 63399 12800 43629 75484
## 1 1 2 1 2 1 2 1 2 1 1 1 1
## 15725 43487 77293 53588 76907 3436 52620 54815 40364 59175 11826 54459 7476
## 2 2 3 2 3 1 1 2 2 2 2 2 1
## 66599 19424 77545 72715 51120 79105 14035 51833 10987 79386 39994 4790 21710
## 2 3 3 3 2 3 1 1 2 3 2 1 3
## 75537 33514 27835 1283 36399 30268 33559 7172 9005 33376 20731 6398 77707
## 1 2 2 1 1 2 2 1 1 2 3 1 3
## 9962 78780 9398 12351 61575 3652 65161 34514 69722 24787 69957 47586 61925
## 2 3 1 1 3 1 2 1 3 1 3 2 2
## 14424 53276 59003 53666 78541 3102 45428 28041 49998 36724 76084 31482 19140
## 1 2 2 2 3 1 1 1 2 2 2 1 3
## 29306 63963 78512 6974 48661 75895 35211 4480 7748 14043 62402 40807 49481
## 1 1 3 1 2 2 2 2 1 1 2 2 2
## 21280 76805 47397 24499 47667 28957 15638 25264 48333 217 61476 69310 41042
## 3 3 2 1 2 1 2 1 2 1 2 2 2
## 38584 2063 23778 66359 52577 38603 54820 3968 74965 46972 18619 35780 23220
## 1 1 1 3 1 1 2 1 1 2 3 1 3
## 10614 47025 68443 27372 33063 45590 67118 71163 11332 30063 56634 51465 54263
## 1 2 2 1 2 2 2 1 1 1 2 2 2
## 20142 78249 10050 42674 4836 66201 56840 70777 25535 26184 51829 1136 9658
## 3 3 1 1 1 2 2 3 1 1 1 1 1
## 11185 28677 34844 22970 74059 78105 55957 59872 69432 65676 5616 71206 8530
## 1 1 2 3 1 3 2 2 2 2 1 1 2
## 62086 59179 9547 60121 71731 40329 52435 21120 31592 55150 41260 76660 49635
## 2 2 1 2 3 1 1 3 2 2 2 3 2
## 62158 70089 70921 50781 67364 12196 77273 3086 16388 50835 50970 51101 77853
## 2 3 2 2 1 1 3 1 3 2 1 1 3
## 8979 7985 74171 56770 73246 39849 76915 79584 1482 36892 17617 54923 24440
## 1 1 1 2 3 1 3 3 1 1 3 2 1
## 54039 46948 47043 60954 62267 58657 63292 13012 55064 54610 51122 8786 53769
## 2 2 2 2 2 2 1 1 2 2 2 1 2
## 38870 5392 22450 50083 5229 24457 52688 75745 26133 61290 51127 11025 22721
## 1 1 3 2 1 1 1 1 2 2 2 1 3
## 20074 18081 47299 55088 51828 29902 42038 73627 63475 22618 28024 18854 2237
## 3 3 2 2 1 1 2 3 1 3 1 3 1
## 10816 22308 32828 39173 11261 11439 30140 70566 76025 11474 12846 11654 23538
## 1 3 2 1 2 1 1 3 2 1 1 1 1
## 40692 18661 28018 41352 40338 27230 38910 39948 69866 56012 55326 73890 42785
## 1 3 1 2 1 1 2 1 3 2 1 1 2
## 27712 23729 67077 80183 25302 12466 49854 1334 56297 35814 6371 48980 40436
## 1 1 3 3 1 1 2 1 2 1 1 2 1
## 70213 68336 27626 8203 49446 78849 44149 25498 77079 32136 7438 3462 4138
## 2 2 1 1 2 3 2 1 3 1 1 1 1
## 20657 58627 22984 33842 50989 55660 44140 5678 58574 69492 55108 56103 65660
## 3 2 3 1 2 2 2 1 2 3 2 2 2
## 45173 8418 13781 25393 1458 9035 53613 78656 75191 62466 48183 71946 18147
## 3 1 1 1 1 1 2 3 1 2 2 3 3
## 58530 54333 33821 79894 26291 7550 68635 11440 39564 45965 39113 60982 55998
## 1 2 2 3 1 1 3 1 1 1 1 2 2
## 42121 64815 21800 67662 68413 23945 69115 35045 2744 31817 24390 62367 75540
## 2 2 3 1 2 2 3 2 1 1 1 2 1
## 8613 303 61089 67190 55451 52041 31830 64048 43615 46350 1293 46429 8445
## 1 1 2 2 2 2 2 2 1 1 1 2 1
## 36060 19281 73887 42832 55405 59168 68250 63387 41026 4437 57060 54975 37066
## 1 1 1 2 2 2 1 1 2 1 2 2 2
## 54775 36390 21762 47056 24102 59798 31850 875 42857 36175 30648 27694 12273
## 2 1 3 2 2 2 2 1 1 1 1 1 1
## 40504 72587 73018 19611 30055 55353 65955 35046 31196 9321 50880 43905 59812
## 2 3 3 3 1 2 2 2 1 1 2 2 2
## 71161 24352 26443 6248 39284 70499 2422 364 8564 73543 27640 14318 22484
## 1 1 1 1 2 1 1 1 1 3 1 1 1
## 11200 5558 23253 64215 50996 72450 36174 63107 23085 39742 32559 14907 41712
## 1 1 3 2 2 2 1 1 3 2 1 1 2
## 52902 2299 21028 57483 41004 58513 4525 51019 78062 52448 63045 78734 8969
## 2 1 3 2 2 2 1 2 3 1 1 3 1
## 46578 39619 42152 47661 33305 9534 44741 56929 8377 5475 70341 74854 47083
## 2 1 2 2 1 1 2 2 1 1 2 1 2
## 2481 1524 41281 31165 74344 30513 58205 61505 53483 47403 48999 59918 57798
## 1 1 1 1 1 2 1 2 2 2 1 2 2
## 20161 75604 51806 78878 3071 10306 13379 67920 6894 53784 28819 47218 36858
## 3 1 2 3 1 1 1 1 1 2 1 1 2
## 14962 51118 55905 38320 61974 44763 13693 35179 37009 64968 20101 55990 48001
## 2 2 2 2 2 1 1 1 1 2 3 2 1
## 73846 69138 935 43558 43971 55803 56233 34326 53109 961 47310 75385 55685
## 1 2 1 2 2 2 2 2 2 1 2 1 2
## 4318 21172 64406 53297 61653 62203 29066 49048 20206 36103 29877 14042 78984
## 1 3 2 2 2 2 2 2 3 1 1 2 3
## 37376 11529 13231 22143 17419 27238 36501 74182 78693 30298 3330 33173 18994
## 1 1 1 3 3 1 2 1 3 1 1 1 3
## 76638 22231 38872 12278 37001 77648 74361 41852 52571 23768 67531 12713 19795
## 3 3 1 1 2 3 1 2 1 1 1 1 3
## 74337 65166 25925 52890 57595 70318 65162 67490 20102 13430 55731 36787 8260
## 1 2 1 2 2 2 2 1 3 1 2 1 1
## 23570 51128 2109 49674 56496 9662 33585 64107 23437 25019 12705 56102
## 3 2 1 2 2 1 2 2 3 1 2 2
##
## Within cluster sum of squares by cluster:
## [1] 718.9333 357.8588 260.9018
## (between_SS / total_SS = 54.3 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"k.max <- 8
data2<-klaszt_data
wss <- sapply(1:k.max,
function(k){kmeans(data2, k, nstart=100,iter.max = 100 )$tot.withinss})
wss## [1] 7095.770 5466.447 4239.492 3566.811 3126.443 2789.884 2490.727 2319.461plot(1:k.max, wss,
type="b", pch = 19, frame = FALSE,
xlab="Number of clusters K",
ylab="Total within-clusters sum of squares")
fviz_nbclust(klaszt_data, FUNcluster=kmeans, method="gap_stat")
kkozep2 <- kmeans(klaszt_data, centers=2)
kkozep2## K-means clustering with 2 clusters of sizes 333, 667
##
## Cluster means:
## Vételár Kmóraállás Szállíthatószemszáma Teljesítmény Csomagtartó
## 1 0.24020841 0.5202689 0.07326061 0.8358609 0.2231230
## 2 -0.09874513 -0.3164387 -0.09576153 -0.4514000 -0.1106009
## Sajáttömeg Hengerűrtartalom Kor
## 1 0.9471965 0.9376382 0.1721994
## 2 -0.4678991 -0.4919839 -0.1418703
##
## Clustering vector:
## 22504 13859 73283 1618 40524 27950 5824 37768 54715 114 24401 70633 4432
## 2 2 2 1 2 2 2 2 1 2 2 1 2
## 15502 39620 24643 1838 75932 42060 1384 55199 24670 44509 19105 14648 58282
## 2 1 2 2 2 1 1 2 2 2 2 2 2
## 13761 69630 8424 20365 60658 12265 44635 49283 13068 71997 71418 10647 10236
## 2 1 1 2 1 2 1 2 1 2 2 2 1
## 16930 22294 8904 49257 19945 56886 31629 22355 30700 20100 18596 4865 53073
## 1 2 2 2 1 1 2 2 2 1 1 2 1
## 13869 62465 75861 76785 68553 16432 32082 47658 13014 18670 45300 67756 43982
## 2 1 2 2 1 1 1 2 2 1 2 1 2
## 14424 54579 14030 121 2573 29485 68846 41016 29191 65775 65430 61875 55356
## 2 1 1 2 2 2 2 1 2 1 1 2 1
## 35678 56987 66897 56447 20168 23413 25070 60013 36940 35000 23194 7428 43290
## 2 2 1 2 2 2 1 2 1 2 1 1 2
## 59831 21485 24069 74259 9032 13897 63637 43867 62843 44057 65682 65479 5472
## 2 2 1 2 2 2 2 1 2 2 2 2 1
## 62550 78238 13021 31819 46705 7097 46056 47885 42688 9699 71828 78977 22532
## 2 2 2 2 1 2 2 1 1 2 1 2 2
## 36931 46430 1869 76088 29055 66779 5631 15168 9424 68576 72365 38706 44072
## 1 2 2 2 2 1 2 1 2 2 2 1 2
## 48242 15143 16336 28456 50383 76559 48493 54197 65457 78162 64376 62821 57552
## 2 2 1 2 2 2 2 1 2 2 2 2 2
## 31241 48657 58644 61067 56243 63935 75983 13639 63820 61272 70126 71718 26794
## 2 1 2 2 1 2 2 2 2 2 1 1 1
## 61177 75762 46216 14050 5182 7318 17272 19942 26379 69628 45525 26910 10866
## 2 2 2 2 2 2 1 1 2 2 2 2 2
## 16661 54380 63137 34076 38061 66186 3641 23503 2199 66992 65691 40615 22168
## 1 2 2 2 1 2 2 1 2 2 1 2 1
## 62421 62443 48914 53539 47491 4753 57596 23031 76549 46516 76203 30430 14992
## 2 1 1 2 2 2 2 1 2 2 2 1 2
## 37072 47752 14467 46107 68761 3029 7212 41842 66763 3892 45918 52136 12640
## 2 2 2 1 2 1 1 2 2 2 2 2 1
## 24213 65373 28019 67021 24997 67989 475 62530 15868 74138 42027 63481 34853
## 1 1 1 2 2 2 1 1 1 1 2 2 2
## 38373 8184 61438 4433 57123 26224 25806 71080 61195 38550 54504 48735 67577
## 2 2 2 2 1 1 2 1 2 2 2 1 1
## 65862 46806 72295 37242 56463 13685 67793 76518 66870 74556 75819 4330 58333
## 2 2 1 1 2 2 2 2 2 2 2 2 2
## 25930 76998 2308 12933 22347 52596 44863 62861 49595 39693 39658 28689 56093
## 1 2 1 1 2 1 2 2 2 2 1 2 2
## 40396 30373 21454 25079 32217 61546 68704 65513 11982 64617 41188 515 64388
## 2 1 1 2 2 1 2 2 1 1 1 2 2
## 72293 59795 41587 56409 29422 41817 5750 44540 9106 39547 62287 66287 6614
## 1 2 2 2 2 1 2 2 2 2 2 1 2
## 19403 1531 71959 57343 60064 4960 11155 48950 47852 47549 59774 3195 22770
## 1 2 1 1 2 2 2 1 2 2 2 2 1
## 60689 50165 30470 71040 78746 78962 49209 21590 52575 30625 21775 22186 64689
## 2 2 2 2 2 2 1 2 1 1 1 1 1
## 9353 15463 72999 17467 18673 61651 11002 1723 46261 23688 18395 10746 64483
## 2 2 1 1 1 2 2 2 2 2 2 2 2
## 22084 43844 4567 74857 2965 18871 26530 9884 69955 33192 24796 6317 37241
## 1 2 2 2 2 1 2 1 1 2 2 2 2
## 50973 11300 52303 12913 64999 33174 19308 42697 59440 19009 38494 55723 17546
## 1 1 1 2 2 2 1 1 2 1 1 2 2
## 74397 49695 27495 76553 63451 65798 33837 63038 32829 19937 75339 11622 23947
## 2 2 1 2 1 2 1 2 2 1 2 2 2
## 30326 29129 14972 31649 49729 62904 28211 19757 68489 11087 20268 45592 15324
## 2 2 2 2 2 2 2 1 2 1 2 2 1
## 34786 14435 69192 41925 8951 73198 73407 25328 24140 21555 34070 39567 10871
## 1 2 2 2 2 2 2 2 1 2 2 2 2
## 12625 73620 26661 39918 9213 39063 46636 50723 12006 55431 51993 9504 51906
## 2 1 2 2 2 1 2 2 1 1 1 1 1
## 52750 56523 1665 36224 16207 78751 28835 66595 9729 79750 37233 56885 19336
## 2 1 2 1 1 2 1 2 2 2 2 2 1
## 47133 35198 17853 46482 72200 12153 24433 40411 24563 50926 13540 44363 6160
## 2 2 2 1 2 2 2 2 1 2 2 1 1
## 75940 34114 61269 26374 29384 71910 61628 73233 65972 75850 59598 164 30812
## 2 1 2 2 1 1 1 1 1 2 2 2 2
## 67365 28466 52318 75513 60926 487 79771 55130 8019 19695 22048 55918 67932
## 2 2 2 2 2 2 2 2 1 2 2 2 2
## 77001 11210 73749 52892 39569 41784 2739 77685 36502 49278 40584 77495 40766
## 2 1 2 1 2 2 2 2 2 2 2 2 2
## 30189 42612 75371 33962 58696 20644 78371 68539 36037 26844 16472 22183 479
## 2 1 2 2 1 2 2 2 2 2 1 1 2
## 74187 58004 12204 67896 24839 60937 79533 70955 27381 70912 57346 77207 31582
## 2 1 1 1 1 1 1 2 1 2 2 2 1
## 47348 44858 70242 24195 37170 49671 69730 8182 68049 63719 42472 75763 26519
## 2 2 1 1 1 2 2 2 2 2 2 1 1
## 20167 51688 42455 6402 66483 4506 23969 42797 39629 79302 12333 51476 76003
## 2 1 2 1 2 2 1 2 1 2 2 2 2
## 59562 1481 4355 34507 41553 18772 61154 35035 10437 78973 71252 34351 43780
## 2 2 2 2 1 2 1 2 2 2 2 2 1
## 55578 4375 15065 25755 77566 51097 54199 18930 1634 69111 62384 41356 37495
## 2 2 1 1 2 2 1 1 1 2 2 2 2
## 627 53165 54790 8901 45603 77077 59110 37007 78095 73162 22884 30811 61785
## 2 1 2 2 1 2 2 2 2 1 1 1 2
## 70037 47783 68800 26483 55232 44220 78904 1636 29560 25441 33389 68382 78858
## 2 2 1 1 1 1 2 2 2 2 2 2 2
## 57504 40123 39308 31031 64809 62481 74457 71859 72996 13850 40365 52022 19606
## 2 1 2 1 1 2 2 1 2 2 2 2 1
## 8867 19736 38568 27711 55128 2095 8740 18354 62542 13148 64231 54836 48309
## 2 2 1 2 2 2 1 1 1 2 2 2 2
## 59427 6377 14606 10896 56877 42416 9015 70372 61981 68283 39251 56753 42712
## 2 2 1 2 2 2 2 2 1 2 1 1 2
## 72523 79408 321 49160 61946 38400 974 51831 46500 15094 75044 50303 68723
## 1 2 1 2 2 2 2 1 2 2 2 2 2
## 17113 33955 69611 46389 63908 28922 65840 38512 7826 24314 39271 43646 55732
## 1 2 1 2 2 2 1 2 2 2 2 1 2
## 74505 5708 18932 26466 62250 41873 5647 46207 46167 6426 40863 8765 14249
## 1 1 1 1 2 1 2 2 2 2 2 1 2
## 75463 62869 12611 3180 29254 44443 16123 64627 54904 26113 78317 33186 38671
## 2 1 2 2 2 2 2 1 2 2 2 1 1
## 53258 47847 34521 46546 20989 14840 29464 56756 68611 53685 78527 42395 41806
## 1 2 2 1 2 1 2 2 1 2 2 2 2
## 22964 1549 29730 17699 12446 47055 59221 24142 41725 7183 51672 30347 583
## 1 2 1 2 2 2 2 1 1 2 2 2 2
## 39831 45684 58320 17078 67138 50984 68151 24214 29318 977 2107 31765 10907
## 2 1 2 1 1 1 2 2 2 2 2 2 2
## 42845 68056 70276 54599 45477 29187 64846 24813 1808 42437 76466 45183 21296
## 2 2 2 2 2 2 2 1 2 2 2 2 2
## 73025 76367 13321 7315 78708 9450 32820 38454 25495 8668 3525 27772 57364
## 1 2 2 1 2 2 1 1 2 2 1 2 1
## 77974 47683 63769 67964 78210 9979 26919 34997 50195 70210 162 50743 30271
## 2 2 2 2 2 2 2 2 2 1 2 2 2
## 40181 11678 63021 1104 15301 45112 49318 46559 11864 18366 78140 42976 65734
## 2 2 2 2 1 2 2 1 2 2 2 2 1
## 25029 66032 65160 46923 17779 38083 34363 43799 15712 77461 46424 15342 12227
## 2 2 1 1 1 2 1 2 2 2 2 2 1
## 53063 58112 1707 77836 60947 77131 69873 20871 70988 64011 27382 78313 16973
## 2 2 1 2 2 2 2 1 1 2 2 2 2
## 26922 61063 37332 10247 8120 17801 50657 4873 34776 24311 61410 38222 16872
## 2 1 2 2 2 1 2 2 2 1 2 2 1
## 45384 60583 35047 10577 17750 19158 42471 58402 53710 54166 59302 76018 52222
## 2 2 2 2 1 1 2 2 2 2 2 2 1
## 50746 61327 4695 4220 18381 67841 11569 11240 26255 6060 46951 1259 14856
## 1 2 2 2 1 2 1 1 2 2 2 2 2
## 34427 2213 15549 439 14831 16271 20561 23938 78530 57776 14864 27002 54988
## 1 2 2 2 2 1 1 1 2 1 1 1 1
## 31267 55473 33706 69581 50052 19427 22493 13698 50789 75008 61114 71139 45761
## 2 1 1 1 2 1 2 2 2 2 2 1 2
## 72816 53592 31175 23550 42148 42719 53239 59560 14419 4933 22463 78933 12513
## 1 2 2 2 1 2 1 2 2 1 1 2 2
## 26849 25388 51102 37082 74220 5601 24222 44036 49584 46163 32372 28673 53667
## 2 1 2 1 2 2 2 2 1 2 1 1 1
## 4307 45879 50630 24101 20038 72349 60618 57840 36085 53149 37838 657 75331
## 2 2 2 2 2 1 2 2 2 2 1 2 2
## 44624 23269 42856 30212 47051 6491 21354 13824 50878 11414 72157 45472 62877
## 1 2 1 1 2 2 1 1 1 2 2 2 2
## 6676 61046 72103 51516 67412 12314 80121 13791 20312 28359 62282 6290 5739
## 1 2 1 2 2 1 1 2 1 2 2 2 1
## 5526 7405 4497 55954 70504 77419 65264 60039 70477 32329 46753 65881 25597
## 2 1 2 1 1 2 2 2 2 2 1 2 2
## 18266 49497 65014 16476 15381 57210 78695 25146 20223 4364 77559 23242 44949
## 2 2 1 2 1 2 2 1 2 2 2 1 2
## 33988 54666 66684 32299 28334 71645 65347 779 2031 37083 79040 44481 44601
## 2 2 2 2 2 1 2 2 2 2 2 2 1
## 16898 69132 59366 62986 66468 48656 9230 62154 10716 34 26385 76708 47161
## 2 1 1 2 2 1 2 2 2 1 2 2 2
## 79097 47241 26970 38599 48092 52836 6709 34594 73388 49308 2437 63734 23837
## 1 1 1 1 2 1 2 2 1 2 2 2 2
## 50210 37758 16696 61185 64646 47471 32176 76103 47215 73242 61014 66262 46122
## 2 2 1 2 2 1 1 2 2 2 1 2 2
## 24933 62156 29861 2043 52340 30308 36399 9641 27593 45172 54108 7062
## 2 1 1 2 2 1 2 2 1 1 1 2
##
## Within cluster sum of squares by cluster:
## [1] 2902.734 2692.253
## (between_SS / total_SS = 21.2 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"k_prot <- kproto(data_klaszt, k = 3)## # NAs in variables:
## Vételár Évjárat Kmóraállás Teljesítmény Állapot Kivitel
## 0 0 0 11 0 0
## Üzemanyag
## 5
## 12 observation(s) with NAs.## Observations with NAs are removed.##
## Estimated lambda: 1.118386
##
## 0 observation(s) with NAs.k_prot## Distance type: standard
##
## Numeric predictors: 4
## Categorical predictors: 3
## Lambda: 1.118386
##
## Number of Clusters: 3
## Cluster sizes: 355 167 466
## Within cluster error: 975.9331 751.3553 1553.602
##
## Cluster prototypes:
## Vételár Évjárat Kmóraállás Teljesítmény Állapot
## 1 0.008240308 0.5449784 -0.4144923 -0.1821337 Kitűnő
## 2 1.631855579 0.8730960 -0.6965839 0.6585588 Kitűnő
## 3 -0.673263676 -0.8080152 0.5843241 -0.1185820 Normál
## Kivitel Üzemanyag
## 1 Ferdehátú Benzin
## 2 Városi terepjáró (crossover) Dízel
## 3 Ferdehátú Benzink_prot2 <- kproto(data_klaszt, k = 2)## # NAs in variables:
## Vételár Évjárat Kmóraállás Teljesítmény Állapot Kivitel
## 0 0 0 11 0 0
## Üzemanyag
## 5
## 12 observation(s) with NAs.## Observations with NAs are removed.##
## Estimated lambda: 1.118386
##
## 0 observation(s) with NAs.k_prot2## Distance type: standard
##
## Numeric predictors: 4
## Categorical predictors: 3
## Lambda: 1.118386
##
## Number of Clusters: 2
## Cluster sizes: 605 383
## Within cluster error: 2094.484 1578.823
##
## Cluster prototypes:
## Vételár Évjárat Kmóraállás Teljesítmény Állapot
## 1 -0.5983014 -0.5769091 0.4406725 -0.1535333 Normál
## 2 0.8451088 0.8140190 -0.6730707 0.2165804 Kitűnő
## Kivitel Üzemanyag
## 1 Ferdehátú Benzin
## 2 Városi terepjáró (crossover) Benzin