podatki <- read.table("./Kozmetika.csv", header=TRUE, sep=";", dec=",")

Vse spremenljivke merjene na Likertovi lestvici (1: Sploh se ne strinjam, 5: Popolnoma se strinjam)

FA

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 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

Shranjevanje faktorskih vrednosti

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

Cronbach alfa

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