A kódoláshoz ChatGPT-t is használtunk adatok előkészítése (numerikus változók kiválasztása, egy időpontbeli megfigyelésekre való csökkentés, márkák előfordlásának kiszámítása)
library(smacof)
## Warning: package 'smacof' was built under R version 4.3.3
## Loading required package: plotrix
## Loading required package: colorspace
## Loading required package: e1071
## Warning: package 'e1071' was built under R version 4.3.3
##
## Attaching package: 'smacof'
## The following object is masked from 'package:base':
##
## transform
library(ggplot2)
library(haven)
set.seed(2024)
vegso_adat <- readRDS("C:/Users/BF/Downloads/vegso_adat.RDS")
unique(vegso_adat$Megfigyelés)
## [1] 2022-03-23 2022-09-29 2023-04-03 2023-10-09 2024-03-29
## Levels: 2022-03-23 2022-09-29 2023-04-03 2023-10-09 2024-03-29
vegso_adat <- vegso_adat[vegso_adat$Megfigyelés == "2024-03-29", ]
vegso_adat <- vegso_adat[, c("Vételár", "Teljesítmény", "Kor", "Kmóraállás", "Sajáttömeg", "Márka")]
unique(vegso_adat$Márka)
## [1] TOYOTA VOLKSWAGEN VOLVO PEUGEOT SEAT
## [6] SKODA MERCEDES-BENZ BMW NISSAN ALFA_ROMEO
## [11] HYUNDAI AUDI TESLA JEEP OPEL
## [16] RENAULT JAGUAR MITSUBISHI SUZUKI FIAT
## [21] FORD MINI KIA CITROEN MAZDA
## [26] SUBARU SSANGYONG HONDA CHEVROLET LADA
## [31] DACIA SMART MG LEXUS PORSCHE
## [36] MERCEDES-AMG
## 38 Levels: ALFA_ROMEO AUDI BMW CHEVROLET CITROEN DACIA FIAT FORD ... ALFA
table(vegso_adat$Márka)
##
## ALFA_ROMEO AUDI BMW CHEVROLET CITROEN
## 675 4339 5973 594 1752
## DACIA FIAT FORD HONDA HYUNDAI
## 894 1442 5964 1646 2539
## JAGUAR JEEP KIA LADA LEXUS
## 257 328 2480 68 502
## MAZDA MERCEDES-AMG MERCEDES-BENZ MG MINI
## 1956 131 4897 365 560
## MITSUBISHI NISSAN OPEL PEUGEOT PORSCHE
## 861 1890 5904 2555 267
## RENAULT SEAT SKODA SMART SSANGYONG
## 2812 1161 3513 95 352
## SUBARU SUZUKI TESLA TOYOTA VOLKSWAGEN
## 202 1675 314 3757 7167
## VOLVO LAND ALFA
## 1830 0 0
counts <- table(vegso_adat$Márka)
első adatszűrés, azokra a márkákra amelyikből legalább 100 megfigyelés van, és utánna “márkánkéni átlag” kiszámolása
set.seed(2024)
valid_brands <- names(counts[counts > 100])
szurtmarkak <- vegso_adat[vegso_adat$Márka %in% valid_brands, ]
summary_df <- aggregate(
cbind(Vételár, Teljesítmény, Kor, Kmóraállás, Sajáttömeg) ~ Márka,
data = szurtmarkak,
FUN = mean,
na.rm = TRUE
)
első modellek (metrikus és nem metrikus), nagyon jó stress értékkel de kissé átláthatatlan lett a “térkép” néhány kiugró miatt, ezért tovább szűkítettü
set.seed(2024)
#####metrikus
adat_num<- scale(summary_df[,-1])
tav <- as.matrix(dist(adat_num))
MDS <- mds(tav)
plot(MDS$conf)
text(MDS$conf, labels=summary_df$Márka)
MDS$stress
## [1] 0.04865049
########## nem metrikus
MDS_nm <- mds(tav, type="ordinal")
plot(MDS_nm$conf)
text(MDS_nm$conf, labels=summary_df$Márka)
MDS_nm$stress
## [1] 0.02971212
második modell (kevesebb márkára szűrtünk, itt is metrikus és nem metrikus modellt is csináltunk) stressek itt is elég jók, de kissé még mindig átláthatatlan
valid_brands2 <- names(counts[counts > 500])
szurtmarkak2 <- vegso_adat[vegso_adat$Márka %in% valid_brands2, ]
summary_df2 <- aggregate(
cbind(Vételár, Teljesítmény, Kor, Kmóraállás, Sajáttömeg) ~ Márka,
data = szurtmarkak2,
FUN = mean,
na.rm = TRUE
)
adat_num2<- scale(summary_df2[,-1])
tav2 <- as.matrix(dist(adat_num2))
MDS2 <- mds(tav2)
plot(MDS2$conf)
text(MDS2$conf, labels=summary_df2$Márka)
MDS2$stress
## [1] 0.07269532
MDS2_nm <- mds(tav2, type="ordinal")
plot(MDS2_nm$conf)
text(MDS2_nm$conf, labels=summary_df2$Márka)
MDS2_nm$stress
## [1] 0.04854847
harmadik modell (csak 1000 megfigyelésnél nagyobb márkák)
valid_brands3 <- names(counts[counts > 1000])
szurtmarkak3 <- vegso_adat[vegso_adat$Márka %in% valid_brands3, ]
summary_df3 <- aggregate(
cbind(Vételár, Teljesítmény, Kor, Kmóraállás, Sajáttömeg) ~ Márka,
data = szurtmarkak3,
FUN = mean,
na.rm = TRUE
)
#####metrikus
adat_num3<- scale(summary_df3[,-1])
tav3 <- as.matrix(dist(adat_num3))
MDS3 <- mds(tav3)
plot(MDS3$conf)
text(MDS3$conf, labels=summary_df3$Márka)
MDS3$stress
## [1] 0.06808861
########## nem metrikus
MDS3_nm <- mds(tav3, type="ordinal")
plot(MDS3_nm$conf)
text(MDS3_nm$conf, labels=summary_df3$Márka)
MDS3_nm$stress
## [1] 0.04355239
teljesség kedvéért 1 dimenzióban is kipróbáltuk, azok nem használhatóak
MDS3_nm_1 <- mds(tav3,ndim = 1, type="ordinal")
MDS3_nm_1$stress
## [1] 0.2826529
MDS_nm_1 <- mds(tav,ndim = 1, type="ordinal")
MDS_nm_1$stress
## [1] 0.2285094
MDS2_nm_1 <- mds(tav2,ndim=1, type="ordinal")
MDS2_nm_1$stress
## [1] 0.2334539
ezt kevesebb változóval is kipróbáltuk
szurtmarkak3_szuk<- szurtmarkak3[,c(2,5,6)]
summary_df3_szuk <- aggregate(
cbind(Teljesítmény, Sajáttömeg) ~ Márka,
data = szurtmarkak3_szuk,
FUN = mean,
na.rm = TRUE
)
adat_num3_szuk<- scale(summary_df3_szuk[,-1])
tav3_szuk <- as.matrix(dist(adat_num3_szuk))
MDS3_szuk <- mds(tav3_szuk)
plot(MDS3_szuk$conf)
text(MDS3_szuk$conf, labels=summary_df3_szuk$Márka)
MDS3_szuk$stress
## [1] 7.921811e-16
########## nem metrikus
MDS3_nm_szuk <- mds(tav3_szuk, type="ordinal")
plot(MDS3_nm_szuk$conf)
text(MDS3_nm_szuk$conf, labels=summary_df3_szuk$Márka)
MDS3_nm_szuk$stress
## [1] 0