Comparing intraclass correlations for Schwarz values across European countriesICC for the First Graph = p = ICC for the Second Graph = p = Changes in intraclass correlations between 2012-2014ICC for 2012: p = ICC for 2014: p = The purpose of this app is to provide an interactive and educational way of understanding the intraclass correlation coefficient (ICC), as well as show the limitations of traditional null hypothesis testing and p values. The European Social Survey (ESS) The app uses real data taken from The European Social Survey (ESS), a cross-national survey carried out by The European Science Foundation. The ESS measures attitudes, beliefs, and behavior patterns of a diverse European population. Our app uses data from rounds six (2012) and seven (2014) of the ESS. We chose to focus on questions about moral beliefs, so for each country we have data for their scores on the 10 Schwarz values. Schwartz's model of universal human values Schwartz's theory identifies 10 distinct moral values that are thought to be recognised across all cultures. Intraclass correlation coefficient (ICC) People from different countries will have different moral values, but so will people within the same country. There will be Between-country variance and within-country variance. The intraclass correlation coefficient, or ICC tells us the proportion of the total variance that is between-groups rather than within-groups (where the groups in our data are countries). An ICC around 0 indicates that most of the variance in the data is within-countries, but a ICC closer to 1 indicates that most of the variance is between countries. It's a similar concept to the F ratio used in an ANOVA. A common use of the ICC is quantifying how much siblings resemble each other for a given trait, by comparing the variation within a family to variance between families (siblings might be appear different, but when compared to members of the general population may actually be quite similar). How to use this app In tab 1, use the drop-down boxes to compare any 2 of the 10 Schwartz to compare. The app will generate some a boxplot for each country that has been ticked, along with their ICC and a P value teling you if it is statisticall significant. Notice how the data for each measure differs, and how it affects the ICC for that measure. Which variables vary most between countries, and which vary mostly within country? Does changing the number of countries affect the ICC value in a systematic way? In tab 2, you choose 1 schwartz value and see how countries have changed in their views of how important that value is between 2012 and 2014. an increase in ICC might indicate that countries shared more views in 2012 than they did in 2014, or that the beliefs of citizens of the same countries become more similar over time. In both tabs You may notice that due to the very large sample size, if you tick enough countries even the smallest ICC will be judged as significant! (p <0.05 ), meaning that statistical significance doesn't always mean the effect is big enough to have any use.
|
#============ Libraries ========================================================================
library(tidyr)
library(lme4)
library(dplyr)
library(ggplot2)
library(shiny)
#================= Prepare the Data =============================================
# load("ESS7_clean.rda") # if you only have raw ESS data, you must first run the separate scripts "2012_data_set.R" and "2012_data_set.R" to create these RDA files.
# load("ESS6_clean.rda")
load("ESS.rda")
data.final_2014 = ungroup(data_2014) %>% group_by(country) # data.final is the final data frame that will be used in the app
data.final_2012 = ungroup(data_2012) %>% group_by(country)
#============== Calculate the ICC ===============================================
# A function to calculate the ICC for the var/column of a dataframe (all countries)
ICC = function(column_name, your_data) {
Model = lmer(formula = paste0(column_name, '~ (1|country)'), data= your_data) #calculate random effect variance at the country level
vc = VarCorr(Model) # variance covariance matrix
Country_variance = as.numeric(diag(vc[["country"]])) #pull out the by-country variance
resid = attr(vc, "sc")^2 # all the other variance
Total_variance = Country_variance + resid
ICC = Country_variance/Total_variance # the ICC is the proportion of total variance that is between country
k = length(levels(your_data$country))
msr = (k*Country_variance)+resid # mean squares row
msw = resid
n = dim(your_data)[1]
F = msr/resid
# P value
p =1-pf(F, df1 = (n-1), df2 = (n*(k-1) ))
return(c(ICC,p) )
}
#========================= Plot it ==============================================
blue_plot = function(your_data, Y){
ggplot(your_data, aes_string(x = 'country', y = Y )) +
geom_boxplot(fill = "blue", colour = "blue",
alpha = 0.35, outlier.size = -1) +
theme(axis.text.x = element_text(angle = 60, hjust = 1))
# makes a boxplot of each country for a single variable Y
#outlier.size = -1 gets rid of the outlier points as they aren't useful for us
# used to have geom_jitter when it only used a sample of 100 data points but current data is too crowded
}
orange_plot = function(Y, your_data){
ggplot(your_data, aes_string(x = 'country', y = Y) ) +
geom_boxplot(fill = "orange", colour = "orange",
alpha = 0.35, outlier.size = -1) +
theme(axis.text.x = element_text(angle = 60, hjust =1) )
}
#================ UI ===========================================================
ui = fluidPage(tags$head(tags$link(rel = "stylesheet",type = "text/css", href = "bootstrap.css")),
includeScript("../../../Matomo-tquant.js"),
tabsetPanel(
tabPanel("Comparing schwartz values", fluidRow(
h3("Comparing intraclass correlations for Schwarz values
across European countries", align = "center"),
column(2,
selectInput("variable1", "Variable for Graph 1:",
c("Self Direction" = 'self_direction',
"Power" = 'power',
"Universalism" = 'universalism',
"Hedonism" = "hedonism",
"Stimulation" = 'stimulation',
"Security" = 'security',
"Achievement" = 'achievement',
"Conformity" = 'conformity',
"Tradition" = 'tradition',
"Benevolence" = 'benevolence'
)
),
selectInput("variable2",
"Variable for Graph 2:",
c("Self Direction" = 'self_direction',
"Power" = 'power',
"Universalism" = 'universalism',
"Hedonism" = "hedonism",
"Stimulation" = 'stimulation',
"Security" = 'security',
"Achievement" = 'achievement',
"Conformity" = 'conformity',
"Tradition" = 'tradition',
"Benevolence" = 'benevolence'
)
),
checkboxGroupInput("country",
choices = c("Austria" = "Austria", "Belgium" = "Belgium", "Czech Republic" = "Czech Republic",
"Denmark" = "Denmark", "Estonia" = "Estonia", "Finland" = "Finland", "France" = "France",
"Germany" = "Germany", "Ireland" = "Ireland", "Lithuania" = "Lithuania", "Netherlands" = "Netherlands",
"Norway" = "Norway", "Poland" = "Poland", "Portugal" = "Portugal", "Slovenia" = "Slovenia",
"Spain" = "Spain", "Sweden" = "Sweden", "Switzerland" = "Switzerland", "United Kingdom" = "United Kingdom"),
label = "Country",
selected = c("Austria","Belgium", "Czech Republic", "Denmark"))
),
column(7, plotOutput("plot1", height = '300px'),
plotOutput("plot2", height = "300px")),
column(2, p("ICC for the First Graph = "),
textOutput("ICC1"),
br(),(" p = "),
textOutput("P1"),
br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),br(),br(),
("ICC for the Second Graph = "),
textOutput("ICC2"),
br(),(" p = "),
textOutput("P2")
)
)),
tabPanel("Change over time", fluidRow(
h3("Changes in intraclass correlations between 2012-2014", align = "center"),
column(2,
selectInput("variable3", "Schwarz Value:",
c("Self Direction" = 'self_direction',
"Power" = 'power',
"Universalism" = 'universalism',
"Hedonism" = "hedonism",
"Stimulation" = 'stimulation',
"Security" = 'security',
"Achievement" = 'achievement',
"Conformity" = 'conformity',
"Tradition" = 'tradition',
"Benevolence" = 'benevolence'
)
),
checkboxGroupInput("country2",
choices = c("Belgium" = "Belgium", "Czech Republic" = "Czech Republic",
"Denmark" = "Denmark", "Estonia" = "Estonia", "Finland" = "Finland", "France" = "France",
"Germany" = "Germany", "Ireland" = "Ireland", "Lithuania" = "Lithuania", "Netherlands" = "Netherlands",
"Norway" = "Norway", "Poland" = "Poland", "Portugal" = "Portugal", "Slovenia" = "Slovenia",
"Spain" = "Spain", "Sweden" = "Sweden", "Switzerland" = "Switzerland", "United Kingdom" = "United Kingdom"),
label = "Country",
selected = c("Belgium", "Czech Republic", "Denmark","Estonia" = "Estonia"))
),
column(7, plotOutput("plot3", height = '300px'),
plotOutput("plot4", height = "300px")),
column(2, p("ICC for 2012: "),
textOutput("ICC3"),
br(),(" p = "),
textOutput("P3"),
br(), br(), br(), br(), br(), br(), br(), br(), br(), br(),br(),br(),
("ICC for 2014:"),
textOutput("ICC4"),
br(), (" p = "),
textOutput("P4")
)
)),
tabPanel("Information", HTML("
<br>
The purpose of this app is to provide an interactive and educational way of understanding the intraclass correlation
coefficient (ICC), as well as show the limitations of traditional null hypothesis testing and p values.
<br><br>
<b>The European Social Survey (ESS)</b><br>
The app uses real data taken from The European Social Survey (ESS),
a cross-national survey carried out by The European Science Foundation. The
ESS measures attitudes, beliefs, and behavior patterns of a diverse European
population.<br>
Our app uses data from rounds six (2012) and seven (2014) of the ESS. We chose to focus on questions about
moral beliefs, so for each country we have data for their scores on the 10 Schwarz values.<br><br>
<b>Schwartz's model of universal human values</b><br>
Schwartz's theory identifies 10 distinct moral values that are thought to be recognised across all cultures.<br><br>
<b>Intraclass correlation coefficient (ICC)</b><br>
People from different countries will have different moral values, but so will people within the same country. There will be
Between-country variance and within-country variance. The intraclass correlation coefficient, or ICC tells us the proportion of the
total variance that is between-groups rather than within-groups (where the groups in our data are countries). An ICC around 0
indicates that most of the variance in the data is within-countries, but a ICC closer
to 1 indicates that most of the variance is between countries. It's a similar concept to
the F ratio used in an ANOVA. A common use of the ICC is quantifying how much siblings resemble each other for a given trait,
by comparing the variation within a family to variance between families (siblings might be appear different, but when compared
to members of the general population may actually be quite similar).<br><br>"),
imageOutput("Schwarz"),
HTML(
"<b>How to use this app</b><br>
In tab 1, use the drop-down boxes to compare any 2 of the 10 Schwartz to compare.
The app will generate some a boxplot for each country that has been ticked,
along with their ICC and a P value teling you if it is statisticall significant.
Notice how the data for each measure differs, and how it affects the ICC for that measure.
Which variables vary most between countries, and which vary mostly
within country? Does changing the number of countries affect the ICC value in a systematic way?
In tab 2, you choose 1 schwartz value and see how countries have changed in their views of how
important that value is between 2012 and 2014. an increase in ICC might indicate that countries
shared more views in 2012 than they did in 2014, or that the beliefs of citizens of the same countries
become more similar over time.
In both tabs You may notice that due to the very large sample size, if you tick enough countries even the smallest
ICC will be judged as significant! (p <0.05 ), meaning that statistical significance doesn't always mean the effect is big enough to have any use.
<br> <br>" )),
tabPanel("Meet the authors",
imageOutput("The_Authors"),
p(HTML("<br><br>The glorious app designers. Left to right:
Thomas, Sandra, Lea, Mirela, Nadine, Massimiliano.<br><br>
Thomas Richardson (Head developer), University of Glasgow<br>
Sandra Garcia Garcia, Compultense University of Madrid<br>
Lea Jakob, University of Zagreb<br>
Nadine Koch, University of Tubingen<br>
Mirela Zaneva, University of Amsterdam<br>
Massimiliano Zuccarini, University of Padua")))
))
#===================== Server ==================================================
Server = function(input, output){
#================ plots ==========================================================
output$plot1 = renderPlot({ #First plot on first page: comparing schwarz values
data.final_plot <- data.frame()
for(j in 1:length(input$country)){
data.final_plot =
rbind(data.final_plot, as.data.frame(data.final_2014[data.final_2014$country == input$country[j],]))
}
data.final_plot = droplevels(data.final_plot)
new_Y = data.final_plot %>%
ungroup() %>%
select(country, var = input$variable1) %>%
group_by(country)
ordered = new_Y %>% summarize(medi = median(var)) %>% arrange(medi)
ordered$country = factor(ordered$country, levels = ordered$country, ordered = T)
data.final_plot$country = factor(data.final_plot$country, levels = ordered$country, ordered = T)
blue_plot(Y = input$variable1, your_data = data.final_plot)
})
output$plot2 = renderPlot({ # second plot on first page
data.final_plot <- data.frame()
for(j in 1:length(input$country)){
data.final_plot <- rbind(data.final_plot,
as.data.frame(data.final_2014[data.final_2014$country == input$country[j],]))
}
data.final_plot = droplevels(data.final_plot)
new_Y = data.final_plot %>%
ungroup() %>%
select(country, var = input$variable2) %>%
group_by(country)
ordered = new_Y %>% summarize(medi = median(var)) %>% arrange(medi)
ordered$country = factor(ordered$country, levels = ordered$country, ordered = T)
data.final_plot$country = factor(data.final_plot$country, levels = ordered$country, ordered = T)
orange_plot(Y = input$variable2, your_data = data.final_plot)
})
output$plot3 = renderPlot({ # 2012 plot
data.final_plot <- data.frame()
for(j in 1:length(input$country2)){
data.final_plot =
rbind(data.final_plot, as.data.frame(data.final_2012[data.final_2012$country == input$country2[j],]))
}
data.final_plot = droplevels(data.final_plot)
new_Y = data.final_plot %>%
ungroup() %>%
select(country, var = (input$variable3)) %>%
group_by(country)
ordered = new_Y %>% summarize(medi = median(var)) %>% arrange(medi)
ordered$country = factor(ordered$country, levels = ordered$country, ordered = T)
data.final_plot$country = factor(data.final_plot$country, levels = ordered$country, ordered = T)
blue_plot(Y = input$variable3, your_data = data.final_plot)
})
output$plot4 = renderPlot({ # 2014 plot
data.final_plot <- data.frame()
for(j in 1:length(input$country2)){
data.final_plot =
rbind(data.final_plot, as.data.frame(data.final_2014[data.final_2014$country == input$country2[j],]))
}
data.final_plot = droplevels(data.final_plot)
new_Y = data.final_plot %>%
ungroup() %>%
select(country, var = (input$variable3)) %>%
group_by(country)
ordered = new_Y %>% summarize(medi = median(var)) %>% arrange(medi)
ordered$country = factor(ordered$country, levels = ordered$country, ordered = T)
data.final_plot$country = factor(data.final_plot$country, levels = ordered$country, ordered = T)
orange_plot(Y = input$variable3, your_data = data.final_plot)
})
# ========= ICC calculators ==========================================================
output$ICC1 = renderPrint({ #ICC 1
data.final_ICC <- data.frame()
for(j in 1:length(input$country)){
data.final_ICC <- rbind(data.final_ICC,
as.data.frame(data.final_2014[data.final_2014$country == input$country[j],]))
}
data.final_ICC = droplevels(data.final_ICC)
ICC(input$variable1,data.final_ICC)[1]
})
output$P1 = renderPrint({ #ICC 1 P value
data.final_ICC <- data.frame()
for(j in 1:length(input$country)){
data.final_ICC <- rbind(data.final_ICC,
as.data.frame(data.final_2014[data.final_2014$country == input$country[j],]))
}
data.final_ICC = droplevels(data.final_ICC)
ICC(input$variable1,data.final_ICC)[2]
})
output$ICC2 = renderPrint({ # ICC 2
data.final_ICC <- data.frame()
for(j in 1:length(input$country)){
data.final_ICC <- rbind(data.final_ICC,
as.data.frame(data.final_2014[data.final_2014$country == input$country[j],]))
}
data.final_ICC = droplevels(data.final_ICC)
ICC(input$variable2,data.final_ICC)[1]
})
output$P2 = renderPrint({ # ICC P value 2
data.final_ICC <- data.frame()
for(j in 1:length(input$country)){
data.final_ICC <- rbind(data.final_ICC,
as.data.frame(data.final_2014[data.final_2014$country == input$country[j],]))
}
data.final_ICC = droplevels(data.final_ICC)
ICC(input$variable2,data.final_ICC)[2]
})
output$ICC3 = renderPrint({ # ICC 3: 2012
data.final_ICC <- data.frame()
for(j in 1:length(input$country2)){
data.final_ICC <- rbind(data.final_ICC,
as.data.frame(data.final_2012[data.final_2012$country == input$country2[j],]))
}
data.final_ICC = droplevels(data.final_ICC)
ICC(input$variable3,data.final_ICC)[1]
})
output$P3 = renderPrint({ #p value for ICC 3: 2012
data.final_ICC <- data.frame()
for(j in 1:length(input$country2)){
data.final_ICC <- rbind(data.final_ICC,
as.data.frame(data.final_2012[data.final_2012$country == input$country2[j],]))
}
data.final_ICC = droplevels(data.final_ICC)
ICC(input$variable3,data.final_ICC)[2]
})
output$ICC4 = renderPrint({ # ICC 4 : 2014
data.final_ICC <- data.frame()
for(j in 1:length(input$country2)){
data.final_ICC <- rbind(data.final_ICC,
as.data.frame(data.final_2014[data.final_2014$country == input$country2[j],]))
}
data.final_ICC = droplevels(data.final_ICC)
ICC(input$variable3,data.final_ICC)[1]
})
output$P4 = renderPrint({ #p value for ICC 4 : 2014
data.final_ICC <- data.frame()
for(j in 1:length(input$country2)){
data.final_ICC <- rbind(data.final_ICC,
as.data.frame(data.final_2014[data.final_2014$country == input$country2[j],]))
}
data.final_ICC = droplevels(data.final_ICC)
ICC(input$variable3,data.final_ICC)[2]
})
# ======== Pictures ==================================================================
output$The_Authors = renderImage({
list(
src = "www/images/authors.png",
filetype = "image/png",
alt = "The authors of this app.")},
deleteFile = F)
output$Schwarz = renderImage({
list(
src = "www/images/circle1.jpg",
filetype = "image/jpg",
alt = "Schwarz' model")},
deleteFile = F)
}
#=========== Run App ============================================================
shinyApp(ui = ui, server = Server)