Подкаст про емоційне сприйняття майбутнього

htmltools::tags$audio(
  
  src = "https://raw.githubusercontent.com/socio-pixel/my-audio/main/Future-emotional-perception.mp3",
  controls = "controls",
  style = "width: 100%;" 
)

Емоційне сприйняття майбутнього – це психоемоційний конструкт, що відображає афективну оцінку індивідом своєї часової перспективи. Його основу становить валентнісний компонент, який визначає емоційне забарвлення цього сприйняття як позитивне або негативне.
Позитивні емоції: оптимізм, радість, упевненість, задоволеність, надія.
Негативні емоції: безвихідність, розгубленість, песимізм, тривога, страх.
Нейтральні або змішані емоції: інтерес, байдужість.

Ресурс – це динамічна система психологічних, матеріальних, духовних та соціальних засобів, доступних індивіду або соціальній групі, що забезпечує адаптацію до середовища, зниження невизначеності та потенціал для розвитку. Ресурси виконують подвійну функцію: захисну (буфер між зовнішніми викликами та внутрішньою стабільністю) та трансформаційну (основа для особистісного зростання та соціальної інтеграції). Їхня ефективність визначається як індивідуальною здатністю до акумуляції та використання, так і контекстуальними умовами соціального та символічного простору.

Теоретичні основи дослідження

Концепція емоційних факторів життєстійкості

Автор: Олена Злобіна (Olena Zlobina)
Ключові положення:
- Емоційні стани населення є чутливим індикатором соціальних трансформацій
- Високий рівень стійкості співвідноситься з оптимізмом, надією, упевненістю, низьким рівнем тривоги, низьким рівнем страху
- Низький рівень стійкості корелює з безвихіддю, розгубленістю, тривогою, страхом, нижчим рівнем оптимізму

Теорія збереження ресурсів (Conservation of Resources Theory, COR)

Автор: Стівен Гобфолл (Stevan E. Hobfoll)
Ключові положення:
- Люди прагнуть набувати, зберігати та захищати свої ресурси
- Втрата ресурсів → основне джерело стресу
- Накопичення ресурсів → психологічне благополуччя
Типи ресурсів:
- Матеріальні блага
- Психологічні характеристики
- Соціальні зв’язки

Теорія обміну ресурсами (Resource Exchange Theory)

Автор: Уріель Фоа (Uriel Foa)
Ключові ідеї:
- Виокремлено 6 категорій ресурсів: любов, статус, інформація, гроші, товари, послуги
- Соціальні взаємодії грунтуються на обміні цими ресурсами
- Якість обміну ресурсами визначає стабільність міжособистісних відносин
Практичне значення: допомагає зрозуміти вплив соціальної підтримки та доступу до ресурсів на впевненість у майбутньому

Теорія самоефективності (Self-Efficacy Theory)

Автор: Альберт Бандура (Albert Bandura)
Основні ідеї:
- Віра у власну здатність досягати цілей визначає поведінку
- Самоефективність впливає на:
  - Вибір складності завдань
  - Наполегливість у досягненні цілей
  - Реакцію на невдачі
Джерела самоефективності:
- Власний досвід успіху
- Спостереження за успіхом інших
- Вербальне переконання
- Емоційний стан

Теорія соціального капіталу (Social Capital Theory)

Автори:
- П’єр Бурдьє (Pierre Bourdieu)
- Джеймс Коулмен (James Coleman)
- Роберт Патнем (Robert Putnam)
Ключові концепції:
- Соціальний капітал як мережа відносин (Бурдьє)
- Функціональна роль у колективній діяльності (Коулмен)
- Зв’язуючий (bonding) і мостовий (bridging) капітал (Патнем)
Значення: пояснює роль соціальних зв’язків у доступі до ресурсів

Концепція психологічного капіталу (Psychological Capital, PsyCap)

Автор: Фред Лютанс (Fred Luthans)
Модель HERO:
- H (Hope) - надія
- E (Efficacy) - самоефективність
- R (Resilience) - стійкість
- O (Optimism) - оптимізм
Вплив на особистість:
- Підвищує адаптивність до змін
- Покращує здатність долати труднощі
- Формує позитивне ставлення до майбутнього

Теорія соціальної вбудованості (Embeddedness Theory)

Автор: Марк Грановеттер (Mark Granovetter)
Головні тези:
- Економічна поведінка формується під впливом соціального оточення
- Соціальні мережі впливають на:
  - Доступ до ресурсів
  - Рівень підтримки
  - Впевненість у майбутньому
Практичне застосування: пояснює вплив соціального середовища на емоційне сприйняття майбутнього

Концептуальна схема

Емоційне ставлення до майбутнього формується під впливом трьох основних груп факторів.
Соціально-демографічні хараткеристики.
Вік - впливає на життєвий досвід та перспективи.
Тип населеного пункту - визначає соціальне середовище та можливості.

Особистінсі ресурси.
Особистісна ефективність як ключовий предиктор оптимістичного бачення майбутнього.
Соціально-політичні знання як фактор критичного осмислення перспектив.
Самооцінка здоров’я як показник особистого благополуччя.
Духовні практики як ресурс психологічної підтримки.
Базове матеріальне забезпечення як фундамент стабільності.

Соціальні ресурси.
Підтримка громади як джерело можливостей.

library(DiagrammeR)

