This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
title: "Income and Psychological Distress in Aussies"
output: html_document
runtime: shiny
---
```r
# Load required packages
library(shiny)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)
library(DT)##
## Attaching package: 'DT'## The following objects are masked from 'package:shiny':
##
## dataTableOutput, renderDataTablelibrary(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(tidyr)data1 <- read.csv("income.csv")
data2 <- read.csv("Distress.csv")
colnames(data1) <- c("Age_Group", "Gender", "Year", "Earners", "Median_Income", "Mean_Income")
colnames(data2) <- c("Age_Group", "Gender", "Low", "Moderate", "High", "Very_High", "High_Very_High", "Total")layout <- fluidPage(
tags$head(
tags$style(HTML("
.sidebar { min-width: 250px; max-width: 300px; }
.main-panel { overflow-y: hidden; }
.plot-container { height: 600px; padding: 0; }
.tab-content { margin-bottom: 10px; }
"))
),
titlePanel("Income and Psychological Distress in Aussies"),
sidebarLayout(
sidebarPanel(
class = "sidebar",
width = 3,
conditionalPanel(
condition = "input.tabs == 'Income Trends'",
selectInput("age_group", "Age Group:", choices = c("All", unique(data1$Age_Group)), selected = "All"),
selectInput("gender", "Gender:", choices = unique(data1$Gender)),
selectInput("year", "Year:", choices = c("All", unique(data1$Year)), selected = "All")
),
conditionalPanel(
condition = "input.tabs == 'Distress Levels(2021)'",
selectInput("age_group", "Age Group:", choices = c("All", unique(data1$Age_Group)), selected = "All"),
selectInput("gender", "Gender:", choices = unique(data1$Gender))
),
conditionalPanel(
condition = "input.tabs == 'Relationship between Income and Distress(2021 only)'",
selectInput("age_group", "Age Group:", choices = c("All", unique(data1$Age_Group)), selected = "All"),
selectInput("gender", "Gender:", choices = unique(data1$Gender))
)
),
mainPanel(
class = "main-panel",
width = 9,
tabsetPanel(
id = "tabs",
tabPanel("Income Trends",
fluidRow(
column(6, div(plotlyOutput("income_trend_plot"), class = "plot-container")),
column(6, div(plotlyOutput("age_income_plot"), class = "plot-container"))
),
fluidRow(
column(6, div(plotlyOutput("gender_income_bar"), class = "plot-container")),
column(6, DTOutput("income_table"))
)
),
tabPanel("Distress Levels(2021)",
fluidRow(column(12, div(plotlyOutput("line_trend_distress", height = "600px"), class = "plot-container")))),
tabPanel("Correlation between Income and Distress",
fluidRow(column(12, div(plotlyOutput("finalrelationvisual", height = "500px"), class = "plot-container"))))
)
)
)
)core <- function(input, output) {
incomecleaned <- reactive({
if (input$age_group == "All" & input$year == "All") {
data1 %>% filter(Gender == input$gender)
} else if (input$age_group == "All") {
data1 %>% filter(Gender == input$gender, Year == input$year)
} else if (input$year == "All") {
data1 %>% filter(Age_Group == input$age_group, Gender == input$gender)
} else {
data1 %>% filter(Age_Group == input$age_group, Gender == input$gender, Year == input$year)
}
})
output$income_trend_plot <- renderPlotly({
a <- ggplot(incomecleaned(), aes(x = Year, y = Median_Income, color = Age_Group, group = Age_Group)) +
geom_line(linewidth = 0.8) +
theme_minimal() +
labs(title = "Median Income change with Time", x = "Year", y = "Median Income ($)", color = "Age Group") +
theme(axis.text.x = element_text(angle = 45, hjust = 1), plot.margin = margin(10, 50, 10, 10))
ggplotly(a) %>% layout(margin = list(r = 100))
})
output$age_income_plot <- renderPlotly({
req(incomecleaned())
a <- ggplot(incomecleaned(), aes(x = Age_Group, y = Median_Income, group = Year, color = Year)) +
geom_line(size = 0.5) +
geom_point(size = 2) +
theme_minimal() +
labs(title = "Age Group vs. Median Income", x = "Age Group", y = "Median Income ($)", color = "Year") +
theme(plot.title = element_text(size = 16, face = "bold", hjust = 0.5), axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "top", plot.margin = margin(10, 50, 10, 10))
ggplotly(a) %>% layout(margin = list(r = 100), height = 450)
})
output$gender_income_bar <- renderPlotly({
data <- incomecleaned()
validate(need(nrow(data) > 0, "No data available for the selected filters."))
income_gender_summary <- data %>%
group_by(Year, Gender) %>%
summarize(Median_Income = mean(Median_Income, na.rm = TRUE), .groups = "drop")
a <- ggplot(income_gender_summary, aes(x = Year, y = Median_Income, fill = Gender)) +
geom_bar(stat = "identity", position = "dodge") +
theme_minimal() +
labs(title = "Gender Income comparison with Time", x = "Year", y = "Median Income ($)", fill = "Gender") +
scale_fill_manual(values = c("Females" = "#ff7f0e", "Males" = "#1f77b4", "Persons" = "#2ca02c")) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(a)
})
output$income_table <- renderDT({
datatable(incomecleaned(), options = list(pageLength = 5))
})
output$line_trend_distress <- renderPlotly({
distressedcleaned <- reactive({
if (input$gender == "All") {
data2
} else {
data2 %>% filter(Gender == input$gender)
}
})
distress_long <- distressedcleaned() %>%
pivot_longer(cols = c(Low, Moderate, High, Very_High), names_to = "Distress_Level", values_to = "Proportion") %>%
group_by(Age_Group, Distress_Level, Gender) %>%
summarize(Proportion = mean(Proportion, na.rm = TRUE), .groups = "drop")
a <- ggplot(distress_long, aes(x = Age_Group, y = Proportion)) +
geom_bar(stat = "identity", fill = "#00BFC4", position = "dodge") +
facet_wrap(~ Distress_Level, scales = "free_y") +
theme_minimal() +
labs(title = "Distress Levels Across Age Groups by Gender", x = "Age Group", y = "Proportion (%)") +
theme(strip.text = element_text(size = 14, face = "bold"), axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none")
ggplotly(a, height = 500)
})
merged_data_2021 <- reactive({
income <- incomecleaned() %>%
filter(Year == "2020-21") %>%
group_by(Age_Group, Gender) %>%
summarize(Median_Income = mean(Median_Income, na.rm = TRUE), .groups = "drop")
distress <- data2 %>%
mutate(Age_Group = case_when(
Age_Group %in% c("16-24") ~ "24 and Under",
Age_Group %in% c("25-34") ~ "25 to 34",
Age_Group %in% c("35-44") ~ "35 to 44",
Age_Group %in% c("45-54") ~ "45 to 54",
Age_Group %in% c("55-64") ~ "55 to 64",
Age_Group == "65-74" ~ "65+",
TRUE ~ NA_character_
)) %>%
filter(!is.na(Age_Group))
merged <- inner_join(income, distress, by = c("Age_Group", "Gender"))
merged
})
output$finalrelationvisual <- renderPlotly({
data <- merged_data_2021()
validate(need(nrow(data) > 0, "No data available for the selected filters."))
a <- ggplot(data, aes(x = Median_Income, y = High_Very_High, color = Gender, shape = Gender)) +
geom_point(size = 4, alpha = 0.8) +
geom_smooth(method = "lm", se = TRUE, linetype = "dotted", size = 1) +
theme_minimal() +
labs(title = "Relationship between Median Income and High/Very High Distress", x = "Median Income ($)", y = "High/Very High Distress Level (%)", color = "Gender", shape = "Gender") +
theme(plot.title = element_text(size = 16, face = "bold", hjust = 0.5), legend.position = "top", axis.text.x = element_text(angle = 45, hjust = 1))
ggplotly(a, tooltip = c("x", "y", "color"), height = 500) %>%
layout(margin = list(l = 80, b = 100))
})
}
shinyApp(ui = layout, server = core)