library(shiny) library(shinydashboard) library(shinyWidgets) library(DT) library(plotly) library(dplyr) library(stringr) library(reactable) library(htmltools) library(shinycssloaders)
stories_data <- data.frame( id = integer(), title = character(), description = character(), category = character(), author = character(), file_name = character(), file_type = character(), upload_date = as.Date(character()), transcript = character(), duration = numeric(), stringsAsFactors = FALSE )
story_categories <- c( “Success Stories”, “Community Impact”, “Volunteer Experiences”, “Program Highlights” )
ui <- dashboardPage( skin = “blue”,
# Header dashboardHeader( title = “Community Stories Platform”,
titleWidth = 300, tags\(li(
class = "dropdown",
tags\)a( href = “#”, class = “dropdown-toggle”,
data-toggle = “dropdown”, role = “button”, “Accessibility”,
tags\(span(class = "caret")
),
tags\)ul( class = “dropdown-menu”, tags\(li(
actionButton("increase_font", "Increase Font
Size",
class = "btn-link", style =
"width: 100%;")
),
tags\)li( actionButton(“decrease_font”, “Decrease Font
Size”, class = “btn-link”, style = “width: 100%;”) ), tags$li(
actionButton(“toggle_contrast”, “Toggle High Contrast”, class =
“btn-link”, style = “width: 100%;”) ) ) ) ),
# Sidebar dashboardSidebar( width = 300, sidebarMenu( id = “sidebar_menu”, menuItem(“Home”, tabName = “home”, icon = icon(“home”)), menuItem(“Upload Story”, tabName = “upload”, icon = icon(“upload”)), menuItem(“Browse Stories”, tabName = “browse”, icon = icon(“search”)), menuItem(“Analytics”, tabName = “analytics”, icon = icon(“chart-bar”)), menuItem(“Accessibility”, tabName = “accessibility”, icon = icon(“universal-access”)) ) ),
# Body dashboardBody( # Custom CSS for accessibility and styling tags\(head( tags\)style(HTML(” .main-header .navbar { background-color: #2c3e50 !important; }
.accessibility-toolbar {
position: fixed;
bottom: 20px;
right: 20px;
z-index: 1000;
background: white;
border-radius: 8px;
box-shadow: 0 2px 10px rgba(0,0,0,0.1);
padding: 10px;
}
.story-card {
border: 1px solid #ddd;
border-radius: 8px;
padding: 15px;
margin-bottom: 15px;
background: white;
box-shadow: 0 2px 5px rgba(0,0,0,0.1);
}
.story-card:hover {
box-shadow: 0 4px 15px rgba(0,0,0,0.15);
}
.category-badge {
display: inline-block;
padding: 4px 8px;
border-radius: 4px;
font-size: 12px;
font-weight: bold;
margin-right: 5px;
}
.success-stories { background-color: #e3f2fd; color: #1976d2; }
.community-impact { background-color: #e8f5e8; color: #2e7d32; }
.volunteer-experiences { background-color: #fff3e0; color: #f57c00; }
.program-highlights { background-color: #f3e5f5; color: #7b1fa2; }
.upload-area {
border: 2px dashed #ccc;
border-radius: 8px;
padding: 40px;
text-align: center;
margin-bottom: 20px;
transition: border-color 0.3s;
}
.upload-area:hover {
border-color: #2196f3;
}
.high-contrast {
background-color: #000000 !important;
color: #ffffff !important;
}
.high-contrast .box {
background-color: #333333 !important;
color: #ffffff !important;
}
.high-contrast .content-wrapper {
background-color: #000000 !important;
}
.newsletter-header {
background: linear-gradient(135deg, #667eea 0%, #764ba2 100%);
color: white;
padding: 30px;
border-radius: 8px;
margin-bottom: 20px;
}
.hero-section {
background: linear-gradient(135deg, #2196f3 0%, #4caf50 100%);
color: white;
padding: 50px 20px;
text-align: center;
border-radius: 8px;
margin-bottom: 30px;
}
.stats-box {
background: #f8f9fa;
padding: 20px;
border-radius: 8px;
text-align: center;
margin-bottom: 20px;
}
.transcript-box {
background: #f5f5f5;
padding: 15px;
border-radius: 8px;
margin-top: 10px;
border-left: 4px solid #2196f3;
}
"))
),
tabItems(
# Home Tab
tabItem(
tabName = "home",
fluidRow(
column(12,
div(class = "hero-section",
h1("Share Your Community's Stories", style = "margin-bottom: 20px;"),
p("Amplify voices, inspire change, and build stronger connections through storytelling",
style = "font-size: 18px; margin-bottom: 30px;"),
actionButton("go_to_upload", "Share Your Story",
class = "btn btn-light btn-lg",
style = "margin-right: 10px;"),
actionButton("browse_stories", "Browse Stories",
class = "btn btn-outline-light btn-lg")
)
)
),
fluidRow(
column(12,
div(class = "newsletter-header",
h2(icon("newspaper"), " Latest Community Stories"),
p(paste("Issue #42 -", format(Sys.Date(), "%B %Y")))
)
)
),
fluidRow(
column(4,
div(class = "stats-box",
h3(textOutput("total_stories"), style = "color: #2196f3; margin: 0;"),
p("Total Stories")
)
),
column(4,
div(class = "stats-box",
h3(textOutput("total_authors"), style = "color: #4caf50; margin: 0;"),
p("Contributors")
)
),
column(4,
div(class = "stats-box",
h3(textOutput("recent_uploads"), style = "color: #ff9800; margin: 0;"),
p("This Month")
)
)
),
fluidRow(
column(12,
h3("Recent Stories"),
withSpinner(uiOutput("recent_stories_cards"))
)
)
),
# Upload Tab
tabItem(
tabName = "upload",
fluidRow(
column(12,
h2(icon("upload"), " Share Your Story"),
p("Upload your audio or video story to share with the community.")
)
),
fluidRow(
column(6,
div(class = "upload-area",
icon("file-upload", style = "font-size: 48px; color: #ccc; margin-bottom: 20px;"),
h4("Drop your file here or click to browse"),
p("Supports MP3, MP4, WAV, MOV files up to 100MB"),
fileInput("story_file", NULL,
accept = c("audio/*", "video/*"),
width = "100%")
),
conditionalPanel(
condition = "output.file_uploaded",
div(class = "alert alert-success",
h5("File uploaded successfully!"),
textOutput("uploaded_file_info")
)
)
),
column(6,
wellPanel(
textInput("story_title", "Story Title*",
placeholder = "Enter a compelling title for your story"),
selectInput("story_category", "Category*",
choices = c("Select a category" = "", story_categories)),
textInput("story_author", "Author*",
placeholder = "Your name"),
textAreaInput("story_description", "Description",
placeholder = "Provide a brief description of your story...",
rows = 4),
textAreaInput("story_transcript", "Transcript (Optional)",
placeholder = "Add transcript for accessibility...",
rows = 6),
checkboxInput("has_captions", "Story has captions/subtitles", FALSE),
br(),
div(style = "text-align: center;",
actionButton("save_draft", "Save Draft",
class = "btn btn-secondary",
style = "margin-right: 10px;"),
actionButton("publish_story", "Publish Story",
class = "btn btn-primary")
)
)
)
)
),
# Browse Tab
tabItem(
tabName = "browse",
fluidRow(
column(12,
h2(icon("search"), " Browse Stories")
)
),
fluidRow(
column(4,
textInput("search_text", "Search Stories",
placeholder = "Search by title, author, or description...")
),
column(4,
selectInput("filter_category", "Filter by Category",
choices = c("All Categories" = "", story_categories))
),
column(4,
selectInput("sort_by", "Sort by",
choices = c("Date (Newest First)" = "date_desc",
"Date (Oldest First)" = "date_asc",
"Title A-Z" = "title_asc",
"Author A-Z" = "author_asc"),
selected = "date_desc")
)
),
fluidRow(
column(12,
withSpinner(uiOutput("filtered_stories"))
)
)
),
# Analytics Tab
tabItem(
tabName = "analytics",
fluidRow(
column(12,
h2(icon("chart-bar"), " Story Analytics")
)
),
fluidRow(
column(6,
h4("Stories by Category"),
withSpinner(plotlyOutput("category_chart"))
),
column(6,
h4("Upload Timeline"),
withSpinner(plotlyOutput("timeline_chart"))
)
),
fluidRow(
column(12,
h4("Story Statistics"),
withSpinner(DT::dataTableOutput("stories_table"))
)
)
),
# Accessibility Tab
tabItem(
tabName = "accessibility",
fluidRow(
column(12,
h2(icon("universal-access"), " Accessibility Features")
)
),
fluidRow(
column(6,
wellPanel(
h4("Visual Accessibility"),
sliderInput("font_size", "Font Size",
min = 12, max = 24, value = 16, step = 1),
checkboxInput("high_contrast", "High Contrast Mode", FALSE),
br(),
h4("Audio Features"),
checkboxInput("screen_reader", "Screen Reader Support", TRUE),
checkboxInput("keyboard_nav", "Keyboard Navigation", TRUE)
)
),
column(6,
wellPanel(
h4("Accessibility Guidelines"),
tags$ul(
tags$li("All images include alternative text"),
tags$li("Proper heading structure (H1, H2, H3)"),
tags$li("High contrast color combinations"),
tags$li("Keyboard navigation support"),
tags$li("Screen reader compatibility"),
tags$li("Transcript support for all audio/video content"),
tags$li("Clear focus indicators"),
tags$li("Semantic HTML structure")
),
br(),
div(class = "alert alert-info",
strong("WCAG 2.1 AA Compliance"),
p("This platform follows Web Content Accessibility Guidelines 2.1 Level AA standards.")
)
)
)
)
)
),
# Accessibility Toolbar
div(class = "accessibility-toolbar",
actionButton("acc_font_plus", "+", title = "Increase Font Size"),
actionButton("acc_font_minus", "-", title = "Decrease Font Size"),
actionButton("acc_contrast", "◐", title = "Toggle High Contrast")
)) )
server <- function(input, output, session) {
# Reactive values values <- reactiveValues( stories = stories_data, font_size = 16, high_contrast = FALSE )
# File upload handling output\(file_uploaded <- reactive({ return(!is.null(input\)story_file)) }) outputOptions(output, “file_uploaded”, suspendWhenHidden = FALSE)
output\(uploaded_file_info <- renderText({ if (!is.null(input\)story_file)) { paste(“File:”, input\(story_file\)name, “- Size:”, round(input\(story_file\)size / 1024^2, 2), “MB”) } })
# Story publication observeEvent(input\(publish_story, { if (is.null(input\)story_file) || input\(story_title == "" || input\)story_category == “” || input$story_author == ““) { showNotification(”Please fill in all required fields and upload a file.”, type = “error”) return() }
new_story <- data.frame(
id = nrow(values$stories) + 1,
title = input$story_title,
description = ifelse(input$story_description == "", "No description provided", input$story_description),
category = input$story_category,
author = input$story_author,
file_name = input$story_file$name,
file_type = ifelse(grepl("audio", input$story_file$type), "Audio", "Video"),
upload_date = Sys.Date(),
transcript = ifelse(input$story_transcript == "", "No transcript provided", input$story_transcript),
duration = round(runif(1, 60, 600), 0), # Random duration for demo
stringsAsFactors = FALSE
)
values$stories <- rbind(values$stories, new_story)
# Reset form
updateTextInput(session, "story_title", value = "")
updateSelectInput(session, "story_category", selected = "")
updateTextInput(session, "story_author", value = "")
updateTextAreaInput(session, "story_description", value = "")
updateTextAreaInput(session, "story_transcript", value = "")
updateCheckboxInput(session, "has_captions", value = FALSE)
showNotification("Story published successfully!", type = "success")})
# Draft saving observeEvent(input$save_draft, { showNotification(“Draft saved successfully!”, type = “success”) })
# Navigation observeEvent(input$go_to_upload, { updateTabItems(session, “sidebar_menu”, “upload”) })
observeEvent(input$browse_stories, { updateTabItems(session, “sidebar_menu”, “browse”) })
# Home page statistics output\(total_stories <- renderText({ nrow(values\)stories) })
output\(total_authors <- renderText({ length(unique(values\)stories$author)) })
output\(recent_uploads <- renderText({ sum(values\)stories$upload_date >= (Sys.Date() - 30)) })
# Recent stories cards output\(recent_stories_cards <- renderUI({ if (nrow(values\)stories) == 0) { return(div(class = “alert alert-info”, h4(“No stories yet!”), p(“Be the first to share your story with the community.”))) }
recent_stories <- values$stories %>%
arrange(desc(upload_date)) %>%
head(6)
story_cards <- lapply(1:nrow(recent_stories), function(i) {
story <- recent_stories[i, ]
category_class <- switch(story$category,
"Success Stories" = "success-stories",
"Community Impact" = "community-impact",
"Volunteer Experiences" = "volunteer-experiences",
"Program Highlights" = "program-highlights",
"success-stories"
)
div(class = "col-md-4",
div(class = "story-card",
h4(story$title),
span(class = paste("category-badge", category_class), story$category),
p(paste("By", story$author, "•", format(story$upload_date, "%B %d, %Y"))),
p(substr(story$description, 1, 100), if(nchar(story$description) > 100) "..." else ""),
div(class = "transcript-box",
strong("Transcript Available: "),
ifelse(story$transcript != "No transcript provided", "Yes", "No")
),
br(),
actionButton(paste0("play_", i), "Play Story", class = "btn btn-primary btn-sm")
)
)
})
div(class = "row", story_cards)})
# Filtered stories for browse page filtered_stories <- reactive({ stories <- values$stories
if (input$search_text != "") {
stories <- stories %>%
filter(
str_detect(tolower(title), tolower(input$search_text)) |
str_detect(tolower(author), tolower(input$search_text)) |
str_detect(tolower(description), tolower(input$search_text))
)
}
if (input$filter_category != "") {
stories <- stories %>%
filter(category == input$filter_category)
}
# Sort stories
stories <- switch(input$sort_by,
"date_desc" = stories %>% arrange(desc(upload_date)),
"date_asc" = stories %>% arrange(upload_date),
"title_asc" = stories %>% arrange(title),
"author_asc" = stories %>% arrange(author),
stories %>% arrange(desc(upload_date))
)
return(stories)})
output$filtered_stories <- renderUI({ stories <- filtered_stories()
if (nrow(stories) == 0) {
return(div(class = "alert alert-warning",
h4("No stories found"),
p("Try adjusting your search or filter criteria.")))
}
story_cards <- lapply(1:nrow(stories), function(i) {
story <- stories[i, ]
category_class <- switch(story$category,
"Success Stories" = "success-stories",
"Community Impact" = "community-impact",
"Volunteer Experiences" = "volunteer-experiences",
"Program Highlights" = "program-highlights",
"success-stories"
)
div(class = "col-md-6",
div(class = "story-card",
h4(story$title),
span(class = paste("category-badge", category_class), story$category),
p(paste("By", story$author, "•", format(story$upload_date, "%B %d, %Y"))),
p(story$description),
div(class = "transcript-box",
strong("Transcript: "),
substr(story$transcript, 1, 200),
if(nchar(story$transcript) > 200) "..." else ""
),
br(),
actionButton(paste0("play_filtered_", i), "Play Story", class = "btn btn-primary btn-sm"),
actionButton(paste0("download_", i), "Download", class = "btn btn-secondary btn-sm")
)
)
})
div(class = "row", story_cards)})
# Analytics charts output\(category_chart <- renderPlotly({ if (nrow(values\)stories) == 0) { return(plot_ly() %>% add_text(text = “No data available”, x = 0.5, y = 0.5) %>% layout(showlegend = FALSE, xaxis = list(showticklabels = FALSE), yaxis = list(showticklabels = FALSE))) }
category_counts <- values$stories %>%
count(category) %>%
arrange(desc(n))
plot_ly(category_counts, x = ~category, y = ~n, type = "bar",
marker = list(color = c("#2196f3", "#4caf50", "#ff9800", "#9c27b0"))) %>%
layout(title = "Stories by Category",
xaxis = list(title = "Category"),
yaxis = list(title = "Number of Stories"))})
output\(timeline_chart <- renderPlotly({ if (nrow(values\)stories) == 0) { return(plot_ly() %>% add_text(text = “No data available”, x = 0.5, y = 0.5) %>% layout(showlegend = FALSE, xaxis = list(showticklabels = FALSE), yaxis = list(showticklabels = FALSE))) }
timeline_data <- values$stories %>%
count(upload_date) %>%
arrange(upload_date)
plot_ly(timeline_data, x = ~upload_date, y = ~n, type = "scatter", mode = "lines+markers",
line = list(color = "#2196f3")) %>%
layout(title = "Upload Timeline",
xaxis = list(title = "Date"),
yaxis = list(title = "Stories Uploaded"))})
# Stories data table output\(stories_table <- DT::renderDataTable({ if (nrow(values\)stories) == 0) { return(data.frame(Message = “No stories available”)) }
display_data <- values$stories %>%
select(title, category, author, file_type, upload_date, duration) %>%
mutate(
duration = paste(duration, "seconds"),
upload_date = format(upload_date, "%Y-%m-%d")
)
DT::datatable(display_data,
options = list(pageLength = 10, scrollX = TRUE),
rownames = FALSE,
colnames = c("Title", "Category", "Author", "Type", "Upload Date", "Duration"))})
# Accessibility features observeEvent(input\(acc_font_plus, { values\)font_size <- min(values\(font_size + 2, 24) runjs(paste0("document.body.style.fontSize = '", values\)font_size, “px’;”)) })
observeEvent(input\(acc_font_minus, { values\)font_size <- max(values\(font_size - 2, 12) runjs(paste0("document.body.style.fontSize = '", values\)font_size, “px’;”)) })
observeEvent(input\(acc_contrast, { values\)high_contrast <- !values\(high_contrast if (values\)high_contrast) { runjs(“document.body.classList.add(‘high-contrast’);”) } else { runjs(“document.body.classList.remove(‘high-contrast’);”) } })
# Font size slider observeEvent(input\(font_size, { values\)font_size <- input\(font_size runjs(paste0("document.body.style.fontSize = '", input\)font_size, “px’;”)) })
# High contrast checkbox observeEvent(input\(high_contrast, { values\)high_contrast <- input\(high_contrast if (input\)high_contrast) { runjs(“document.body.classList.add(‘high-contrast’);”) } else { runjs(“document.body.classList.remove(‘high-contrast’);”) } }) }
shinyApp(ui = ui, server = server)