setwd("C:/Users/irina/Documents/DND/EOHI/eohi2") options(scipen = 999) df <- read.csv("eohi2.csv") library(psych) library(dplyr) library(knitr) library(irr) # Your named variable sets (replace df with your actual dataframe name) present_pref_vars <- c("present_pref_read", "present_pref_music", "present_pref_tv", "present_pref_nap", "present_pref_travel") past_5_pref_vars <- c("past_5_pref_read", "past_5_pref_music", "past_5_pref_TV", "past_5_pref_nap", "past_5_pref_travel") past_10_pref_vars <- c("past_10_pref_read", "past_10_pref_music", "past_10_pref_TV", "past_10_pref_nap", "past_10_pref_travel") fut_5_pref_vars <- c("fut_5_pref_read", "fut_5_pref_music", "fut_5_pref_TV", "fut_5_pref_nap", "fut_5_pref_travel") fut_10_pref_vars <- c("fut_10_pref_read", "fut_10_pref_music", "fut_10_pref_TV", "fut_10_pref_nap", "fut_10_pref_travel") present_pers_vars <- c("present_pers_extravert", "present_pers_critical", "present_pers_dependable", "present_pers_anxious", "present_pers_complex") past_5_pers_vars <- c("past_5_pers_extravert", "past_5_pers_critical", "past_5_pers_dependable", "past_5_pers_anxious", "past_5_pers_complex") past_10_pers_vars <- c("past_10_pers_extravert", "past_10_pers_critical", "past_10_pers_dependable", "past_10_pers_anxious", "past_10_pers_complex") fut_5_pers_vars <- c("fut_5_pers_extravert", "fut_5_pers_critical", "fut_5_pers_dependable", "fut_5_pers_anxious", "fut_5_pers_complex") fut_10_pers_vars <- c("fut_10_pers_extravert", "fut_10_pers_critical", "fut_10_pers_dependable", "fut_10_pers_anxious", "fut_10_pers_complex") present_val_vars <- c("present_val_obey", "present_val_trad", "present_val_opinion", "present_val_performance", "present_val_justice") past_5_val_vars <- c("past_5_val_obey", "past_5_val_trad", "past_5_val_opinion", "past_5_val_performance", "past_5_val_justice") past_10_val_vars <- c("past_10_val_obey", "past_10_val_trad", "past_10_val_opinion", "past_10_val_performance", "past_10_val_justice") fut_5_val_vars <- c("fut_5_val_obey", "fut_5_val_trad", "fut_5_val_opinion", "fut_5_val_performance", "fut_5_val_justice") fut_10_val_vars <- c("fut_10_val_obey", "fut_10_val_trad", "fut_10_val_opinion", "fut_10_val_performance", "fut_10_val_justice") all_scales <- list( "Present_Preferences" = present_pref_vars, "Past5_Preferences" = past_5_pref_vars, "Past10_Preferences" = past_10_pref_vars, "Fut5_Preferences" = fut_5_pref_vars, "Fut10_Preferences" = fut_10_pref_vars, "Present_Personality" = present_pers_vars, "Past5_Personality" = past_5_pers_vars, "Past10_Personality" = past_10_pers_vars, "Fut5_Personality" = fut_5_pers_vars, "Fut10_Personality" = fut_10_pers_vars, "Present_Values" = present_val_vars, "Past5_Values" = past_5_val_vars, "Past10_Values" = past_10_val_vars, "Fut5_Values" = fut_5_val_vars, "Fut10_Values" = fut_10_val_vars ) # Reliability analysis loop alpha_results <- list() summary_data <- data.frame() item_data <- data.frame() for(scale_name in names(all_scales)) { vars <- all_scales[[scale_name]] scale_data <- df %>% select(all_of(vars)) # Only run if there is more than one column present if(ncol(scale_data) > 1) { alpha_out <- psych::alpha(scale_data, check.keys = TRUE) alpha_results[[scale_name]] <- alpha_out # Print full output for diagnostics cat("\n----------", scale_name, "----------\n") print(alpha_out$total) print(alpha_out$item.stats) print(alpha_out$alpha.drop) # Collect summary data for HTML - fix the data collection total_row <- as.data.frame(alpha_out$total) total_row$Scale <- scale_name # Debug: print what we're collecting cat("Collecting data for", scale_name, "- columns:", paste(colnames(total_row), collapse = ", "), "\n") if(nrow(summary_data) == 0) { summary_data <- total_row } else { summary_data <- rbind(summary_data, total_row) } # Collect item data for HTML item_row <- alpha_out$item.stats alpha_drop_row <- alpha_out$alpha.drop item_row$Scale <- scale_name item_row$AlphaIfDropped <- alpha_drop_row$raw_alpha item_data <- rbind(item_data, item_row) } } # Calculate ICC(2,1) across time points for each construct icc_data <- data.frame() # Define construct groups constructs <- list( "Preferences" = c("Present_Preferences", "Past5_Preferences", "Past10_Preferences", "Fut5_Preferences", "Fut10_Preferences"), "Personality" = c("Present_Personality", "Past5_Personality", "Past10_Personality", "Fut5_Personality", "Fut10_Personality"), "Values" = c("Present_Values", "Past5_Values", "Past10_Values", "Fut5_Values", "Fut10_Values") ) for(construct_name in names(constructs)) { construct_scales <- constructs[[construct_name]] # Get data for all time points of this construct construct_data <- data.frame() for(scale_name in construct_scales) { if(scale_name %in% names(all_scales)) { vars <- all_scales[[scale_name]] scale_data <- df %>% select(all_of(vars)) if(ncol(scale_data) > 1) { # Calculate mean score for this time point scale_mean <- rowMeans(scale_data, na.rm = TRUE) if(ncol(construct_data) == 0) { construct_data <- data.frame(scale_mean) colnames(construct_data)[1] <- scale_name } else { construct_data <- cbind(construct_data, scale_mean) colnames(construct_data)[ncol(construct_data)] <- scale_name } } } } # Calculate ICC(2,1) across time points if(ncol(construct_data) > 1) { tryCatch({ icc_result <- icc(construct_data, model = "twoway", type = "consistency", unit = "single") cat("ICC(2,1) for", construct_name, "across time points:", round(icc_result$value, 4), "\n") # Collect ICC data for HTML icc_row <- data.frame( Construct = construct_name, ICC_2_1 = icc_result$value, ICC_CI_Lower = icc_result$lbound, ICC_CI_Upper = icc_result$ubound, F_Value = icc_result$Fvalue, p_Value = icc_result$p.value, stringsAsFactors = FALSE ) # Debug: print actual p-value and all ICC results cat("ICC results for", construct_name, ":\n") cat(" ICC value:", icc_result$value, "\n") cat(" F value:", icc_result$Fvalue, "\n") cat(" p-value:", icc_result$p.value, "\n") cat(" p-value class:", class(icc_result$p.value), "\n") cat(" p-value length:", length(icc_result$p.value), "\n") cat(" p-value is.na:", is.na(icc_result$p.value), "\n") cat(" p-value is.null:", is.null(icc_result$p.value), "\n") cat(" p-value == 0:", icc_result$p.value == 0, "\n") cat("\n") if(nrow(icc_data) == 0) { icc_data <- icc_row } else { icc_data <- rbind(icc_data, icc_row) } }, error = function(e) { cat("ICC calculation failed for", construct_name, ":", e$message, "\n") }) } } # Debug: check summary_data cat("Final summary_data has", nrow(summary_data), "rows\n") if(nrow(summary_data) > 0) { cat("Column names:", paste(colnames(summary_data), collapse = ", "), "\n") cat("First few rows:\n") print(head(summary_data)) } else { cat("ERROR: summary_data is empty!\n") } # Create simple HTML report html_content <- paste0(" Reliability Analysis Results

