Kod analizy

Analizę statystyczną wykonano przy użyciu języka programowania statystycznego R (R Core Team, 2022) oraz pakietów ze szczególnym uwzględnieniem tidyverse (Wickham i in., 2019), rstatix (Kassambara, 2021) oraz psych (Revelle, 2021). Analiza jest w pełni reprodukowalna.

#' ---
#' title: "Badanie walidacyjne KTR"
#' author: "Jakub Jędrusiak"
#' ---

options(dplyr.summarise.inform = FALSE, readr.show_col_types = FALSE) # do raportu

pacman::p_load(rstatix, tidyverse, magrittr, psych, lavaan, jtools)


# Definicje funkcji ----
flip_scale <- function(x, range_max, range_min = 1) {
  (range_min + range_max) - x
}


# Dane ----
baza_raw <- readxl::read_excel("baza-KTR.xlsx")

baza <- baza_raw

metryczka <- baza %>%
  select(8:11) %>%
  set_names(c("ID", "plec", "wiek", "wyksz"))

KTR_raw <- baza %>%
  select(8, 12:25) %>%
  set_names(c("ID", paste0("KTR", 1:14)))

MFQ_raw <- baza %>%
  select(8, starts_with(paste0(1:30, "."))) %>% # wybór w ten sposób wymusza poprawną kolejność, bo w bazie jest błędna; itemy MFQ zaczynają się od liczby
  set_names(c("ID", paste0("MFQ", 1:30)))

TIPI_raw <- baza %>%
  select(8, 31, 46, 58, 59, 61, 63:67) %>%
  set_names(c("ID", paste0("TIPI", 1:10)))

pytania_dodatkowe_raw <- baza %>%
  select(8, 60, 62, 68) %>%
  set_names(c("ID", "shot_st", "shot_chec", "maseczki"))


# Charakterystyka próby badawczej ----
metryczka %<>% mutate(wiek = parse_number(wiek))

rozklad_plci <- count(metryczka, plec)

rozklad_wyksztalcenia <- count(metryczka, wyksz)

histogram_plec <- metryczka %>% ggplot(aes(x = plec)) +
  geom_bar() +
  ggtitle("Histogram płci") +
  theme_apa()

histogram_wyksztalcenie <- metryczka %>% ggplot(aes(x = wyksz)) +
  geom_bar() +
  ggtitle("Histogram wykształcenia") +
  theme_apa()

histogram_wiek <- metryczka %>% ggplot(aes(x = wiek)) +
  geom_histogram() +
  ggtitle("Histogram wieku") +
  theme_apa()


# Podsumowanie kwestionariuszy ----

## KTR ----
KTR <- KTR_raw %>%
  mutate(across(2:15, parse_number)) %>%
  pivot_longer(2:15, names_to = "pyt", values_to = "odp") %>%
  mutate(
    odp = case_when(
      pyt == "KTR3" ~ flip_scale(odp, 6), # pozycje odwrócone
      TRUE ~ odp
    ),
    skala = case_when(
      pyt %in% paste0("KTR", seq(1, 14, 2)) ~ "KTR_O",
      pyt %in% paste0("KTR", seq(2, 14, 2)) ~ "KTR_W"
    )
  )

KTR_liczby_odpowiedzi <- KTR %>% # liczba osób wybierających każdą z odpowiedzi
  mutate(
    odp = case_when(pyt == "KTR3" ~ flip_scale(odp, 6), TRUE ~ odp), # oryginalne odpowiedzi
    pyt = str_replace(pyt, "KTR(\\d)$", "KTR0\\1") # etykiety typu „KTR01” zamiast „KTR1” do sortowania
  ) %>%
  group_by(pyt) %>%
  count(odp) %>%
  ungroup() %>%
  pivot_wider(id_cols = pyt, values_from = n, names_from = odp) %>%
  select(pyt, sort(colnames(.))) %>% # odpowiednia kolejność kolumn
  replace(is.na(.), 0) %>%
  mutate(`nie zgadzam się` = `1` + `2` + `3`, `zgadzam się` = `4` + `5` + `6`)

