library(psych)

Exemplo 1 pág 64 AM FIPECAFI

library(haven)
ex_1_alpha <- read_sav("Exemplo1alpha.sav")
names(ex_1_alpha) <- c("tipo","preco","qualidade","confianca","planejamento","controle","decisao")
ex_1_alpha
exemplo1 <-ex_1_alpha[,2:7]
#str(exemplo1)
#is(exemplo1)
# variância por coluna (qi)
somavar <- sum(apply(exemplo1,2,var))
#variância total
# soma todas as linhas e obtem a var da coluna resultante
vartot <-var(apply(exemplo1,1,sum))
k <- ncol(exemplo1) # obter o valor de k
alfa <- (k/(k-1))*(1-(somavar)/vartot)
alfa
[1] 0.8214961
# usando a fórmula alternativa (raw alfa)
tvar1 <- var(exemplo1, na.rm = FALSE) # missing data aborts var()
alfa <- (k/(k-1)) * (1 - sum(diag(tvar1))/sum(tvar1))
alfa
[1] 0.8214961
# usando a fórmula alternativa (standard alfa) - padroniza o alfa
tvar1 <- cor(exemplo1) 
alfa <- (k/(k-1)) * (1 - sum(diag(tvar1))/sum(tvar1))
alfa
[1] 0.8272472
# existe uma forma mais simples para calcular o Alfa com o comando alpha
# o comando (psych::) antes do alpha é usado para não ter conflito com o package ggplot2 que será usado para construir um gráfico mais adiante, caso contrário, pode ser omitido. 
alfa <- psych::alpha(as.matrix(exemplo1))
alfa

Reliability analysis   
Call: psych::alpha(x = as.matrix(exemplo1))

  raw_alpha std.alpha G6(smc) average_r S/N   ase mean   sd
      0.82      0.83    0.82      0.44 4.8 0.012  3.1 0.97

 lower alpha upper     95% confidence boundaries
0.8 0.82 0.85 

 Reliability if an item is dropped:
             raw_alpha std.alpha G6(smc) average_r S/N alpha se
preco             0.76      0.77    0.76      0.40 3.4    0.017
qualidade         0.80      0.81    0.80      0.46 4.3    0.014
confianca         0.77      0.78    0.76      0.41 3.5    0.016
planejamento      0.86      0.86    0.84      0.55 6.1    0.010
controle          0.77      0.78    0.77      0.41 3.5    0.016
decisao           0.78      0.79    0.78      0.42 3.7    0.016

 Item statistics 
               n raw.r std.r r.cor r.drop mean  sd
preco        500  0.82  0.83  0.81   0.73  3.1 1.3
qualidade    500  0.70  0.69  0.59   0.54  3.2 1.4
confianca    500  0.80  0.80  0.78   0.69  3.1 1.3
planejamento 500  0.51  0.49  0.32   0.29  3.2 1.4
controle     500  0.80  0.80  0.76   0.68  3.1 1.3
decisao      500  0.77  0.78  0.73   0.66  3.1 1.3

Non missing response frequency for each item
                1    2    3    4    5 miss
preco        0.13 0.21 0.25 0.25 0.16    0
qualidade    0.15 0.21 0.19 0.22 0.23    0
confianca    0.14 0.21 0.21 0.29 0.14    0
planejamento 0.18 0.17 0.17 0.24 0.24    0
controle     0.15 0.17 0.27 0.19 0.21    0
decisao      0.12 0.24 0.24 0.25 0.15    0
library(ggplot2)

Attaching package: 㤼㸱ggplot2㤼㸲

The following objects are masked from 㤼㸱package:psych㤼㸲:

    %+%, alpha
library(ggcorrplot)
# Correlation matrix
corr <- round(cor(exemplo1), 1)
corr
             preco qualidade confianca planejamento controle decisao
preco          1.0       0.5       0.7          0.3      0.6     0.6
qualidade      0.5       1.0       0.5          0.2      0.4     0.4
confianca      0.7       0.5       1.0          0.2      0.6     0.6
planejamento   0.3       0.2       0.2          1.0      0.3     0.2
controle       0.6       0.4       0.6          0.3      1.0     0.6
decisao        0.6       0.4       0.6          0.2      0.6     1.0
# Plot
ggcorrplot(corr, hc.order = TRUE, 
           type = "lower", 
           lab = TRUE, 
           lab_size = 3, 
           method="circle", 
           colors = c("tomato2", "white", "springgreen3"), 
           title="Correlograma - base de dados exemplo 1", 
           ggtheme=theme_bw)

