## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = FALSE ) ## ----setup-------------------------------------------------------------------- # library(bidux) # library(shiny) # library(bslib) # library(reactable) # library(echarts4r) ## ----data-storytelling-overview----------------------------------------------- # ui <- page_fillable( # theme = bs_theme( # version = 5, # bg = "#FFFFFF", # fg = "#333333" # ), # # Clear section headers # layout_column_wrap( # width = 12, # card( # card_header( # h2("Sales Dashboard", class = "fs-4") # ), # card_body( # p("Key sales metrics for Q2 2025") # ) # ) # ), # # Limited filters grouped by purpose # layout_column_wrap( # width = 12, # card( # card_header("Filters"), # card_body( # layout_column_wrap( # width = 1 / 3, # # Time-related filters grouped together # card( # card_body( # h5("Time Period"), # dateRangeInput( # "date_range", # NULL, # start = Sys.Date() - 90, # end = Sys.Date() # ), # checkboxInput("compare_prev", "Compare to previous period") # ) # ), # # Product-related filters grouped together # card( # card_body( # h5("Products"), # selectInput( # "category", # "Category:", # choices = c("All", "Electronics", "Clothing", "Home") # ) # ) # ), # # Region-related filters grouped together # card( # card_body( # h5("Regions"), # selectInput( # "region", # "Region:", # choices = c("All", "North", "South", "East", "West") # ) # ) # ) # ) # ) # ) # ), # # Main content with clear organization # layout_column_wrap( # width = 1 / 3, # # Key metrics with visual simplicity # value_box( # title = "Total Revenue", # value = "$1.24M", # showcase = bsicons::bs_icon("graph-up-arrow"), # theme = value_box_theme( # bg = "#f8f9fa", # fg = "#333333" # ) # ), # value_box( # title = "Orders", # value = "8,490", # showcase = bsicons::bs_icon("cart"), # theme = value_box_theme( # bg = "#f8f9fa", # fg = "#333333" # ) # ), # value_box( # title = "Avg Order Value", # value = "$146", # showcase = bsicons::bs_icon("tag"), # theme = value_box_theme( # bg = "#f8f9fa", # fg = "#333333" # ) # ) # ), # # Main charts with progressive disclosure # accordion( # accordion_panel( # "Sales Performance", # echarts4rOutput("sales_chart", height = "300px") # ), # accordion_panel( # "Category Breakdown", # echarts4rOutput("category_chart", height = "300px") # ), # accordion_panel( # "Regional Analysis", # echarts4rOutput("region_chart", height = "300px") # ) # ) # ) ## ----cognitive-load----------------------------------------------------------- # ui <- page_fillable( # theme = bs_theme( # version = 5, # bg = "#FFFFFF", # fg = "#333333" # ), # # Story Hook: Lead with a compelling insight # layout_column_wrap( # width = 12, # card( # card_header("Q2 2025 Sales Analysis"), # card_body( # layout_column_wrap( # width = 1, # # Hook: Draw attention to an interesting pattern # h3( # "Online sales exceeded in-store for the first time", # class = "text-primary fs-4" # ), # p( # paste( # "Q2 saw a historic shift in our sales channels,", # "creating both challenges and opportunities." # ) # ) # ) # ) # ) # ), # # Story Context: Provide background # layout_column_wrap( # width = 1 / 2, # card( # card_header("Sales Channel Trend"), # card_body( # # Context: Show the historical trend # echarts4rOutput("channel_trend") # ), # card_footer( # p( # paste( # "Historical context: Online sales have been steadily increasing", # "over the past 8 quarters." # ) # ) # ) # ), # # Supporting context visualization # card( # card_header("Q2 Channel Breakdown"), # card_body( # echarts4rOutput("channel_pie") # ) # ) # ), # # Story Tension: Highlight the challenge or opportunity # layout_column_wrap( # width = 12, # card( # card_header("The Challenge"), # card_body( # layout_column_wrap( # width = 1 / 2, # div( # # Tension: Highlight the problem # h4("Different Customer Behaviors by Channel"), # p( # paste( # "Online customers show distinct shopping patterns compared", # "to in-store shoppers." # ) # ), # p("Key differences:") # ), # # Supporting data for tension # echarts4rOutput("behavior_comparison") # ) # ) # ) # ), # # Story Resolution: Provide insights and next steps # layout_column_wrap( # width = 12, # card( # card_header("Recommended Actions"), # card_body( # layout_column_wrap( # width = 1 / 3, # card( # card_body( # h5("Update Digital Strategy"), # p("Adapt marketing approach to online-first customer base"), # p("Timeline: Immediate") # ) # ), # card( # card_body( # h5("Enhance Online Experience"), # p("Focus on mobile optimization and checkout flow"), # p("Timeline: Q3 2025") # ) # ), # card( # card_body( # h5("Reposition Physical Stores"), # p("Shift from transaction centers to experience hubs"), # p("Timeline: Q4 2025") # ) # ) # ) # ), # card_footer( # actionButton( # "download_report", # "Download Full Analysis", # class = "btn-primary" # ) # ) # ) # ) # ) # # # Server function for data storytelling charts: # server <- function(input, output, session) { # # Channel trend chart showing the story over time # output$channel_trend <- renderEcharts4r({ # data.frame( # quarter = paste0("Q", 1:8, " ", c(rep("2024", 4), rep("2025", 4))), # online = c(42, 45, 47, 48, 49, 52, 54, 56), # in_store = c(58, 55, 53, 52, 51, 48, 46, 44) # ) |> # e_charts(quarter) |> # e_line(online, name = "Online") |> # e_line(in_store, name = "In-store") |> # e_title("Sales Channel Distribution (%)") |> # e_x_axis(axisLabel = list(rotate = 45)) |> # e_tooltip(trigger = "axis") |> # e_mark_line( # data = list(xAxis = "Q2 2025"), # name = "Current Quarter" # ) |> # e_color(c("#3498db", "#2ecc71")) # }) # # # Channel gauge chart for current quarter # output$channel_pie <- renderEcharts4r({ # data.frame( # channel = c("Online", "In-store"), # value = c(56, 44) # ) |> # e_charts(channel) |> # e_title("Q2 2025 Sales Distribution") |> # e_gauge( # value, # startAngle = 180, # endAngle = 0, # detail = list(formatter = "{value}%"), # axisLine = list( # lineStyle = list( # color = list( # c(value / 100, "#3498db"), # c(1, "#e9e9e9") # ), # width = 30 # ) # ) # ) |> # e_tooltip() # }) # # # Behavior comparison for tension # output$behavior_comparison <- renderEcharts4r({ # data.frame( # metric = c( # "Avg Order Value", # "Items per Order", # "Return Rate", # "Repeat Purchase" # ), # online = c(120, 2.4, 12, 45), # in_store = c(150, 1.8, 5, 35) # ) |> # e_charts(metric) |> # e_bar(online, name = "Online") |> # e_bar(in_store, name = "In-store") |> # e_tooltip() |> # e_color(c("#3498db", "#2ecc71")) # }) # } ## ----anchoring-bias-overview-------------------------------------------------- # ui <- page_fillable( # theme = bs_theme( # version = 5, # bg = "#FFFFFF", # fg = "#333333" # ), # # Page title with ample space # layout_column_wrap( # width = 12, # gap = "2rem", # Add breathing room # card( # card_header( # h1( # "Customer Analytics Dashboard", # class = "fs-3 py-2" # Add vertical padding # ) # ) # ) # ), # # KPI cards with generous spacing # layout_column_wrap( # width = 1 / 3, # gap = "2rem", # Generous spacing between cards # card( # card_body( # padding = "1.5rem", # Extra padding inside cards # h3("Customers", class = "fs-4 mb-4"), # Bottom margin for breathing room # div(class = "display-5 mb-3", "12,486"), # Large text with spacing # div(class = "text-success", "↑ 8% from last month") # ) # ), # card( # card_body( # padding = "1.5rem", # h3("Retention Rate", class = "fs-4 mb-4"), # div(class = "display-5 mb-3", "86%"), # div(class = "text-success", "↑ 3% from last month") # ) # ), # card( # card_body( # padding = "1.5rem", # h3("Satisfaction", class = "fs-4 mb-4"), # div(class = "display-5 mb-3", "4.7/5"), # div(class = "text-success", "↑ 0.2 from last month") # ) # ) # ), # # Add vertical spacing # layout_column_wrap( # width = 12, # gap = "2rem", # card( # card_header( # h3("Customer Segments", class = "fs-4") # ), # card_body( # padding = "1.5rem", # Extra padding # echarts4rOutput("segments_chart", height = "300px") # ) # ) # ), # # Tabbed interface with inner spacing # layout_column_wrap( # width = 12, # gap = "2rem", # nav_panel_tabset( # nav_panel( # "Demographics", # div( # class = "py-4", # Top and bottom padding # layout_column_wrap( # width = 1 / 2, # gap = "2rem", # echarts4rOutput("age_chart", height = "300px"), # echarts4rOutput("location_chart", height = "300px") # ) # ) # ), # nav_panel( # "Behavior", # div( # class = "py-4", # layout_column_wrap( # width = 1 / 2, # gap = "2rem", # echarts4rOutput("frequency_chart", height = "300px"), # echarts4rOutput("channels_chart", height = "300px") # ) # ) # ) # ) # ), # # Data table with breathing room # layout_column_wrap( # width = 12, # gap = "2rem", # card( # card_header( # h3("Customer Details", class = "fs-4") # ), # card_body( # padding = "1.5rem", # Extra padding # reactableOutput("customers_table") # ) # ) # ), # # Add space at bottom of page # layout_column_wrap( # width = 12, # gap = "1rem", # div(class = "py-3") # Empty div for padding # ) # ) ## ----breathable-layouts------------------------------------------------------- # ui <- page_fillable( # theme = bs_theme( # version = 5 # ), # # Context explanation # layout_column_wrap( # width = 12, # card( # card_header("Sales Performance Dashboard"), # card_body( # p( # paste( # "This dashboard provides multiple reference points", # "to help avoid anchoring bias." # ) # ) # ) # ) # ), # # Multiple reference points in KPIs # layout_column_wrap( # width = 1 / 3, # card( # card_header("Revenue"), # card_body( # layout_column_wrap( # width = 1, # h3("$1.24M", class = "text-center fs-2"), # # Multiple reference points to reduce anchoring # navset_pill( # nav_panel( # "vs Target", # div( # class = "text-center mt-2", # div(class = "text-success fw-bold", "+8%"), # div(class = "text-muted small", "Target: $1.15M") # ) # ), # nav_panel( # "vs Last Year", # div( # class = "text-center mt-2", # div(class = "text-success fw-bold", "+12%"), # div(class = "text-muted small", "Last Year: $1.11M") # ) # ), # nav_panel( # "vs Industry", # div( # class = "text-center mt-2", # div(class = "text-success fw-bold", "+5%"), # div(class = "text-muted small", "Industry Avg: $1.18M") # ) # ) # ) # ) # ) # ), # # Similar pattern for other metrics # card( # card_header("Conversion Rate"), # card_body( # layout_column_wrap( # width = 1, # h3("3.2%", class = "text-center fs-2"), # # Multiple reference points # navset_pill( # nav_panel( # "vs Target", # div( # class = "text-center mt-2", # div(class = "text-success fw-bold", "+0.2%"), # div(class = "text-muted small", "Target: 3.0%") # ) # ), # nav_panel( # "vs Last Year", # div( # class = "text-center mt-2", # div(class = "text-success fw-bold", "+0.5%"), # div(class = "text-muted small", "Last Year: 2.7%") # ) # ), # nav_panel( # "vs Industry", # div( # class = "text-center mt-2", # div(class = "text-danger fw-bold", "-0.3%"), # div(class = "text-muted small", "Industry Avg: 3.5%") # ) # ) # ) # ) # ) # ), # # Third metric with multiple anchors # card( # card_header("Average Order Value"), # card_body( # layout_column_wrap( # width = 1, # h3("$148", class = "text-center fs-2"), # # Multiple reference points # navset_pill( # nav_panel( # "vs Target", # div( # class = "text-center mt-2", # div(class = "text-danger fw-bold", "-$7"), # div(class = "text-muted small", "Target: $155") # ) # ), # nav_panel( # "vs Last Year", # div( # class = "text-center mt-2", # div(class = "text-success fw-bold", "+$10"), # div(class = "text-muted small", "Last Year: $138") # ) # ), # nav_panel( # "vs Industry", # div( # class = "text-center mt-2", # div(class = "text-success fw-bold", "+$8"), # div(class = "text-muted small", "Industry Avg: $140") # ) # ) # ) # ) # ) # ) # ), # # Chart with multiple reference lines # layout_column_wrap( # width = 12, # card( # card_header("Sales Performance with Multiple References"), # card_body( # echarts4rOutput("sales_references") # ) # ) # ), # # Data table with multiple reference columns # layout_column_wrap( # width = 12, # card( # card_header("Performance Metrics with Multiple References"), # card_body( # reactableOutput("metrics_table") # ) # ) # ) # ) # # # Server logic for anchoring bias mitigation # server <- function(input, output, session) { # # Chart with multiple reference points # output$sales_references <- renderEcharts4r({ # data.frame( # month = month.name[1:6], # actual = c(980, 1020, 1150, 1240, 1310, 1280), # target = c(1000, 1050, 1100, 1150, 1200, 1250), # prev_year = c(920, 950, 990, 1110, 1160, 1200), # industry = c(990, 1040, 1090, 1130, 1170, 1210) # ) |> # e_charts(month) |> # e_line( # actual, # name = "Actual", # symbol = "circle", # symbolSize = 10 # ) |> # e_line( # target, # name = "Target", # symbol = "none", # lineStyle = list(type = "dashed") # ) |> # e_line( # prev_year, # name = "Previous Year", # symbol = "none", # lineStyle = list(type = "dotted") # ) |> # e_line( # industry, # name = "Industry Avg", # symbol = "none", # lineStyle = list(type = "dashed") # ) |> # e_title("Revenue Performance (Thousands)") |> # e_tooltip(trigger = "axis") |> # e_color(c("#3498db", "#e74c3c", "#2ecc71", "#f39c12")) # }) # # # Table with multiple reference columns # output$metrics_table <- renderReactable({ # data <- data.frame( # metric = c( # "Revenue", # "Conversion Rate", # "Avg Order Value", # "Customer Count", # "Units Sold" # ), # actual = c("$1.24M", "3.2%", "$148", "8,378", "12,420"), # target = c("$1.15M", "3.0%", "$155", "7,500", "11,500"), # vs_target = c("+8%", "+7%", "-5%", "+12%", "+8%"), # prev_year = c("$1.11M", "2.7%", "$138", "7,825", "11,830"), # vs_prev = c("+12%", "+19%", "+7%", "+7%", "+5%"), # industry = c("$1.18M", "3.5%", "$140", "8,100", "12,000"), # vs_industry = c("+5%", "-9%", "+6%", "+3%", "+4%") # ) # # # Custom cell renderer for comparisons # compare_cell <- function(value) { # if (grepl("^\\+", value)) { # div(value, style = list(color = "#2ecc71", fontWeight = "bold")) # } else if (grepl("^\\-", value)) { # div(value, style = list(color = "#e74c3c", fontWeight = "bold")) # } else { # value # } # } # # reactable( # data, # columns = list( # metric = colDef(name = "Metric"), # actual = colDef(name = "Actual"), # target = colDef(name = "Target"), # vs_target = colDef(name = "vs Target", cell = compare_cell), # prev_year = colDef(name = "Previous Year"), # vs_prev = colDef(name = "vs Prev Year", cell = compare_cell), # industry = colDef(name = "Industry Avg"), # vs_industry = colDef(name = "vs Industry", cell = compare_cell) # ), # striped = TRUE, # highlight = TRUE, # bordered = TRUE # ) # }) # } ## ----peak-end-rule------------------------------------------------------------ # ui <- page_fillable( # theme = bs_theme( # version = 5 # ), # # # Dashboard content would go here... # # # End with a strong summary and clear next steps # layout_column_wrap( # width = 12, # card( # card_header( # h2("Key Insights & Recommended Actions", class = "fs-4") # ), # card_body( # layout_column_wrap( # width = 1 / 2, # # Summary insights at the end of the dashboard # card( # card_header("Key Takeaways"), # card_body( # tags$ul( # tags$li( # span("Revenue is trending ", class = "fw-bold"), # span("8% above target", class = "text-success fw-bold"), # span( # paste( # " for the quarter, primarily driven by", # "the Electronics category." # ) # ) # ), # tags$li( # span("Customer acquisition cost has ", class = "fw-bold"), # span("decreased by 12%", class = "text-success fw-bold"), # span(" following the new digital marketing strategy.") # ), # tags$li( # span("The West region continues to ", class = "fw-bold"), # span("underperform by 5%", class = "text-danger fw-bold"), # span(" compared to other regions.") # ) # ) # ) # ), # # Clear next steps to end on a positive action-oriented note # card( # card_header("Recommended Next Steps"), # card_body( # layout_column_wrap( # width = 1, # # Button card for first recommendation # card( # card_body( # h5("Increase Electronics Inventory"), # p( # paste( # "Current inventory will only support 2 more", # "weeks of sales at current pace." # ) # ), # actionButton( # "action1", # "Order Inventory", # class = "btn-primary w-100" # ) # ) # ), # # Button card for second recommendation # card( # card_body( # h5("Expand Digital Marketing"), # p( # paste( # "Current campaigns are performing well.", # "Consider increasing budget allocation." # ) # ), # actionButton( # "action2", # "Adjust Budget", # class = "btn-primary w-100" # ) # ) # ), # # Button card for third recommendation # card( # card_body( # h5("Review West Region Strategy"), # p( # paste( # "Schedule meeting with regional team to", # "address performance gaps." # ) # ), # actionButton( # "action3", # "Schedule Meeting", # class = "btn-primary w-100" # ) # ) # ) # ) # ) # ) # ) # ), # # Final call to action # card_footer( # layout_column_wrap( # width = 1, # p("These insights are based on data through Q1."), # div( # class = "text-end", # actionButton( # "export_pdf", # "Export as PDF", # class = "btn-outline-primary me-2" # ), # actionButton( # "share_dashboard", # "Share Dashboard", # class = "btn-primary" # ) # ) # ) # ) # ) # ) # ) ## ----------------------------------------------------------------------------- # bid_concepts() |> # select(concept, category, implementation_tips) |> # head(5) ## ----------------------------------------------------------------------------- # bid_concept("Anchoring Effect") |> # select(concept, description, implementation_tips)