290 lines
12 KiB
R
290 lines
12 KiB
R
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("<!DOCTYPE html>
|
|
<html>
|
|
<head>
|
|
<title>Reliability Analysis Results</title>
|
|
<style>
|
|
body { font-family: Arial, sans-serif; margin: 20px; }
|
|
h1 { color: #2c3e50; }
|
|
h2 { color: #34495e; border-bottom: 2px solid #3498db; padding-bottom: 5px; }
|
|
table { border-collapse: collapse; width: 100%; margin: 20px 0; }
|
|
th, td { border: 1px solid #ddd; padding: 8px; text-align: left; }
|
|
th { background-color: #3498db; color: white; }
|
|
tr:nth-child(even) { background-color: #f2f2f2; }
|
|
.summary-stats { background-color: #ecf0f1; padding: 15px; border-radius: 5px; }
|
|
</style>
|
|
</head>
|
|
<body>
|
|
<h1>Reliability Analysis Results</h1>
|
|
<p>Generated on: ", Sys.time(), "</p>
|
|
<h2>Overall Scale Statistics</h2>
|
|
<div class='summary-stats'>
|
|
<table>
|
|
<tr><th>Scale</th><th>Raw Alpha</th><th>Std Alpha</th><th>G6(SMC)</th><th>Average r</th><th>S/N</th><th>ASE</th><th>Mean</th><th>SD</th><th>Median r</th></tr>")
|
|
|
|
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("<tr><td>%s</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td></tr>",
|
|
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, "<tr><td colspan='10'>No data available</td></tr>")
|
|
}
|
|
|
|
html_content <- paste0(html_content, "</table></div>")
|
|
|
|
# Add item statistics with alpha if dropped
|
|
html_content <- paste0(html_content, "<h2>Item Statistics</h2>
|
|
<table>
|
|
<tr><th>Scale</th><th>Item</th><th>n</th><th>Raw r</th><th>Std r</th><th>r.cor</th><th>r.drop</th><th>Mean</th><th>SD</th><th>Alpha if Dropped</th></tr>")
|
|
|
|
for(i in 1:nrow(item_data)) {
|
|
row <- item_data[i,]
|
|
html_content <- paste0(html_content, sprintf("<tr><td>%s</td><td>%s</td><td>%.0f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td></tr>",
|
|
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, "</table>")
|
|
|
|
# Add ICC(2,1) results across time points
|
|
if(nrow(icc_data) > 0) {
|
|
html_content <- paste0(html_content, "<h2>ICC(2,1) Results (Temporal Stability)</h2>
|
|
<table>
|
|
<tr><th>Construct</th><th>ICC(2,1)</th><th>95% CI Lower</th><th>95% CI Upper</th><th>F Value</th><th>p Value</th></tr>")
|
|
|
|
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("<tr><td>%s</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%.4f</td><td>%s</td></tr>",
|
|
row$Construct, row$ICC_2_1, row$ICC_CI_Lower, row$ICC_CI_Upper, row$F_Value, p_display))
|
|
}
|
|
|
|
html_content <- paste0(html_content, "</table>")
|
|
}
|
|
|
|
html_content <- paste0(html_content, "
|
|
</body>
|
|
</html>")
|
|
|
|
# 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")
|
|
}
|
|
}
|
|
}
|
|
|