KTR_odsetki_odpowiedzi <- KTR_liczby_odpowiedzi %>%
  mutate(across(where(is.numeric), ~ round(.x / nrow(baza), 2))) # liczności na procenty

KTR_wyniki <- KTR %>%
  group_by(ID, skala) %>%
  summarise(suma = sum(odp)) %>%
  pivot_wider(names_from = skala, values_from = suma) %>%
  mutate(KTR_R = KTR_O + KTR_W)

KTR_wide <- KTR %>%
  pivot_wider(id_cols = "ID", names_from = "pyt", values_from = "odp") %>%
  select(-1) %>%
  mutate(KTR3 = flip_scale(KTR3, 6)) # oryginalna punktacja

## MFQ ----
MFQ <- MFQ_raw %>%
  pivot_longer(2:31, names_to = "pyt", values_to = "odp") %>%
  mutate(
    odp = parse_number(odp),
    skala = case_when(
      pyt %in% paste0("MFQ", seq(1, 30, 5)) ~ "MFQ_Tro",
      pyt %in% paste0("MFQ", seq(2, 30, 5)) ~ "MFQ_Spr",
      pyt %in% paste0("MFQ", seq(3, 30, 5)) ~ "MFQ_Loj",
      pyt %in% paste0("MFQ", seq(4, 30, 5)) ~ "MFQ_Aut",
      pyt %in% paste0("MFQ", seq(5, 30, 5)) ~ "MFQ_Sw"
    )
  )

MFQ_wyniki <- MFQ %>%
  group_by(ID, skala) %>%
  summarise(suma = sum(odp)) %>%
  pivot_wider(names_from = skala, values_from = suma)


## TIPI ----
TIPI <- TIPI_raw %>%
  pivot_longer(2:11, names_to = "pyt", values_to = "odp") %>%
  mutate(
    odp = parse_number(odp),
    odp = case_when(
      pyt %in% paste0("TIPI", seq(2, 10, 2)) ~ flip_scale(odp, 7),
      pyt %in% paste0("TIPI", seq(1, 10, 2)) ~ odp
    ),
    skala = case_when(
      pyt %in% c("TIPI1", "TIPI6") ~ "TIPI_E",
      pyt %in% c("TIPI2", "TIPI7") ~ "TIPI_U",
      pyt %in% c("TIPI3", "TIPI8") ~ "TIPI_Su",
      pyt %in% c("TIPI4", "TIPI9") ~ "TIPI_St",
      pyt %in% c("TIPI5", "TIPI10") ~ "TIPI_O"
    )
  )

TIPI_wyniki <- TIPI %>%
  group_by(ID, skala) %>%
  summarise(suma = sum(odp)) %>%
  pivot_wider(names_from = skala, values_from = suma)


## Pytania dodatkowe ----
pytania_dodatkowe <- pytania_dodatkowe_raw %>%
  mutate(
    shot_st = case_when(
      shot_st == "Nie i nie zamierzam" ~ 0,
      shot_st == "Nie, ale gdybym mógł/mogła to bym się zaszczepił/a" ~ as.numeric(NA),
      shot_st == "Nie, ale planuję" ~ as.numeric(NA),
      shot_st == "Tak" ~ 1
    ),
    shot_chec = case_when(
      shot_chec == "Bardzo chętnie" ~ 4,
      shot_chec == "Raczej chętnie" ~ 3,
      shot_chec == "Raczej niechętnie" ~ 2,
      shot_chec == "Bardzo niechętnie" ~ 1
    ),
    shot_chec = case_when( # usuwanie chęci szczepienia dla osób niezaszczepionych
      shot_st %in% c(0, NA) ~ as.numeric(NA),
      TRUE ~ shot_chec
    ),
    maseczki = case_when(
      maseczki == "Zawsze/prawie zawsze" ~ 4,
      maseczki == "Często" ~ 3,
      maseczki == "Rzadko" ~ 2,
      maseczki == "Nigdy/prawie nigdy" ~ 1
    )
  )


# Wyniki ----
wyniki <- metryczka %>%
  left_join(KTR_wyniki, by = "ID") %>%
  left_join(MFQ_wyniki, by = "ID") %>%
  left_join(TIPI_wyniki, by = "ID") %>%
  left_join(pytania_dodatkowe, by = "ID")