# Додаємо CSS стилі для збільшення тексту
DiagrammeR::mermaid("
%%{init: {'theme': 'base', 'themeVariables': { 'fontSize': '16px', 'fontFamily': 'Arial' }}}%%
    graph LR
    subgraph Соціально-демографічні характеристики
        A[Вік]
        B[Тип населеного пункту]
    end
    subgraph Індивідуальні ресурси
        subgraph Компетентнісні ресурси
            C[Особистісна ефективність]
            D[Соціально-політичні знання]
        end
        subgraph Вітальні ресурси
            E[Самооцінка здоров'я]
            G[Базове матеріальне забезпечення]
        end
        subgraph Ціннісно-смислові ресурси
            F[Духовні практики]
        end
    end
    subgraph Соціальні ресурси
        H[Підтримка громади]
    end
    I[Емоційне ставлення до майбутнього]
    A --> I
    B --> I
    C --> I
    D --> I
    E --> I
    F --> I
    G --> I
    H --> I
")

Змінні та їх вимірювання

Залежна змінна.
Індекс емоційного ставлення до майбутнього (FutureFeelings) розраховано на основі відповідей на запитання множинного вибору (r6) про почуття щодо майбутнього.
Перекодування: Позитивні емоції (“оптимізм”, “радість”, “упевненість”, “задоволеність”, “надія”, “інтерес”) отримали бал +1, негативні (“байдужість”, “безвихідність”, “розгубленість”, “песимізм”, “тривога”, “страх” тощо) – бал -1.
Побудова індексу. Сума балів. Вищі значення індексу вказують на більш позитивне емоційне ставлення до майбутнього.

Незалежні змінні.
Вік (Age): Кількість повних років респондента.
Тип населеного пункту (ResidenceType): Бінарна змінна. Перекодування: “село” = 1, “місто” = 2.

Компоненти Інтегрального індексу соціального самопочуття (ІІСС-20).
Перекодування: “не вистачає” = 0, “важко сказати/не цікавить” = 1, “вистачає” = 2.
Побудова індексів. Сума балів за відповідними питаннями, поділена на кількість запитань.

Індекс особистісної ефективності (SelfEfficacy) побудований на основі питань f6.7, f6.12, f6.17 (впевненість, рішучість, ініціатива).
Індекс соціально-політичних знань (Knowledge) побудований на основі питань f6.6, f6.11 (економічні знання, політичні знання).
Індекс базового матеріального забезпечення (BasicNeeds) побудований на основі питань f6.4, f6.5, f6.10, f6.16 (одяг, житло, меблі, продукти).

Підтримка громади (ComSup). Бінарна змінна, на основі питання stp1 (можливість отримати допомогу). Перекодування: “відсутня” (об’єднано “Зовсім не можу розраховувати” та “Важко відповісти”) = 1, “наявна” (об’єднано “Певною мірою можу розраховувати” та “Цілком можу розраховувати”) = 2.

Духовні практики (Spirit). Бінарна змінна. Перекодування: “не звертаються до духовних практик” = 1, “звертаються до духовних практик” = 2.

Самооцінка здоров’я (selfRatedHealth). Оцінка за 5-бальною шкалою (від “дуже поганий” до “відмінний”).

Емпірична база

Емпіричною базою дослідження слугували результати всеукраїнського опитування, реалізованого компанією «Група «Рейтинг» за фінансової підтримки Проєкту USAID «Трансформація комунікацій». Польовий етап тривав з 27 червня по 6 липня 2024 року. Опитування охопило підконтрольну територію України (за винятком тимчасово окупованих територій та районів без українського мобільного зв’язку) і було проведено з використанням комбінованої методології CATI-CAWI (n = 4101).

cat("Завантаження необхідних пакетів")

## Завантаження необхідних пакетів

  rm(list=ls())
  
  library(here)        # Шлях до файлу
  library(haven)       # Для імпорту файлів
  library(smacof)      # Для багатовимірного шкалювання
  library(ggplot2)     # Для створення графіків
  library(ggrepel)     # Для підписів на графіку
  library(plotly)      # Для стоврення інтерактивних графіків
  library(sjPlot)      # Для створення графіків
  library(Hmisc)       # Для зваженої медіани
  library(weights)     # Для зважених середнього та квантилів, кореляційного аналізу
  library(DescTools)    # Для зважених асиметрії та ексцесу
  library(knitr)       # Для стилей табличок
  library(kableExtra)  # Додаткові стилі
  library(corrplot)    # Для візуалізації кореляційної матриці
  library(sjmisc)      # Для описової статистики та частотного аналізу
  library(dplyr)       # Для маніпуляцій з даними
  library(DescTools)   # Для розширених функцій описової статистики
  library(knitr)       # Для створення таблиць
  library(ggfortify)   # Для графіків перевірки припущень моделі 
  library(car)         # Для VIF (фактор інфляції дисперсії) та ANOVA
  library(effectsize)  # Для розрахунку величини ефекту (eta_squared)

# Завантаження даних з файлу .sav
df <- read_sav(here("1-Monitoring2024.sav"))

variables_to_check <- c(  "r6_1", "r6_2", "r6_3",  "r6_4",
                          "r6_5", "r6_6", "r6_7", "r6_8",
                          "r6_9", "r6_10", "r6_11", "r6_12", 
"FutureFeelings", "Age", "ComSup", "ResidenceType", "BasicNeeds", "Knowledge", "SelfEfficacy", "selfRatedHealth", "Spirit", "wt_UA4101")

variables_with_na <- variables_to_check[sapply(df[variables_to_check], function(x) any(is.na(x)))]
if(length(variables_with_na) > 0){
    cat("\nЗмінні, що містять NA значення:\n")
    cat(paste(variables_with_na, collapse = ", "))
    cat("\n")
} else {
    cat("\nУ жодній змінній немає NA значень.\n")
}

## 
## У жодній змінній немає NA значень.

sample_size_weighted <- sum(df$wt_UA4101, na.rm = TRUE) 

cat(paste("\nРозмір вибірки (зважений):", round(sample_size_weighted, 0), "\n"))

## 
## Розмір вибірки (зважений): 4101

# Перетворення змінних на числові
df$FutureFeelings <- as.numeric(df$FutureFeelings)
df$Age <- as.numeric(df$Age)
df$SelfEfficacy <- as.numeric(df$SelfEfficacy)
df$BasicNeeds <- as.numeric(df$BasicNeeds)
df$Knowledge <- as.numeric(df$Knowledge)
df$selfRatedHealth <- as.numeric(df$selfRatedHealth)

# Відбір змінних r6_1 - r6_12
data_emotions <- df[, paste0("r6_", 1:12)]

colnames(data_emotions) <- c("Оптимізм", "Байдужість", "Радість", "Безвихідність",                                       "Упевненість", "Розгубленість",
                             "Задоволеність", "Песимізм", "Надія", "Тривога", "Інтерес",                                  "Страх")

data_emotions<-cbind(data_emotions, df$wt_UA4101)

Частотний розподіл

frq(data_emotions[1:12], weights = data_emotions$wt_UA4101)

## Оптимізм (Оптимізм) <numeric> 
## # total N=4101 valid N=4101 mean=0.36 sd=0.48
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 2632 | 64.18 |   64.18 |  64.18
##     1 |   Так | 1469 | 35.82 |   35.82 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Байдужість (Байдужість) <numeric> 
## # total N=4101 valid N=4101 mean=0.03 sd=0.16
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 3988 | 97.24 |   97.24 |  97.24
##     1 |   Так |  113 |  2.76 |    2.76 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Радість (Радість) <numeric> 
## # total N=4101 valid N=4101 mean=0.06 sd=0.24
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 3847 | 93.81 |   93.81 |  93.81
##     1 |   Так |  254 |  6.19 |    6.19 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Безвихідність (Безвихідність) <numeric> 
## # total N=4101 valid N=4101 mean=0.12 sd=0.32
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 3616 | 88.17 |   88.17 |  88.17
##     1 |   Так |  485 | 11.83 |   11.83 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Упевненість (Упевненість) <numeric> 
## # total N=4101 valid N=4101 mean=0.11 sd=0.32
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 3632 | 88.56 |   88.56 |  88.56
##     1 |   Так |  469 | 11.44 |   11.44 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Розгубленість (Розгубленість) <numeric> 
## # total N=4101 valid N=4101 mean=0.22 sd=0.42
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 3194 | 77.88 |   77.88 |  77.88
##     1 |   Так |  907 | 22.12 |   22.12 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Задоволеність (Задоволеність) <numeric> 
## # total N=4101 valid N=4101 mean=0.05 sd=0.21
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 3903 | 95.17 |   95.17 |  95.17
##     1 |   Так |  198 |  4.83 |    4.83 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Песимізм (Песимізм) <numeric> 
## # total N=4101 valid N=4101 mean=0.08 sd=0.27
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 3784 | 92.27 |   92.27 |  92.27
##     1 |   Так |  317 |  7.73 |    7.73 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Надія (Надія) <numeric> 
## # total N=4101 valid N=4101 mean=0.51 sd=0.50
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 2011 | 49.04 |   49.04 |  49.04
##     1 |   Так | 2090 | 50.96 |   50.96 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Тривога (Тривога) <numeric> 
## # total N=4101 valid N=4101 mean=0.34 sd=0.47
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 2718 | 66.28 |   66.28 |  66.28
##     1 |   Так | 1383 | 33.72 |   33.72 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Інтерес (Інтерес) <numeric> 
## # total N=4101 valid N=4101 mean=0.17 sd=0.38
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 3396 | 82.81 |   82.81 |  82.81
##     1 |   Так |  705 | 17.19 |   17.19 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>
## 
## Страх (Страх) <numeric> 
## # total N=4101 valid N=4101 mean=0.14 sd=0.35
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     0 |     - | 3508 | 85.54 |   85.54 |  85.54
##     1 |   Так |  593 | 14.46 |   14.46 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>

Кореляційна матриця

# Обчислення кореляційної матриці
correlation_matrix <- wtd.cor(data_emotions[1:12], 
                          weight = data_emotions$wt_UA4101)

# Доступ до кореляційної матриці
rounded_cor_matrix_emot <- round(correlation_matrix$correlation, 2)

cat("Кореляційна матриця взаємозв'язків між емоційними оцінками власного майбутнього")

## Кореляційна матриця взаємозв'язків між емоційними оцінками власного майбутнього

# Графік
corrplot(rounded_cor_matrix_emot, 
         method = "color",  # Колірна заливка
         type = "lower",    # Показати тільки нижню трикутну частину
         addCoef.col = "black", # Додавання числових значень (коефіцієнтів)
         tl.col = "black",  # Колір підписів змінних
         tl.srt = 45,       # Кут підписів змінних
         number.cex = 0.8,  # Розмір цифр кореляції
         order ="hclust",   # Ієрархічний кластерний аналіз
         hclust.method ="average")  # Метод середнього зв'язку

Багатовимірне шкалювання

## Convert correlations to Euclidean distances
dst_W <- sim2diss(rounded_cor_matrix_emot, method = "corr")

## Non-metric multidimensional scaling with two axes
map_W <- mds(delta = dst_W, ndim = 2,
             type = "ordinal")

stress_value  <- round(map_W$stress, 3)

# Отримання значення стресу

print(paste("Значення стресу:", stress_value))

## [1] "Значення стресу: 0.017"

# Отримання координат
mds_coordinates <- map_W$conf
print("Координати MDS:")

## [1] "Координати MDS:"

print(round(mds_coordinates,2))

##                  D1    D2
## Оптимізм       0.83  0.13
## Байдужість    -0.27 -0.65
## Радість        0.56 -0.06
## Безвихідність -0.71 -0.10
## Упевненість    0.67 -0.11
## Розгубленість -0.72  0.15
## Задоволеність  0.53 -0.11
## Песимізм      -0.62 -0.28
## Надія          0.51  0.52
## Тривога       -0.68  0.23
## Інтерес        0.50  0.17
## Страх         -0.60  0.10

# Приклад, якщо mds_coordinates - матриця (як в попередніх відповідях):
mds_coordinates_df <- as.data.frame(mds_coordinates)
mds_coordinates_df$emotion <- rownames(mds_coordinates) # Додаємо колонку з назвами емоцій
rownames(mds_coordinates_df) <- NULL # Очищаємо rownames, якщо вони не потрібні

# Побудова графіка за допомогою ggplot2
mds_plot <- ggplot(mds_coordinates_df, aes(x = D1, y = D2, label = emotion)) +
  geom_point(shape = 16, size = 2) +  
  geom_text_repel(
    size = 4,        # ЗБІЛЬШУЄМО РОЗМІР ШРИФТА
    box.padding   = 0.5,  # Збільшуємо відступ від тексту до рамки
    point.padding = 0.3,  # Збільшуємо відступ від тексту до точки
    segment.color = "grey50",  # Колір лінії
    fontface = "bold",     # ЗРОБИТИ ШРИФТ ЖИРНИМ
    color = "darkblue",     # ЗМІНИТИ КОЛІР ШРИФТА (для кращої видимості)
    # Додаткові параметри для тонкого налаштування:
    max.overlaps = Inf,  # Дозволяє перекриття (якщо підписів багато)
    min.segment.length = 0, # Дозволяє короткі лінії (навіть нульової довжини)
    force = 2, # Відштовхування міток від інших міток та точок (можна регулювати силу)
    nudge_x = 0.05,      # Зсув по X (можна використовувати для невеликих коригувань)
    nudge_y = 0.05       # Зсув по Y
  ) +
  xlim(-1.5, 1.5) +
  ylim(-1.5, 1.5) +
  xlab("Валентність (негативна – позитивна)") +
  ylab("Активація (низька – висока)") +
  geom_hline(yintercept = 0, linetype = "dashed", color = "gray") +
  geom_vline(xintercept = 0, linetype = "dashed", color = "gray") +
  theme_minimal() +
  theme( # Додаткові налаштування теми для всього графіка
       axis.title.x = element_text(size = 14), # Розмір шрифта для назви осі X
       axis.title.y = element_text(size = 14), # Розмір шрифта для назви осі Y
       axis.text.x  = element_text(size = 12), # Розмір шрифта для міток на осі X
       axis.text.y  = element_text(size = 12)  # Розмір шрифта для міток на осі Y
      )

mds_plot

Описові статистики

# Обчислення зважених частот для кожної категорії FutureFeelings
weighted_counts <- aggregate(wt_UA4101 ~ FutureFeelings, data = df, FUN = sum)  %>% round(1)

names(weighted_counts) <- c("FutureFeelings", "WeightedFrequency")

# Створення барплоту з ggplot2
FutureFeelings_plot_bar <- ggplot(weighted_counts, aes(x = FutureFeelings, y = WeightedFrequency)) +
  geom_col(fill = "#2E5CB8") +
  labs(x = "Індекс емоційного сприйняття майбутнього",
       y = "Зважена частота") +
  theme_minimal() +
  theme(panel.grid.major.y = element_line(color = "lightgrey", linetype = "dashed"),
        axis.title.x = element_text(size = 14),
        axis.title.y = element_text(size = 14),
        axis.text.x  = element_text(size = 12),
        axis.text.y  = element_text(size = 12)
       )


# Виведення графіку
pl<-ggplotly(FutureFeelings_plot_bar)
pl

# Частотний розподіл для ResidenceType
frq(df$ResidenceType, weights = df$wt_UA4101)

## 1 - село, 2 - місто (xw) <numeric> 
## # total N=4101 valid N=4101 mean=1.74 sd=0.44
## 
## Value | Label |    N | Raw % | Valid % | Cum. %
## -----------------------------------------------
##     1 |  село | 1047 | 25.53 |   25.53 |  25.53
##     2 | місто | 3054 | 74.47 |   74.47 | 100.00
##  <NA> |  <NA> |    0 |  0.00 |    <NA> |   <NA>

# Частотний розподіл для Spirit
frq(df$Spirit, weights = df$wt_UA4101)

## Звернення до духовних практик (xw) <numeric> 
## # total N=4101 valid N=4101 mean=1.70 sd=0.46
## 
## Value |        Label |    N | Raw % | Valid % | Cum. %
## ------------------------------------------------------
##     1 | Не звертаюся | 1244 | 30.33 |   30.33 |  30.33
##     2 |    Звертаюся | 2857 | 69.67 |   69.67 | 100.00
##  <NA> |         <NA> |    0 |  0.00 |    <NA> |   <NA>

# Частотний розподіл для ComSup
frq(df$ComSup, weights = df$wt_UA4101)

## Здатність розраховувати на допомогу сусідів або членів громади (xw) <numeric> 
## # total N=4101 valid N=4101 mean=1.56 sd=0.50
## 
## Value |     Label |    N | Raw % | Valid % | Cum. %
## ---------------------------------------------------
##     1 | Відсутній | 1792 | 43.70 |   43.70 |  43.70
##     2 |   Наявний | 2309 | 56.30 |   56.30 | 100.00
##  <NA> |      <NA> |    0 |  0.00 |    <NA> |   <NA>

weight_var <- df$wt_UA4101  # Змінна ваг

weighted_summary <- function(var, weight) {
  data.frame(
    Mean = round(weighted.mean(var, weight, na.rm = TRUE), 2),
    SD = round(sqrt(Hmisc::wtd.var(var, weight, na.rm = TRUE)), 2),
    Median = wtd.quantile(var, weight, probs = 0.5, na.rm = TRUE),
    Min = min(var, na.rm = TRUE),
    Max = max(var, na.rm = TRUE)
  )
}

# Отримуємо таблицю з описовою статистикою
summary_table <- do.call(rbind, 
                         lapply(df[, c("FutureFeelings", "Age", "SelfEfficacy", "BasicNeeds", "Knowledge", "selfRatedHealth")], 
                                weighted_summary, weight = weight_var))

# Додаємо назви змінних як рядки
summary_table <- cbind(Variable = rownames(summary_table), summary_table)
rownames(summary_table) <- NULL  # Видаляємо зайві індекси

# Вивід у вигляді красивої таблиці
kable(summary_table, format = "html", digits = 2) %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))