LS0tDQp0aXRsZTogIkV4ZW1wbG8gQWxwaGEgQ3JvbmJhY2ggLSBTTElERVMiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpgYGB7cn0NCmxpYnJhcnkocHN5Y2gpDQpgYGANCg0KPiBFeGVtcGxvIDEgDQo+IHDDoWcgNjQgQU0gRklQRUNBRkkNCg0KDQpgYGB7cn0NCmxpYnJhcnkoaGF2ZW4pDQpleF8xX2FscGhhIDwtIHJlYWRfc2F2KCJFeGVtcGxvMWFscGhhLnNhdiIpDQoNCm5hbWVzKGV4XzFfYWxwaGEpIDwtIGMoInRpcG8iLCJwcmVjbyIsInF1YWxpZGFkZSIsImNvbmZpYW5jYSIsInBsYW5lamFtZW50byIsImNvbnRyb2xlIiwiZGVjaXNhbyIpDQpleF8xX2FscGhhDQpgYGANCg0KYGBge3J9DQpleGVtcGxvMSA8LWV4XzFfYWxwaGFbLDI6N10NCiNzdHIoZXhlbXBsbzEpDQojaXMoZXhlbXBsbzEpDQoNCg0KIyB2YXJpw6JuY2lhIHBvciBjb2x1bmEgKHFpKQ0Kc29tYXZhciA8LSBzdW0oYXBwbHkoZXhlbXBsbzEsMix2YXIpKQ0KDQojdmFyacOibmNpYSB0b3RhbA0KIyBzb21hIHRvZGFzIGFzIGxpbmhhcyBlIG9idGVtIGEgdmFyIGRhIGNvbHVuYSByZXN1bHRhbnRlDQp2YXJ0b3QgPC12YXIoYXBwbHkoZXhlbXBsbzEsMSxzdW0pKQ0KDQoNCmsgPC0gbmNvbChleGVtcGxvMSkgIyBvYnRlciBvIHZhbG9yIGRlIGsNCmFsZmEgPC0gKGsvKGstMSkpKigxLShzb21hdmFyKS92YXJ0b3QpDQphbGZhDQoNCiMgdXNhbmRvIGEgZsOzcm11bGEgYWx0ZXJuYXRpdmEgKHJhdyBhbGZhKQ0KdHZhcjEgPC0gdmFyKGV4ZW1wbG8xLCBuYS5ybSA9IEZBTFNFKSAjIG1pc3NpbmcgZGF0YSBhYm9ydHMgdmFyKCkNCmFsZmEgPC0gKGsvKGstMSkpICogKDEgLSBzdW0oZGlhZyh0dmFyMSkpL3N1bSh0dmFyMSkpDQphbGZhDQoNCiMgdXNhbmRvIGEgZsOzcm11bGEgYWx0ZXJuYXRpdmEgKHN0YW5kYXJkIGFsZmEpIC0gcGFkcm9uaXphIG8gYWxmYQ0KdHZhcjEgPC0gY29yKGV4ZW1wbG8xKSANCmFsZmEgPC0gKGsvKGstMSkpICogKDEgLSBzdW0oZGlhZyh0dmFyMSkpL3N1bSh0dmFyMSkpDQphbGZhDQoNCg0KDQojIGV4aXN0ZSB1bWEgZm9ybWEgbWFpcyBzaW1wbGVzIHBhcmEgY2FsY3VsYXIgbyBBbGZhIGNvbSBvIGNvbWFuZG8gYWxwaGENCiMgbyBjb21hbmRvIChwc3ljaDo6KSBhbnRlcyBkbyBhbHBoYSDDqSB1c2FkbyBwYXJhIG7Do28gdGVyIGNvbmZsaXRvIGNvbSBvIHBhY2thZ2UgZ2dwbG90MiBxdWUgc2Vyw6EgdXNhZG8gcGFyYSBjb25zdHJ1aXIgdW0gZ3LDoWZpY28gbWFpcyBhZGlhbnRlLCBjYXNvIGNvbnRyw6FyaW8sIHBvZGUgc2VyIG9taXRpZG8uIA0KDQphbGZhIDwtIHBzeWNoOjphbHBoYShhcy5tYXRyaXgoZXhlbXBsbzEpKQ0KYWxmYQ0KDQoNCmBgYA0KDQoNCmBgYHtyfQ0KbGlicmFyeShnZ3Bsb3QyKQ0KbGlicmFyeShnZ2NvcnJwbG90KQ0KDQojIENvcnJlbGF0aW9uIG1hdHJpeA0KY29yciA8LSByb3VuZChjb3IoZXhlbXBsbzEpLCAxKQ0KY29ycg0KDQojIFBsb3QNCmdnY29ycnBsb3QoY29yciwgaGMub3JkZXIgPSBUUlVFLCANCiAgICAgICAgICAgdHlwZSA9ICJsb3dlciIsIA0KICAgICAgICAgICBsYWIgPSBUUlVFLCANCiAgICAgICAgICAgbGFiX3NpemUgPSAzLCANCiAgICAgICAgICAgbWV0aG9kPSJjaXJjbGUiLCANCiAgICAgICAgICAgY29sb3JzID0gYygidG9tYXRvMiIsICJ3aGl0ZSIsICJzcHJpbmdncmVlbjMiKSwgDQogICAgICAgICAgIHRpdGxlPSJDb3JyZWxvZ3JhbWEgLSBiYXNlIGRlIGRhZG9zIGV4ZW1wbG8gMSIsIA0KICAgICAgICAgICBnZ3RoZW1lPXRoZW1lX2J3KQ0KYGBgDQoNCg0K