Untitled
Matic Pacek
2024-02-15
Bolezni srca in ožilja (BSO) so globalno vodilni vzrok smrti, terjajo ocenjenih 17,9 milijona življenj vsako leto. BSO predstavljajo skupino motenj srca in krvnih žil, vključno s koronarno srčno boleznijo, možgansko kapjo, revmatično srčno boleznijo in drugimi pogoji. Več kot štiri od petih smrtnih primerov BSO je posledica srčnih napadov in možganskih kapi, in ena tretjina teh smrti se zgodi prezgodaj pri ljudeh, mlajših od 70 let (WHO, n.d.)
Najpomembnejši vedenjski dejavniki tveganja za srčne bolezni in možganske kapi so nezdrava prehrana, telesna neaktivnost, uporaba tobaka in škodljiva uporaba alkohola. Učinki vedenjskih dejavnikov tveganja se lahko pokažejo pri posameznikih kot povišan krvni tlak, povišan krvni sladkor, povišane krvne maščobe ter prekomerna telesna teža in debelost. Ti “posredni dejavniki tveganja” se lahko merijo v primarnih zdravstvenih ustanovah in kažejo na povečano tveganje za srčni napad, možgansko kap, srčno popuščanje in druge zaplete (WHO, n.d.)
Identifikacija tistih z najvišjim tveganjem za BSO in zagotovitev ustrezne obravnave lahko prepreči prezgodnje smrti. Dostop do zdravil za nekomunicirajoče bolezni in osnovnih zdravstvenih tehnologij v vseh osnovnih zdravstvenih ustanovah je ključen, da se zagotovi, da tisti, ki to potrebujejo, prejmejo zdravljenje in svetovanje (WHO n.d.).
Raziskovalno vprašanje: Ali lahko prepoznamo ločene skupine posameznikov na podlagi njihovih parametrov, povezanih z zdravjem srca in ožilja?
V raziskavi sem uporabil metodo razvrščanja, ki nam omogoča združevanje podobnih opazovanj v skupine na podlagi njihovih značilnosti. Z uporabo metode razvrščanja v kontekstu raziskovanja zdravja srca in ožilja lahko identificiramo skupine posameznikov z podobnimi zdravstvenimi profili. Na primer, lahko identificiramo skupine ljudi z podobnimi vrednostmi parametrov, kot so holesterol, krvni tlak, pulz, itd. To nam lahko pomaga pri razumevanju različnih tipov srčno-žilnih profilov v populaciji.
VIR TEORETIČNE OSNOVE: https://www.who.int/health-topics/cardiovascular-diseases#tab=tab_1 VIR PODATKOV ZA ANALIZO: https://www.kaggle.com/datasets/juledz/heart-attack-prediction
podatki <- read.csv("D:/EKONOMSKA FAKULTETA/PROGRAM R/MTRD23_prirpavljalnica/Pripravljalnica/srcni zastoj/heart.csv")
head(podatki)## age sex cp trestbps chol fbs restecg thalach exang oldpeak slope ca thal
## 1 52 1 0 125 212 0 1 168 0 1.0 2 2 3
## 2 53 1 0 140 203 1 0 155 1 3.1 0 0 3
## 3 70 1 0 145 174 0 1 125 1 2.6 0 0 3
## 4 61 1 0 148 203 0 1 161 0 0.0 2 1 3
## 5 62 0 0 138 294 1 1 106 0 1.9 1 3 2
## 6 58 0 0 100 248 0 0 122 0 1.0 1 0 2
## target
## 1 0.23
## 2 0.37
## 3 0.24
## 4 0.28
## 5 0.21
## 6 0.78colnames(podatki) <- c("Starost", "Spol", "Bolprsnica", "RR", "Holesterol", "Glukoza", "EKG", "Pulz", "Napor", "DeprST", "NaklonST", "Fluoroskopija", "Talasemija", "Napoved")head(podatki)## Starost Spol Bolprsnica RR Holesterol Glukoza EKG Pulz Napor DeprST NaklonST
## 1 52 1 0 125 212 0 1 168 0 1.0 2
## 2 53 1 0 140 203 1 0 155 1 3.1 0
## 3 70 1 0 145 174 0 1 125 1 2.6 0
## 4 61 1 0 148 203 0 1 161 0 0.0 2
## 5 62 0 0 138 294 1 1 106 0 1.9 1
## 6 58 0 0 100 248 0 0 122 0 1.0 1
## Fluoroskopija Talasemija Napoved
## 1 2 3 0.23
## 2 0 3 0.37
## 3 0 3 0.24
## 4 1 3 0.28
## 5 3 2 0.21
## 6 0 2 0.78Razlaga spremenljivk: Starost: v letih Spol: 0: ženske, 1: moški Bolprsnica: vrsta bolečine v prsnici 0: tipična, 1: atipična, 2: neanginalna, 3: asimptomatska RR: krvni tlak v mirovanju - številsko Holesterol: serumski holesterol - številsko Glukoza: kvrni sladkor na tešče 0: <= 120 mg/dL, 1: > 120 mg/dL EKG: Merjenje dejavnosti srca v mirovanju: 0: Normalno, 1: Nenormalno, 2: Hipertrofija Pulz: najvišja vrednost srčnega utripa - številsko Napor: Bolečina ob naporu: 0: Ne, 1: Da DeprST: sprememba ST-spojnice med fizično obremenitvijo in po njej - številsko NaklonST: naklon vrha ST-segmenta med fizičnim naporom - 0: navzgor, 1: raven, 2:navzdol Fluoroskopija: število obarvanih žil - številsko Talasemija: genetska bolezen, ki vpliva na tvorbo hemoglobina, ki se nahaja v eritrocitih in skrbi za prenos kisika po telesu - 0: normalno, 1: fiksna okvara, 2: reverzibilna oblika Napoved: napoved možnosti za srčni napad
podatki1 <- podatki[sample(nrow(podatki), 300),]Naključno smo izbrali 300 enot iz skupno 1025 enot primarno zajetih v vzorec.
summary(podatki1)## Starost Spol Bolprsnica RR
## Min. :29.00 Min. :0.0000 Min. :0.00 Min. :100.0
## 1st Qu.:47.00 1st Qu.:0.0000 1st Qu.:0.00 1st Qu.:120.0
## Median :55.00 Median :1.0000 Median :0.00 Median :130.0
## Mean :54.03 Mean :0.7233 Mean :0.92 Mean :132.9
## 3rd Qu.:60.25 3rd Qu.:1.0000 3rd Qu.:2.00 3rd Qu.:140.0
## Max. :76.00 Max. :1.0000 Max. :3.00 Max. :192.0
## Holesterol Glukoza EKG Pulz
## Min. :131.0 Min. :0.0000 Min. :0.0000 Min. : 71.0
## 1st Qu.:207.8 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:131.8
## Median :239.5 Median :0.0000 Median :1.0000 Median :151.0
## Mean :242.7 Mean :0.1533 Mean :0.5267 Mean :148.1
## 3rd Qu.:270.0 3rd Qu.:0.0000 3rd Qu.:1.0000 3rd Qu.:165.0
## Max. :417.0 Max. :1.0000 Max. :2.0000 Max. :202.0
## Napor DeprST NaklonST Fluoroskopija Talasemija
## Min. :0.0000 Min. :0.000 Min. :0.000 Min. :0.00 Min. :0.00
## 1st Qu.:0.0000 1st Qu.:0.000 1st Qu.:1.000 1st Qu.:0.00 1st Qu.:2.00
## Median :0.0000 Median :0.950 Median :1.000 Median :0.00 Median :2.00
## Mean :0.3633 Mean :1.152 Mean :1.347 Mean :0.75 Mean :2.36
## 3rd Qu.:1.0000 3rd Qu.:1.800 3rd Qu.:2.000 3rd Qu.:1.00 3rd Qu.:3.00
## Max. :1.0000 Max. :6.200 Max. :2.000 Max. :4.00 Max. :3.00
## Napoved
## Min. :0.1000
## 1st Qu.:0.2600
## Median :0.3900
## Mean :0.5201
## 3rd Qu.:0.7900
## Max. :0.9000Najmlajša oseba zajeta v vzorec je bila stara 29 let, najstarejša pa 77 let.Največ je bilo oseb s starostjo 56. Iz povprečja v spolu lahko razberemo, da je približno 69% moških in 39% žensk zajeto v vzorec. Vrednost 132,0 predstavlja, da je imelo 25% posameznikov zajetih v vzorec srčni utrip do vključno toliko ali manj.
podatki1$Starost_z <- scale(podatki1$Starost)
podatki1$RR_z <- scale(podatki1$RR)
podatki1$Holesterol_z <- scale(podatki1$Holesterol)
podatki1$Pulz_z <- scale(podatki1$Pulz)
podatki1$DeprST_z <- scale(podatki1$DeprST)
podatki1$Talasemija_z <- scale(podatki1$Talasemija)
podatki1$Napoved_z <- scale(podatki1$Napoved)library(Hmisc)## Warning: package 'Hmisc' was built under R version 4.3.2##
## Attaching package: 'Hmisc'## The following objects are masked from 'package:base':
##
## format.pval, unitsrcorr(as.matrix(podatki1[ , c("Starost_z", "RR_z", "Holesterol_z", "Pulz_z", "DeprST_z", "Talasemija_z", "Napoved_z")]),
type = "pearson")## Starost_z RR_z Holesterol_z Pulz_z DeprST_z Talasemija_z
## Starost_z 1.00 0.29 0.24 -0.38 0.20 0.15
## RR_z 0.29 1.00 0.23 -0.01 0.18 0.05
## Holesterol_z 0.24 0.23 1.00 -0.01 -0.06 0.07
## Pulz_z -0.38 -0.01 -0.01 1.00 -0.32 -0.09
## DeprST_z 0.20 0.18 -0.06 -0.32 1.00 0.28
## Talasemija_z 0.15 0.05 0.07 -0.09 0.28 1.00
## Napoved_z -0.27 -0.13 -0.05 0.39 -0.38 -0.37
## Napoved_z
## Starost_z -0.27
## RR_z -0.13
## Holesterol_z -0.05
## Pulz_z 0.39
## DeprST_z -0.38
## Talasemija_z -0.37
## Napoved_z 1.00
##
## n= 300
##
##
## P
## Starost_z RR_z Holesterol_z Pulz_z DeprST_z Talasemija_z
## Starost_z 0.0000 0.0000 0.0000 0.0004 0.0094
## RR_z 0.0000 0.0000 0.9235 0.0013 0.3542
## Holesterol_z 0.0000 0.0000 0.8759 0.2860 0.2070
## Pulz_z 0.0000 0.9235 0.8759 0.0000 0.1125
## DeprST_z 0.0004 0.0013 0.2860 0.0000 0.0000
## Talasemija_z 0.0094 0.3542 0.2070 0.1125 0.0000
## Napoved_z 0.0000 0.0260 0.3858 0.0000 0.0000 0.0000
## Napoved_z
## Starost_z 0.0000
## RR_z 0.0260
## Holesterol_z 0.3858
## Pulz_z 0.0000
## DeprST_z 0.0000
## Talasemija_z 0.0000
## Napoved_zS korelacijsko matriko smo preverili povezave med spremenljivkami. Zaželjeno je, da so čim bližje 0, da so med seboj čim manj povezane. Med starostjo in krvnim pritiskom obstaja majhna pozitivna korelacija.
podatki1$Razlicnost_Z <- sqrt(podatki1$Starost_z^2 + podatki1$RR_z^2 + podatki1$Holesterol_z^2 + podatki1$Pulz_z^2 + podatki1$DeprST_z^2 + podatki1$Talasemija_z^2 + podatki1$Napoved_z^2)head(podatki1[order(-podatki1$Razlicnost_Z), ], 10)## Starost Spol Bolprsnica RR Holesterol Glukoza EKG Pulz Napor DeprST
## 394 62 0 0 160 164 0 0 145 0 6.2
## 70 62 0 0 160 164 0 0 145 0 6.2
## 890 63 0 0 150 407 0 0 154 0 4.0
## 320 53 0 2 128 216 0 0 115 0 0.0
## 247 54 1 1 192 283 0 0 195 0 0.0
## 56 55 1 0 140 217 0 1 111 1 5.6
## 834 55 1 0 140 217 0 1 111 1 5.6
## 669 29 1 1 130 204 0 0 202 0 0.0
## 687 52 1 0 128 204 1 1 156 1 1.0
## 959 65 0 2 140 417 1 0 157 0 0.8
## NaklonST Fluoroskopija Talasemija Napoved Starost_z RR_z
## 394 0 3 3 0.22 0.899265888 1.4968228
## 70 0 3 3 0.32 0.899265888 1.4968228
## 890 1 3 3 0.19 1.012050071 0.9445576
## 320 2 0 0 0.83 -0.115791762 -0.2704259
## 247 2 1 3 0.20 -0.003007578 3.2640715
## 56 0 0 3 0.35 0.109776605 0.3922924
## 834 0 0 3 0.40 0.109776605 0.3922924
## 669 2 0 2 0.88 -2.822612161 -0.1599728
## 687 1 0 0 0.34 -0.228575945 -0.2704259
## 959 2 1 2 0.81 1.237618438 0.3922924
## Holesterol_z Pulz_z DeprST_z Talasemija_z Napoved_z Razlicnost_Z
## 394 -1.6187025 -0.1315574 4.0467183 1.049831 -1.0847338 4.933699
## 70 -1.6187025 -0.1315574 4.0467183 1.049831 -0.7233165 4.867024
## 890 3.3820779 0.2541158 2.2830931 1.049831 -1.1931590 4.599755
## 320 -0.5485767 -1.4171349 -0.9234983 -3.871252 1.1199118 4.414679
## 247 0.8302393 2.0110717 -0.9234983 1.049831 -1.1570173 4.322217
## 56 -0.5279973 -1.5885453 3.5657296 1.049831 -0.6148913 4.142809
## 834 -0.5279973 -1.5885453 3.5657296 1.049831 -0.4341827 4.119865
## 669 -0.7955288 2.3110398 -0.9234983 -0.590530 1.3006204 4.106055
## 687 -0.7955288 0.3398210 -0.1218505 -3.871252 -0.6510331 4.037203
## 959 3.5878713 0.3826736 -0.2821800 -0.590530 1.0476283 4.028738head(as.data.frame(podatki1))## Starost Spol Bolprsnica RR Holesterol Glukoza EKG Pulz Napor DeprST
## 636 53 0 0 130 264 0 0 143 0 0.4
## 854 67 1 0 120 229 0 0 129 1 2.6
## 216 49 1 1 130 266 0 1 171 0 0.6
## 998 54 1 0 120 188 0 1 113 0 1.4
## 288 71 0 1 160 302 0 1 162 0 0.4
## 298 58 1 0 150 270 0 0 111 1 0.8
## NaklonST Fluoroskopija Talasemija Napoved Starost_z RR_z
## 636 1 0 2 0.79 -0.115791762 -0.1599728
## 854 1 2 3 0.26 1.463186805 -0.7122380
## 216 2 0 2 0.84 -0.566928495 -0.1599728
## 998 1 1 3 0.13 -0.003007578 -0.7122380
## 288 2 2 2 0.80 1.914323538 1.4968228
## 298 2 0 3 0.16 0.448129155 0.9445576
## Holesterol_z Pulz_z DeprST_z Talasemija_z Napoved_z Razlicnost_Z
## 636 0.4392318 -0.2172626 -0.6028392 -0.590530 0.9753449 1.393759
## 854 -0.2810452 -0.8171988 1.1607861 1.049831 -0.9401669 2.593932
## 216 0.4803905 0.9826097 -0.4425096 -0.590530 1.1560535 1.850485
## 998 -1.1247983 -1.5028401 0.1988087 1.049831 -1.4100094 2.675965
## 288 1.2212468 0.5969365 -0.6028392 -0.590530 1.0114866 3.080282
## 298 0.5627078 -1.5885453 -0.2821800 1.049831 -1.3015842 2.609409Enote 159, 295 in 482 so najbolj različne tako, da so morda kandidati za odstranitev, ker so lahko ali osamelci ali enote z visokim vplivom. Vendar menim, da je iz vsebinskega vidika pomembno, da ostanejo v vzorcu, saj tudi take osebe odražajo določen delež ljudi.
library(factoextra)## Warning: package 'factoextra' was built under R version 4.3.2## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.3.2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBaRazdalje <- get_dist(podatki1[c("Starost_z", "RR_z", "Holesterol_z", "Pulz_z", "DeprST_z", "Talasemija_z", "Napoved_z")],
method = "euclidean")
Razdalje2 <- Razdalje^2
fviz_dist(Razdalje2)
get_clust_tendency(podatki1[c("Starost_z", "RR_z", "Holesterol_z", "Pulz_z", "DeprST_z", "Talasemija_z", "Napoved_z" )],
n = nrow(podatki1) -1,
graph = FALSE)## $hopkins_stat
## [1] 0.8045845
##
## $plot
## NULLVrednost Hopkinsove statistike nakazuje na to, da so podatki primerni za razvrstitev v skupine, saj je vrednost nad 0,5 (0.82).
library(dplyr)## Warning: package 'dplyr' was built under R version 4.3.2##
## Attaching package: 'dplyr'## The following objects are masked from 'package:Hmisc':
##
## src, summarize## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(factoextra)library(dplyr)
WARD <- podatki1[c("Starost_z", "RR_z", "Holesterol_z", "Pulz_z", "DeprST_z", "Talasemija_z", "Napoved_z")] %>%
get_dist(method = "euclidean") %>%
hclust(method = "ward.D2")
WARD##
## Call:
## hclust(d = ., method = "ward.D2")
##
## Cluster method : ward.D2
## Distance : euclidean
## Number of objects: 300library(factoextra)
fviz_dend(WARD)## 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.
set.seed(123)
library(dplyr)
library(NbClust)
SteviloSkupin <- podatki1[c("Starost_z", "RR_z", "Holesterol_z", "Pulz_z", "DeprST_z", "Talasemija_z", "Napoved_z")] %>%
NbClust(distance= "euclidean",
min.nc = 2, max.nc = 8,
method = "ward.D2",
index = "all")
## *** : The Hubert index is a graphical method of determining the number of clusters.
## In the plot of Hubert index, we seek a significant knee that corresponds to a
## significant increase of the value of the measure i.e the significant peak in Hubert
## index second differences plot.
## 
## *** : The D index is a graphical method of determining the number of clusters.
## In the plot of D index, we seek a significant knee (the significant peak in Dindex
## second differences plot) that corresponds to a significant increase of the value of
## the measure.
##
## *******************************************************************
## * Among all indices:
## * 6 proposed 2 as the best number of clusters
## * 6 proposed 3 as the best number of clusters
## * 4 proposed 4 as the best number of clusters
## * 7 proposed 8 as the best number of clusters
##
## ***** Conclusion *****
##
## * According to the majority rule, the best number of clusters is 8
##
##
## *******************************************************************Glede na podane rezultate jih večina predlaga 2 kot najboljše število skupin. Ker se tudi na podlagi dendrograma vidi, da je dobra možnost tudi 4 skupine in to število skupin potrjujejo tudi kot drugo najboljšo izbiro sem se odločil, da bom v nadaljevanju uporabil 4 skupine.
podatki1$RazvrstitevWARD <- cutree(WARD,
k=4)
head(podatki1)## Starost Spol Bolprsnica RR Holesterol Glukoza EKG Pulz Napor DeprST
## 636 53 0 0 130 264 0 0 143 0 0.4
## 854 67 1 0 120 229 0 0 129 1 2.6
## 216 49 1 1 130 266 0 1 171 0 0.6
## 998 54 1 0 120 188 0 1 113 0 1.4
## 288 71 0 1 160 302 0 1 162 0 0.4
## 298 58 1 0 150 270 0 0 111 1 0.8
## NaklonST Fluoroskopija Talasemija Napoved Starost_z RR_z
## 636 1 0 2 0.79 -0.115791762 -0.1599728
## 854 1 2 3 0.26 1.463186805 -0.7122380
## 216 2 0 2 0.84 -0.566928495 -0.1599728
## 998 1 1 3 0.13 -0.003007578 -0.7122380
## 288 2 2 2 0.80 1.914323538 1.4968228
## 298 2 0 3 0.16 0.448129155 0.9445576
## Holesterol_z Pulz_z DeprST_z Talasemija_z Napoved_z Razlicnost_Z
## 636 0.4392318 -0.2172626 -0.6028392 -0.590530 0.9753449 1.393759
## 854 -0.2810452 -0.8171988 1.1607861 1.049831 -0.9401669 2.593932
## 216 0.4803905 0.9826097 -0.4425096 -0.590530 1.1560535 1.850485
## 998 -1.1247983 -1.5028401 0.1988087 1.049831 -1.4100094 2.675965
## 288 1.2212468 0.5969365 -0.6028392 -0.590530 1.0114866 3.080282
## 298 0.5627078 -1.5885453 -0.2821800 1.049831 -1.3015842 2.609409
## RazvrstitevWARD
## 636 1
## 854 2
## 216 1
## 998 2
## 288 3
## 298 2Zac_Voditelji <- aggregate (podatki1[, c("Starost_z", "RR_z", "Holesterol_z", "Pulz_z", "DeprST_z", "Talasemija_z", "Napoved_z")],
by = list(podatki1$RazvrstitevWARD),
FUN = mean)
Zac_Voditelji## Group.1 Starost_z RR_z Holesterol_z Pulz_z DeprST_z
## 1 1 -0.455169622 -0.24030231 -0.32856480 0.4150078 -0.460000108
## 2 2 0.266111117 0.03578059 -0.13087715 -0.8710827 0.804409957
## 3 3 0.742823311 1.55561232 1.42239331 0.2651746 0.002275645
## 4 4 0.002826086 -0.43800979 0.09080221 0.5880704 -0.529585152
## Talasemija_z Napoved_z
## 1 -0.7098290 0.97633054
## 2 0.3514596 -0.90438301
## 3 0.2561080 0.09395296
## 4 0.5973177 -0.32700374library(factoextra)
MetodaVod <- hkmeans(podatki1[c("Starost_z", "RR_z", "Holesterol_z", "Pulz_z", "DeprST_z", "Talasemija_z", "Napoved_z")],
k = 4,
hc.metric = "euclidean",
hc.method = "ward.D2")
MetodaVod## Hierarchical K-means clustering with 4 clusters of sizes 103, 70, 59, 68
##
## Cluster means:
## Starost_z RR_z Holesterol_z Pulz_z DeprST_z Talasemija_z
## 1 -0.77388200 -0.284366538 -0.34458145 0.571141731 -0.4884292436 -0.7179367
## 2 0.49968764 0.001761989 -0.26634570 -0.984323846 1.1035255178 0.7217589
## 3 0.81133246 1.347055963 0.94604171 0.005716099 -0.0009239331 -0.1456863
## 4 -0.04613094 -0.739851288 -0.02471135 0.143203252 -0.3953538543 0.4708801
## Napoved_z
## 1 0.94165936
## 2 -0.85342675
## 3 -0.04397448
## 4 -0.50965511
##
## Clustering vector:
## 636 854 216 998 288 298 248 779 669 960 673 368 596 415 708 982
## 1 2 1 2 3 2 2 4 1 3 4 4 4 3 3 4
## 389 688 988 740 979 978 342 756 622 95 121 701 727 746 96 420
## 2 4 3 4 4 1 1 1 4 1 4 1 4 1 1 3
## 249 41 908 104 128 500 171 440 603 663 282 33 50 811 419 674
## 1 3 1 1 1 1 1 4 1 1 1 2 4 2 1 4
## 804 67 466 627 720 617 258 843 969 907 589 5 175 125 842 270
## 4 1 1 2 4 1 3 4 2 1 3 2 2 2 1 4
## 858 259 606 458 921 278 434 783 195 922 654 470 729 343 468 548
## 1 4 4 1 4 1 1 3 3 2 2 3 2 3 4 4
## 222 897 718 366 951 111 386 70 301 167 576 928 505 239 600 789
## 2 3 4 1 3 4 1 2 1 2 1 1 4 4 1 2
## 8 140 132 655 1018 875 165 336 31 966 435 80 82 118 995 583
## 3 1 1 1 2 3 4 2 1 3 1 1 4 2 4 1
## 675 799 321 905 816 641 478 819 250 577 144 20 315 265 757 150
## 2 3 1 1 4 1 4 1 1 3 1 1 1 3 2 1
## 36 79 308 767 101 786 370 1025 532 841 968 829 628 952 464 88
## 2 1 1 2 1 3 1 2 3 2 1 1 4 2 4 3
## 126 260 501 682 57 428 228 247 608 517 297 540 392 408 25 680
## 3 3 2 3 4 1 1 3 1 2 2 3 4 4 1 3
## 814 537 610 1016 365 52 345 529 54 692 781 30 1003 221 255 504
## 2 1 3 2 4 4 1 3 2 1 1 3 4 4 4 1
## 707 397 213 769 538 573 728 269 534 719 3 822 955 56 356 42
## 4 3 2 4 1 1 4 2 1 1 2 3 1 2 1 4
## 890 402 78 508 105 635 98 382 475 289 503 437 293 373 412 311
## 3 2 2 1 1 4 2 2 4 1 1 3 3 1 4 2
## 892 760 933 823 106 480 332 996 103 469 37 225 889 666 109 715
## 3 3 3 4 4 2 4 1 4 3 1 1 2 3 4 1
## 136 607 261 863 926 324 226 634 909 580 43 184 66 97 881 949
## 3 4 1 3 2 3 3 2 2 2 3 1 3 1 1 2
## 888 566 743 181 652 75 661 153 439 878 750 787 917 1020 514 693
## 1 1 2 2 1 4 2 4 1 1 4 4 2 1 4 2
## 72 896 14 768 894 993 47 328 598 1023 149 303 196 556 394 320
## 2 2 2 2 1 1 1 3 1 4 3 3 1 4 2 1
## 323 862 631 141 646 76 795 902 243 160 351 10 498 947 233 4
## 4 3 4 2 2 1 2 1 1 1 3 2 3 3 2 4
## 186 850 879 834 251 154 316 959 353 230 687 455
## 3 4 2 2 4 4 1 3 2 3 1 2
##
## Within cluster sum of squares by cluster:
## [1] 348.7511 311.7182 323.2193 279.2730
## (between_SS / total_SS = 39.7 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault" "data"
## [11] "hclust"fviz_cluster(MetodaVod,
palette = "jama",
repel = FALSE,
ggtheme = theme_classic())
podatki1$RazvrstitevVod <- MetodaVod$cluster
head(podatki1[c("Spol", "RazvrstitevWARD", "RazvrstitevVod")])## Spol RazvrstitevWARD RazvrstitevVod
## 636 0 1 1
## 854 1 2 2
## 216 1 1 1
## 998 1 2 2
## 288 0 3 3
## 298 1 2 2table(podatki1$RazvrstitevWARD)##
## 1 2 3 4
## 110 101 31 58table(podatki1$RazvrstitevVod)##
## 1 2 3 4
## 103 70 59 68table(podatki1$RazvrstitevWARD, podatki1$RazvrstitevVod)##
## 1 2 3 4
## 1 92 2 12 4
## 2 3 68 12 18
## 3 4 0 27 0
## 4 4 0 8 46Ugotavljamo, da se je z Wardovim algoritmom 49 posameznikov razvrstilo v skupino 4. Z metodo voditeljev pa se je v isto skupino razvrstilo 42 posameznikov.
Povprecja <- MetodaVod$centers
Povprecja## Starost_z RR_z Holesterol_z Pulz_z DeprST_z Talasemija_z
## 1 -0.77388200 -0.284366538 -0.34458145 0.571141731 -0.4884292436 -0.7179367
## 2 0.49968764 0.001761989 -0.26634570 -0.984323846 1.1035255178 0.7217589
## 3 0.81133246 1.347055963 0.94604171 0.005716099 -0.0009239331 -0.1456863
## 4 -0.04613094 -0.739851288 -0.02471135 0.143203252 -0.3953538543 0.4708801
## Napoved_z
## 1 0.94165936
## 2 -0.85342675
## 3 -0.04397448
## 4 -0.50965511library(ggplot2)
library(tidyr)## Warning: package 'tidyr' was built under R version 4.3.2Slika <- as.data.frame(Povprecja)
Slika$Spol <- 1:nrow(Slika)
Slika <- pivot_longer(Slika, cols = c("Starost_z", "RR_z", "Holesterol_z", "Pulz_z", "DeprST_z", "Talasemija_z", "Napoved_z"))
Slika$Skupina <- factor(Slika$Spol,
levels = c(1, 2, 3, 4),
labels = c("1", "2", "3","4"))
Slika$nameFactor <- factor(Slika$name,
levels = c("Starost_z", "RR_z", "Holesterol_z", "Pulz_z", "DeprST_z", "Talasemija_z", "Napoved_z"),
labels = c ("Starost_z", "RR_z", "Holesterol_z", "Pulz_z", "DeprST_z", "Talasemija_z", "Napoved_z"))
ggplot(Slika, aes(x = nameFactor, y = value)) +
geom_hline(yintercept = 0) +
theme_bw() +
geom_point(aes(shape = Skupina, col = Skupina), size=4) +
geom_line(aes(group = Spol), linewidth = 1) +
ylab("Povprecje") +
xlab("Razvrstitvene spremenljivke") +
ylim(-1.5, 1.5)
Ugotovitev: 5 od 7 meritvenih spremenljivk v skupini 1 in 3 je nad povprečjem. V skupini 2 in 4 so samo 2 merjene spremenljivke nad povprečjem. Holesterol je v povprečju najvišji v skupini 3. V povprečju so najmlajši posamezniki v skupini 2.
fit<- aov(cbind(Starost_z, RR_z, Holesterol_z, Pulz_z, DeprST_z, Talasemija_z, Napoved_z) ~ as.factor(RazvrstitevVod),
data = podatki1)
summary(fit)## Response 1 :
## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(RazvrstitevVod) 3 118.15 39.382 64.456 < 2.2e-16 ***
## Residuals 296 180.85 0.611
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Response 2 :
## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(RazvrstitevVod) 3 152.61 50.870 102.86 < 2.2e-16 ***
## Residuals 296 146.39 0.495
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Response 3 :
## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(RazvrstitevVod) 3 70.042 23.3473 30.184 < 2.2e-16 ***
## Residuals 296 228.958 0.7735
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Response 4 :
## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(RazvrstitevVod) 3 102.82 34.273 51.711 < 2.2e-16 ***
## Residuals 296 196.18 0.663
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Response 5 :
## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(RazvrstitevVod) 3 120.44 40.148 66.556 < 2.2e-16 ***
## Residuals 296 178.56 0.603
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Response 6 :
## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(RazvrstitevVod) 3 105.89 35.295 54.099 < 2.2e-16 ***
## Residuals 296 193.12 0.652
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Response 7 :
## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(RazvrstitevVod) 3 160.09 53.364 113.72 < 2.2e-16 ***
## Residuals 296 138.91 0.469
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Uporabil sem analizo variance (ANOVA), da bi ugotovil, ali so vse spremenljivke učinkovito razdelile enote v skupine. P-vrednost mi je sporočila, da lahko zavrnem predpostavko enakih povprečij za te spremenljivke; dejansko so se bistveno razlikovale med seboj - njihove razlike so rasle sorazmerno njihovi statistični pomembnosti v ANOVI.Najmanjšo statistično razliko lahko zaznamo v odzivu 2, pa še v tem primeru znaša p-vrednost 0,03114, kar je manjše od 0,05 tako, da je vseeno še statistično značilno.
hi_kvadrat <- chisq.test(podatki1$Spol, as.factor(podatki1$RazvrstitevVod))
hi_kvadrat##
## Pearson's Chi-squared test
##
## data: podatki1$Spol and as.factor(podatki1$RazvrstitevVod)
## X-squared = 33.636, df = 3, p-value = 2.365e-07Na podlagi rezultatov hi-kvadrat testa in p-vrednosti (< 0,001) ugotavljamo, da imamo dovolj dokazov za zavrnitev ničelne hipoteze. Torej, lahko sklepamo, da obstaja statistično pomembna povezava med razvrstitvijo in spolom.
addmargins(hi_kvadrat$observed)##
## podatki1$Spol 1 2 3 4 Sum
## 0 37 10 29 7 83
## 1 66 60 30 61 217
## Sum 103 70 59 68 300addmargins(round(hi_kvadrat$expected, 2))##
## podatki1$Spol 1 2 3 4 Sum
## 0 28.5 19.37 16.32 18.81 83
## 1 74.5 50.63 42.68 49.19 217
## Sum 103.0 70.00 59.00 68.00 300round(hi_kvadrat$res, 2)##
## podatki1$Spol 1 2 3 4
## 0 1.59 -2.13 3.14 -2.72
## 1 -0.99 1.32 -1.94 1.68Na podlagi standardiziranih ostankov ugotavljamo, da obstaja razlika v empiričnih in pričakovanih frekvencah pri obeh spolih oz. kategorijah 0 in 1.
library(effectsize)## Warning: package 'effectsize' was built under R version 4.3.2effectsize::cramers_v(podatki1$Spol, as.factor(podatki1$RazvrstitevVod))## Cramer's V (adj.) | 95% CI
## --------------------------------
## 0.32 | [0.20, 1.00]
##
## - One-sided CIs: upper bound fixed at [1.00].Vrednost Cramerjevega V se giblje med 0 in 1, kjer večja vrednost označuje močnejšo povezanost. V našem primeru je rezultat 0.33, kar nakazuje na srednje močno povezanost. Če je vrednost blizu 0, povezanost ni močna, medtem ko vrednosti bližje 1 kažejo na močnejšo povezanost.
Ugotovitve: Razversitev 300 posameznikov smo izvedli na 7 standardiziranih spremenljivkah. Pri hierarhičnem razvrščanju smo uporabili Wardov združevalni algoritem ter se na podlagi analize dendrograma odločili za razvrstitev v 4 skupine. Razvrstitev smo še dodatno optimizirali z metodo voditeljev.
V skupino 1 je uvrščenih največ dijakov (33%), za njih pa je značično, da je nadpovprečna vrednost večine razvrstitvenih spremelnjivk. Podpovprečna vrednost je le pri vrednosti utripa (Pulz_z) in pri napovedi.
Odgovor na raziskovalno vprašanje: Posameznike lahko na podlagi meritev v povezavi z srčno-žilnim stanjem razdelimo v različne skupine.