Variable	Mean	SD	Median	Min	Max
FutureFeelings	0.38	1.91	1.00	-6	6
Age	46.15	14.85	47.00	18	84
SelfEfficacy	1.13	0.63	1.00	0	2
BasicNeeds	1.20	0.60	1.25	0	2
Knowledge	0.88	0.62	1.00	0	2
selfRatedHealth	2.96	0.73	3.00	1	5

# Розрахунок зважених коефіцієнтів асиметрії та ексцесу:

weighted_skewness <- round (Skew(df$FutureFeelings, weights = df$wt_UA4101),2)
weighted_kurtosis <- round (Kurt(df$FutureFeelings, weights = df$wt_UA4101, method = 1),2)


cat("Асиметрія та ексцес для FutureFeelings")

## Асиметрія та ексцес для FutureFeelings

cat("Зважена асиметрія (Skewness):", weighted_skewness, "\n")

## Зважена асиметрія (Skewness): -0.09

cat("Зважений ексцес (Kurtosis):", weighted_kurtosis, "\n")

## Зважений ексцес (Kurtosis): 0.55

Кореляції між змінними

df1<-df[, c("FutureFeelings", "SelfEfficacy", "Knowledge", "selfRatedHealth", 
                                 "Spirit", "BasicNeeds", "ComSup", 
                                 "Age", "ResidenceType", "wt_UA4101")]

wtd_cor_matrix <- wtd.cor(df1[1:9], 
                          weight = df1$wt_UA4101)

## Warning in summary.lm(lm(stdz(y, weight = weight) ~ stdz(x, weight = weight), :
## essentially perfect fit: summary may be unreliable

# Доступ до кореляційної матриці
rounded_cor_matrix <- round(wtd_cor_matrix$correlation, 2)

# Графік
corrplot(rounded_cor_matrix, 
         method = "color",  # Колірна заливка
         type = "lower",    # Показати тільки нижню трикутну частину
         addCoef.col = "black", # Додавання числових значень (коефіцієнтів)
         tl.col = "black",  # Колір підписів змінних
         tl.srt = 45,       # Кут підписів змінних
         number.cex = 0.8)  # Розмір цифр кореляції

