Demographics

Explore how happiness, trust, and wellbeing vary across demographic groups.

Use the tabs below to examine different aspects of the data.

Happiness by Education Level
Age Distribution by Happiness Level

Age Distribution of Respondents
Age Distribution by Gender

Education Level Distribution
Mean Age by Education and Region

--- title: "{{< iconify ph users-three >}} Demographics" format: html --- ```{r, include=FALSE} # Initialize dashboardr page configuration (CSS/JS for charts) dashboardr:::.page_config() ``` Explore how happiness, trust, and wellbeing vary across demographic groups. Use the tabs below to examine different aspects of the data. ```{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') ``` ::: {.panel-tabset} ### Happiness ::: {.panel-tabset} ##### Happiness by Education Level ```{r happiness} # Happiness by Education Level result <- viz_stackedbar( data = data, title = "Happiness by Education Level", x_var = "degree", stack_var = "happy", subtitle = "How does education relate to self-reported happiness?", x_label = "Education Level", y_label = "Percentage", stack_label = "Happiness", stacked_type = "percent", x_order = c("less than high school", "high school", "associate/junior college", "bachelor's", "graduate"), 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 = 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 ``` ##### Age Distribution by Happiness Level ```{r happiness-2} # Age Distribution by Happiness Level result <- viz_boxplot( data = data, title = "Age Distribution by Happiness Level", x_var = "happy", y_var = "age", subtitle = "Are happier people younger or older?", x_label = "Happiness Level", y_label = "Age (years)", x_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 = 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 ``` ::: ### Age Distribution ::: {.panel-tabset} ##### Age Distribution of Respondents ```{r age} # Age Distribution of Respondents result <- viz_histogram( data = data, title = "Age Distribution of Respondents", x_var = "age", subtitle = "Overall age distribution in the GSS sample", x_label = "Age (years)", y_label = "Count", bins = 25, color_palette = "#3498db" ) # 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 ``` ##### Age Distribution by Gender ```{r age-2} # Age Distribution by Gender result <- viz_density( data = data, title = "Age Distribution by Gender", x_var = "age", group_var = "sex", subtitle = "Comparing age distributions between men and women", x_label = "Age (years)", 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 ``` ::: ### Education ::: {.panel-tabset} ##### Education Level Distribution ```{r education} # Education Level Distribution result <- viz_bar( data = data, title = "Education Level Distribution", x_var = "degree", subtitle = "Sample composition by highest degree attained", x_label = "Education Level", y_label = "Count", x_order = c("less than high school", "high school", "associate/junior college", "bachelor's", "graduate"), color_palette = c("#1abc9c", "#3498db", "#9b59b6", "#e74c3c", "#f39c12") ) # 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 ``` ##### Mean Age by Education and Region ```{r education-2} # Mean Age by Education and Region result <- viz_heatmap( data = data, title = "Mean Age by Education and Region", x_var = "degree", y_var = "region", value_var = "age", subtitle = "Geographic and educational patterns in respondent age", x_label = "Education Level", y_label = "Region", value_label = "Mean Age", x_order = c("less than high school", "high school", "associate/junior college", "bachelor's", "graduate"), color_palette = c("#f7fbff", "#deebf7", "#9ecae1", "#3182bd", "#08519c"), 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 = 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 ``` ::: :::