wyniki_opis <- describe(wyniki) %>% slice(-(1:4))

## Rozkłady ----
histogram_KTR_O <- wyniki %>% ggplot(aes(x = KTR_O)) +
  geom_histogram(aes(y = ..density..)) +
  stat_function(
    fun = dnorm,
    args = list(mean = mean(wyniki$KTR_O), sd = sd(wyniki$KTR_O)),
    colour = "black",
    size = 1
  ) +
  ggtitle("Rozkład wyników – opór przed ograniczeniami") +
  theme_apa()

histogram_KTR_W <- wyniki %>% ggplot(aes(x = KTR_W)) +
  geom_histogram(aes(y = ..density..)) +
  stat_function(
    fun = dnorm,
    args = list(mean = mean(wyniki$KTR_W), sd = sd(wyniki$KTR_W)),
    colour = "black",
    size = 1
  ) +
  ggtitle("Rozkład wyników – potrzeba wolności") +
  theme_apa()

histogram_KTR <- wyniki %>% ggplot(aes(x = KTR_R)) +
  geom_histogram(aes(y = ..density..)) +
  stat_function(
    fun = dnorm,
    args = list(mean = mean(wyniki$KTR_R), sd = sd(wyniki$KTR_R)),
    colour = "black",
    size = 1
  ) +
  ggtitle("Rozkład wyników – reaktancja") +
  theme_apa()

## Normalność ----
KTR_shapiro <- wyniki %>% shapiro_test(KTR_O, KTR_W, KTR_R)

# Korelacje ----

## Macierze ----
korelacje_matryca <- wyniki %>%
  select(5:6, 8:17) %>%
  corr.test()

## Hipotezy ----

# Hipoteza: opór przed ograniczeniami jest dodatnio skorelowany z potrzebą wolności.
r_opor_wolnosc <- wyniki %$%
  cor.test(KTR_O, KTR_W)

# Hipoteza: opór przed ograniczeniami jest ujemnie skorelowany z ważnością kodu moralnego autorytet/kwestionowanie władzy.
r_opor_autorytet <- wyniki %$%
  cor.test(KTR_O, MFQ_Aut)

# Hipoteza: opór przed ograniczeniami jest ujemnie skorelowany z poziomem ugodowości.
r_opor_ugodowosc <- wyniki %$%
  cor.test(KTR_O, TIPI_U)

# Hipoteza: potrzeba wolności jest dodatnio skorelowana z poziomem otwartości na doświadczenie.
r_wolnosc_otwartosc <- wyniki %$%
  cor.test(KTR_W, TIPI_O)

# Hipoteza: opór przed ograniczeniami jest ujemnie skorelowany ze stosowaniem się do nakazu noszenia maseczek.
r_opor_maseczki <- wyniki %$%
  cor.test(KTR_O, maseczki, method = "kendall")

# Hipoteza: nie występuje korelacja między wiekiem a oporem przed ograniczeniami.
r_wiek_opor <- wyniki %$%
  cor.test(wiek, KTR_O)

# Hipoteza: nie występuje korelacja między wiekiem a potrzebą wolności.
r_wiek_wolnosc <- wyniki %$%
  cor.test(wiek, KTR_W)

# Analiza czynnikowa ----

## Adekwatność analizy czynnikowej ----
KTR_bartlett <- cortest.bartlett(KTR_wide)

KTR_KMO <- KMO(KTR_wide)

KTR_det <- KTR_wide %>%
  cor() %>%
  det()

## Modele czynnikowe ----
m1a <- "KTR_O =~ KTR1 + KTR3 + KTR5 + KTR7 + KTR9 + KTR11 + KTR13
        KTR_W =~ KTR2 + KTR4 + KTR6 + KTR8 + KTR10 + KTR12 + KTR14"

model_korelacja <- cfa(m1a, KTR_wide, std.lv = TRUE)

analiza_czynnikowa <- summary(model_korelacja, fit.measures = TRUE, standardized = TRUE)

# Rzetelność ----