# Розрахунок коефіцієнту кореляції та p-значення між змінними FutureFeeling та wt_UA4101
cor_test_result <- cor.test(df$FutureFeelings, df$wt_UA4101)

# Вивід коефіцієнту кореляції
cat("Коефіцієнт кореляції між FutureFeeling та wt_UA4101 =", round(cor_test_result$estimate, 2), "\n")

## Коефіцієнт кореляції між FutureFeeling та wt_UA4101 = 0.03

# Вивід p-значення
cat("p-значення =", round(cor_test_result$p.value,3), "\n")

## p-значення = 0.055

Лінійність залежності: графічна перевірка

# Змінні для графіків по осі X
x_variables <- c("Age", "BasicNeeds", "Knowledge", "SelfEfficacy", "selfRatedHealth")

# Цикл для створення графіків
for (x_var in x_variables) {
  # Створення графіка за допомогою ggplot2
  plot <- ggplot(data = df, aes(x = .data[[x_var]], y = FutureFeelings, weight = wt_UA4101)) +
    geom_point(alpha = 0.3) + # Розсіяні точки для даних
    geom_smooth(method = "loess", color = "red") + # Накладання кривої loess (непараметричне згладжування)
    labs(
      title = paste("Розподіл FutureFeelings відносно", x_var),
      x = x_var,
      y = "FutureFeelings"
    ) +
    theme_minimal()

  # Виведення графіка
  print(plot)
}

# Перевірка нелінійного (квадратичнного) впливу віку на емоційне сприйняття майбутнього

cat("Поліноміальна регресія другого порядку:\n")

## Поліноміальна регресія другого порядку:

model_lm_weighted_poly <- lm( 
  formula = FutureFeelings ~ 1 + poly(Age, 2),
  weights = wt_UA4101,
  data = df
)

tab_model(model_lm_weighted_poly)

	Future Feelings
Predictors	Estimates	CI	p
(Intercept)	0.37	0.32 – 0.43	<0.001
poly(Age, 2)1	10.89	7.40 – 14.37	<0.001
poly(Age, 2)2	-2.28	-5.95 – 1.40	0.225
Observations	4101
R² / R² adjusted	0.010 / 0.009

Специфікація моделі

cat ("Центрування коваріат")

## Центрування коваріат

# Центрування неперервних змінних та створення нових стовпців у 'data'

data <- data.frame(
  FutureFeelings=df$FutureFeelings,
  cAge = df$Age - mean(df$Age, na.rm = TRUE),
  cBasicNeeds = df$BasicNeeds - mean(df$BasicNeeds, na.rm = TRUE),
  cKnowledge = df$Knowledge - mean(df$Knowledge, na.rm = TRUE),
  cSelfEfficacy = df$SelfEfficacy - mean(df$SelfEfficacy, na.rm = TRUE),
  cselfRatedHealth = df$selfRatedHealth - mean(df$selfRatedHealth, na.rm = TRUE),
  Spirit = factor(df$Spirit, levels = c(1, 2), labels = c("не звертаються", "звертаються")),
  ComSup = factor(df$ComSup, levels = c(1, 2), labels = c("відсутня", "наявна")),
  ResidenceType = factor(df$ResidenceType, levels = c(1, 2), labels = c("село", "місто")),
  wt_UA4101 = df$wt_UA4101
)

# Видалення підписів змінних
data <- data %>%
    dplyr::mutate(dplyr::across(dplyr::everything(), ~{attr(., "label") <- NULL; .}))

# Формула моделі з факторами та центрованими предикторами 

formula <- FutureFeelings ~ 1 + cSelfEfficacy + cKnowledge +  cselfRatedHealth +Spirit + 
           cBasicNeeds + ComSup +
           cAge + ResidenceType

# Запуск регресійної моделі з вагами
model_lm_weighted <- lm(
  formula = formula,
  weights = wt_UA4101,
  data = data
  )

cat("Матриці контрастів")

## Матриці контрастів

str(model_lm_weighted$contrasts)

## List of 3
##  $ Spirit       : chr "contr.treatment"
##  $ ComSup       : chr "contr.treatment"
##  $ ResidenceType: chr "contr.treatment"

cat("Контраст для ResidenceType")

## Контраст для ResidenceType

contrasts(data$ResidenceType)

##       місто
## село      0
## місто     1

cat("Контраст для ComSup")

## Контраст для ComSup

contrasts(data$ComSup)

##          наявна
## відсутня      0
## наявна        1

cat("Контраст для Spirit")

## Контраст для Spirit

contrasts(data$Spirit)

##                звертаються
## не звертаються           0
## звертаються              1

ANOVA

model_summary <- summary(model_lm_weighted)
f_value <- model_summary$fstatistic[1]  # Значення F-статистики
num_df  <- model_summary$fstatistic[2]  # Ступені свободи чисельника
den_df  <- model_summary$fstatistic[3]  # Ступені свободи знаменника

cat("Значення F-статистики: ", round(f_value, 2), "\n")

## Значення F-статистики:  80.47

cat("Ступені свободи чисельника (між групами): ", num_df, "\n")

## Ступені свободи чисельника (між групами):  8

cat("Ступені свободи знаменника (внутрішньогрупові або залишки): ", den_df, "\n")

## Ступені свободи знаменника (внутрішньогрупові або залишки):  4092

cat("\nANOVA Omnibus Tests\n")

## 
## ANOVA Omnibus Tests

# Створення робастної коваріаційної матриці (HC3)
robust_vcov <- sandwich::vcovHC(model_lm_weighted, type = "HC3")

# ANOVA з робастною коваріаційною матрицею (Type III ANOVA)
anova_robust <- car::Anova(model_lm_weighted, type = "III", vcov. = robust_vcov)

## Coefficient covariances computed by robust_vcov

# Виведення результатів ANOVA
print(anova_robust)

## Analysis of Deviance Table (Type III tests)
## 
## Response: FutureFeelings
##                    Df        F    Pr(>F)    
## (Intercept)         1   6.3891  0.011520 *  
## cSelfEfficacy       1 147.6258 < 2.2e-16 ***
## cKnowledge          1  12.5343  0.000404 ***
## cselfRatedHealth    1  76.5242 < 2.2e-16 ***
## Spirit              1   5.5852  0.018159 *  
## cBasicNeeds         1   6.0066  0.014294 *  
## ComSup              1  32.1217 1.548e-08 ***
## cAge                1  33.0355 9.708e-09 ***
## ResidenceType       1   9.7423  0.001813 ** 
## Residuals        4092                       
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Розмір ефекту

cat("Partial Eta-squared")

## Partial Eta-squared

# Величина ефекту
partial_eta_squared <- effectsize::eta_squared(car::Anova(model_lm_weighted, type="3"),
                                               partial = TRUE)
# partial eta-squared: small = 0.01; medium = 0.06; large = 0.14. 

# Виведення результатів

table_data <- data.frame(
  Variables = partial_eta_squared$Parameter, # Перший стовпчик - назви змінних
  Part_eta_squared = round (partial_eta_squared$Eta2_partial,2) # Другий стовпчик - числові значення
)


library(knitr)
library(kableExtra)

knitr::kable(table_data, 
             caption = "Часткові значення Eta-squared",
             format = "markdown",
             align = c("l", "r"), 
             digits = 2,
             col.names = c("Змінна", "Часткова η²")) %>%
  kableExtra::column_spec(1, width = "3cm") %>% 
  kableExtra::column_spec(2, width = "3cm")

Часткові значення Eta-squared
Змінна	Часткова η²
cSelfEfficacy	0.05
cKnowledge	0.00
cselfRatedHealth	0.02
Spirit	0.00
cBasicNeeds	0.00
ComSup	0.01
cAge	0.01
ResidenceType	0.00

Фактори, що впливають на сприйняття майбутнього

cat("Коефіцієнти лінійної регресії для предикторів майбутніх відчуттів")

## Коефіцієнти лінійної регресії для предикторів майбутніх відчуттів

tab_model(model_lm_weighted,
          vcov.fun = "HC3",
          show.se = T,
          digits = 3,
          show.std = T,
          file = "model_summary.html")

	Future Feelings
