# List of packages
packages <- c("tidyverse", "fst", "modelsummary") # add any you need here

# Install packages if they aren't installed already
new_packages <- packages[!(packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages)

# Load the packages
lapply(packages, library, character.only = TRUE)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.4.4     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## [[1]]
##  [1] "lubridate" "forcats"   "stringr"   "dplyr"     "purrr"     "readr"    
##  [7] "tidyr"     "tibble"    "ggplot2"   "tidyverse" "stats"     "graphics" 
## [13] "grDevices" "utils"     "datasets"  "methods"   "base"     
## 
## [[2]]
##  [1] "fst"       "lubridate" "forcats"   "stringr"   "dplyr"     "purrr"    
##  [7] "readr"     "tidyr"     "tibble"    "ggplot2"   "tidyverse" "stats"    
## [13] "graphics"  "grDevices" "utils"     "datasets"  "methods"   "base"     
## 
## [[3]]
##  [1] "modelsummary" "fst"          "lubridate"    "forcats"      "stringr"     
##  [6] "dplyr"        "purrr"        "readr"        "tidyr"        "tibble"      
## [11] "ggplot2"      "tidyverse"    "stats"        "graphics"     "grDevices"   
## [16] "utils"        "datasets"     "methods"      "base"

#TASK 1

france_data <- read.fst("france_data.fst")

table(france_data$lrscale)
## 
##    0    1    2    3    4    5    6    7    8    9   10   77   88 
##  945  499 1269 1996 1838 5274 1594 1749 1458  409  686  381  940
france_data <- france_data %>%
  mutate(
    lrscale = case_when(
      lrscale %in% 0:3 ~ "Left",
      lrscale %in% 7:10 ~ "Right",
      lrscale %in% c(77, 88, 99) ~ NA_character_,
    ),
    
    educ.ba = case_when(
      essround < 5 & edulvla == 5 ~ "BA or More",
      essround >= 5 & edulvlb > 600 ~ "BA or More",
      TRUE ~ "No BA"
    )
  )%>%
  
  mutate(
    edulvla = ifelse(edulvla %in% c(77, 88), NA_integer_, edulvla),
    edulvlb = ifelse(edulvlb %in% c(5555, 7777, 8888), NA_integer_, edulvlb),
    educ.ba = as.character(educ.ba)
  )

#Chi Squared Analysis

tab_dat <- france_data

mytab <- table(tab_dat$lrscale, tab_dat$educ.ba)

rsums <- rowSums(mytab)

csums <- colSums(mytab)

N <- sum(mytab)
ptab <- tcrossprod(rsums/N, csums/N)
cat("Table of Expected Proportions:\n")
## Table of Expected Proportions:
print(ptab)
##           [,1]      [,2]
## [1,] 0.1311243 0.3914592
## [2,] 0.1197912 0.3576253
ftab <- N * ptab
cat("Table of Expected Frequencies:\n")
## Table of Expected Frequencies:
print(ftab)
##          [,1]     [,2]
## [1,] 1181.561 3527.439
## [2,] 1079.439 3222.561
#Critical Value
alpha<- 0.05
c_val <- qchisq(alpha, df= 1, lower.tail = FALSE)
cat("Critical Value", round(c_val, 3), "\n")
## Critical Value 3.841
#Pearson's R
test_stat <- sum((mytab - ftab)^2 / ftab)
cat("Pearson's Chi-Squared Statistic:", round(test_stat, 4), "\n")
## Pearson's Chi-Squared Statistic: 100.8551

#INTERPRETATION:

First the obtained Critical Value for independence from our analysis is 3.841. Thus, from a P value of .05, the CV represents the threshold to which we reject or retain the null hypothesis depending on whether our test statistic exceeds or falls under the CV.

Based on our analysis we find that the obtained value is 100.86. Given the obtained value lies above the critical value, we can conclude that there is a statistical significance between one’s placement on left or right, and the level of educational attainment.

#TASK 2

france_data <- read.fst("france_data.fst")
library(dplyr)

france_data <- france_data %>%
  mutate(
    sbbsntx = case_when(
      sbbsntx %in% 1 ~ "Strongly Agree",
      sbbsntx %in% 2 ~ "Agree",
      sbbsntx %in% 3 ~ "Neither Agree nor Disagree",
      sbbsntx %in% 4 ~ "Disagree",
      sbbsntx %in% 5 ~ "Strongly Disagree",
      sbbsntx %in% c(7, 8, 9) ~ NA_character_,
    ),
    
    domicil = case_when(
      domicil %in% 1:3 ~ "Urban",
      domicil %in% 4:5 ~ "Rural",
      domicil %in% c(7, 8, 9) ~ NA_character_,
    )
  )
table(france_data$sbbsntx)
## 
##                      Agree                   Disagree 
##                       1538                        640 
## Neither Agree nor Disagree             Strongly Agree 
##                        804                        757 
##          Strongly Disagree 
##                        301
table(france_data$domicil)
## 
## Rural Urban 
##  6830 12202
library(infer)
## Warning: package 'infer' was built under R version 4.3.3
test_stat <- france_data %>%
  specify(explanatory = domicil,
          response = sbbsntx) %>%
  hypothesize(null = "independence") %>%
  calculate(stat = "Chisq")
## Warning: Removed 14999 rows containing missing values.
print(test_stat$stat)
## X-squared 
##  20.19097
null_distribution <- france_data %>%
  specify(explanatory = domicil,
          response = sbbsntx) %>%
  hypothesize(null = "independence") %>%
  generate(reps = 1000, type = "permute")%>%
  calculate(stat = "chisq")
## Warning: Removed 14999 rows containing missing values.
p_val <- null_distribution %>%
  get_pvalue(obs_stat = test_stat, direction = "greater")
## Warning: Please be cautious in reporting a p-value of 0. This result is an approximation
## based on the number of `reps` chosen in the `generate()` step.
## ℹ See `get_p_value()` (`?infer::get_p_value()`) for more information.
p_val
## # A tibble: 1 × 1
##   p_value
##     <dbl>
## 1       0

INTERPRETATION:

Given that we found a p-value of 0.001, we have strong evidence to reject the null hypothesis which states there NOT EXIST a relationship between the participant’s geographical place of residence and their attitudes towards social beneifts and its impacts on businesses.

#TASK 3

null_distribution %>%
  visualize()+
  shade_p_value(obs_stat = test_stat, direction = "greater")
## Warning in min(diff(unique_loc)): no non-missing arguments to min; returning
## Inf

null_distribution
## Response: sbbsntx (factor)
## Explanatory: domicil (factor)
## Null Hypothesis: independence
## # A tibble: 1,000 × 2
##    replicate  stat
##        <int> <dbl>
##  1         1 0.823
##  2         2 5.12 
##  3         3 3.82 
##  4         4 2.68 
##  5         5 5.79 
##  6         6 0.279
##  7         7 2.21 
##  8         8 9.27 
##  9         9 1.33 
## 10        10 2.52 
## # ℹ 990 more rows
cV <- null_distribution %>%
  get_confidence_interval(level = 0.95, type = "percentile")

null_distribution %>%
  visualize() +
  shade_p_value(obs_stat = test_stat, direction = "greater") 
## Warning in min(diff(unique_loc)): no non-missing arguments to min; returning
## Inf

Interpretation:

Here we see the red line, which indicates our observed value to lie beyond our theoretical distribution model. Further, this tells us that under frequentest hypothesis testing to reject the null-hypothesis. As well, we retain the null hypothesis which states there being no relationship between the two as P < 0.05

#TASK 4

france_data <- read.fst("france_data.fst")
table(france_data$ccrdprs)
## 
##   0   1   2   3   4   5   6   7   8   9  10  66  77  88  99 
##  72  26  64  78 114 478 403 736 952 358 708  27   1  29   1
library(dplyr)

france_data <- france_data %>%
  mutate(
    lrscale = case_when(
      lrscale %in% 0:3 ~ "Left",
      lrscale %in% 4:6 ~ "Moderate",
      lrscale %in% 7:10 ~ "Right",
      lrscale %in% c(77, 88, 99) ~ NA_character_
    ),
    
    ccrdprs = case_when(
          ccrdprs %in% c(66, 77, 88, 99) ~ NA_real_,
          TRUE ~ ccrdprs
    ),
    
  )
table(france_data$ccrdprs)
## 
##   0   1   2   3   4   5   6   7   8   9  10 
##  72  26  64  78 114 478 403 736 952 358 708
library(dplyr)
library(infer)

lrscale_ccrdprs_stats <- france_data %>%
  specify(explanatory = lrscale,
          response = ccrdprs) %>%
  hypothesize(null = "independence") %>%
  calculate(stat = "F")
## Warning: Removed 15413 rows containing missing values.
library(dplyr)
library(infer)

lrscale_ccrdprs_null <- france_data %>%
  specify(explanatory = lrscale,
          response = ccrdprs) %>%
  hypothesize(null = "independence") %>%
  generate(reps = 1000, type = "permute") %>%
  calculate(stat = "F")
## Warning: Removed 15413 rows containing missing values.
p_val <- lrscale_ccrdprs_null %>%
  get_pvalue(obs_stat = lrscale_ccrdprs_stats, direction = "two-sided")
## Warning: Please be cautious in reporting a p-value of 0. This result is an approximation
## based on the number of `reps` chosen in the `generate()` step.
## ℹ See `get_p_value()` (`?infer::get_p_value()`) for more information.
p_val
## # A tibble: 1 × 1
##   p_value
##     <dbl>
## 1       0

#INTERPRETATION

Based on the information provided, we obtained a p-value of 0 which indicates the probability of the null hypothesis. Having a p-value close to zero indicates a low probability of there to be an existing relationship between political self-placement and responsibility towards climate change.

#TASK 5

lrscale_ccrdprs_null %>%
  visualize() +
  shade_p_value(obs_stat = lrscale_ccrdprs_stats, direction = "two-sided")
## Warning: F usually corresponds to right-tailed tests. Proceed with caution.

conf_int <- null_distribution %>%
  get_confidence_interval(level = 0.95, type = "percentile")

lrscale_ccrdprs_null %>%
  visualize()

shade_p_value(obs_stat = lrscale_ccrdprs_stats, direction = "two-sided")
## A p-value shading layer.

#Interpretation

Based on the distribution and the data provided, and given that upon repeated measures we can be 95% confident on the obtained value lies within the critical value, we reject the null hypothesis and that P > 0.05. This means that we reject the null which hypothesizes that there be no relationship between one’s self-placement and their feelings of responisibility towards climate change.