## Alfa Cronbacha ----
KTR_O_Cronbach <- KTR_wide %>%
  select(paste0("KTR", seq(1, 14, 2))) %>%
  mutate(KTR3 = flip_scale(KTR3, 6)) %>%
  alpha(title = "Opór przed ograniczeniami")

KTR_W_Cronbach <- KTR_wide %>%
  select(paste0("KTR", seq(2, 14, 2))) %>%
  alpha(title = "Potrzeba wolności")

## Retest ----
retest_raw <- readxl::read_excel("baza-retest.xlsx")

KTR_retest <- retest_raw %>%
  select(8:22) %>%
  set_names(c("ID", paste0("KTR", 1:14))) %>%
  mutate(across(2:15, parse_number)) %>%
  mutate(KTR3 = flip_scale(KTR3, 6)) %>%
  pivot_longer(2:15, names_to = "pyt", values_to = "odp") %>%
  mutate(
    skala = case_when(
      pyt %in% paste0("KTR", seq(1, 14, 2)) ~ "KTR_O_retest",
      TRUE ~ "KTR_W_retest"
    ),
    ID = case_when( # dostosowanie formy ID w bazie retestowej do formy w bazie głównej
      ID == "kow08" ~ "kow0806",
      ID == "Pie 05,09,2000" ~ "PIE 05.09.2000",
      ID == "rafalborko69@gmail.com" ~ "rafalborko69@gmail.com 17.11.1969",
      ID == "Woj26" ~ "Wojcie26",
      ID == "Giz1" ~ "Giz, 1.04",
      ID == "jagienka.2000@o2.pl" ~ "jagienka.2000@o2.pl, 25.06.2000",
      ID == "jakubkucharski@gmail.com" ~ "jakubkucharskioffice@gmail.com",
      ID == "Jeż20" ~ "Jeż 20",
      ID == "Pro06" ~ "Pro6",
      ID == "ROW12.05.1998" ~ "Row 12.05.1998",
      ID == "Mus 06" ~ "Mus+06",
      ID == "w.nowaczyk@s-cabling.pl" ~ "w.nowaczyk@interia.pl",
      ID == "Wit" ~ "Wit 14",
      TRUE ~ ID
    )
  )

KTR_retest_wyniki <- KTR_retest %>%
  group_by(ID, skala) %>%
  summarise(suma = sum(odp)) %>%
  pivot_wider(names_from = skala, values_from = suma) %>%
  mutate(KTR_R_retest = KTR_O_retest + KTR_W_retest)

KTR_retest_join <- KTR_retest_wyniki %>%
  fuzzyjoin::stringdist_left_join(KTR_wyniki, "ID", max_dist = 0, ignore_case = TRUE) %>%
  left_join(metryczka, c("ID.y" = "ID"))

### Charakterystyka próby i wyników
rozklad_plci_retest <- KTR_retest_join %>%
  ungroup() %>%
  count(plec)

KTR_retest_shapiro <- KTR_retest_join %>%
  drop_na() %>%
  ungroup() %>%
  shapiro_test(KTR_O_retest, KTR_W_retest, KTR_R_retest)

### Korelacje
r_KTR_retest <- KTR_retest_join %>%
  drop_na() %$%
  cor.test(KTR_R, KTR_R_retest)

r_KTR_O_retest <- KTR_retest_join %>%
  drop_na() %$%
  cor.test(KTR_O, KTR_O_retest)

r_KTR_W_retest <- KTR_retest_join %>%
  drop_na() %$%
  cor.test(KTR_W, KTR_W_retest)

Charakterystyka próby

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

W badaniu wzięły udział 144 osoby (75 kobiet, 68 mężczyzn i 1 osoba deklarująca inną tożsamość płciową). Średnia wieku osób badanych wyniosła 36,45 (SD = 15,78).

Opis wyników

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

W próbie sprawdzono normalność rozkładów wyników KTR z użyciem testu W Shapiro-Wilka. Wyniki testu nie pozwalają odrzucić hipotezy o normalności rozkładu w przypadku wyników sumarycznych (W(144) = 0,99, p = 0,439) i podskali opór przed ograniczeniami (W(144) = 0,987, p = 0,196), ale jednocześnie wskazują na istotne odchylenie od normalności rozkładu w podskali potrzeba wolności (W(144) = 0,98, p = 0,036).