Reliability Analysis Results

Generated on: ", Sys.time(), "

Overall Scale Statistics

") if(nrow(summary_data) > 0) { for(i in 1:nrow(summary_data)) { row <- summary_data[i,] # Debug: print what we're trying to access cat("Row", i, "- trying to access columns:", paste(colnames(row), collapse = ", "), "\n") cat("Raw alpha value:", row$raw_alpha, "\n") html_content <- paste0(html_content, sprintf("", row[["Scale"]], row[["raw_alpha"]], row[["std.alpha"]], row[["G6(smc)"]], row[["average_r"]], row[["S/N"]], row[["ase"]], row[["mean"]], row[["sd"]], row[["median_r"]])) } } else { cat("ERROR: No summary data to display!\n") html_content <- paste0(html_content, "") } html_content <- paste0(html_content, "
ScaleRaw AlphaStd AlphaG6(SMC)Average rS/NASEMeanSDMedian r
%s%.4f%.4f%.4f%.4f%.4f%.4f%.4f%.4f%.4f
No data available
") # Add item statistics with alpha if dropped html_content <- paste0(html_content, "

Item Statistics

") for(i in 1:nrow(item_data)) { row <- item_data[i,] html_content <- paste0(html_content, sprintf("", row$Scale, rownames(row), row$n, row$raw.r, row$std.r, row$r.cor, row$r.drop, row$mean, row$sd, row$AlphaIfDropped)) } html_content <- paste0(html_content, "
ScaleItemnRaw rStd rr.corr.dropMeanSDAlpha if Dropped
%s%s%.0f%.4f%.4f%.4f%.4f%.4f%.4f%.4f
") # Add ICC(2,1) results across time points if(nrow(icc_data) > 0) { html_content <- paste0(html_content, "

ICC(2,1) Results (Temporal Stability)

") for(i in 1:nrow(icc_data)) { row <- icc_data[i,] # Format p-value appropriately p_val <- row$p_Value # Debug: print the actual p-value cat("Debug - p-value for", row$Construct, ":", p_val, "\n") if(p_val < 1e-10) { p_display <- "< 1e-10" # For extremely small values } else if(p_val < 0.001) { p_display <- sprintf("%.2e", p_val) # Scientific notation } else { p_display <- sprintf("%.4f", p_val) # 4 decimal places } html_content <- paste0(html_content, sprintf("", row$Construct, row$ICC_2_1, row$ICC_CI_Lower, row$ICC_CI_Upper, row$F_Value, p_display)) } html_content <- paste0(html_content, "
ConstructICC(2,1)95% CI Lower95% CI UpperF Valuep Value
%s%.4f%.4f%.4f%.4f%s
") } html_content <- paste0(html_content, " ") # Write HTML file writeLines(html_content, "reliability_analysis_report.html") # Check for reversed items cat("\n=== REVERSED ITEMS CHECK ===\n") for(scale_name in names(all_scales)) { vars <- all_scales[[scale_name]] scale_data <- df %>% select(all_of(vars)) if(ncol(scale_data) > 1) { alpha_out <- alpha_results[[scale_name]] # Check if any items were reversed by looking at the keys if(!is.null(alpha_out$keys)) { keys_df <- as.data.frame(alpha_out$keys) reversed_items <- rownames(keys_df)[keys_df[,1] < 0] if(length(reversed_items) > 0) { cat(scale_name, "reversed items:", paste(reversed_items, collapse = ", "), "\n") } else { cat(scale_name, ": No items reversed\n") } } else { cat(scale_name, ": No keys available\n") } } }