Predictors	Estimates	std. Error	std. Beta	standardized std. Error	CI	standardized CI	p
(Intercept)	0.239	0.094	-0.072	0.049	0.054 – 0.424	-0.169 – 0.025	0.012
cSelfEfficacy	0.701	0.058	0.232	0.019	0.588 – 0.814	0.195 – 0.270	<0.001
cKnowledge	-0.187	0.053	-0.061	0.017	-0.291 – -0.084	-0.095 – -0.027	<0.001
cselfRatedHealth	0.413	0.047	0.159	0.018	0.321 – 0.506	0.124 – 0.195	<0.001
Spirit [звертаються]	0.163	0.069	0.085	0.036	0.028 – 0.297	0.015 – 0.156	0.018
cBasicNeeds	0.150	0.061	0.047	0.019	0.030 – 0.270	0.009 – 0.085	0.014
ComSup [наявна]	0.367	0.065	0.192	0.034	0.240 – 0.493	0.126 – 0.259	<0.001
cAge	0.014	0.002	0.106	0.019	0.009 – 0.018	0.070 – 0.143	<0.001
ResidenceType [місто]	-0.246	0.079	-0.129	0.041	-0.400 – -0.091	-0.210 – -0.048	0.002
Observations	4101
R² / R² adjusted	0.136 / 0.134

cat("Стандартизовані коефіцієнти")

## Стандартизовані коефіцієнти

plot_model(model_lm_weighted, vcov.fun = "HC3", type = "std")

Порівняння прогнозів з фактичними даними

cat ("Описова статистика прогнозованих значень")

## Описова статистика прогнозованих значень

predictions <- predict(model_lm_weighted, data = data)

data$predicted_values <- round(predictions,2)

# Розрахунок середнього значення (зважене)
mean_predicted_values <- DescTools:: Mean(x = data$predicted_values, weights = data$wt_UA4101)%>%round(2)

# Розрахунок мінімального значення (не зважене, стандартне мінімальне значення)
min_predicted_values <- min(data$predicted_values)

# Розрахунок максимального значення (не зважене, стандартне максимальне значення)
max_predicted_values <- max(data$predicted_values)

# Виведення результатів
cat("Середнє:", mean_predicted_values, "\n")

## Середнє: 0.38

cat("Мінімальне значення:", min_predicted_values, "\n")

## Мінімальне значення: -1.94

cat("Максимальне значення:", max_predicted_values, "\n")

## Максимальне значення: 2.11

cat ("Візуальне порівняння розподілів прогнозу та FutureFeelings")

## Візуальне порівняння розподілів прогнозу та FutureFeelings

ggplot(data, aes(x = predictions, weight = wt_UA4101)) + 
  geom_histogram(aes(fill = "Predictions"), alpha = 0.5, position = "identity", binwidth = 0.5) +
  geom_histogram(aes(x = FutureFeelings, fill = "FutureFeelings", weight = wt_UA4101), 
                 alpha = 0.5, position = "identity", binwidth = 0.5) +
  scale_fill_manual(name = "Змінні",
                    values = c("Predictions" = "blue", "FutureFeelings" = "red")) +
  labs(title = "Гістограми розподілу Predictions та FutureFeelings",
       x = "Значення",
       y = "Зважена частота") +
  theme_minimal()

Маргінальні ефекти

Вихідні шкали

library(dplyr)

dat <- df %>%
  select(
    FutureFeelings,
    Age,
    BasicNeeds,
    Knowledge,
    SelfEfficacy,
    selfRatedHealth,
    Spirit,
    ComSup,
    ResidenceType,
    wt_UA4101
  ) %>%
  mutate(
    selfRatedHealth = as.numeric(selfRatedHealth), 
    Spirit = factor(Spirit, levels = c(1, 2), labels = c("не звертаються", "звертаються")),
    ComSup = factor(ComSup, levels = c(1, 2), labels = c("відсутня", "наявна")),
    ResidenceType = factor(ResidenceType, levels = c(1, 2), labels = c("село", "місто"))
  ) 


dat <- lapply(dat, function(x) {
    attr(x, "label") <- NULL
    return(x)
}) %>% as.data.frame()


formula_unc <- FutureFeelings ~ 1 + SelfEfficacy + Knowledge +  selfRatedHealth +Spirit + 
           BasicNeeds + ComSup + 
           Age + ResidenceType

# Запуск lm() з вагами

model_lm_weighted_unc <- lm(
  formula = formula_unc,
  weights = wt_UA4101,
  data = dat
  )

 tab_model(model_lm_weighted_unc, vcov.fun = "HC3", show.se = TRUE,  digits = 2,
                      show.std = TRUE, show.p = TRUE)

	Future Feelings
Predictors	Estimates	std. Error	std. Beta	standardized std. Error	CI	standardized CI	p
(Intercept)	-2.42	0.21	-0.07	0.05	-2.84 – -2.00	-0.17 – 0.03	<0.001
SelfEfficacy	0.70	0.06	0.23	0.02	0.59 – 0.81	0.19 – 0.27	<0.001
Knowledge	-0.19	0.05	-0.06	0.02	-0.29 – -0.08	-0.09 – -0.03	<0.001
selfRatedHealth	0.41	0.05	0.16	0.02	0.32 – 0.51	0.12 – 0.20	<0.001
Spirit [звертаються]	0.16	0.07	0.09	0.04	0.03 – 0.30	0.01 – 0.16	0.018
BasicNeeds	0.15	0.06	0.05	0.02	0.03 – 0.27	0.01 – 0.09	0.014
ComSup [наявна]	0.37	0.06	0.19	0.03	0.24 – 0.49	0.13 – 0.26	<0.001
Age	0.01	0.00	0.11	0.02	0.01 – 0.02	0.07 – 0.14	<0.001
ResidenceType [місто]	-0.25	0.08	-0.13	0.04	-0.40 – -0.09	-0.21 – -0.05	0.002
Observations	4101
R² / R² adjusted	0.136 / 0.134

Кожен графік відображає зміну прогнозованих значень при зростанні рівня очікуваної підтримки від сусідів та членів громади (ComSup).

# Графіки прогнозованих значень
cat("Прогнозні значення залежної змінної залежно від віку для міського та сільського населення при різних рівнях очікуваної підтримки громади.\n")

## Прогнозні значення залежної змінної залежно від віку для міського та сільського населення при різних рівнях очікуваної підтримки громади.

plot_model(model_lm_weighted_unc, robust = T, type = "pred", terms = c("Age",
                                                                   "ResidenceType",
                                                                   "ComSup"))

cat("Прогнозні значення залежної змінної залежно від самоефективності для міського та сільського населення при різних рівнях очікуваної підтримки громади.\n")

## Прогнозні значення залежної змінної залежно від самоефективності для міського та сільського населення при різних рівнях очікуваної підтримки громади.

plot_model(model_lm_weighted_unc, robust = T, type = "pred", terms = c("SelfEfficacy",
                                                                   "ResidenceType",
                                                                   "ComSup"))

cat("Прогнозні значення залежної змінної залежно від самооцінки здоров'я для міського та сільського населення при різних рівнях очікуваної підтримки громади.\n")

## Прогнозні значення залежної змінної залежно від самооцінки здоров'я для міського та сільського населення при різних рівнях очікуваної підтримки громади.

plot_model(model_lm_weighted_unc, robust = T, type = "pred", terms = c("selfRatedHealth",
                                                                   "ResidenceType",
                                                                   "ComSup"))

cat("Прогнозні значення залежної змінної залежно від задоволення базових потреб для міського та сільського населення при різних рівнях очікуваної підтримки громади.\n")

## Прогнозні значення залежної змінної залежно від задоволення базових потреб для міського та сільського населення при різних рівнях очікуваної підтримки громади.

plot_model(model_lm_weighted_unc, robust = T, type = "pred", terms = c("BasicNeeds",
                                                                   "ResidenceType",
                                                                   "ComSup"))

cat("Прогнозні значення залежної змінної в залежності від рівня знань для міського та сільського населення при різних рівнях очікуваної підтримки громади.\n")

## Прогнозні значення залежної змінної в залежності від рівня знань для міського та сільського населення при різних рівнях очікуваної підтримки громади.

plot_model(model_lm_weighted_unc, robust = T, type = "pred", terms = c("Knowledge ",
                                                                   "ResidenceType",
                                                                   "ComSup"))

Перевірка припущень моделі

# Collinearity Statistics (VIF)
# Значення VIF більше 5 на проблеми з мультиколінеарністю.

vif_values <- car::vif(model_lm_weighted)

# Округлення значень VIF до 2 знаків після коми
rounded_vif_values <- round(vif_values, 2)

cat("\nCollinearity Statistics (VIF):\n")

## 
## Collinearity Statistics (VIF):

print(rounded_vif_values)