Trafność

Interkorelacja podskal

## 
##  Pearson's product-moment correlation
## 
## data:  KTR_O and KTR_W
## t = 5,3256, df = 142, p-value = 3,848e-07
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0,2619297 0,5358363
## sample estimates:
##       cor 
## 0,4080237

Wykonano analizę korelacji celem sprawdzenia związku dwóch podskal Kwestionariusza Tendencji do Reaktancji – opór przed ograniczeniami i potrzeba wolności. Wykazano istnienie umiarkowanej, dodatniej korelacji, r(142) = 0,41, p < 0,001.

Hipotezy

Celem sprawdzenia trafności teoretycznej kwestionariusza, wysunięto 6 hipotez:

Opór przed ograniczeniami jest ujemnie skorelowany z ważnością kodu moralnego autorytet/kwestionowanie władzy.
Opór przed ograniczeniami jest ujemnie skorelowany z poziomem ugodowości.
Potrzeba wolności jest dodatnio skorelowana z poziomem otwartości na doświadczenie.
Opór przed ograniczeniami jest ujemnie skorelowany ze stosowaniem się do nakazu noszenia maseczek.
Nie występuje korelacja między wiekiem a oporem przed ograniczeniami.
Nie występuje korelacja między wiekiem a potrzebą wolności.

## 
##  Pearson's product-moment correlation
## 
## data:  KTR_O and MFQ_Aut
## t = -0,67159, df = 142, p-value = 0,5029
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0,2178398  0,1083038
## sample estimates:
##         cor 
## -0,05626894

## 
##  Pearson's product-moment correlation
## 
## data:  KTR_O and TIPI_U
## t = -1,0736, df = 142, p-value = 0,2848
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0,24964666  0,07494077
## sample estimates:
##         cor 
## -0,08973517

## 
##  Pearson's product-moment correlation
## 
## data:  KTR_W and TIPI_O
## t = 3,3061, df = 142, p-value = 0,001198
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0,1085095 0,4128615
## sample estimates:
##       cor 
## 0,2673402

## 
##  Kendall's rank correlation tau
## 
## data:  KTR_O and maseczki
## z = -4,7648, p-value = 1,891e-06
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
##        tau 
## -0,3208859

## 
##  Pearson's product-moment correlation
## 
## data:  wiek and KTR_O
## t = -0,62391, df = 142, p-value = 0,5337
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0,2140312  0,1122502
## sample estimates:
##        cor 
## -0,0522858

## 
##  Pearson's product-moment correlation
## 
## data:  wiek and KTR_W
## t = -0,66114, df = 142, p-value = 0,5096
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0,2170061  0,1091685
## sample estimates:
##         cor 
## -0,05539662

Analiza korelacji pozwoliła określić, że poczynione przewidywania były trafne w przypadku 4 spośród 6 hipotez. Wyniki analizy przedstawiono w tabeli X. W przypadku hipotezy 4. zastosowano nieparametryczny współczynnik tau Kendalla ze względu na to, że stosowanie się do nakazu noszenia maseczek mierzono na skali porządkowej. W pozostałych przypadkach wykorzystano współczynnik korelacji Pearsona.

Hipoteza	Korelacja
1	r(142) = -0,056, p = 0,503
2	r(142) = -0,09, p = 0,285
3	r(142) = 0,267, p = 0,001**
4	r_\tau = -0,321, p < 0,001***
5	r(142) = -0,052, p < 0,001***
6	r(142) = -0,055, p = 0,51

Rzetelność

Alfa Cronbacha

