## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", eval = FALSE ) ## ----setup-------------------------------------------------------------------- # library(bidux) # library(shiny) # library(bslib) # library(dplyr) ## ----everything-dashboard-before---------------------------------------------- # # The "show everything" approach # ui_before <- navbarPage( # "User Engagement Analytics", # tabPanel( # "Overview", # fluidRow( # # 12 KPIs across the top # column(2, valueBoxOutput("dau")), # column(2, valueBoxOutput("wau")), # column(2, valueBoxOutput("mau")), # column(2, valueBoxOutput("retention")), # column(2, valueBoxOutput("churn")), # column(2, valueBoxOutput("ltv")) # ), # fluidRow( # column(2, valueBoxOutput("sessions")), # column(2, valueBoxOutput("session_duration")), # column(2, valueBoxOutput("pages_per_session")), # column(2, valueBoxOutput("bounce_rate")), # column(2, valueBoxOutput("conversion")), # column(2, valueBoxOutput("revenue")) # ), # # # Multiple complex charts # fluidRow( # column(6, plotOutput("engagement_trend", height = "400px")), # column(6, plotOutput("cohort_analysis", height = "400px")) # ), # fluidRow( # column(4, plotOutput("funnel_chart")), # column(4, plotOutput("retention_curve")), # column(4, plotOutput("ltv_distribution")) # ) # ), # tabPanel("Segments", "More detailed segmentation..."), # tabPanel("Cohorts", "Cohort analysis details..."), # tabPanel("Funnels", "Conversion funnel details..."), # tabPanel("Revenue", "Revenue analytics..."), # tabPanel("Product", "Product usage analytics...") # ) ## ----bid-everything-solution-------------------------------------------------- # # Stage 1: Interpret - Understand the real user need # interpret_result <- bid_interpret( # central_question = "How is our user engagement trending, and what needs attention?", # data_story = new_data_story( # hook = "User engagement metrics are spread across multiple systems", # context = "Leadership needs quick insights for weekly business reviews", # tension = "Current dashboards take too long to interpret", # resolution = "Provide immediate key insights with drill-down capability" # ), # user_personas = data.frame( # name = c("Sarah (Product Manager)", "Mike (Executive)"), # goals = c( # "Quickly spot concerning trends and dive deeper when needed", # "Understand overall health at a glance" # ), # pain_points = c( # "Too many metrics to process in limited meeting time", # "Gets lost in details when just needs the big picture" # ), # technical_level = c("intermediate", "basic"), # stringsAsFactors = FALSE # ) # ) # # # Stage 2: Notice - Identify the specific problem # notice_result <- bid_notice( # previous_stage = interpret_result, # problem = "Users experience information overload with 12+ simultaneous metrics", # evidence = "User interviews show 80% struggle to prioritize information, average time-to-insight is 5+ minutes" # ) # # # Stage 3: Anticipate - Consider cognitive biases # anticipate_result <- bid_anticipate( # previous_stage = notice_result, # bias_mitigations = list( # attention_bias = "Use size and color to direct focus to most important metrics first", # choice_overload = "Implement progressive disclosure - show key metrics, hide advanced analytics until requested", # anchoring = "Lead with the most important business metric to set proper context" # ) # ) # # # Stage 4: Structure - Organize for cognitive efficiency # structure_result <- bid_structure(previous_stage = anticipate_result) # # # Stage 5: Validate - Ensure actionable insights # validate_result <- bid_validate( # previous_stage = structure_result, # summary_panel = "Executive summary highlighting key trends and required actions", # collaboration = "Enable commenting and sharing of specific insights", # next_steps = c( # "Focus on the primary engagement metric trend", # "Investigate any red-flag indicators", # "Use drill-down for detailed analysis only when needed" # ) # ) ## ----everything-dashboard-after----------------------------------------------- # # The BID-informed approach: Progressive disclosure with clear hierarchy # ui_after <- page_fillable( # theme = bs_theme(version = 5), # # # Primary insight first (addresses anchoring bias) # layout_columns( # col_widths = c(8, 4), # # # Key insight panel # card( # card_header( # "📈 Engagement Health Score", # class = "bg-primary text-white" # ), # layout_columns( # value_box( # title = "Overall Score", # value = "87/100", # showcase = bs_icon("speedometer2", size = "2em"), # theme = "success", # p( # "↑ 5 points vs. last month", # style = "font-size: 0.9em; color: #666;" # ) # ), # div( # h5("Key Drivers", style = "margin-bottom: 10px;"), # tags$ul( # tags$li("DAU trending up (+12%)"), # tags$li("Retention stable (73%)"), # tags$li("⚠️ Session duration declining (-8%)") # ) # ) # ) # ), # # # Action panel # card( # card_header("🎯 Focus Areas"), # div( # tags$div( # class = "alert alert-warning", # tags$strong("Attention needed:"), # br(), # "Session duration declining. Investigate user experience." # ), # actionButton( # "investigate_sessions", # "Investigate Session Trends", # class = "btn btn-warning btn-sm" # ) # ) # ) # ), # # # Secondary metrics (progressive disclosure) # card( # card_header( # div( # style = "display: flex; justify-content: space-between; align-items: center;", # span("📊 Detailed Metrics"), # actionButton( # "toggle_details", # "Show Details", # class = "btn btn-outline-secondary btn-sm" # ) # ) # ), # # # Hidden by default, shown on demand # conditionalPanel( # condition = "input.toggle_details % 2 == 1", # layout_columns( # col_widths = c(3, 3, 3, 3), # value_box("DAU", "45.2K", icon = "people"), # value_box("Retention", "73%", icon = "arrow-clockwise"), # value_box("Sessions", "2.1M", icon = "activity"), # value_box("Revenue", "$127K", icon = "currency-dollar") # ), # # # Charts appear only when details are requested # layout_columns( # col_widths = c(6, 6), # card( # card_header("Engagement Trend"), # plotOutput("engagement_trend_focused", height = "300px") # ), # card( # card_header("Key Drivers Analysis"), # plotOutput("drivers_analysis", height = "300px") # ) # ) # ) # ) # ) ## ----data-dump-before--------------------------------------------------------- # ui_sales_before <- fluidPage( # titlePanel("Q4 Sales Performance Dashboard"), # # # Massive filter section # sidebarLayout( # sidebarPanel( # dateRangeInput("date_range", "Date Range"), # selectInput("region", "Region", choices = regions, multiple = TRUE), # selectInput( # "product", # "Product Line", # choices = products, # multiple = TRUE # ), # selectInput("salesperson", "Sales Rep", choices = reps, multiple = TRUE), # selectInput( # "customer_segment", # "Customer Segment", # choices = segments, # multiple = TRUE # ), # selectInput( # "deal_size", # "Deal Size", # choices = deal_sizes, # multiple = TRUE # ), # checkboxGroupInput("deal_stage", "Deal Stages", choices = stages), # numericInput("min_value", "Minimum Deal Value", value = 0), # numericInput("max_value", "Maximum Deal Value", value = 1000000), # radioButtons("currency", "Currency", choices = c("USD", "EUR", "GBP")), # actionButton("apply_filters", "Apply Filters", class = "btn-primary") # ), # mainPanel( # tabsetPanel( # tabPanel( # "Summary", # fluidRow( # column(3, valueBoxOutput("total_revenue")), # column(3, valueBoxOutput("deal_count")), # column(3, valueBoxOutput("avg_deal_size")), # column(3, valueBoxOutput("win_rate")) # ), # plotOutput("revenue_chart", height = "600px") # ), # tabPanel("By Region", dataTableOutput("region_table")), # tabPanel("By Product", dataTableOutput("product_table")), # tabPanel("By Rep", dataTableOutput("rep_table")), # tabPanel("Pipeline", dataTableOutput("pipeline_table")), # tabPanel("Forecasting", plotOutput("forecast_chart")) # ) # ) # ) # ) ## ----sales-bid-solution------------------------------------------------------- # # Apply BID framework focusing on sales manager workflow # sales_interpret <- bid_interpret( # central_question = "What deals need my attention this week?", # data_story = new_data_story( # hook = "Sales managers spend 2+ hours weekly creating status reports", # context = "They need to quickly identify at-risk deals and top opportunities", # tension = "Current data requires extensive filtering and analysis", # resolution = "Provide intelligent prioritization with drill-down capability" # ), # user_personas = data.frame( # name = "Jennifer (Regional Sales Manager)", # goals = "Identify at-risk deals, spot top opportunities, prepare for team meetings", # pain_points = "Too much filtering required to find actionable insights", # technical_level = "intermediate", # stringsAsFactors = FALSE # ) # ) # # sales_notice <- bid_notice( # previous_stage = sales_interpret, # problem = "Sales managers overwhelmed by filter complexity and data volume", # evidence = "Users spend average 15 minutes per session just setting up filters, 40% abandon before getting insights" # ) # # sales_anticipate <- bid_anticipate( # previous_stage = sales_notice, # bias_mitigations = list( # recency_bias = "Show deals by urgency, not just recent activity", # confirmation_bias = "Highlight both positive and concerning trends", # choice_overload = "Limit initial choices to most common use cases" # ) # ) # # sales_structure <- bid_structure(previous_stage = sales_anticipate) ## ----sales-dashboard-after---------------------------------------------------- # ui_sales_after <- page_navbar( # title = "Sales Command Center", # theme = bs_theme(version = 5, preset = "bootstrap"), # nav_panel( # "🚨 Needs Attention", # layout_columns( # # Immediate action items # card( # card_header( # "🔥 Urgent - Deals at Risk", # class = "bg-danger text-white" # ), # card_body( # p("3 deals worth $340K need immediate attention"), # layout_columns( # col_widths = c(6, 6), # div( # h6("MegaCorp Deal - $180K"), # p( # "❌ No activity in 14 days", # style = "color: #dc3545; margin: 0;" # ), # p("Owner: Mike Chen", style = "font-size: 0.9em; color: #666;") # ), # div( # actionButton( # "view_megacorp", # "View Details", # class = "btn btn-sm btn-outline-danger" # ), # actionButton( # "contact_mike", # "Contact Mike", # class = "btn btn-sm btn-danger" # ) # ) # ) # ) # ), # # # Opportunities # card( # card_header("⭐ Hot Opportunities", class = "bg-success text-white"), # card_body( # p("2 deals worth $280K ready to close"), # actionButton( # "view_opportunities", # "Review Opportunities", # class = "btn btn-success btn-sm" # ) # ) # ) # ), # # # Smart filters (only show when needed) # conditionalPanel( # condition = "input.show_filters", # card( # card_header("🔍 Refine Focus"), # layout_columns( # col_widths = c(3, 3, 3, 3), # selectInput("quick_region", "Region", choices = c("All", regions)), # selectInput( # "quick_timeframe", # "Timeframe", # choices = c("This Week", "This Month", "This Quarter") # ), # selectInput( # "quick_value", # "Deal Size", # choices = c("All", ">$50K", ">$100K", ">$250K") # ), # actionButton( # "show_all_filters", # "More Filters...", # class = "btn btn-outline-secondary btn-sm" # ) # ) # ) # ) # ), # nav_panel( # "📊 Performance", # layout_columns( # col_widths = c(4, 4, 4), # value_box( # "This Month", # "$1.2M", # "vs. $980K target (+22%)", # showcase = bs_icon("graph-up"), # theme = "success" # ), # value_box( # "Pipeline Health", # "Strong", # "3.2x coverage ratio", # showcase = bs_icon("speedometer2"), # theme = "info" # ), # value_box( # "Team Status", # "On Track", # "8 of 10 reps hitting quota", # showcase = bs_icon("people"), # theme = "success" # ) # ), # card( # card_header("📈 Key Trends"), # plotOutput("performance_trends", height = "400px") # ) # ), # nav_panel( # "🎯 Team Focus", # # Team-specific insights # p("Individual rep performance and coaching opportunities...") # ) # ) ## ----technical-metrics-solution----------------------------------------------- # # Interpret stage: Understand different user needs # technical_interpret <- bid_interpret( # central_question = "How is our application performing and what needs attention?", # data_story = new_data_story( # hook = "Application performance directly impacts user satisfaction and revenue", # context = "Different stakeholders need different views of system health", # tension = "Technical metrics are critical but overwhelming for non-engineers", # resolution = "Provide role-appropriate views while maintaining data integrity" # ), # user_personas = data.frame( # name = c("DevOps Engineer", "Engineering Manager", "Executive"), # goals = c( # "Identify performance bottlenecks and system issues", # "Understand overall system health and team priorities", # "Understand business impact of technical issues" # ), # pain_points = c( # "Needs detailed metrics and historical trends", # "Needs summary view but ability to drill down", # "Technical details are overwhelming" # ), # technical_level = c("expert", "advanced", "beginner"), # stringsAsFactors = FALSE # ) # ) ## ----technical-dashboard-after------------------------------------------------ # # Adaptive interface based on user role # ui_technical_after <- page_sidebar( # sidebar = sidebar( # # Role selector affects entire interface # radioButtons( # "user_role", # "View Mode:", # choices = c( # "Executive Summary" = "executive", # "Management View" = "manager", # "Technical Details" = "engineer" # ), # selected = "executive" # ) # ), # # # Executive view: Business impact focus # conditionalPanel( # condition = "input.user_role == 'executive'", # h2("🟢 System Health: Good"), # layout_columns( # col_widths = c(6, 6), # card( # card_header("Business Impact"), # value_box( # "Service Availability", # "99.8%", # "Within SLA targets", # theme = "success" # ), # value_box( # "User Experience", # "Good", # "Page loads < 2 seconds", # theme = "success" # ) # ), # card( # card_header("Action Items"), # div( # class = "alert alert-info", # "✅ No critical issues requiring immediate attention" # ), # p("Next scheduled maintenance: Friday 2am") # ) # ) # ), # # # Manager view: Balance of summary and detail # conditionalPanel( # condition = "input.user_role == 'manager'", # layout_columns( # col_widths = c(3, 3, 3, 3), # value_box("Uptime", "99.8%", theme = "success"), # value_box("Response Time", "1.2s", theme = "success"), # value_box("Error Rate", "0.02%", theme = "success"), # value_box("Throughput", "15K/min", theme = "info") # ), # card( # card_header("System Trends"), # plotOutput("system_trends", height = "300px") # ), # card( # card_header("Team Alerts"), # p("2 minor alerts resolved this week"), # actionButton("view_alerts", "View Alert History") # ) # ), # # # Engineer view: Full technical detail # conditionalPanel( # condition = "input.user_role == 'engineer'", # # Comprehensive technical metrics # tabsetPanel( # tabPanel("Performance", "Detailed performance metrics..."), # tabPanel("Infrastructure", "Server and database metrics..."), # tabPanel("Alerts", "Full alert history and configuration..."), # tabPanel("Logs", "System logs and debugging info...") # ) # ) # ) ## ----telemetry-analysis------------------------------------------------------- # # Analyze telemetry data to identify real friction points # library(bidux) # # # Example telemetry data structure (your actual data would come from shinymetrics, etc.) # telemetry_data <- data.frame( # session_id = c(rep("s1", 10), rep("s2", 8), rep("s3", 12)), # input_id = c( # "date_filter", "region_filter", "product_filter", "date_filter", # "region_filter", "date_filter", "region_filter", "date_filter", # "advanced_options", "advanced_options", # "date_filter", "export_btn", "export_btn", "export_btn", # "date_filter", "date_filter", "date_filter", "date_filter", # "date_filter", "region_filter", "date_filter", "date_filter", # "help_btn", "export_btn", "export_btn", "export_btn", # "date_filter", "date_filter", "date_filter", "date_filter" # ), # timestamp = Sys.time() + 1:30, # error_occurred = c(rep(FALSE, 8), TRUE, TRUE, rep(FALSE, 20)), # stringsAsFactors = FALSE # ) # # # Use bidux telemetry analysis # issues <- bid_telemetry( # telemetry_data, # session_col = "session_id", # input_col = "input_id", # time_col = "timestamp" # ) # # # Convert telemetry issues to Notice stage # telemetry_notices <- bid_notices(issues) # # print(telemetry_notices) ## ----telemetry-bid-solution--------------------------------------------------- # # Start with telemetry-discovered problems # interpret_telemetry <- bid_interpret( # central_question = "Why are users struggling with the date filter interface?", # data_story = new_data_story( # hook = "Telemetry reveals 60% of user interactions involve date filter adjustments", # context = "Users are repeatedly changing date filters, suggesting confusion or poor defaults", # tension = "The date filter is creating friction rather than helping users", # resolution = "Redesign date filtering with smarter defaults and clearer feedback" # ), # user_personas = data.frame( # name = "Data Analyst", # goals = "Quickly analyze trends for specific time periods", # pain_points = "Spends too much time adjusting date ranges to see relevant data", # technical_level = "intermediate", # stringsAsFactors = FALSE # ) # ) # # # Use telemetry findings in Notice stage # notice_telemetry <- bid_notice( # previous_stage = interpret_telemetry, # problem = "Users make excessive date filter adjustments (avg 8 per session)", # theory = "Choice Architecture", # evidence = paste( # "Telemetry shows 60% of interactions are date-related,", # "suggesting poor default choices and unclear time period options" # ) # ) # # # Address cognitive biases revealed by behavior # anticipate_telemetry <- bid_anticipate( # previous_stage = notice_telemetry, # bias_mitigations = list( # status_quo_bias = "Users stick with default settings - provide smarter defaults", # choice_overload = "Too many date options confuse users - offer common presets", # analysis_paralysis = "Users repeatedly adjust - provide clear visual feedback on data coverage" # ) # ) # # # Get layout and UI suggestions # structure_telemetry <- bid_structure(previous_stage = anticipate_telemetry) # # # Document validation approach # validate_telemetry <- bid_validate( # previous_stage = structure_telemetry, # summary_panel = "Redesigned date filtering with smart defaults and preset options", # collaboration = "Share telemetry insights with team; A/B test new design", # next_steps = c( # "Implement intelligent date defaults based on data recency", # "Add quick-select presets: 'Last 7 days', 'Last 30 days', 'Year to date'", # "Provide visual feedback showing data coverage for selected range", # "Monitor telemetry to validate improvements" # ) # ) ## ----telemetry-improved-ui---------------------------------------------------- # # Before: Generic date picker with no guidance # ui_date_before <- dateRangeInput( # "date_range", # "Select Date Range:", # start = "2024-01-01", # end = Sys.Date() # ) # # # After: Smart defaults + quick presets based on telemetry insights # ui_date_after <- div( # # Quick presets (addresses choice overload from telemetry) # div( # style = "margin-bottom: 10px;", # radioButtons( # "date_preset", # "Quick Select:", # choices = c( # "Last 7 days" = "7d", # "Last 30 days" = "30d", # "Year to date" = "ytd", # "Custom range" = "custom" # ), # selected = "30d", # Smart default based on most common usage # inline = TRUE # ) # ), # # # Custom date range (only shown when needed) # conditionalPanel( # condition = "input.date_preset == 'custom'", # dateRangeInput( # "date_range_custom", # NULL, # start = Sys.Date() - 30, # end = Sys.Date() # ) # ), # # # Data coverage indicator (provides feedback on selection) # uiOutput("data_coverage_info") # ) # # # Server logic for data coverage feedback # server_date_feedback <- function(input, output, session) { # output$data_coverage_info <- renderUI({ # # Calculate based on selected date range # coverage_pct <- 95 # Example: 95% of data falls in selected range # # div( # class = "alert alert-info", # style = "margin-top: 10px; padding: 8px;", # icon("info-circle"), # " This date range covers ", # strong(paste0(coverage_pct, "%")), # " of your available data" # ) # }) # } ## ----user-intent-focus-------------------------------------------------------- # # ❌ Data-structure driven # ui_wrong <- tabPanel( # "Database Tables", # tabPanel("Users Table", dataTableOutput("users")), # tabPanel("Orders Table", dataTableOutput("orders")), # tabPanel("Products Table", dataTableOutput("products")) # ) # # # ✅ User-intent driven # ui_right <- tabPanel( # "Customer Insights", # card_body( # h4("What customers need your attention?"), # # Show actionable customer insights # ) # ) ## ----progressive-disclosure--------------------------------------------------- # # ❌ Everything visible at once # ui_dense <- fluidRow( # column(2, metric1), # column(2, metric2), # column(2, metric3), # column(2, metric4), # column(2, metric5), # column(2, metric6) # ) # # # ✅ Key information first, details on demand # ui_progressive <- div( # value_box("Key Metric", "Primary value"), # actionButton("show_details", "View Supporting Metrics"), # conditionalPanel( # condition = "input.show_details", # # Additional metrics here # ) # ) ## ----context-over-numbers----------------------------------------------------- # # ❌ Raw number without meaning # valueBox("Revenue", "$127,432") # # # ✅ Number with context and meaning # value_box( # "Revenue Progress", # "$127K", # "22% above $104K target", # showcase = bs_icon("graph-up"), # theme = "success" # )