##    cSelfEfficacy       cKnowledge cselfRatedHealth           Spirit 
##             1.32             1.18             1.16             1.03 
##      cBasicNeeds           ComSup             cAge    ResidenceType 
##             1.27             1.05             1.06             1.01

# Використовуємо критерій Бройша-Пагана (Breusch-Pagan Test) для перевірки гомоскедастичності залишків.

bp_test <- lmtest::bptest(model_lm_weighted)

print(bp_test)

## 
##  studentized Breusch-Pagan test
## 
## data:  model_lm_weighted
## BP = 118.78, df = 8, p-value < 2.2e-16

# Критерій Левена на гомогенність дисперсій за всіма факторами

# Отримання залишків з моделі
residuals_model <- residuals(model_lm_weighted)


levene_test_all_factors <- leveneTest(residuals_model ~ data$ComSup *
                                      data$ResidenceType * data$Spirit)

print(levene_test_all_factors)

## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value   Pr(>F)   
## group    7  2.6982 0.008653 **
##       4093                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

cat("\nГрафічна перевірка залишків\n")

## 
## Графічна перевірка залишків

cat("\nГістограма залишків:\n")

## 
## Гістограма залишків:

hist(residuals(model_lm_weighted),
     main = "Гістограма залишків",
     xlab = "Залишки",
     ylab = "Щільність",
     freq = FALSE, # Відображення щільності замість частот
     col = "lightblue",
     border = "white")
curve(dnorm(x, mean = mean(residuals(model_lm_weighted)), sd = sd(residuals(model_lm_weighted))),
      add = TRUE, col = "darkblue", lwd = 2) # Додавання кривої нормального розподілу для порівняння

# Графік залишків проти передбачених значень (Residuals vs Fitted)
cat("\nГрафік залишків проти передбачених значень (Residuals vs Fitted):\n")

## 
## Графік залишків проти передбачених значень (Residuals vs Fitted):

autoplot(model_lm_weighted, which = 1) +
  ggtitle("Графік залишків проти передбачених значень") +
  xlab("Передбачені значення (Fitted values)") +
  ylab("Залишки (Residuals)") +
  theme_minimal()

# Q-Q графік залишків (Normal Q-Q Plot)
cat("\nQ-Q графік залишків (Normal Q-Q Plot):\n")

## 
## Q-Q графік залишків (Normal Q-Q Plot):

autoplot(model_lm_weighted, which = 2) +
  ggtitle("Q-Q графік залишків") +
  xlab("Теоретичні квантили") +
  ylab("Спостережувані квантили") +
  theme_minimal()

# Scale-Location (перевірка гомоскедастичності)
cat("\nГрафік масштабованих залишків (Scale-Location Plot):\n")

## 
## Графік масштабованих залишків (Scale-Location Plot):

autoplot(model_lm_weighted, which = 3) +
  ggtitle("Графік масштабованих залишків") +
  xlab("Передбачені значення (Fitted values)") +
  ylab("Корінь квадратний зі стандартних залишків") +
  theme_minimal()

# Cook’s Distance (впливові точки)
cat("\nГрафік впливових точок (Cook’s Distance):\n")

## 
## Графік впливових точок (Cook’s Distance):

autoplot(model_lm_weighted, which = 4) +
  ggtitle("Графік впливових точок (Cook’s Distance)") +
  xlab("Номер спостереження") +
  ylab("Значення Cook’s Distance") +
  theme_minimal()

Перевірка коректності зважування

Для оцінки регресійної моделі з перезважуванням ми використали два підходи: функцію glm із параметром weights та додатково пакет survey із функцією svyglm. Це дозволило перевірити стійкість результатів до вибору методу та врахувати потенційні особливості вибіркового дизайну.

Створення об’єкта дизайну опитування
Спочатку ми створюємо спеціальний об’єкт survey.design, який інформує R про структуру вибірки, зокрема про вагові коефіцієнти.

# Коректний підхід з використанням пакета survey
library(survey)

# Створення об'єкта дизайну, що містить інформацію про ваги
survey_design <- svydesign(
  ids = ~1,                # Припускаємо дизайн без кластеризації
  weights = ~wt_UA4101,    # Вказуємо змінну з вагами вибірки
  data = data              # Наш датафрейм
)

Побудова регресійної моделі за допомогою svyglm() Замість glm() ми використовуємо функцію svyglm(), яка розроблена для роботи з об’єктами survey.design.

# Будуємо модель на основі об'єкта дизайну
model_survey <- svyglm(
  formula = formula, # Використовуємо ту ж саму формулу моделі
  design = survey_design
)

summary(model_survey)

## 
## Call:
## svyglm(formula = formula, design = survey_design)
## 
## Survey design:
## svydesign(ids = ~1, weights = ~wt_UA4101, data = data)
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)         0.238566   0.093805   2.543  0.01102 *  
## cSelfEfficacy       0.700618   0.057399  12.206  < 2e-16 ***
## cKnowledge         -0.187196   0.052635  -3.557  0.00038 ***
## cselfRatedHealth    0.413339   0.046990   8.796  < 2e-16 ***
## Spiritзвертаються   0.162517   0.068442   2.375  0.01762 *  
## cBasicNeeds         0.149936   0.060876   2.463  0.01382 *  
## ComSupнаявна        0.366634   0.064400   5.693 1.33e-08 ***
## cAge                0.013657   0.002363   5.779 8.07e-09 ***
## ResidenceTypeмісто -0.245925   0.078279  -3.142  0.00169 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 3.13876)
## 
## Number of Fisher Scoring iterations: 2

ANOVA

predictor_names <- attr(terms(model_survey), "term.labels")

# Ви можете подивитись, що вийшло:
# print(predictor_names) 
# Це буде вектор типу: c("cSelfEfficacy", "cKnowledge", "cselfRatedHealth", ...)

# 2. Виконати тест, передавши вектор з іменами предикторів у 'test.terms'
# Це є альтернативою до використання формули ~.
omnibus_test <- regTermTest(model_survey, test.terms = predictor_names)

# 3. Тепер решта коду для виведення результатів повинна спрацювати
f_value <- omnibus_test$Ftest[1]
num_df  <- omnibus_test$df
den_df  <- omnibus_test$ddf
p_value <- omnibus_test$p

# 4. Гарний вивід результатів
cat("--- Загальна значущість моделі (Omnibus Test) ---\n")

## --- Загальна значущість моделі (Omnibus Test) ---

cat("F-статистика:", round(f_value, 2), "\n")

## F-статистика: 58.58

cat("Ступені свободи (чисельник):", num_df, "\n")

## Ступені свободи (чисельник): 8

cat("Ступені свободи (знаменник):", round(den_df), "\n")

## Ступені свободи (знаменник): 4092

cat("p-значення:", (p_value), "\n\n")

## p-значення: 7.086134e-91

# Встановіть та завантажте пакет 'weights', якщо ще не зробили
if (!require("weights")) {
  install.packages("weights")
  library(weights)
}

cat("--- Розрахунок Псевдо R-квадрату ---\n")

## --- Розрахунок Псевдо R-квадрату ---

# Витягнення компонентів з моделі
observed_values  <- model_survey$model[[1]]
predicted_values <- fitted(model_survey)
model_weights    <- weights(model_survey$survey.design)

# Перевірка на наявність пропущених значень
if(length(observed_values) != length(predicted_values) || length(observed_values) != length(model_weights)) {
  cat("Помилка: довжина векторів не збігається.\n")
} else {
  # *** КЛЮЧОВЕ ВИПРАВЛЕННЯ ТУТ ***
  # 1. Розраховуємо зважену кореляцію
  weighted_correlation_object <- wtd.cor(observed_values, predicted_values, weight = model_weights)
  
  # 2. Витягуємо ЛИШЕ коефіцієнт кореляції (перший елемент)
  correlation_value <- weighted_correlation_object[1]
  
  # 3. Тепер підносимо до квадрату ОДНЕ число
  pseudo_r_squared <- correlation_value^2
  
  cat("Псевдо R-квадрат:", round(pseudo_r_squared, 3), "\n")
  
  # Розрахунок скоригованого Псевдо R-квадрату (тепер він буде правильним)
  n_obs <- nobs(model_survey)
  k_predictors <- length(coef(model_survey)) - 1
  
  adjusted_pseudo_r_squared <- 1 - (1 - pseudo_r_squared) * (n_obs - 1) / (n_obs - k_predictors - 1)
  
  cat("Скоригований Псевдо R-квадрат:", round(adjusted_pseudo_r_squared, 3), "\n")
  cat("(Розрахований на основі зваженої кореляції між спостережуваними та передбаченими значеннями)\n")
}