## 
## Reliability analysis  Opór przed ograniczeniami  
## Call: alpha(x = ., title = "Opór przed ograniczeniami")
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean   sd median_r
##       0,54      0,54    0,56      0,14 1,2 0,059  3,4 0,59     0,14
## 
##  lower alpha upper     95% confidence boundaries
## 0,42 0,54 0,65 
## 
##  Reliability if an item is dropped:
##       raw_alpha std.alpha G6(smc) average_r  S/N alpha se  var.r med.r
## KTR1       0,49      0,50    0,51      0,14 0,98    0,066 0,0169  0,14
## KTR3       0,54      0,53    0,51      0,16 1,14    0,059 0,0094  0,14
## KTR5       0,54      0,55    0,56      0,17 1,23    0,059 0,0173  0,17
## KTR7       0,52      0,52    0,53      0,15 1,09    0,062 0,0181  0,16
## KTR9       0,46      0,46    0,46      0,13 0,86    0,070 0,0144  0,13
## KTR11      0,43      0,44    0,45      0,11 0,78    0,074 0,0145  0,13
## KTR13      0,51      0,51    0,50      0,15 1,04    0,063 0,0116  0,14
## 
##  Item statistics 
##         n raw.r std.r r.cor r.drop mean  sd
## KTR1  144  0,53  0,53  0,40   0,29  4,3 1,1
## KTR3  144  0,47  0,45  0,32   0,19  2,7 1,3
## KTR5  144  0,40  0,41  0,20   0,15  4,3 1,1
## KTR7  144  0,48  0,48  0,30   0,22  3,4 1,2
## KTR9  144  0,59  0,60  0,51   0,38  2,4 1,1
## KTR11 144  0,64  0,64  0,57   0,43  3,2 1,2
## KTR13 144  0,50  0,50  0,39   0,25  3,6 1,2
## 
## Non missing response frequency for each item
##          1    2    3    4    5    6 miss
## KTR1  0,03 0,03 0,15 0,30 0,37 0,12    0
## KTR3  0,16 0,33 0,34 0,07 0,05 0,05    0
## KTR5  0,03 0,02 0,13 0,37 0,33 0,12    0
## KTR7  0,07 0,10 0,35 0,33 0,12 0,03    0
## KTR9  0,22 0,36 0,31 0,07 0,03 0,01    0
## KTR11 0,03 0,28 0,37 0,17 0,11 0,03    0
## KTR13 0,02 0,14 0,34 0,24 0,20 0,06    0

## 
## Reliability analysis  Potrzeba wolności  
## Call: alpha(x = ., title = "Potrzeba wolności")
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean   sd median_r
##       0,72      0,73    0,74      0,28 2,7 0,036  4,8 0,63     0,29
## 
##  lower alpha upper     95% confidence boundaries
## 0,65 0,72 0,79 
## 
##  Reliability if an item is dropped:
##       raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## KTR2       0,67      0,68    0,69      0,26 2,2    0,043 0,020  0,29
## KTR4       0,69      0,70    0,71      0,28 2,3    0,041 0,022  0,27
## KTR6       0,67      0,68    0,68      0,26 2,1    0,043 0,024  0,29
## KTR8       0,71      0,72    0,72      0,30 2,5    0,038 0,025  0,31
## KTR10      0,67      0,68    0,68      0,26 2,2    0,042 0,016  0,29
## KTR12      0,75      0,75    0,75      0,34 3,0    0,033 0,012  0,32
## KTR14      0,67      0,68    0,67      0,26 2,1    0,043 0,016  0,29
## 
##  Item statistics 
##         n raw.r std.r r.cor r.drop mean   sd
## KTR2  144  0,67  0,68  0,62   0,51  4,9 1,01
## KTR4  144  0,62  0,62  0,52   0,44  4,9 1,06
## KTR6  144  0,68  0,68  0,62   0,53  5,1 0,95
## KTR8  144  0,59  0,57  0,45   0,38  4,1 1,16
## KTR10 144  0,66  0,68  0,63   0,51  5,0 0,90
## KTR12 144  0,45  0,43  0,26   0,21  4,6 1,10
## KTR14 144  0,66  0,68  0,64   0,51  5,1 0,95
## 
## Non missing response frequency for each item
##          1    2    3    4    5    6 miss
## KTR2  0,01 0,01 0,06 0,20 0,41 0,31    0
## KTR4  0,01 0,01 0,08 0,21 0,33 0,37    0
## KTR6  0,01 0,01 0,01 0,19 0,38 0,40    0
## KTR8  0,01 0,10 0,15 0,38 0,26 0,10    0
## KTR10 0,01 0,00 0,04 0,23 0,42 0,31    0
## KTR12 0,01 0,04 0,08 0,31 0,33 0,23    0
## KTR14 0,01 0,01 0,03 0,20 0,34 0,42    0

