# CDR Analysis Script - Theory-Driven Hypothesis Testing Approach # Addresses reviewer concerns about model construction and systematic hypothesis testing # Load required libraries library(tidyverse) library(MASS) library(brant) library(logistf) library(car) library(sjPlot) library(emmeans) library(ggplot2) library(stringr) library(nnet) library(radiant.data) library(rctutils) library(emmeans) # ============================================================================ # DATA PREPARATION # ============================================================================ # Load data cdr <- read_csv('/Users/celinascott-buechler/DFP/cdr/cdr_cleaned.csv', col_names = TRUE) pp <- read_csv('/Users/celinascott-buechler/DFP/cdr/Power_Plants.csv', col_names = TRUE) # Process power plant data for fossil fuel context variable pp_petro <- pp %>% filter(PrimSource=='petroleum') %>% group_by(Zip) %>% summarise(petro_sum = n(), petro_capacity_sum = sum(Total_MW)) pp_ng <- pp %>% filter(PrimSource=='natural gas') %>% group_by(Zip) %>% summarise(ng_sum = n(), ng_capacity_sum = sum(Total_MW)) pp_coal <- pp %>% filter(PrimSource=='coal') %>% group_by(Zip) %>% summarise(coal_sum = n(), coal_capacity_sum = sum(Total_MW)) # Join fossil fuel data to main dataset cdr <- cdr %>% left_join(pp_petro, by = c("ZipCode" = "Zip")) %>% left_join(pp_ng, by = c("ZipCode" = "Zip")) %>% left_join(pp_coal, by = c("ZipCode" = "Zip")) %>% mutate( across(c(petro_sum, ng_sum, coal_sum, petro_capacity_sum, ng_capacity_sum, coal_capacity_sum), ~replace_na(.x, 0)), ff_sum = petro_sum + ng_sum + coal_sum, ff_cap_sum = petro_capacity_sum + coal_capacity_sum + ng_capacity_sum ) # Set reference levels for analysis cdr <- relevel_columns(cdr, party3 = "Democrat", Education = "No high school diploma", Income = "Under $25,000", Race = 'White', education3 = "High school or less") # Clean party variable cdr$party3[cdr$party3 == "Neither"] <- "Independent" # ============================================================================ # HYPOTHESIS-SPECIFIC DATA PREPARATION # ============================================================================ # Prepare messenger experiment data for H1a and H1b cdr_messenger <- cdr %>% mutate( # H1a: Support for CDR law by partisan messenger support = case_when( !is.na(DemMessenger) ~ DemMessenger, !is.na(RepMessenger) ~ RepMessenger, !is.na(BipartMessenger) ~ BipartMessenger, TRUE ~ NA_character_ ), # H1b: Support change by sector messenger support2 = case_when( !is.na(FossilFuelMessenger) ~ FossilFuelMessenger, !is.na(CommunityLeaderMessenger) ~ CommunityLeaderMessenger, !is.na(EnviroMessenger) ~ EnviroMessenger, TRUE ~ NA_character_ ) ) %>% mutate( support = factor(support, levels = c("Strongly oppose", "Somewhat oppose", "Somewhat support", "Strongly support")), support2 = factor(support2, levels = c("Strongly decrease", "Somewhat decrease", "No difference in my support", "Somewhat increase", "Strongly increase")) ) # Prepare moral hazard variables for H2 cdr <- cdr %>% mutate( FossilFuelUse_fac = factor(FossilFuelUse, levels = c("Greatly increase", "Somewhat increase", "No effect", "Somewhat decrease", "Greatly decrease")), RenewablesUse_fac = factor(RenewablesUse, levels = c("Greatly decrease", "Somewhat decrease", "No effect", "Somewhat increase", "Greatly increase")), CarbonPollution_fac = factor(CarbonPollution, levels = c("Greatly increase", "Somewhat increase", "No effect", "Somewhat decrease", "Greatly decrease")), # Numeric versions for t-tests (centered on "no effect" = 0) FossilFuelUse_num = dplyr::recode(FossilFuelUse, "Greatly increase" = 2, "Somewhat increase" = 1, "No effect" = 0, "Somewhat decrease" = -1, "Greatly decrease" = -2), RenewablesUse_num = dplyr::recode(RenewablesUse, "Greatly decrease" = -2, "Somewhat decrease" = -1, "No effect" = 0, "Somewhat increase" = 1, "Greatly increase" = 2), CarbonPollution_num = dplyr::recode(CarbonPollution, "Greatly increase" = 2, "Somewhat increase" = 1, "No effect" = 0, "Somewhat decrease" = -1, "Greatly decrease" = -2) ) # Prepare ownership data for H3 # Create a mapping from the long descriptions to shorter ordered categories cdr$CommunityEngagement_ord <- factor(cdr$CommunityEngagement, levels = c( "No requirement about community engagement, benefit, or ownership between the community and CDR developers", "Requiring that CDR developers consult with the community where they site a project", "Requiring that CDR developers consult with and invest in the community where they site a project", "Requiring that CDR developers allow the community where they site a project to have voting stakes in the project", "Requiring that CDR developers be paid for their construction of the project, but that the community where they site a project ultimately owns, operates, and profits from the project" ), labels = c( "No requirements", "Community consultation", "Community consultation and investment", "Community voting stakes", "Community ownership" ), ordered = TRUE) # Check if it worked table(cdr$CommunityEngagement_ord, useNA = "always") cdr_own <- cdr %>% filter(ProjectOwnership != "Haven't heard enough to say") %>% mutate(publicly_owned_pref = ifelse(ProjectOwnership == 'Publicly owned and operated', 1, 0)) # Prepare fossil fuel industry role data for H4 cdr_ff_roles <- cdr %>% mutate( across(c(FossilFuelRole_Experience, FossilFuelRole_Untrustworthy, FossilFuelRole_ProvideEnergy, FossilFuelRole_Nationalization), ~factor(.x, levels = c("Strongly disapprove", "Somewhat disapprove", "Somewhat approve", "Strongly approve"), ordered = TRUE)) ) # ============================================================================ # DEFINE CORE MODEL BUILDING FUNCTIONS # ============================================================================ # Function for systematic model building build_models_systematic <- function(formula_base, data, weights_var, method = "polr") { # Extract outcome and base predictors outcome <- all.vars(formula_base)[1] base_predictors <- paste(all.vars(formula_base)[-1], collapse = " + ") # Progressive model building models <- list() # Core theoretical model core_formula <- as.formula(paste(outcome, "~", base_predictors)) # Add demographic controls incrementally demo_formula <- as.formula(paste(outcome, "~", base_predictors, "+ Gender + Age + education3")) # Full model with all controls full_formula <- as.formula(paste(outcome, "~", base_predictors, "+ Gender + Age + education3 + Income_num + Race + LocType + ff_cap_sum")) # Fit models based on method if(method == "polr") { models$core <- polr(core_formula, data = data, weights = data[[weights_var]], Hess = TRUE) models$demo <- polr(demo_formula, data = data, weights = data[[weights_var]], Hess = TRUE) models$full <- polr(full_formula, data = data, weights = data[[weights_var]], Hess = TRUE) } else if(method == "logistf") { models$core <- logistf(core_formula, data = data, weights = data[[weights_var]], pl = TRUE) models$demo <- logistf(demo_formula, data = data, weights = data[[weights_var]], pl = TRUE) models$full <- logistf(full_formula, data = data, weights = data[[weights_var]], pl = TRUE) } else if(method == "multinom") { models$core <- multinom(core_formula, data = data, weights = data[[weights_var]]) models$demo <- multinom(demo_formula, data = data, weights = data[[weights_var]]) models$full <- multinom(full_formula, data = data, weights = data[[weights_var]]) } return(models) } # Function for model diagnostics model_diagnostics <- function(model) { diagnostics <- list() if(class(model)[1] == "polr") { # Proportional odds test tryCatch({ diagnostics$brant <- brant(model) }, error = function(e) { diagnostics$brant <- "Brant test failed" }) # Pseudo R-squared diagnostics$mcfadden_r2 <- 1 - (model$deviance / model$null.deviance) # VIF (approximate using equivalent GLM) tryCatch({ glm_equiv <- glm(as.numeric(model$model[,1]) ~ ., data = model$model[,-1], family = gaussian) diagnostics$vif <- car::vif(glm_equiv) }, error = function(e) { diagnostics$vif <- "VIF calculation failed" }) } return(diagnostics) } # ============================================================================ # HYPOTHESIS 1: MESSENGER EFFECTS (H1a & H1b) # ============================================================================ cat("===============================================\n") cat("HYPOTHESIS 1: MESSENGER EFFECTS\n") cat("===============================================\n") # H1a: Partisan messenger effects (in-party effect for Republicans) cat("\nH1a: Testing partisan messenger effects...\n") # 1. First, let's check the interaction model results h1a_model <- polr(support ~ Messenger_party_cat * party3 + ClimateChange_num + Gender + Age + education3 + Income_num + Race + LocType + ff_cap_sum, data = cdr_messenger, weights = dfp_weight_adults, Hess = TRUE) # Display the model results to see if interaction is significant summary(h1a_model) # or tab_model(h1a_model) # 2. Calculate emmeans correctly h1a_emmeans <- emmeans(h1a_model, ~ Messenger_party_cat | party3) # 3. Get pairwise contrasts within each party h1a_pairwise <- pairs(h1a_emmeans) summary(h1a_pairwise) # 4. Alternative approach - get specific contrasts we want # Test H1a specific predictions: # Overall effect (across all parties): Republican vs Bipartisan h1a_overall <- emmeans(h1a_model, ~ Messenger_party_cat) h1a_overall_contrast <- pairs(h1a_overall) summary(h1a_overall_contrast) # In-party effect: Focus on Republicans only # Extract just the Republican contrasts h1a_republican_emmeans <- emmeans(h1a_model, ~ Messenger_party_cat, at = list(party3 = "Republican")) h1a_republican_contrast <- pairs(h1a_republican_emmeans) summary(h1a_republican_contrast) # 5. Test interaction effect directly # This tests if the messenger effect differs by party h1a_interaction_test <- contrast(h1a_emmeans, interaction = "pairwise") summary(h1a_interaction_test) # 6. Specific hypothesis test for H1a # Test: Do Republicans respond more positively to Republican messengers than Democrats do? h1a_specific <- contrast(h1a_emmeans, interaction = list(Messenger = "pairwise", party3 = "pairwise")) summary(h1a_specific) # Extract coefficients to interpret interaction coef_summary <- summary(h1a_model) print(coef_summary) # Calculate predicted probabilities for easier interpretation h1a_predictions <- emmeans(h1a_model, ~ Messenger_party_cat * party3, type = "response") summary(h1a_predictions) # H1b: Sector messenger effects cat("\n\nH1b: Testing sector messenger effects...\n") h1b_models <- build_models_systematic( formula_base = support2 ~ Messenger_sector_cat + party3 + ClimateChange_num, data = cdr_messenger, weights_var = "dfp_weight_adults", method = "polr" ) # Display results cat("H1b Model Results:\n") tab_model(h1b_models$full, title = "H1b: Sector Messenger Effects") # H1b model with interactions h1b_model_interaction <- polr(support2 ~ Messenger_sector_cat * party3 + ClimateChange_num + Gender + Age + education3 + Income_num + Race + LocType + ff_cap_sum, data = cdr_messenger, weights = dfp_weight_adults, Hess = TRUE) # Display results tab_model(h1b_model_interaction) # Test sector effects within each party h1b_emmeans <- emmeans(h1b_model_interaction, ~ Messenger_sector_cat | party3) h1b_contrasts_by_party <- pairs(h1b_emmeans) summary(h1b_contrasts_by_party) # Test if sector effects differ by party h1b_interaction_test <- contrast(h1b_emmeans, interaction = "pairwise") summary(h1b_interaction_test) # Test specific H1b hypothesis: NGO positive, FF negative vs community leader h1b_emmeans <- emmeans(h1b_models$full, ~ Messenger_sector_cat) h1b_contrasts <- pairs(h1b_emmeans) cat("\nH1b Contrasts (testing NGO vs FF vs Community Leader):\n") summary(h1b_contrasts) # ============================================================================ # HYPOTHESIS 2: MORAL HAZARD EFFECTS (H2) # ============================================================================ cat("\n\n===============================================\n") cat("HYPOTHESIS 2: MORAL HAZARD EFFECTS\n") cat("===============================================\n") # H2: Test if perceptions differ from "no effect" (neutral) cat("\nH2: Testing moral hazard perceptions...\n") # One-sample t-tests against neutral point (0 = "no effect") h2_tests <- list( fossil_fuel = t.test(cdr$FossilFuelUse_num, mu = 0, na.rm = TRUE), renewables = t.test(cdr$RenewablesUse_num, mu = 0, na.rm = TRUE), carbon_pollution = t.test(cdr$CarbonPollution_num, mu = 0, na.rm = TRUE) ) cat("H2 One-sample t-tests (testing if different from 'no effect'):\n") for(outcome in names(h2_tests)) { test_result <- h2_tests[[outcome]] cat(sprintf("%s: t = %.3f, p = %.3f, mean = %.3f\n", outcome, test_result$statistic, test_result$p.value, test_result$estimate)) } # Ordinal models to identify predictors of moral hazard perceptions h2_ff_models <- build_models_systematic( formula_base = FossilFuelUse_fac ~ party3 + ClimateChange_num + Messenger_sector_cat, data = cdr, weights_var = "dfp_weight_adults", method = "polr" ) h2_ren_models <- build_models_systematic( formula_base = RenewablesUse_fac ~ party3 + ClimateChange_num + Messenger_sector_cat, data = cdr, weights_var = "dfp_weight_adults", method = "polr" ) h2_co2_models <- build_models_systematic( formula_base = CarbonPollution_fac ~ party3 + ClimateChange_num + Messenger_sector_cat, data = cdr, weights_var = "dfp_weight_adults", method = "polr" ) tab_model(h2_ff_models$full, title = "H2: Fossil Fuel Use Moral Hazard") tab_model(h2_ren_models$full, title = "H2: Renewable Energy Use Moral Hazard") tab_model(h2_co2_models$full, title = "H2: Carbon Pollution Moral Hazard") # ============================================================================ # HYPOTHESIS 3: COMMUNITY ENGAGEMENT PREFERENCES (H3) # ============================================================================ cat("\n\n===============================================\n") cat("HYPOTHESIS 3: COMMUNITY ENGAGEMENT PREFERENCES\n") cat("===============================================\n") # H3a: Preferences for community engagement levels cat("\nH3: Testing community engagement preferences...\n") h3_engagement_models <- build_models_systematic( formula_base = CommunityEngagement_ord ~ party3 + ClimateChange_num, data = cdr, weights_var = "dfp_weight_adults", method = "polr" ) cat("H3 Community Engagement Preferences:\n") tab_model(h3_engagement_models$full, title = "H3: Community Engagement Preferences") table(cdr$CommunityEngagement_ord, useNA = "always") prop.table(table(cdr$CommunityEngagement_ord, useNA = "always")) # H3b: Public vs private ownership preferences h3_ownership_models <- build_models_systematic( formula_base = publicly_owned_pref ~ party3 * ClimateChange_num, data = cdr_own, weights_var = "dfp_weight_adults", method = "logistf" ) cat("\nH3 Public vs Private Ownership Preferences:\n") tab_model(h3_ownership_models$full, title = "H3: Public Ownership Preferences") # Check VIF for ownership model vif_h3 <- vif(glm(publicly_owned_pref ~ party3 + ClimateChange_num + Gender + Age + Income_num + Race + LocType + education3 + ff_cap_sum, data = cdr_own, family = binomial)) cat("\nH3 VIF values:\n") print(vif_h3) # Create binary indicators for key policy positions cdr <- cdr %>% mutate( # Funding mechanism indicators supports_industry_tax = grepl("tax polluting industries", GovernmentFundingMechanism, ignore.case = TRUE), supports_public_tax = grepl("tax the public|tax only the wealthiest", GovernmentFundingMechanism, ignore.case = TRUE), opposes_funding = grepl("should not fund", GovernmentFundingMechanism, ignore.case = TRUE), # Ownership indicators supports_govt_ownership = grepl("owned and operated by the government", GovernmentFundingOwnership), supports_cdr_ownership = grepl("owned and operated by carbon dioxide removal companies", GovernmentFundingOwnership), supports_community_ownership = grepl("owned and operated by local communities", GovernmentFundingOwnership), supports_fossil_ownership = grepl("owned and operated by fossil fuel companies", GovernmentFundingOwnership), # Funding level supports_any_funding = !grepl("should not provide any funding", GovernmentFundingOwnership), # Key policy contrasts supports_polluter_pays = supports_industry_tax, supports_public_control = supports_govt_ownership | supports_community_ownership, supports_private_control = supports_cdr_ownership | supports_fossil_ownership ) # Generate key statistics cat("FINANCING MECHANISM PREFERENCES\n") cat("================================\n") cat("Supports taxing polluting industries:", round(mean(cdr$supports_industry_tax, na.rm = TRUE) * 100, 1), "%\n") cat("Supports public/community ownership:", round(mean(cdr$supports_public_control, na.rm = TRUE) * 100, 1), "%\n") cat("Supports private sector ownership:", round(mean(cdr$supports_private_control, na.rm = TRUE) * 100, 1), "%\n") # Generate detailed summary statistics cat("\n==================================================\n") cat("CDR FINANCING & GOVERNANCE: SUMMARY STATISTICS\n") cat("==================================================\n\n") # 1. FUNDING MECHANISM PREFERENCES cat("1. FUNDING MECHANISM PREFERENCES\n") cat("---------------------------------\n") funding_mechanisms <- cdr %>% summarise( `Tax polluting industries` = sum(supports_industry_tax, na.rm = TRUE), `Tax the public` = sum(supports_public_tax, na.rm = TRUE), `Tax wealthy only` = sum(grepl("wealthiest", GovernmentFundingMechanism), na.rm = TRUE), `Divert from other climate funds` = sum(supports_divert_funds, na.rm = TRUE), `No government funding` = sum(opposes_funding, na.rm = TRUE), `Missing/NA` = sum(is.na(GovernmentFundingMechanism)) ) %>% pivot_longer(everything(), names_to = "Mechanism", values_to = "n") %>% mutate( Percent = round(n / nrow(cdr) * 100, 1), Summary = paste0(n, " (", Percent, "%)") ) print(funding_mechanisms %>% select(Mechanism, Summary)) # 2. OWNERSHIP PREFERENCES cat("\n2. PROJECT OWNERSHIP PREFERENCES\n") cat("---------------------------------\n") ownership_prefs <- cdr %>% summarise( `Government` = sum(supports_govt_ownership, na.rm = TRUE), `CDR companies` = sum(supports_cdr_ownership, na.rm = TRUE), `Local communities` = sum(supports_community_ownership, na.rm = TRUE), `Fossil fuel companies` = sum(supports_fossil_ownership, na.rm = TRUE), `No funding preference stated` = sum(grepl("should not provide any funding", GovernmentFundingOwnership), na.rm = TRUE), `Missing/NA` = sum(is.na(GovernmentFundingOwnership)) ) %>% pivot_longer(everything(), names_to = "Owner", values_to = "n") %>% mutate( Percent = round(n / nrow(cdr) * 100, 1), Summary = paste0(n, " (", Percent, "%)") ) print(ownership_prefs %>% select(Owner, Summary)) # 3. KEY POLICY POSITIONS cat("\n3. KEY POLICY POSITIONS\n") cat("-----------------------\n") policy_positions <- cdr %>% summarise( `Polluter pays (any industry tax)` = sum(supports_industry_tax, na.rm = TRUE), `Public/community control` = sum(supports_public_control, na.rm = TRUE), `Private sector control` = sum(supports_private_control, na.rm = TRUE), `Both public & private control` = sum(supports_public_control & supports_private_control, na.rm = TRUE) ) %>% pivot_longer(everything(), names_to = "Position", values_to = "n") %>% mutate( Percent = round(n / nrow(cdr) * 100, 1), Summary = paste0(n, " (", Percent, "%)") ) print(policy_positions %>% select(Position, Summary)) # 4. PARTISAN DIFFERENCES if("party3" %in% names(cdr)) { cat("\n4. PARTISAN DIFFERENCES\n") cat("------------------------\n") partisan_summary <- cdr %>% filter(!is.na(party3)) %>% group_by(party3) %>% summarise( n = n(), `Industry tax (%)` = round(mean(supports_industry_tax, na.rm = TRUE) * 100, 1), `Public/comm control (%)` = round(mean(supports_public_control, na.rm = TRUE) * 100, 1), `Private control (%)` = round(mean(supports_private_control, na.rm = TRUE) * 100, 1) ) print(partisan_summary) # Chi-square tests cat("\nChi-square tests:\n") if(sum(!is.na(cdr$supports_industry_tax)) > 0) { tax_test <- chisq.test(table(cdr$party3, cdr$supports_industry_tax)) cat("Industry taxation by party: X² =", round(tax_test$statistic, 2), ", p =", format.pval(tax_test$p.value), "\n") } if(sum(!is.na(cdr$supports_public_control)) > 0) { public_test <- chisq.test(table(cdr$party3, cdr$supports_public_control)) cat("Public control by party: X² =", round(public_test$statistic, 2), ", p =", format.pval(public_test$p.value), "\n") } } # 5. FUNDING LEVEL PREFERENCES cat("\n5. FUNDING LEVEL PREFERENCES\n") cat("-----------------------------\n") funding_level <- cdr %>% mutate( funding_level = case_when( grepl("should not provide any funding", GovernmentFundingOwnership) ~ "None", grepl("all the funding", GovernmentFundingOwnership) ~ "All", grepl("some of the funding", GovernmentFundingOwnership) ~ "Some", is.na(GovernmentFundingOwnership) ~ NA_character_, TRUE ~ "Unclear" ) ) %>% count(funding_level) %>% mutate( Percent = round(n / sum(n) * 100, 1), Summary = paste0(n, " (", Percent, "%)") ) print(funding_level %>% select(funding_level, Summary)) # 6. COMBINATIONS cat("\n6. COMMON COMBINATIONS\n") cat("----------------------\n") cat("Supports both industry tax AND public/community control:", sum(cdr$supports_industry_tax & cdr$supports_public_control, na.rm = TRUE), "(", round(mean(cdr$supports_industry_tax & cdr$supports_public_control, na.rm = TRUE) * 100, 1), "%)\n") cat("Supports industry tax BUT NOT public control:", sum(cdr$supports_industry_tax & !cdr$supports_public_control, na.rm = TRUE), "(", round(mean(cdr$supports_industry_tax & !cdr$supports_public_control, na.rm = TRUE) * 100, 1), "%)\n") cat("Supports public control BUT NOT industry tax:", sum(!cdr$supports_industry_tax & cdr$supports_public_control, na.rm = TRUE), "(", round(mean(!cdr$supports_industry_tax & cdr$supports_public_control, na.rm = TRUE) * 100, 1), "%)\n") # ============================================================================ # HYPOTHESIS 4: FOSSIL FUEL INDUSTRY ROLE (H4) # ============================================================================ cat("\n\n===============================================\n") cat("HYPOTHESIS 4: FOSSIL FUEL INDUSTRY ROLE\n") cat("===============================================\n") # Descriptive statistics h4_descriptives <- cdr_ff_roles %>% dplyr::select(FossilFuelRole_Experience, FossilFuelRole_Untrustworthy, FossilFuelRole_ProvideEnergy, FossilFuelRole_Nationalization) %>% pivot_longer(everything(), names_to = "role_type", values_to = "response") %>% filter(!is.na(response)) %>% group_by(role_type) %>% summarise( n = n(), approve_pct = mean(as.numeric(response) > 2, na.rm = TRUE) * 100, disapprove_pct = mean(as.numeric(response) < 3, na.rm = TRUE) * 100, variance = var(as.numeric(response), na.rm = TRUE), .groups = 'drop' ) cat("H4 Descriptive statistics (showing divided opinion):\n") print(h4_descriptives) cat("\n\n===============================================\n") cat("HYPOTHESIS 4: FOSSIL FUEL INDUSTRY ROLE\n") cat("===============================================\n") # Experience Model cat("\nH4 Experience Model:\n") experience_data <- cdr_ff_roles %>% filter(!is.na(FossilFuelRole_Experience)) h4_experience_models <- build_models_systematic( formula_base = FossilFuelRole_Experience ~ party3 + ClimateChange_num, data = experience_data, weights_var = "dfp_weight_adults", method = "polr" ) tab_model(h4_experience_models$full, title = "H4: Experience Role") # Untrustworthy Model cat("\nH4 Untrustworthy Model:\n") untrustworthy_data <- cdr_ff_roles %>% filter(!is.na(FossilFuelRole_Untrustworthy)) h4_untrustworthy_models <- build_models_systematic( formula_base = FossilFuelRole_Untrustworthy ~ party3 + ClimateChange_num, data = untrustworthy_data, weights_var = "dfp_weight_adults", method = "polr" ) tab_model(h4_untrustworthy_models$full, title = "H4: Untrustworthy Role") # ProvideEnergy Model cat("\nH4 ProvideEnergy Model:\n") provide_energy_data <- cdr_ff_roles %>% filter(!is.na(FossilFuelRole_ProvideEnergy)) h4_provide_energy_models <- build_models_systematic( formula_base = FossilFuelRole_ProvideEnergy ~ party3 + ClimateChange_num, data = provide_energy_data, weights_var = "dfp_weight_adults", method = "polr" ) tab_model(h4_provide_energy_models$full, title = "H4: ProvideEnergy Role") # Nationalization Model cat("\nH4 Nationalization Model:\n") nationalization_data <- cdr_ff_roles %>% filter(!is.na(FossilFuelRole_Nationalization)) h4_nationalization_models <- build_models_systematic( formula_base = FossilFuelRole_Nationalization ~ party3 + ClimateChange_num, data = nationalization_data, weights_var = "dfp_weight_adults", method = "polr" ) tab_model(h4_nationalization_models$full, title = "H4: Nationalization Role") # Store all models for contrasts h4_models <- list( Experience = h4_experience_models, Untrustworthy = h4_untrustworthy_models, ProvideEnergy = h4_provide_energy_models, Nationalization = h4_nationalization_models ) # Partisan contrasts for each model ff_role_types <- c("Experience", "Untrustworthy", "ProvideEnergy", "Nationalization") for(role_type in ff_role_types) { h4_emmeans <- emmeans(h4_models[[role_type]]$full, ~ party3) h4_contrasts <- pairs(h4_emmeans) cat(sprintf("\nH4 %s Partisan Contrasts:\n", role_type)) print(summary(h4_contrasts)) } # 1. CONSISTENCY ANALYSIS: Pro-industry vs Anti-industry camps cat("\n1. CONSISTENCY ANALYSIS:\n") # Create composite scores for pro/anti industry sentiment cdr_ff_roles <- cdr_ff_roles %>% mutate( # Pro-industry variables (higher = more pro-industry) experience_score = as.numeric(FossilFuelRole_Experience), provide_energy_score = as.numeric(FossilFuelRole_ProvideEnergy), # Anti-industry variables (reverse code so higher = more anti-industry) untrustworthy_score = as.numeric(FossilFuelRole_Untrustworthy), nationalization_score = as.numeric(FossilFuelRole_Nationalization), # Overall pro-industry composite (mean of pro-industry items) pro_industry_composite = (experience_score + provide_energy_score) / 2, # Overall anti-industry composite anti_industry_composite = (untrustworthy_score + nationalization_score) / 2 ) # Test correlation between pro- and anti-industry composites cor_test <- cor.test(cdr_ff_roles$pro_industry_composite, cdr_ff_roles$anti_industry_composite, use = "complete.obs") cat("Correlation between pro-industry and anti-industry composites:\n") print(cor_test) # Identify coherent camps cdr_ff_roles <- cdr_ff_roles %>% mutate( industry_stance = case_when( pro_industry_composite >= 3 & anti_industry_composite <= 2 ~ "Pro-Industry", pro_industry_composite <= 2 & anti_industry_composite >= 3 ~ "Anti-Industry", TRUE ~ "Mixed/Moderate" ) ) table(cdr_ff_roles$industry_stance, useNA = "always") prop.table(table(cdr_ff_roles$industry_stance, useNA = "always")) # 2. GEOGRAPHIC/ECONOMIC DEPENDENCE ANALYSIS cat("\n\n2. GEOGRAPHIC ANALYSIS:\n") # Rural vs urban differences rural_analysis <- cdr_ff_roles %>% group_by(LocType) %>% summarise( n = n(), experience_support = mean(as.numeric(FossilFuelRole_Experience) > 2, na.rm = TRUE), untrustworthy_support = mean(as.numeric(FossilFuelRole_Untrustworthy) > 2, na.rm = TRUE), .groups = 'drop' ) print(rural_analysis) # Fossil fuel capacity effects cdr_ff_roles <- cdr_ff_roles %>% mutate(ff_dependent = ifelse(ff_cap_sum > 0, "FF Dependent", "No FF")) ff_analysis <- cdr_ff_roles %>% group_by(ff_dependent) %>% summarise( n = n(), experience_support = mean(as.numeric(FossilFuelRole_Experience) > 2, na.rm = TRUE), provide_energy_support = mean(as.numeric(FossilFuelRole_ProvideEnergy) > 2, na.rm = TRUE), nationalization_support = mean(as.numeric(FossilFuelRole_Nationalization) > 2, na.rm = TRUE), .groups = 'drop' ) print(ff_analysis) # 3. CLIMATE CONCERN × PARTISANSHIP INTERACTIONS cat("\n\n3. CLIMATE CONCERN × PARTISANSHIP INTERACTIONS:\n") # Create high/low climate concern groups cdr_ff_roles <- cdr_ff_roles %>% mutate(climate_concern_level = case_when( ClimateChange_num >= 3 ~ "High Concern", ClimateChange_num <= 1 ~ "Low Concern", TRUE ~ "Moderate Concern" )) # Cross-tabs by party and climate concern climate_party_analysis <- cdr_ff_roles %>% filter(!is.na(party3) & !is.na(climate_concern_level)) %>% group_by(party3, climate_concern_level) %>% summarise( n = n(), experience_support = mean(as.numeric(FossilFuelRole_Experience) > 2, na.rm = TRUE), untrustworthy_support = mean(as.numeric(FossilFuelRole_Untrustworthy) > 2, na.rm = TRUE), nationalization_support = mean(as.numeric(FossilFuelRole_Nationalization) > 2, na.rm = TRUE), .groups = 'drop' ) print(climate_party_analysis) # Test interaction models experience_interaction <- polr(FossilFuelRole_Experience ~ party3 * ClimateChange_num + Age + Gender + education3 + Income_num + Race + LocType + ff_cap_sum, data = cdr_ff_roles, weights = dfp_weight_adults, Hess = TRUE) cat("\nExperience Model with Party × Climate Interaction:\n") tab_model(experience_interaction, title = "H4: Experience with Interaction") # 4. AGE COHORT EFFECTS cat("\n\n4. AGE COHORT ANALYSIS:\n") # Create age cohorts cdr_ff_roles <- cdr_ff_roles %>% mutate(age_cohort = case_when( Age < 35 ~ "Young (18-34)", Age < 50 ~ "Middle-aged (35-49)", Age < 65 ~ "Older (50-64)", TRUE ~ "Senior (65+)" )) age_analysis <- cdr_ff_roles %>% group_by(age_cohort) %>% summarise( n = n(), experience_support = mean(as.numeric(FossilFuelRole_Experience) > 2, na.rm = TRUE), untrustworthy_support = mean(as.numeric(FossilFuelRole_Untrustworthy) > 2, na.rm = TRUE), provide_energy_support = mean(as.numeric(FossilFuelRole_ProvideEnergy) > 2, na.rm = TRUE), nationalization_support = mean(as.numeric(FossilFuelRole_Nationalization) > 2, na.rm = TRUE), .groups = 'drop' ) print(age_analysis) # 5. EDUCATION × INCOME INTERACTIONS cat("\n\n5. EDUCATION × INCOME ANALYSIS:\n") # Create socioeconomic status groups cdr_ff_roles <- cdr_ff_roles %>% mutate( high_ses = ifelse(education3 %in% c("College", "Post-college degree") & Income_num >= 4, "High SES", "Other"), low_ses = ifelse(education3 == "High school or less" & Income_num <= 2, "Low SES", "Other") ) ses_analysis <- cdr_ff_roles %>% filter(high_ses == "High SES" | low_ses == "Low SES") %>% mutate(ses_group = ifelse(high_ses == "High SES", "High SES", "Low SES")) %>% group_by(ses_group) %>% summarise( n = n(), experience_support = mean(as.numeric(FossilFuelRole_Experience) > 2, na.rm = TRUE), untrustworthy_support = mean(as.numeric(FossilFuelRole_Untrustworthy) > 2, na.rm = TRUE), nationalization_support = mean(as.numeric(FossilFuelRole_Nationalization) > 2, na.rm = TRUE), .groups = 'drop' ) print(ses_analysis) # Test for significant partisan differences (supporting "divided opinion") h4_contrasts <- list() for(role_type in ff_role_types) { h4_emmeans <- emmeans(h4_models[[role_type]]$full, ~ party3) h4_contrasts[[role_type]] <- pairs(h4_emmeans) cat(sprintf("\nH4 %s Partisan Contrasts:\n", role_type)) print(summary(h4_contrasts[[role_type]])) } # ============================================================================ # COMPREHENSIVE MODEL COMPARISON AND SUMMARY # ============================================================================ cat("\n\n===============================================\n") cat("MODEL COMPARISON AND SUMMARY\n") cat("===============================================\n") # Function to extract model fit statistics extract_model_fits <- function(models_list, hypothesis_name) { fits <- data.frame( Hypothesis = hypothesis_name, Model = names(models_list), AIC = sapply(models_list, AIC), stringsAsFactors = FALSE ) # Add pseudo R-squared for ordinal models if(class(models_list[[1]])[1] == "polr") { fits$McFadden_R2 <- sapply(models_list, function(m) 1 - (m$deviance / m$null.deviance)) } return(fits) } # Compile model fit statistics all_model_fits <- rbind( extract_model_fits(h1a_models, "H1a_Partisan"), extract_model_fits(h1b_models, "H1b_Sector"), extract_model_fits(h2_ff_models, "H2_FF_Moral_Hazard"), extract_model_fits(h2_ren_models, "H2_Ren_Moral_Hazard"), extract_model_fits(h3_engagement_models, "H3_Engagement") ) cat("Model Fit Comparison:\n") print(all_model_fits) # ============================================================================ # HYPOTHESIS TESTING SUMMARY # ============================================================================ cat("\n\n===============================================\n") cat("HYPOTHESIS TESTING SUMMARY\n") cat("===============================================\n") # Create systematic hypothesis test results hypothesis_results <- list() # H1a: Republican in-party effect rep_contrast_result <- summary(h1a_contrasts) %>% filter(party3 == "Republican", grepl("Republican.*Bipartisan", contrast)) hypothesis_results$H1a <- list( hypothesis = "Republican messengers increase support among Republicans", supported = ifelse(nrow(rep_contrast_result) > 0, rep_contrast_result$p.value[1] < 0.05, FALSE), evidence = "Interaction term and planned contrasts" ) # H1b: NGO positive, FF negative effects ngο_contrast <- summary(h1b_contrasts) %>% filter(grepl("Environmental.*Community", contrast)) ff_contrast <- summary(h1b_contrasts) %>% filter(grepl("Fossil.*Community", contrast)) hypothesis_results$H1b <- list( hypothesis = "NGO endorsements increase support, FF endorsements decrease support", supported = (nrow(ngο_contrast) > 0 && ngο_contrast$estimate[1] > 0) && (nrow(ff_contrast) > 0 && ff_contrast$estimate[1] < 0), evidence = "Planned contrasts against community leader baseline" ) # H2: Little recognition of moral hazard hypothesis_results$H2 <- list( hypothesis = "Little recognition of moral hazard effects", supported = all(sapply(h2_tests, function(x) abs(x$estimate) < 0.5)), evidence = "One-sample t-tests against neutral point" ) # H3: Strong community engagement preferences engagement_high_pref <- mean(as.numeric(cdr$CommunityEngagement_ord) > 2, na.rm = TRUE) ownership_public_pref <- mean(cdr_own$publicly_owned_pref, na.rm = TRUE) hypothesis_results$H3 <- list( hypothesis = "Strong preferences for community engagement and public ownership", supported = engagement_high_pref > 0.5 && ownership_public_pref > 0.5, evidence = "Descriptive statistics and model coefficients" ) # H4: Divided opinion on fossil fuel industry hypothesis_results$H4 <- list( hypothesis = "Divided opinion on fossil fuel industry role", supported = mean(h4_descriptives$variance) > 1, evidence = "High variance and partisan differences in role perceptions" ) # Print hypothesis testing summary cat("FINAL HYPOTHESIS TESTING RESULTS:\n") cat("==================================\n") for(h in names(hypothesis_results)) { result <- hypothesis_results[[h]] cat(sprintf("%s: %s\n", h, result$hypothesis)) cat(sprintf(" Supported: %s\n", result$supported)) cat(sprintf(" Evidence: %s\n\n", result$evidence)) } cat("Analysis completed. All models use theory-driven approach with systematic hypothesis testing.\n")