## Псевдо R-квадрат: 0.136 
## Скоригований Псевдо R-квадрат: 0.134 
## (Розрахований на основі зваженої кореляції між спостережуваними та передбаченими значеннями)

Розмір ефекту

# --- Переконайтесь, що ваша модель 'model_survey' вже існує ---

# 1. Отримати імена всіх предикторів з вашої моделі
predictor_names <- attr(terms(model_survey), "term.labels")

# 2. Створити порожній датафрейм для зберігання результатів
effect_sizes <- data.frame(
  Parameter = character(),
  Partial_Eta_Squared = numeric(),
  stringsAsFactors = FALSE
)

# 3. Запустити цикл по кожному предиктору
cat("Розрахунок розмірів ефекту (аналог Partial Eta-squared)...\n")

## Розрахунок розмірів ефекту (аналог Partial Eta-squared)...

for (predictor in predictor_names) {
  
  # Виконуємо тест для ОДНОГО предиктора за раз
  term_test <- regTermTest(model_survey, test.terms = as.formula(paste("~", predictor)))
  
  # Витягуємо необхідні значення
  f_value <- term_test$Ftest[1]
  df_num  <- term_test$df
  df_den  <- term_test$ddf
  
  # Розраховуємо аналог часткової ета-квадрат
  partial_eta_sq <- (f_value * df_num) / (f_value * df_num + df_den)
  
  # Додаємо результати до нашого датафрейму
  effect_sizes <- rbind(effect_sizes, data.frame(
    Parameter = predictor,
    Partial_Eta_Squared = partial_eta_sq
  ))
}

# 4. Виведення результатів у гарній таблиці (використовуючи ваш код)
cat("\n--- Розміри ефекту (аналог Partial η²) для кожного предиктора ---\n")

## 
## --- Розміри ефекту (аналог Partial η²) для кожного предиктора ---

knitr::kable(effect_sizes, 
             caption = "Часткові значення Eta-squared (розраховано для зважених даних)",
             format = "markdown",
             align = c("l", "r"), 
             digits = 3, # Рекомендую 3 знаки для кращої точності
             col.names = c("Змінна", "Часткова η²")) %>%
  kableExtra::column_spec(1, width = "15em") %>% 
  kableExtra::column_spec(2, width = "10em")

Часткові значення Eta-squared (розраховано для зважених даних)
Змінна	Часткова η²
cSelfEfficacy	0.035
cKnowledge	0.003
cselfRatedHealth	0.019
Spirit	0.001
cBasicNeeds	0.001
ComSup	0.008
cAge	0.008
ResidenceType	0.002

# Нагадування про інтерпретацію (за Коеном)
cat("\nНагадування про інтерпретацію (Cohen's rules of thumb):\n")

## 
## Нагадування про інтерпретацію (Cohen's rules of thumb):

cat("small ≈ 0.01; medium ≈ 0.06; large ≈ 0.14.\n")

## small ≈ 0.01; medium ≈ 0.06; large ≈ 0.14.

Розрахунок стандартизованих коефіцієнтів
Для порівняння сили впливу різних предикторів необхідно розрахувати стандартизовані коефіцієнти.
Категоріальні змінні (ResidenceType, ComSup, Spirit) були перекодовані з 1, 2 на 0, 1.
Неперервні предиктори та залежна змінна були стандартизовані (віднято зважене середнє та поділено на зважене стандартне відхилення). На цих підготовлених даних було побудовано фінальну модель svyglm.

# Встановіть та завантажте необхідні пакети
if (!require("Hmisc")) {
  install.packages("Hmisc")
  library(Hmisc)
}
library(survey)

# --- Припустимо, у вас є:
# data    - ваш початковий датафрейм
# formula - ваш об'єкт formula
# wt_UA4101 - назва змінної з вагами


# === Створення копії даних ===
data_prepared <- data


# === Перекодування категоріальних змінних (1/2 -> 0/1) ===

# Список ваших категоріальних змінних, які потрібно перекодувати
categorical_vars <- c("ResidenceType", "ComSup", "Spirit")

cat("Перекодування категоріальних змінних...\n")

## Перекодування категоріальних змінних...

for (var in categorical_vars) {
  # Переконуємось, що змінна числова, і віднімаємо 1
  if (is.numeric(data_prepared[[var]])) {
    data_prepared[[var]] <- data_prepared[[var]] - 1
    cat(paste("  - Змінна '", var, "' перекодована на 0/1.\n", sep=""))
  }
}
# Тепер у data_prepared ці змінні мають значення 0 і 1.


# === Стандартизація неперервних змінних ===

# Функція для зваженої стандартизації (ми її вже використовували)
weighted_scale <- function(x, w) {
  weighted_mean <- weighted.mean(x, w, na.rm = TRUE)
  weighted_sd <- sqrt(wtd.var(x, weights = w, na.rm = TRUE))
  return((x - weighted_mean) / weighted_sd)
}

# Список ваших неперервних змінних (ЗАЛЕЖНА + ПРЕДИКТОРИ)
continuous_vars <- c("FutureFeelings", "cSelfEfficacy", "cKnowledge", 
                     "cselfRatedHealth", "cBasicNeeds", "cAge")

cat("\nСтандартизація неперервних змінних (з урахуванням ваг)...\n")

## 
## Стандартизація неперервних змінних (з урахуванням ваг)...

for (var in continuous_vars) {
  data_prepared[[var]] <- weighted_scale(data_prepared[[var]], data_prepared$wt_UA4101)
  cat(paste("  - Змінна '", var, "' стандартизована.\n", sep=""))
}

##   - Змінна 'FutureFeelings' стандартизована.
##   - Змінна 'cSelfEfficacy' стандартизована.
##   - Змінна 'cKnowledge' стандартизована.
##   - Змінна 'cselfRatedHealth' стандартизована.
##   - Змінна 'cBasicNeeds' стандартизована.
##   - Змінна 'cAge' стандартизована.

# === Створення нового дизайн-об'єкта ===

cat("\nСтворення нового survey.design об'єкта на підготовлених даних...\n")

## 
## Створення нового survey.design об'єкта на підготовлених даних...

survey_design_prepared <- svydesign(
  ids = ~1,
  weights = ~wt_UA4101,
  data = data_prepared # ВИКОРИСТОВУЄМО ПІДГОТОВЛЕНІ ДАНІ!
)


# Перезапуск моделі для отримання бета-коефіцієнтів ===

cat("Запуск фінальної моделі для отримання стандартизованих коефіцієнтів...\n\n")

## Запуск фінальної моделі для отримання стандартизованих коефіцієнтів...

model_final_beta <- svyglm(
  FutureFeelings ~ 1 + cSelfEfficacy + cKnowledge + cselfRatedHealth + Spirit + 
                   cBasicNeeds + ComSup + cAge + ResidenceType,
  design = survey_design_prepared
)


# === РЕЗУЛЬТАТ: Правильні стандартизовані коефіцієнти ===
summary(model_final_beta)

## 
## Call:
## svyglm(formula = FutureFeelings ~ 1 + cSelfEfficacy + cKnowledge + 
##     cselfRatedHealth + Spirit + cBasicNeeds + ComSup + cAge + 
##     ResidenceType, design = survey_design_prepared)
## 
## Survey design:
## svydesign(ids = ~1, weights = ~wt_UA4101, data = data_prepared)
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        -0.07163    0.04915  -1.457  0.14513    
## cSelfEfficacy       0.23213    0.01902  12.206  < 2e-16 ***
## cKnowledge         -0.06103    0.01716  -3.557  0.00038 ***
## cselfRatedHealth    0.15933    0.01811   8.796  < 2e-16 ***
## Spiritзвертаються   0.08527    0.03591   2.375  0.01762 *  
## cBasicNeeds         0.04723    0.01918   2.463  0.01382 *  
## ComSupнаявна        0.19237    0.03379   5.693 1.33e-08 ***
## cAge                0.10643    0.01842   5.779 8.07e-09 ***
## ResidenceTypeмісто -0.12903    0.04107  -3.142  0.00169 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.8640606)
## 
## Number of Fisher Scoring iterations: 2

Порівняння результатів двох способів аналізу
Спосіб 1. Модель, побудована за допомогою glm.
Спосіб 2. Модель, побудована за допомогою svyglm з пакета survey.