Rzetelność podskal kwestionariusza KTR sprawdzono licząc współczynnik alfa Cronbacha. Dla podskali opór przed ograniczeniami przyjął on wartość 0,54, którą należy ocenić jako niezadowalającą. Dla podskali potrzeba wolności przyjął on wartość 0,72, którą to wartość można uznać za dopuszczalną. Jednocześnie test wykazał, że wartość współczynnika alfa Cronbacha wzrosłaby (do 0,75) po wykluczeniu pozycji 12., tj. „Przy podejmowaniu decyzji lubię mieć wiele opcji do wyboru”.

Wartości korelacji między pozycją a podskalą sugerują konieczność przeformułowania lub usunięcia pozycji 5. (r(142) = 0,411) i 12. (r(142) = 0,428.

Retest

Celem sprawdzenia rzetelności testu, po upływie ok. 3 tygodni od pierwszego badania wykonano badanie retestowe. 74 osób badanych ponownie wypełniło kwestionariusz KTR. Ze względu na niemożność dopasowania numerów identyfikacyjnych między badaniami wykluczono 7 obserwacji, w wyniku czego ostateczna liczba wyników poddanych analizie statystycznej wyniosła 67 (38 kobiet i 29 mężczyzn). Średnia wieku w próbie wyniosła 34,48 lat (SD = 14,32).

## # A tibble: 3 × 3
##   variable     statistic      p
##   <chr>            <dbl>  <dbl>
## 1 KTR_O_retest     0.981 0.382 
## 2 KTR_R_retest     0.983 0.493 
## 3 KTR_W_retest     0.965 0.0575

Normalność rozkładów wyników w reteście sprawdzono testem W Shapiro-Wilka. Uznano brak podstaw do odrzucenia hipotezy o normalności rozkładu dla wyników sumarycznych (W(67) = 0,983, p = 0,493), podskali oporu przed ograniczeniami (W(67) = 0,981, p = 0,382) oraz podskali potrzeby wolności (W(67) = 0,965, p = 0,057).

## 
##  Pearson's product-moment correlation
## 
## data:  KTR_R and KTR_R_retest
## t = 10,824, df = 65, p-value = 3,475e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0,6958165 0,8738490
## sample estimates:
##       cor 
## 0,8019811

## 
##  Pearson's product-moment correlation
## 
## data:  KTR_O and KTR_O_retest
## t = 9,8751, df = 65, p-value = 1,465e-14
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0,6565903 0,8556266
## sample estimates:
##      cor 
## 0,774626

## 
##  Pearson's product-moment correlation
## 
## data:  KTR_W and KTR_W_retest
## t = 8,2251, df = 65, p-value = 1,163e-11
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0,5720634 0,8146079
## sample estimates:
##      cor 
## 0,714139

Korelacja między wynikami sumarycznymi w dwóch testach wyniosła r(65) = 0,802, p < 0,001. Istnienie korelacji potwierdzono również dla podskali opór przed ograniczeniami (r(65) = 0,775, p < 0,001) oraz potrzeba wolności (r(65) = 0,714, p < 0,001). Wartości korelacji należy uznać za niezadowalające.

Bibliografia

Kassambara, A. (2021). rstatix: Pipe-Friendly Framework for Basic Statistical Tests. Pobrano z https://CRAN.R-project.org/package=rstatix

R Core Team. (2022). R: A Language and Environment for Statistical Computing. Vienna, Austria: R Foundation for Statistical Computing. Pobrano z https://www.R-project.org/

Revelle, W. (2021). psych: Procedures for Psychological, Psychometric, and Personality Research. Evanston, Illinois: Northwestern University. Pobrano z https://CRAN.R-project.org/package=psych

Wickham, H., Averick, M., Bryan, J., Chang, W., McGowan, L. D., François, R., … Yutani, H. (2019). Welcome to the tidyverse. Journal of Open Source Software, 4(43), 1686. https://doi.org/10.21105/joss.01686

Raport z badania walidacyjnego kwestionariusza KTR

Jakub Jędrusiak

2022-01-22 21:31:27