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