comparison_data <- data.frame(
  Predictor = c("(Intercept)", "cSelfEfficacy", "cKnowledge", "cselfRatedHealth",
                "Spirit [звертаються]", "cBasicNeeds", "ComSup [наявна]",
                "cAge", "ResidenceType [місто]"),
  B_lm = c(0.239, 0.701, -0.187, 0.413, 0.163, 0.150, 0.367, 0.014, -0.246),
  p_lm = c(0.012, 0.0001, 0.0001, 0.0001, 0.018, 0.014, 0.0001, 0.0001, 0.002),
  B_svyglm = c(0.238566, 0.700618, -0.187196, 0.413339, 0.162517, 0.149936, 0.366634, 0.013657, -0.245925),
  p_svyglm = c(0.01102, 0.000001, 0.00038, 0.000001, 0.01762, 0.01382, 0.000001, 0.000001, 0.00169)
)


comparison_data %>%
  # Крок 3.1: Створюємо нові стовпчики з відформатованими p-значеннями
  mutate(
    p_lm_formatted = if_else(p_lm < 0.001, "<.001", sprintf("%.3f", p_lm)),
    p_svyglm_formatted = if_else(p_svyglm < 0.001, "<.001", sprintf("%.3f", p_svyglm))
  ) %>%
  # Крок 3.2: Вибираємо стовпчики для фінальної таблиці
  select(
    Predictor,
    B_lm,
    p_lm_formatted,
    B_svyglm,
    p_svyglm_formatted
  ) %>%
  # Крок 3.3: Тепер передаємо чистий датафрейм у kable
  kable(
    format = "html",
    digits = 3,
    col.names = c("Предиктор", "B", "p-значення", "B", "p-значення"),
    align = "lcccc",
    caption = "Порівняння не стандартизованих коефіцієнтів (B) за двома способами аналізу",
    # ВАЖЛИВО: додаємо escape = FALSE, щоб символ '<' відображався коректно
    escape = FALSE 
  ) %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed", "responsive"),
    full_width = FALSE
  ) %>%
  add_header_above(
    c(" " = 1, "Спосіб 1 (glm)" = 2, "Спосіб 2 (svyglm)" = 2)
  )

Порівняння не стандартизованих коефіцієнтів (B) за двома способами аналізу
	Спосіб 1 (glm)		Спосіб 2 (svyglm)
Предиктор	B	p-значення	B	p-значення
(Intercept)	0.239	0.012	0.239	0.011
cSelfEfficacy	0.701	<.001	0.701	<.001
cKnowledge	-0.187	<.001	-0.187	<.001
cselfRatedHealth	0.413	<.001	0.413	<.001
Spirit [звертаються]	0.163	0.018	0.163	0.018
cBasicNeeds	0.150	0.014	0.150	0.014
ComSup [наявна]	0.367	<.001	0.367	<.001
cAge	0.014	<.001	0.014	<.001
ResidenceType [місто]	-0.246	0.002	-0.246	0.002

Аналіз порівняння
Як показано в таблиці, обидва методи аналізу — glm і svyglm — дали ідентичні результати щодо оцінок коефіцієнтів (β) та їхньої статистичної значущості (p-значень). Оцінки коефіцієнтів (β). Точкові оцінки впливу предикторів збігаються після округлення до трьох знаків після коми. Це пояснюється тим, що обидва методи використовують зважену максимізацію правдоподібності для оцінки параметрів.
Статистична значущість (p-значення). p-значення в обох підходах практично однакові, оскільки для цього набору даних із простим дизайном вибірки оцінки стандартних помилок, які лежать в основі p-значень, є еквівалентними.

Додаток. Кодування змінних

cat("Перекодування змінних в SPSS")

#* 0
#* Індекс емоційного сприйняття свого майбутнього.
#Compute FutureFeelings=r6_1+(1*r6_2) + r6_3 + (-1*r6_4) + r6_5+ (-1*r6_6) + r6_7 +(-1*r6_8) #+ r6_9 +(-1*r6_10) + r6_11 +(-1*r6_12).

#VARIABLE LABELS
#    FutureFeelings 'Індекс ЕСМ'.


# * Перекодування змінних з новими іменами та мітками.
#RECODE f6.1 TO f6.20   (1=0) (2, 4=1) (3=2) INTO Q1 TO Q20.
#RECODE  f6.49 (1=0) (2, 4=1) (3=2) INTO Q21.

#* Додавання міток змінних.
#VARIABLE LABELS
#    Q1 'Вміння жити в нових суспільних умовах'
#    Q2 'Здоров''я'
#    Q3 'Роботи, що підходить'
#    Q4 'Необхідного одягу'
#    Q5 'Хорошого житла'
#    Q6 'Сучасних економічних знань'
#    Q7 'Упевненості в своїх силах'
#    Q8 'Необхідної медичної допомоги'
#    Q9 'Модного та красивого одягу'
#    Q10 'Необхідних меблів'
#    Q11 'Сучасних політичних знань'
#    Q12 'Рішучості в досягненні своїх цілей'
#    Q13 'Юридичної допомоги для захисту своїх прав та інтересів'
#    Q14 'Можливості повноцінно проводити відпустку'
#    Q15 'Можливості мати додатковий заробіток'
#    Q16 'Можливості купувати найнеобхідніші продукти'
#    Q17 'Ініціативи i самостійності під час розв''язання життєвих проблем'
#    Q18 'Повноцінного дозвілля'
#    Q19 'Можливості працювати з повною віддачею'
#    Q20 'Можливості харчуватися відповідно до своїх смаків'
#    Q21 'Можливості дати дітям повноцінну освіту'.

#* Додавання міток значень для всіх нових змінних.
#VALUE LABELS Q1 TO Q21
#    0 'Не вистачає'
#    1 'ВВ, не цікавить'
#    2 'Вистачає'.

#* 1-3
#* Створення індексів.
#COMPUTE BasicNeeds = MEAN(Q4, Q5, Q10, Q16).
#COMPUTE Knowledge = MEAN(Q6, Q11).
#COMPUTE SelfEfficacy = MEAN(Q7, Q12, Q17).

#* Додавання міток для індексів.
#VARIABLE LABELS
#    BasicNeeds 'Індекс базового матеріального забезпечення'
#    Knowledge 'Індекс соціально-політичних знань'
#    SelfEfficacy 'Індекс особистісної ефективності'
# EXECUTE.

#* 4
#* Перекодування імені змінної Dage1 в Age.
#RENAME VARIABLES (Dage1 = Age).

#* 5
#* Встановлення значення 1 для села та 2 для міста.
#IF (sd12CATI = 4) ResidenceType = 1.
#IF (sd12CATI = 1 OR sd12CATI = 2 OR sd12CATI = 3) ResidenceType = 2.

#* Визначення значень нової змінної ResidenceType.
#* Факторна змінна

#VARIABLE LABELS ResidenceType '1 - село, 2 - місто'.
#VALUE LABELS ResidenceType
#  1 'село'
#  2 'місто'.
# EXECUTE.

#* 6
#* Створення нової дихотомізованої змінної ComSup.
#* Факторна змінна

#RECODE stp1 (1=1) (4=1) (2=2) (3=2) INTO ComSup.
#EXECUTE.

#* Додавання міток для нової змінної.
#VARIABLE LABELS ComSup 'Здатність розраховувати на допомогу сусідів або членів громади'.
#VALUE LABELS ComSup
#    1 'Відсутній'
#    2 'Наявний'.
#EXECUTE.

#* 7
#* Створення нової дихотомізованої змінної Spirit
#* факторна змінна

#RECODE rel
#  (9=1) (1 THRU 8=2)
#  INTO Spirit.
# VARIABLE LABELS Spirit  'Звернення до духовних практик'.
# VALUE LABELS Spirit
#  1 'Не звертаюся'
#  2 'Звертаюся'.
#EXECUTE.

#* 8
#* Перейменування  змінної g1 в selfRatedHealth.
#RENAME  VARIABLES (g1 = selfRatedHealth).

Як індивідуальні та соціальні ресурси формують емоційне сприйняття майбутнього

Андрій Бова

2025-03-01

Подкаст про емоційне сприйняття майбутнього

Теоретичні основи дослідження

Концептуальна схема

Змінні та їх вимірювання

Емпірична база

Частотний розподіл

Кореляційна матриця

Багатовимірне шкалювання

Описові статистики

Кореляції між змінними

Лінійність залежності: графічна перевірка

Специфікація моделі

ANOVA

Розмір ефекту

Фактори, що впливають на сприйняття майбутнього

Порівняння прогнозів з фактичними даними

Маргінальні ефекти

Перевірка припущень моделі

Перевірка коректності зважування

Додаток. Кодування змінних