Party identification and ideological views across different groups.
Party identification and ideological views across different groups.
---
title: "{{< iconify ph chart-bar >}} Political Attitudes"
format: html
---
```{r, include=FALSE}
# Initialize dashboardr page configuration (CSS/JS for charts)
dashboardr:::.page_config()
```
Party identification and ideological views across different groups.
```{r setup}
#| echo: false
#| warning: false
#| message: false
#| error: false
#| results: 'hide'
# Load dashboardr (includes dplyr, highcharter as dependencies)
library(dashboardr)
# Global chunk options
knitr::opts_chunk$set(
echo = FALSE,
warning = FALSE,
message = FALSE,
error = FALSE,
fig.width = 12,
fig.height = 8,
dpi = 300
)
# Load data
data <- readRDS('dataset_2849obs.rds')
# Data summary
cat('Dataset loaded:', nrow(data), 'rows,', ncol(data), 'columns\n')
```
## Happiness by Political Ideology
```{r stackedbar-polviews-happy}
# Happiness by Political Ideology
result <- viz_stackedbar(
data = data,
title = "Happiness by Political Ideology",
x_var = "polviews",
stack_var = "happy",
subtitle = "How happiness varies across the political spectrum",
x_label = "Political Views",
y_label = "Percentage",
stack_label = "Happiness",
stacked_type = "percent",
x_order = c("extremely liberal", "liberal", "slightly liberal", "moderate, middle of the road", "slightly conservative", "conservative", "extremely conservative"),
stack_order = c("very happy", "pretty happy", "not too happy"),
color_palette = c("#27ae60", "#f39c12", "#e74c3c")
)
# Extract cross-tab data BEFORE wrapping (wrapping strips attributes)
cross_tab_data <- attr(result, 'cross_tab_data')
cross_tab_config <- attr(result, 'cross_tab_config')
cross_tab_id <- attr(result, 'cross_tab_id')
# Force container height with explicit wrapper
if (inherits(result, 'highchart')) {
result <- highcharter::hc_size(result, height = 500)
}
result <- htmltools::div(
style = 'height: 500px !important; min-height: 500px !important; width: 100%; overflow: visible;',
result
)
# Embed cross-tab data for client-side filtering
if (!is.null(cross_tab_data)) {
cross_tab_json <- jsonlite::toJSON(cross_tab_data, dataframe = 'rows')
config_json <- jsonlite::toJSON(cross_tab_config, auto_unbox = TRUE)
script_tag <- htmltools::tags$script(
htmltools::HTML(paste0(
'window.dashboardrCrossTab = window.dashboardrCrossTab || {};',
'window.dashboardrCrossTab["', cross_tab_id, '"] = {',
'data: ', cross_tab_json, ',',
'config: ', config_json,
'};'
))
)
result <- htmltools::tagList(script_tag, result)
}
result
```
## Mean Age by Ideology and Social Class
```{r heatmap-polviews-class}
# Mean Age by Ideology and Social Class
result <- viz_heatmap(
data = data,
title = "Mean Age by Ideology and Social Class",
x_var = "polviews",
y_var = "class",
value_var = "age",
subtitle = "Demographic patterns across political and class lines",
x_label = "Political Views",
y_label = "Social Class",
value_label = "Mean Age",
x_order = c("extremely liberal", "liberal", "slightly liberal", "moderate, middle of the road", "slightly conservative", "conservative", "extremely conservative"),
y_order = c("lower class", "working class", "middle class", "upper class"),
color_palette = c("#f7fbff", "#c6dbef", "#6baed6", "#2171b5", "#08306b"),
data_labels_enabled = TRUE,
tooltip_labels_format = "{point.value:.1f}"
)
# Extract cross-tab data BEFORE wrapping (wrapping strips attributes)
cross_tab_data <- attr(result, 'cross_tab_data')
cross_tab_config <- attr(result, 'cross_tab_config')
cross_tab_id <- attr(result, 'cross_tab_id')
# Force container height with explicit wrapper
if (inherits(result, 'highchart')) {
result <- highcharter::hc_size(result, height = 450)
}
result <- htmltools::div(
style = 'height: 450px !important; min-height: 450px !important; width: 100%; overflow: visible;',
result
)
# Embed cross-tab data for client-side filtering
if (!is.null(cross_tab_data)) {
cross_tab_json <- jsonlite::toJSON(cross_tab_data, dataframe = 'rows')
config_json <- jsonlite::toJSON(cross_tab_config, auto_unbox = TRUE)
script_tag <- htmltools::tags$script(
htmltools::HTML(paste0(
'window.dashboardrCrossTab = window.dashboardrCrossTab || {};',
'window.dashboardrCrossTab["', cross_tab_id, '"] = {',
'data: ', cross_tab_json, ',',
'config: ', config_json,
'};'
))
)
result <- htmltools::tagList(script_tag, result)
}
result
```
## Political Ideology by Gender
```{r bar-polviews-sex}
# Political Ideology by Gender
result <- viz_bar(
data = data,
title = "Political Ideology by Gender",
x_var = "polviews",
group_var = "sex",
subtitle = "Distribution of political views across genders",
x_label = "Political Views",
y_label = "Count",
x_order = c("extremely liberal", "liberal", "slightly liberal", "moderate, middle of the road", "slightly conservative", "conservative", "extremely conservative"),
color_palette = c("#3498db", "#e74c3c")
)
# Extract cross-tab data BEFORE wrapping (wrapping strips attributes)
cross_tab_data <- attr(result, 'cross_tab_data')
cross_tab_config <- attr(result, 'cross_tab_config')
cross_tab_id <- attr(result, 'cross_tab_id')
# Force container height with explicit wrapper
if (inherits(result, 'highchart')) {
result <- highcharter::hc_size(result, height = 400)
}
result <- htmltools::div(
style = 'height: 400px !important; min-height: 400px !important; width: 100%; overflow: visible;',
result
)
# Embed cross-tab data for client-side filtering
if (!is.null(cross_tab_data)) {
cross_tab_json <- jsonlite::toJSON(cross_tab_data, dataframe = 'rows')
config_json <- jsonlite::toJSON(cross_tab_config, auto_unbox = TRUE)
script_tag <- htmltools::tags$script(
htmltools::HTML(paste0(
'window.dashboardrCrossTab = window.dashboardrCrossTab || {};',
'window.dashboardrCrossTab["', cross_tab_id, '"] = {',
'data: ', cross_tab_json, ',',
'config: ', config_json,
'};'
))
)
result <- htmltools::tagList(script_tag, result)
}
result
```