podatki <- read.table("./Kozmetika.csv", header=TRUE, sep=";", dec=",")
Vse spremenljivke merjene na Likertovi lestvici (1: Sploh se ne strinjam, 5: Popolnoma se strinjam)
library(pastecs)
round(stat.desc(podatki[-1], basic=FALSE), 2)
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 X16 X17 X18 X19 X20
## median 4.00 5.00 3.00 3.00 3.00 4.00 3.00 4.00 3.00 4.00 4.00 3.00 3.00 4.00 4.00 4.00 2.00 3.00 3.00 2.00
## mean 3.62 4.38 3.42 3.21 3.28 3.78 3.08 3.77 3.15 3.75 3.55 3.13 3.12 3.54 3.43 3.71 2.38 2.83 3.11 2.56
## SE.mean 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.03 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02 0.02
## CI.mean.0.95 0.03 0.03 0.04 0.04 0.04 0.04 0.04 0.03 0.05 0.03 0.04 0.04 0.04 0.03 0.04 0.04 0.04 0.04 0.04 0.04
## var 0.68 0.72 1.16 0.90 0.93 1.26 1.22 0.75 1.60 0.77 0.90 1.00 0.84 0.77 1.11 1.22 1.07 0.97 1.09 1.09
## std.dev 0.83 0.85 1.08 0.95 0.97 1.12 1.11 0.87 1.27 0.88 0.95 1.00 0.92 0.88 1.06 1.10 1.04 0.99 1.04 1.04
## coef.var 0.23 0.19 0.31 0.30 0.29 0.30 0.36 0.23 0.40 0.23 0.27 0.32 0.29 0.25 0.31 0.30 0.44 0.35 0.34 0.41
sapply(podatki[-1], FUN = min) #Ocena izbranega parametra za vse spremenljivke hkrati
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 X16 X17 X18 X19 X20
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
sapply(podatki[-1], FUN = max)
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 X16 X17 X18 X19 X20
## 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
podatki_FA <- podatki[,c(-1)] #Ustvarimo novo tabelo s podatki brez spremenljivke ID
R <- cor(podatki_FA) #V objekt R shranimo korelacijsko matriko
library(psych)
corPlot(R) #Grafično prikažemo korelacijsko matriko
det(R) #Izračunamo determinanto korelacijske matrike
## [1] 0.001770237
library(psych)
cortest.bartlett(R, n=2500) #Izvedemo Bartlettov preizkus sferičnosti
## $chisq
## [1] 15787.74
##
## $p.value
## [1] 0
##
## $df
## [1] 190
library(psych)
KMO(R) #Izračunamo KMO in MSA statistike
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = R)
## Overall MSA = 0.92
## MSA for each item =
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 X16 X17 X18 X19 X20
## 0.93 0.86 0.94 0.95 0.96 0.88 0.93 0.86 0.82 0.89 0.94 0.96 0.94 0.92 0.94 0.93 0.88 0.92 0.86 0.76
library(psych)
fa.parallel(podatki_FA, #Izvedemo paralelno analizo
sim = FALSE, #Izključimo simulacijo
fa = "fa") #FA (fa = factor analysis)
## Parallel analysis suggests that the number of factors = 5 and the number of components = NA
library(psych) #Aktiviramo knjižnico
library(GPArotation) #Aktiviramo knjižnico
faktorska <- fa(podatki_FA, #Tabela s podatki
covar = FALSE, #Standardizacija (izvedba na korelacijski matriki)
nfactors = 5, #Število faktorjev
fm = "minres", #Metoda (privzeta faktorska metoda je minres (minimum residual method))
rotate = "oblimin", #Faktorska rotacija
impute = "mean") #V primeru manjkajočih vrednosti so te nadomeščene s povprečjem
print.psych(faktorska,
cut = 0.3, #Skrijemo faktorske uteži, nižje od 0,3
sort = TRUE) #Faktorske uteži razporedimo po velikosti
## Factor Analysis using method = minres
## Call: fa(r = podatki_FA, nfactors = 5, rotate = "oblimin", covar = FALSE,
## impute = "mean", fm = "minres")
## Standardized loadings (pattern matrix) based upon correlation matrix
## item MR3 MR4 MR1 MR5 MR2 h2 u2 com
## X6 6 0.81 0.57 0.43 1.0
## X15 15 0.59 0.56 0.44 1.2
## X7 7 0.52 0.51 0.49 1.4
## X11 11 0.50 0.47 0.53 1.3
## X12 12 0.40 0.42 0.58 1.8
## X8 8 0.85 0.66 0.34 1.0
## X10 10 0.75 0.63 0.37 1.1
## X14 14 0.63 0.56 0.44 1.1
## X1 1 0.76 0.52 0.48 1.0
## X13 13 0.58 0.50 0.50 1.1
## X5 5 0.50 0.33 0.67 1.1
## X4 4 0.47 0.42 0.58 1.3
## X18 18 0.71 0.64 0.36 1.1
## X17 17 0.59 0.36 0.64 1.2
## X9 9 0.60 0.35 0.65 1.0
## X19 19 0.50 0.26 0.74 1.3
## X2 2 0.46 0.26 0.74 1.2
## X3 3 0.35 0.46 0.54 2.7
## X20 20 0.35 0.11 0.89 1.5
## X16 16 0.34 0.25 0.75 1.6
##
## MR3 MR4 MR1 MR5 MR2
## SS loadings 2.13 1.97 1.95 1.41 1.38
## Proportion Var 0.11 0.10 0.10 0.07 0.07
## Cumulative Var 0.11 0.20 0.30 0.37 0.44
## Proportion Explained 0.24 0.22 0.22 0.16 0.16
## Cumulative Proportion 0.24 0.46 0.68 0.84 1.00
##
## With factor correlations of
## MR3 MR4 MR1 MR5 MR2
## MR3 1.00 0.48 0.53 0.43 -0.30
## MR4 0.48 1.00 0.59 0.41 -0.18
## MR1 0.53 0.59 1.00 0.57 -0.31
## MR5 0.43 0.41 0.57 1.00 -0.37
## MR2 -0.30 -0.18 -0.31 -0.37 1.00
##
## Mean item complexity = 1.3
## Test of the hypothesis that 5 factors are sufficient.
##
## df null model = 190 with the objective function = 6.34 with Chi Square = 15787.74
## df of the model are 100 and the objective function was 0.15
##
## The root mean square of the residuals (RMSR) is 0.02
## The df corrected root mean square of the residuals is 0.02
##
## The harmonic n.obs is 2500 with the empirical chi square 251.08 with prob < 5.6e-15
## The total n.obs was 2500 with Likelihood Chi Square = 380.17 with prob < 2.9e-34
##
## Tucker Lewis Index of factoring reliability = 0.966
## RMSEA index = 0.033 and the 90 % confidence intervals are 0.03 0.037
## BIC = -402.23
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## MR3 MR4 MR1 MR5 MR2
## Correlation of (regression) scores with factors 0.90 0.92 0.89 0.86 0.82
## Multiple R square of scores with factors 0.81 0.84 0.80 0.74 0.67
## Minimum correlation of possible factor scores 0.62 0.68 0.59 0.49 0.33
library(dplyr)
podatki_FA <- podatki_FA %>%
select(-c("X3", "X20"))
faktorska <- fa(podatki_FA,
covar = FALSE,
nfactors = 5,
fm = "minres",
rotate = "oblimin",
impute = "mean")
print.psych(faktorska,
cut = 0.3,
sort = TRUE)
## Factor Analysis using method = minres
## Call: fa(r = podatki_FA, nfactors = 5, rotate = "oblimin", covar = FALSE,
## impute = "mean", fm = "minres")
## Standardized loadings (pattern matrix) based upon correlation matrix
## item MR3 MR4 MR1 MR5 MR2 h2 u2 com
## X6 5 0.81 0.57 0.43 1.0
## X15 14 0.58 0.55 0.45 1.2
## X7 6 0.51 0.51 0.49 1.4
## X11 10 0.49 0.47 0.53 1.3
## X12 11 0.40 0.42 0.58 1.8
## X8 7 0.84 0.66 0.34 1.0
## X10 9 0.77 0.65 0.35 1.1
## X14 13 0.62 0.56 0.44 1.1
## X1 1 0.76 0.52 0.48 1.0
## X13 12 0.59 0.50 0.50 1.1
## X5 4 0.50 0.33 0.67 1.1
## X4 3 0.47 0.41 0.59 1.3
## X18 17 0.81 0.72 0.28 1.0
## X17 16 0.54 0.33 0.67 1.3
## X9 8 0.61 0.37 0.63 1.0
## X2 2 0.49 0.27 0.73 1.1
## X19 18 0.45 0.23 0.77 1.2
## X16 15 0.34 0.24 0.76 1.6
##
## MR3 MR4 MR1 MR5 MR2
## SS loadings 2.06 1.93 1.86 1.36 1.09
## Proportion Var 0.11 0.11 0.10 0.08 0.06
## Cumulative Var 0.11 0.22 0.32 0.40 0.46
## Proportion Explained 0.25 0.23 0.22 0.16 0.13
## Cumulative Proportion 0.25 0.48 0.70 0.87 1.00
##
## With factor correlations of
## MR3 MR4 MR1 MR5 MR2
## MR3 1.00 0.47 0.53 0.45 -0.28
## MR4 0.47 1.00 0.60 0.42 -0.15
## MR1 0.53 0.60 1.00 0.57 -0.28
## MR5 0.45 0.42 0.57 1.00 -0.33
## MR2 -0.28 -0.15 -0.28 -0.33 1.00
##
## Mean item complexity = 1.2
## Test of the hypothesis that 5 factors are sufficient.
##
## df null model = 153 with the objective function = 5.76 with Chi Square = 14346.2
## df of the model are 73 and the objective function was 0.1
##
## The root mean square of the residuals (RMSR) is 0.01
## The df corrected root mean square of the residuals is 0.02
##
## The harmonic n.obs is 2500 with the empirical chi square 154.16 with prob < 9.5e-08
## The total n.obs was 2500 with Likelihood Chi Square = 260.97 with prob < 6e-23
##
## Tucker Lewis Index of factoring reliability = 0.972
## RMSEA index = 0.032 and the 90 % confidence intervals are 0.028 0.036
## BIC = -310.18
## Fit based upon off diagonal values = 1
## Measures of factor score adequacy
## MR3 MR4 MR1 MR5 MR2
## Correlation of (regression) scores with factors 0.90 0.92 0.89 0.89 0.78
## Multiple R square of scores with factors 0.81 0.84 0.79 0.78 0.62
## Minimum correlation of possible factor scores 0.62 0.68 0.59 0.57 0.23
library(psych)
fa.diagram(faktorska) #Grafičen prikaz faktorskega modela
Ostanki <- faktorska$residual #V objekt shranimo ostanke modela
Ostanki <- as.matrix(Ostanki[upper.tri(Ostanki)]) #Shranimo samo zgornji del matrike z ostanki (nad glavno diagonalo), saj bi drugače vsak ostanek šteli dvakrat (simetričnost matrike)
VisokiOstanki <- abs(Ostanki) > 0.05 #Logični test za preverbo visokih ostankov
sum(VisokiOstanki)/nrow(Ostanki) #Izračun deleža visokih ostankov
## [1] 0
head(faktorska$scores) #Prikažemo faktorske vrednosti za prvih 6 oseb
## MR3 MR4 MR1 MR5 MR2
## [1,] 0.4626491 1.7044798361 0.85175483 1.328594144 0.9253449
## [2,] 0.7402278 0.4595216621 0.82573960 -0.600287970 -1.0099880
## [3,] 0.3715178 -0.0264892110 -0.05375521 0.002751305 0.6127375
## [4,] -0.7437342 0.2813183304 -0.70490442 -0.966492371 0.3664461
## [5,] -0.2568337 0.4043207899 0.91636113 0.917030021 -0.6146158
## [6,] -1.6496452 0.0007313612 0.14167070 -0.302805115 0.7505407
podatki$F1_Sest <- faktorska$scores[ , 1] #V tabelo s podatki shranimo faktorske vrednosti
podatki$F2_Emba <- faktorska$scores[ , 2]
podatki$F3_Blag <- faktorska$scores[ , 3]
podatki$F4_Proi <- faktorska$scores[ , 4]
podatki$F5_Prip <- faktorska$scores[ , 5]
head(podatki[, c(1, 22, 23, 24, 25, 26)], 10) #Prikažemo podatke za prvih 10 oseb
## ID F1_Sest F2_Emba F3_Blag F4_Proi F5_Prip
## 1 1 0.4626491 1.7044798361 0.85175483 1.328594144 0.92534486
## 2 2 0.7402278 0.4595216621 0.82573960 -0.600287970 -1.00998802
## 3 3 0.3715178 -0.0264892110 -0.05375521 0.002751305 0.61273752
## 4 4 -0.7437342 0.2813183304 -0.70490442 -0.966492371 0.36644613
## 5 5 -0.2568337 0.4043207899 0.91636113 0.917030021 -0.61461580
## 6 6 -1.6496452 0.0007313612 0.14167070 -0.302805115 0.75054069
## 7 7 0.6322042 0.5140060395 1.02878945 1.501369377 -1.33141165
## 8 8 0.7142630 0.4893423962 1.05031858 1.313786904 -1.41081471
## 9 9 -2.3297617 -3.6681535336 -2.66779815 -2.226322326 -0.06113416
## 10 10 1.1456219 0.4456989467 0.54934354 1.241861231 -1.54832156
podatki[9, ]
## ID X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 X16 X17 X18 X19 X20 F1_Sest F2_Emba F3_Blag F4_Proi
## 9 9 3 3 5 2 1 3 1 1 3 1 1 1 1 1 1 4 1 1 3 3 -2.329762 -3.668154 -2.667798 -2.226322
## F5_Prip
## 9 -0.06113416
Blagovna_Znamka <- podatki[, c("X1", "X13", "X5", "X4")] #Izberemo samo tiste indikatorje, ki merijo faktor Blagovna znamke
library(psych)
alpha(Blagovna_Znamka, #Tabela s podatki z ustreznimi indikatorji
check.keys = TRUE) #Obrnjene indikatorje avtomatično obrne
##
## Reliability analysis
## Call: alpha(x = Blagovna_Znamka, check.keys = TRUE)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.74 0.75 0.69 0.42 2.9 0.0084 3.3 0.69 0.41
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.73 0.74 0.76
## Duhachek 0.73 0.74 0.76
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## X1 0.67 0.67 0.58 0.40 2.0 0.011 0.00019 0.40
## X13 0.68 0.68 0.59 0.41 2.1 0.011 0.00051 0.40
## X5 0.71 0.71 0.62 0.45 2.5 0.010 0.00143 0.44
## X4 0.69 0.69 0.60 0.43 2.3 0.011 0.00305 0.40
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## X1 2500 0.76 0.77 0.67 0.57 3.6 0.83
## X13 2500 0.76 0.76 0.65 0.55 3.1 0.92
## X5 2500 0.74 0.73 0.58 0.50 3.3 0.97
## X4 2500 0.76 0.75 0.62 0.53 3.2 0.95
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## X1 0.02 0.07 0.29 0.52 0.10 0
## X13 0.06 0.16 0.42 0.33 0.04 0
## X5 0.04 0.18 0.29 0.43 0.06 0
## X4 0.05 0.17 0.36 0.37 0.05 0
Priporočila <- podatki[, c("X9", "X19", "X2", "X16")]
library(psych)
alpha(Priporočila,
check.keys=TRUE)
##
## Reliability analysis
## Call: alpha(x = Priporočila, check.keys = TRUE)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.56 0.57 0.5 0.25 1.3 0.014 3.6 0.71 0.24
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.54 0.56 0.59
## Duhachek 0.54 0.56 0.59
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## X9 0.46 0.46 0.37 0.22 0.87 0.018 0.00038 0.23
## X19 0.50 0.51 0.41 0.26 1.03 0.017 0.00323 0.25
## X2 0.50 0.50 0.40 0.25 1.00 0.017 0.00014 0.25
## X16 0.51 0.53 0.43 0.27 1.11 0.016 0.00173 0.26
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## X9 2500 0.73 0.69 0.53 0.39 3.1 1.27
## X19 2500 0.65 0.65 0.45 0.34 3.1 1.04
## X2 2500 0.60 0.66 0.47 0.36 4.4 0.85
## X16 2500 0.65 0.64 0.42 0.32 3.7 1.10
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## X9 0.08 0.29 0.23 0.20 0.20 0
## X19 0.05 0.26 0.34 0.26 0.10 0
## X2 0.01 0.04 0.08 0.32 0.56 0
## X16 0.02 0.15 0.22 0.33 0.29 0
Sestavine <- podatki[, c("X6", "X15", "X7", "X11", "X12")]
library(psych)
alpha(Sestavine,
check.keys=TRUE)
##
## Reliability analysis
## Call: alpha(x = Sestavine, check.keys = TRUE)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.82 0.82 0.79 0.48 4.5 0.0057 3.4 0.8 0.48
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.81 0.82 0.83
## Duhachek 0.81 0.82 0.83
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## X6 0.78 0.79 0.73 0.48 3.7 0.0070 0.0015 0.47
## X15 0.77 0.77 0.71 0.45 3.3 0.0076 0.0014 0.44
## X7 0.78 0.78 0.73 0.48 3.6 0.0071 0.0024 0.48
## X11 0.79 0.79 0.74 0.48 3.7 0.0070 0.0022 0.50
## X12 0.80 0.80 0.75 0.49 3.9 0.0066 0.0012 0.51
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## X6 2500 0.77 0.76 0.67 0.61 3.8 1.12
## X15 2500 0.80 0.80 0.74 0.67 3.4 1.06
## X7 2500 0.77 0.76 0.67 0.61 3.1 1.11
## X11 2500 0.74 0.76 0.67 0.60 3.6 0.95
## X12 2500 0.72 0.73 0.63 0.56 3.1 1.00
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## X6 0.06 0.10 0.13 0.44 0.27 0
## X15 0.06 0.12 0.31 0.37 0.15 0
## X7 0.09 0.24 0.26 0.34 0.08 0
## X11 0.03 0.12 0.26 0.48 0.12 0
## X12 0.07 0.18 0.38 0.32 0.06 0
Embalaža <- podatki[, c("X8", "X10", "X14")]
library(psych)
alpha(Embalaža,
check.keys=TRUE)
##
## Reliability analysis
## Call: alpha(x = Embalaža, check.keys = TRUE)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.82 0.82 0.75 0.6 4.5 0.0063 3.7 0.75 0.59
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.81 0.82 0.83
## Duhachek 0.81 0.82 0.83
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## X8 0.74 0.74 0.58 0.58 2.8 0.0105 NA 0.58
## X10 0.74 0.74 0.59 0.59 2.9 0.0104 NA 0.59
## X14 0.77 0.77 0.63 0.63 3.4 0.0091 NA 0.63
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## X8 2500 0.86 0.86 0.76 0.68 3.8 0.87
## X10 2500 0.86 0.86 0.75 0.68 3.8 0.88
## X14 2500 0.85 0.85 0.72 0.65 3.5 0.88
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## X8 0.03 0.06 0.19 0.58 0.15 0
## X10 0.02 0.06 0.22 0.53 0.16 0
## X14 0.03 0.10 0.27 0.52 0.09 0
Proizvajalec <- podatki[, c("X18", "X17")]
library(psych)
alpha(Proizvajalec,
check.keys=TRUE)
##
## Reliability analysis
## Call: alpha(x = Proizvajalec, check.keys = TRUE)
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.63 0.63 0.46 0.46 1.7 0.015 2.6 0.86 0.46
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.6 0.63 0.66
## Duhachek 0.6 0.63 0.66
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## X18 0.44 0.46 0.21 0.46 0.86 NA 0 0.46
## X17 0.48 0.46 0.21 0.46 0.86 NA 0 0.46
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## X18 2500 0.85 0.85 0.58 0.46 2.8 0.99
## X17 2500 0.86 0.85 0.58 0.46 2.4 1.04
##
## Non missing response frequency for each item
## 1 2 3 4 5 miss
## X18 0.09 0.29 0.33 0.27 0.02 0
## X17 0.22 0.37 0.25 0.15 0.02 0