What Is Cognitive Engineering?

Cognitive engineering places human cognition at the center of system design. It treats attention, memory, judgment, and coordination as first-order constraints that shape everything from CI/CD pipelines to incident response procedures.

This goes well beyond traditional notions of “user experience”. Cognitive engineering recognizes that every technology exists within a distributed cognitive system composed of human minds, software, infrastructure, and teams. Performance emerges from how well these elements support one another.

When we neglect the cognitive aspects of this system, the consequences are predictable. Developers burn out. Projects fail despite technical correctness. Systems function in theory but falter in practice.

Organizations that take cognition seriously see measurable results. When Microsoft’s dev division implemented cognitive load budgeting, production incidents dropped by nearly half. When Etsy redesigned their deployment pipeline around cognitive principles, deployment frequency increased while errors fell dramatically. Supporting developer cognition and improving business outcomes turn out to be the same work.

The Science of Not Undermining Yourself

A Three-Step Starting Point

Large-scale transformation can wait. Start with these concrete practices.

The Technology We Deserve

Cognitive engineering offers a path toward building technology that amplifies human capabilities rather than demanding superhuman ones. It means designing systems that respect how minds actually work, including their strengths and their limits.

We’re at an inflection point. Systems are growing more complex. AI is entering workflows. Cognitive demands are increasing, not decreasing. We can continue treating human cognition as peripheral, or we can recognize it as the critical infrastructure it’s always been.

Introducing the Cognitive Engineering Field Guide

This post outlines what becomes possible when we design with cognition in mind. To go deeper, we’re creating the Cognitive Engineering Field Guide, a living, open-source manual for building human-aligned systems.

The guide translates decades of research into practical tools covering infrastructure design, team dynamics, measurement, and AI collaboration. It’s open science meeting open source, built as a community resource.

The first chapters launch next month, beginning with Foundations, Infrastructure, Teams, and Measurement.

The Choice Is Yours

Every system embodies assumptions about whose cognition matters. Every process either supports or undermines the minds executing it.

Cloudflare and AWS didn’t plan to take down the internet. They had capable engineers, sophisticated systems, and detailed runbooks. What they lacked was systematic attention to cognitive engineering.

The research is clear. The economics are compelling. The path forward is available.

What will you build tomorrow?

The Cognitive Engineering Field Guide launches early 2026! Subscribe for updates and early access to chapters as they’re released.

Have a story about cognitive engineering in practice? I’m actively collecting case studies for the Guide and would love to hear from you! Share your experience and help build this resource together.

Your Database, Your Telemetry, Your Way

Let’s be honest: Most of our telemetry doesn’t live in neat CSV files. It lives in production databases, behind connection strings, in tables with names like user_events_v2_final_FINAL.

With v0.3.3, bid_telemetry() and bid_ingest_telemetry() now speak {DBI} fluently. Pass in your existing database connection (e.g., SQLite, PostgreSQL, MySQL, whatever you’ve got) and {bidux} will work with it directly:

library(bidux)
library(DBI)

# Your existing database connection (that you definitely already have open)
con <- dbConnect(RSQLite::SQLite(), "production.db")

# Old way: Export to file, then analyze (ugh)
# New way: Just point {bidux} at your connection
issues <- bid_telemetry(
  con,
  table_name = "shiny_events",  # auto-detection is nice, but control is nicer
  thresholds = bid_telemetry_presets("moderate")
)

# The connection stays open: {bidux} doesn't presume to manage your resources
dbDisconnect(con)  # When YOU'RE ready

This isn’t just about convenience (though it is convenient). It’s about reducing the friction between noticing a problem and fixing it. Every export-import cycle is a chance for good intentions to die in a TODO list.

Quick Suggestions for Real Humans

Sometimes you don’t need a five-stage behavioral intervention. Sometimes you just need to know: “Should this be a card layout or tabs?”

Enter bid_quick_suggest(), the function that respects your time:

# When your standup is in 10 minutes and users are confused
suggestions <- bid_quick_suggest(
  "Users can't find the export button after running analysis"
)

# Get immediate, ranked suggestions you can actually implement
print(suggestions)
# ✓ Add bslib::tooltip() to explain export availability
# ✓ Use bslib::card_header() to group export with results
# ✓ Consider shinyjs::toggleState() to enable only when ready

No stages. No ceremony. Just behavioral science applied to your specific problem, because sometimes the perfect is the enemy of the good-enough-to-ship-today.

Structure Suggestions You Can Actually Filter

The Structure stage now returns suggestions in a format that plays nicely with your existing data wrangling reflexes. Every suggestion comes as both the rich nested format and a practical tibble:

structure_result <- bid_structure(
  previous_stage = anticipate_result,
  telemetry_flags = bid_flags(issues)  # Real usage data informing suggestions
)

# Find the low-hanging fruit
quick_wins <- structure_result$suggestions_tbl |>
  filter(difficulty == "Easy", score > 0.7) |>
  select(title, components, rationale) |>
  head(3)

# Or focus on navigation issues
nav_improvements <- structure_result$suggestions_tbl |>
  filter(category == "Navigation") |>
  arrange(desc(score))

This isn’t just about making data rectangular; it’s about making insights actionable. When you can filter() and arrange() your way to the next improvement, you’re more likely to actually make it.

Better Sources, Better Science

We’ve also strengthened our theoretical foundations. The Beautiful-Is-Good Stereotype now properly cites both its social psychology origins (Dion et al., 1972) and its UX applications (Tractinsky et al., 2000). The Data Storytelling Framework references the actual visualization experts (Knaflic, 2015; Dykes, 2020).

These become useful breadcrumbs for when you need to dig deeper, to defend a design decision, or to learn more about why that suggestion actually works.

Quarto Dashboards? We’ve Got You

The documentation now explicitly supports Quarto dashboard developers. While {bidux} was born in the Shiny world, most of our suggestions translate beautifully to Quarto’s static and server: shiny contexts:

• Static Quarto dashboards: Layout suggestions, component recommendations, and the full BID framework apply directly
• Interactive Quarto (with server: shiny): Everything works, including telemetry integration

Because good UX principles don’t care about your rendering engine.

A Tool That Respects Your Context

What I love about this release is how it meets people where they are. Got a database? Connect directly. Need something quick? bid_quick_suggest(). Want to integrate with your dplyr workflow? Here’s a tibble. Building in Quarto? We support that too.

This is what cognitive engineering looks like in practice: Reducing the cognitive load of reducing cognitive load. Making the right thing the easy thing.

Install and Explore

install.packages("bidux")

For the full details, including migration notes and comprehensive examples, check out the release on GitHub.

What’s Next?

Every release teaches us something about how people actually use behavioral science in production. Your telemetry databases, your quick fixes, your Quarto dashboards: They all inform where {bidux} goes next.

So please, open issues, share your workflows, tell us what friction you’re facing. Because the best tools are built in conversation with the people who use them.

Happy designing, and remember: Sometimes the best behavioral intervention is the one that ships today 🚀

The Comfort of Shared Myopia

Most groups don’t consciously suppress new information. They just drift toward what’s easy to agree on.

The bias runs deep: Sharedness feels safe. Familiar ideas reward us with microbursts of social approval. Each nod and “exactly!” strengthens the illusion that consensus equals truth.

Pluralistic ignorance amplifies this. Everyone privately doubts the shared focus, but no one wants to be the first to say so. And so, silence masquerades as agreement. Even those who do see the structural issue start calibrating their language, testing the wind before speaking up.

You’ve seen this in the workplace too. A dev team argues for hours about a UI color but defers a looming database overhaul. The visible topic feels more manageable, more social, more presentable. Under pressure to align, attention collapses to the path of least resistance.

In social systems and engineering alike, the group’s collective gaze narrows exactly when it needs to widen.

The Real Threat

Authoritarianism thrives on the suppression of dissent not just for control, but because it simplifies cognition. When loyalty replaces deliberation, systems get faster…but dumber. They trade complexity for coordination, nuance for narrative.

That same tradeoff happens in corporate culture when “alignment” becomes a euphemism for “agreement”. A perfectly aligned team can ship a perfectly flawed product. Everyone’s happy…until the structure breaks under the weight of the unspoken.

Hackman would say the fix isn’t to exhort people to “speak up”. It’s to redesign the environment so that dissent doesn’t require heroism.

Why Groups Chase the Visible Target

Let’s go back to that protest scene. Every chant, every viral post, every demand for “decisive action” is a bid for cognitive simplicity. People want to make sense of chaos. They want to see the problem, name it, and fix it.

That impulse isn’t wrong; it’s human. Collective outrage is often the first spark of accountability. The danger comes when leaders or algorithms capture that spark and aim it somewhere safer for power.

Leaders often exploit this tendency, redirecting attention to symbolic skirmishes while dismantling the systems that actually distribute power. The crowd doesn’t see the scaffolding behind the spectacle: bureaucratic hollowing, erosion of norms, loss of institutional memory. They’re staring at the storm, not the climate.

You can watch this in microcosm every day inside organizations. A leadership team zeroes in on quarterly optics while ignoring crumbling infrastructure. A product team launches a glossy feature that hides the absence of documentation.

When attention becomes performance, groups start mistaking visibility for impact.

The cure is not cynicism; it’s redesign. Make dissent cheap. Make invisible work visible. Create conditions where the most informative signal isn’t the loudest one.

Designing for Dissent

So how do we design for dissent without creating chaos?

Hackman’s decades of research give us a deceptively simple blueprint: Structure, clarity, and purpose are the enabling conditions of collective intelligence.

These are structural levers, not personality hacks. They let courage scale without burning out the people who supply it.

When the Group Turns on Itself

There’s a haunting irony in collective processes: The same cohesion that helps a group survive can make it fragile to error.

As coordination improves, the social cost of dissent rises. Eventually, good people start self-silencing, assuming someone else will say what needs saying. But they don’t. And slowly, the system forgets how to self-correct. You can see this in collapsing democracies, in failing companies, in scientific replication crises, even in open-source communities.

The details change, but the dynamic is identical: When sharedness becomes the goal, truth becomes a casualty.

Dr. Cat Hicks⁴ has described curiosity as a shared resource. Dissent is too. It’s how groups stay honest about what they know and what they don’t. But unlike curiosity, dissent doesn’t feel communal. It feels risky.

That’s why structure matters. It lowers the social tax of honesty.

Reframing What’s Worth Talking About

Imagine if our public discourse treated dissent the way high-reliability teams treat anomalies: as signals to investigate, not threats to silence. Imagine if our teams treated disagreement as a sign that the system is alive.

Protest, dissent, and debate are how we remind systems that truth is still a shared project. Because dissent, at its best, is an act of stewardship.

It’s the refusal to let collective attention decay into convenience. It’s not rebellion; it’s repair.

So the next time you’re in a meeting, a debate, or a crowd, notice what everyone’s staring at…and what no one’s mentioning. That’s often where the real work begins.

(And if you’re reading this on Halloween, consider it your annual reminder that sometimes the scariest thing in a group isn’t the conflict: It’s the silence.)

Closing Thoughts

When groups get stuck on the wrong problem, it’s rarely because they’re malicious or ignorant. It’s because sharedness feels safe, and dissent feels costly.

But every complex system, whether a government, a research team, or a startup, depends on its ability to surface unshared truths. The question isn’t whether we’ll disagree. It’s whether we’ve designed the conditions that let disagreement matter.

If democracy is a system for making collective decisions, then teams are its smallest working model. Get the micro right, and the macro starts to follow.

Every movement for justice begins as minority influence. One small group insisting the system can do better.

And maybe that’s the lesson tucked inside all this research. Collective intelligence doesn’t come from harmony. It comes from friction handled well.

Flattening the Story: Intuitive Data Stories

Crafting a BID data story in v0.3.2 is more intuitive. The new_data_story() function now uses a flat API with four straightforward arguments (hook, context, tension, resolution), instead of nesting parts of the story inside.

In other words, you can directly specify the key elements of your story without the cognitive overhead of wrapping them in variables and relationships lists. This covers about 80% of use cases with a cleaner syntax:

# Before (nested format, now deprecated)
story_old <- new_data_story(
  context = "Dashboard usage dropped",
  variables = list(hook = "User engagement declining"),
  relationships = list(resolution = "Analyze telemetry")
)

# After (flat format, v0.3.2+)
story <- new_data_story(
  hook = "User engagement declining",
  context = "Dashboard usage dropped 30%",
  tension = "Unsure if UX or user needs are causing the drop",
  resolution = "Analyze telemetry for friction points"
)

The new flat syntax is not only easier to read, it’s also future-proof. The old nested format still works for now, but will trigger a deprecation warning and is slated for removal in 0.4.0.

I recommend updating your code to the flat style soon. Your future self will thank you.

On the bright side, all other BID functions seamlessly accept the new bid_data_story objects, and printing a story now neatly lists out the hook, context, tension, and resolution for a quick overview.

Telemetry Tuning Made Easy

If you’ve been ingesting telemetry data to inform your designs, {bidux} v0.3.2 introduces a welcome convenience: telemetry sensitivity presets.

The new bid_telemetry_presets() function gives you pre-configured threshold sets ("strict", "moderate", "relaxed") for flagging UX issues. This means you no longer need to hand-tweak what counts as an “unused input” or a “delay” in user interactions. Just pick a preset that fits your scenario:

• Strict: Use for brand-new or mission-critical dashboards to catch even minor friction (e.g. flags inputs used by < 2% of sessions and delays over ~20 seconds).
• Moderate: The default balance for most applications, offering a good signal-to-noise ratio (e.g. flags inputs under ~5% usage, delays over ~30 seconds).
• Relaxed: For mature, stable dashboards where only major issues merit attention (e.g. flags inputs under ~10% usage, delays over ~60 seconds).

These presets let you adapt to your app’s context with one line of code. For example, a brand new internal app might start with bid_telemetry_presets("strict") to catch early pain points, whereas a long-running product dashboard might use "relaxed" to focus only on high-impact issues. Under the hood, each preset just supplies a list of threshold values to the thresholds argument of bid_telemetry(), so you retain full control if you ever need a custom tweak.

Enjoy the Silence: Quiet Mode

Do you ever feel inundated by informational messages when running BID analyses or pipelines? In v0.3.2, quiet mode is here to help.

Every BID stage function (from bid_interpret() through bid_validate()) gains a new quiet parameter. Set quiet = TRUE and those friendly yet noisy console messages will be suppressed. This can make a huge difference when running complex pipelines or rendering Shiny apps where clean logs are gold.

For example, you can wrap an entire sequence of stages in silence:

library(bidux)

# Globally turn on quiet mode for the whole workflow
bid_set_quiet(TRUE)  # new helper to set quietness across all functions

result <- bid_interpret(..., quiet = TRUE) |>
  bid_notice(..., quiet = TRUE) |>
  bid_anticipate(..., quiet = TRUE) |>
  bid_structure(..., quiet = TRUE) |>
  bid_validate(..., quiet = TRUE)

Rather not sprinkle quiet = TRUE everywhere? You can also use bid_with_quiet() to temporarily suppress messages within a block of code, or configure the default with bid_set_quiet() and bid_get_quiet() at a global level.

Now you’re in charge of the verbosity. Run noisy when debugging, then go quiet when integrating into a polished Shiny app or R Markdown report.

New S3 Helpers and Print Enhancements

To further modernize the API, v0.3.2 introduces new S3 constructors for key BID components. You can now create user personas and bias mitigation sets with dedicated functions: new_user_personas() and new_bias_mitigations(). These expect a data frame with the appropriate columns (e.g. name, goals, pain_points, etc. for personas) and return structured S3 objects.

The benefit? Type-safe, validated objects that play nicely with BID workflows. If you’ve been using raw lists for personas or biases, these helpers provide a clear migration path to a more robust format (and they’ll warn you if required fields are missing or misformatted).

Printing of BID objects also got a polish. For example, printing a bid_data_story now shows a tidy summary with each element on its own line, rather than a raw list dump. Likewise, bid_user_personas and bid_bias_mitigations objects print with a concise header (e.g. “bidux user personas (3 personas):”) followed by a tibble of the contents. This makes inspecting these objects in the console much more reader-friendly. Little quality-of-life improvements like this help you quickly verify that your inputs are set up correctly.

Under the Hood: Leaner and Cleaner

This release also trims some fat and cleans up behind the scenes to make the package more efficient:

• Reduced dependencies: We removed unused packages {purrr} and {stringr} from our imports, opting for base R solutions. This reduces installation size and the risk of version conflicts, so your projects load a bit faster and ship with fewer baggage.
• Better error messages: We’ve adopted the glue and cli packages for error handling. Now errors come with clearer context and suggestions (using cli::cli_abort() with our new standard_error_msg() helper). When something goes wrong, the feedback will be more informative and actionable than the old generic stop() messages.
• Text normalization: Various text-processing utilities in bidux have been refined to handle whitespace and special characters more gracefully. This means more reliable matching when generating suggestions or interpreting inputs, especially in edge cases.
• Code refactoring: We reorganized internal code into domain-specific modules (messaging, validation, stages, safe access). While invisible to you as a user, this modular structure makes bidux easier to maintain and test, which ultimately leads to more robust features.
• Telemetry constants: All those “magic numbers” for telemetry thresholds are now named constants at the top of the telemetry module. This cleanup makes the logic more transparent and sets the stage for easier tuning (for us and adventurous contributors).

Crucially, none of these changes break existing functionality. They either improve performance, clarity, or developer experience without altering how you call the functions. It’s all gain, no pain.

Documentation and Resources

To help you get the most out of these updates, we’ve expanded and refreshed the documentation:

• New “API Modernization” vignette: A comprehensive guide for migrating from legacy list-based usage to the new S3 classes and flat APIs. This is a great starting point if you’re upgrading from an older version and want to adopt best practices (with plenty of examples for data_story, user_personas, and bias_mitigations).
• Simplified “Advanced Workflows” vignette: We’ve updated our advanced examples to showcase these new features in action. This includes how to use telemetry presets in different contexts and how to utilize quiet mode in complex pipelines. If you’re pushing bidux to its limits (e.g. analyzing dozens of dashboards in batch), check out this vignette for patterns and tips.
• Updated “Getting Started” vignette: New users will find the getting started guide now uses the flat new_data_story() and data frame-based personas from the outset. We’ve also ensured the examples reflect the current recommended usage (no outdated list formats) and highlighted the corrected BID stage ordering that was fixed in v0.3.1.
• Function reference examples: Key functions like bid_interpret() now include examples demonstrating both the modern usage and how to handle legacy inputs. Our goal is to guide users toward the new approaches while still acknowledging the old way for those in transition.

As always, the reference documentation is available and has been updated with all new parameters (like quiet) and functions. And behind the scenes, we bolstered test coverage for all these changes, so you can upgrade with confidence.

Migration and Backward Compatibility

Upgrading to v0.3.2 should be seamless. All your code from v0.3.1 (and even v0.3.0) will continue to run, thanks to careful backward compatibility. If you do use any now-deprecated patterns, bidux will politely prod you with warnings and guidance:

• Nested data_story format: If you pass variables or relationships into new_data_story(), you’ll get a deprecation warning. The function will still return a valid story object (so your pipeline won’t break), but consider this your nudge to switch to the flat syntax before 0.4.0.
• Legacy telemetry ingestion: The old bid_ingest_telemetry() function remains available for those who haven’t migrated to the new bid_telemetry() workflow. It continues to return the hybrid list-like object as before. However, we signaled in v0.3.1 that a shift toward bid_telemetry() is the future, and that remains true. Plan to update to the tidy tibble approach when convenient.
• List-based personas and mitigations: You can still supply user personas as plain lists of lists, and bias mitigations as raw lists. Internally, bidux will convert or migrate these to the new S3 objects on the fly. You might see messages suggesting to use new_user_personas() or new_bias_mitigations() going forward, but your results will be the same. This gentle transition means you can adopt the new helpers at your own pace.

In short, no breaking changes in v0.3.2. We’ve laid the groundwork for 0.4.0 deprecations but provided a smooth on-ramp.

If you run into any issues while upgrading, please check the API Modernization vignette or reach out on the GitHub repo.

Install the Latest Release

You can install {bidux} v0.3.2 from CRAN today:

install.packages("bidux")

As a minor release after v0.3.1, this version focuses on refining your experience: Making the API more intuitive, reducing friction from extraneous output, and keeping the package lean and efficient.

The goal is to let you spend less time wrangling the tool and more time applying Behavioral Insight Design to build better Shiny apps and dashboards. We hope these improvements make your BID workflows smoother and more enjoyable.

Happy designing! 🚀

The Click: Where My Work Meets My Values

My academic work looked at group decision making as a system of information processing. That lens made me care about how evidence actually moves through a pipeline: methods, statistics, and whether the work is verifiable by someone who is not me.

Very quickly, I realized three ideas were inseparable for me: open science, open source, and open access. Not as slogans, as habits. That looks like preregistration and reproducible code, but also public issue threads, code review in daylight, and packages stewarded by a community instead of a gatekeeper. R and Posit folks treated these not as extras but as table stakes. That alignment shaped my path toward building systems that lower friction and widen access for other people.

What open science and open source share in practice (how I try to work):

• Make claims traceable: Analysis scripts, data lineage, and assumptions live with the work
• Prefer repair to perfection: Log issues, document tradeoffs, and improve in public
• Share context, not just code: Explain what a function is for and how to use it responsibly
• Design for stewardship: Make it easy for someone else to keep the lights on after you

Why I Keep Coming Back

I keep returning because the technical depth is matched by something rarer: A culture that is welcoming without theater. You can engage on your own terms. I’ve given talks at other conferences, but at posit::conf, I mostly come to learn, listen, and connect. The constant has always been folks who treat curiosity as a shared resource.

I’ve read a lot of posts about people’s posit::conf experiences over the years, and they all match exactly what I’ve felt since 2018: belonging, room to participate at your own pace, serious inspiration, hands-on collaboration, and small moments of joy that matter more because of the people you share them with.

If you know, you know. And if you don’t, I hope you join us to find out.

From Audience to Speaker

Last week, I stepped onto the posit::conf stage for the first time. Just being accepted was an honor. Every year there are more excellent proposals than slots, so a “yes” signals the committee is trusting you to carry something useful onto that stage. And I was there to share something I care deeply about: the intersection of behavioral science and tool design.

I spoke about bringing these ideas to Shiny so teams can design apps that reduce cognitive friction instead of creating it, to think about cognitive engineering as much as we do performance engineering. Think fewer “data dumps” with dozens of dropdowns and more guided flows that surface the right decision at the right moment. Better products for users, fewer support tickets for teams.

I was anxious the whole week leading up to my talk, which isn’t unusual since I often feel that way before presenting. I’ve spoken at other conferences, led workshops, and taught college courses, so public speaking is familiar territory. But this felt different. The moment I walked on stage and brought up my slides, the anxiety disappeared! I had never experienced that before. It felt like a conversation with friends who care about good tools and solid evidence. The examples landed, the audience leaned in, and the Q&A could have gone on much longer if we hadn’t run out of time.

It was easily the most fun I’ve ever had giving a talk; truly an experience I’ll carry with me for a long time. The best part might have been the hallway follow-ups: quick notebook sketches, a few “this changes how I think about building dashboards” epiphanies, and two separate chats about adapting the ideas for decision-making research.

I’m so grateful to the Posit team for creating conditions where growth is possible, and to this polyglot community for making it feel like home. The spirit that met me in 2018 is still doing profound, durable work.

A Day Contributing: Tidyverse Developer Day

After the main program, I spent most of Friday at Tidyverse Developer Day: A room full of people contributing to {tidyverse} packages with the authors and maintainers working alongside them. The team curates issues for all skill levels, with helpers floating around to unblock any hiccups that might come up.

It’s a welcoming space for a topic that can feel high-friction the first time you try it. The bar to contribute drops incredibly fast when someone says, “let’s open the issue and look together”. This year, Joe Cheng was at my table, a genuine delight for this avid Shiny user.

I strongly suspect days like this compound: first PRs become second and third ones, kind reviews early on create the next round of kind reviewers, and the effect spills into broader open source ecosystems.

What I Took Home This Time

• A clearer north star for my work: Build systems that help reduce friction, support better choices, and promote equitable collaboration so the next person/team moves faster.
• A reminder that precision and kindness are not in tension: You can ask for evidence and still be generous. They are not mutually exclusive but mutually necessary for progress.
• A short list of things next: Deepen Rust knowledge, keep improving {bidux}, continue bridging behavioral science and tech, and always strive to meet people where they are.

Looking Ahead

Seven years later, I still leave recharged and focused. My plan is simple: Pay forward the clarity and encouragement this community gave me. Build things that make it easier for the next person to do good work.

If that sounds like your kind of place, I look forward to seeing you there!

A Modern Telemetry Workflow

Telemetry data is increasingly central to BID workflows. Until now, telemetry ingestion produced list-like objects that worked but weren’t always convenient for analysis.

In v0.3.1, bid_ingest_telemetry() now returns hybrid telemetry objects: they behave like lists for backward compatibility, while adding new methods such as as_tibble() and bid_flags().

For new projects, the preferred interface is the tidy-friendly bid_telemetry(), which returns structured tibbles (bid_issues_tbl) ready for dplyr pipelines:

issues <- bid_telemetry("telemetry.sqlite")
critical <- issues |> filter(severity == "critical")

From Telemetry to BID Stages

This release also introduces bridge functions that connect telemetry issues directly to BID stages:

• bid_notice_issue(): convert one issue into a Notice stage
• bid_notices(): batch process multiple issues
• bid_address(): quickly act on a set of issues
• bid_pipeline(): process the first N issues with limits

These functions make it easier to move from raw telemetry data to structured BID insights without extra glue code.

A Quick Example

Here’s what a telemetry-informed BID pipeline can look like in v0.3.1:

library(bidux)
library(dplyr)

# Ingest telemetry as tidy issues
issues <- bid_telemetry("telemetry.sqlite")

# Focus on the most severe issues
critical <- issues |>
  filter(severity == "critical")

# Turn those into BID notices
notices <- bid_notices(critical)

# Move forward through the pipeline
structure <- bid_structure(notices, telemetry_flags = bid_flags(critical))
validate  <- bid_validate(structure, telemetry_refs = critical)

This pipeline takes real user behavior (via telemetry), surfaces critical issues, and carries them through to structured design recommendations and validation, all with tidy, pipeline-friendly functions.

Framework Stability and Improvements

Alongside telemetry, this release improves framework stability and consistency:

• Stage order correction:
  • BID stages now follow the canonical sequence: Interpret → Notice → Anticipate → Structure → Validate
  • Migration support is built in, so older outputs remain interpretable

• Unified suggestion system:
  • Interpret, Notice, and Validate now share consistent rules, reducing duplication and simplifying outputs
• Structure and validation refinements:
  • bid_structure() can adjust recommendations using telemetry flags (e.g., avoid tabs if navigation drop-offs are detected)
  • bid_validate() can link validation results back to the telemetry issues that motivated them

Migration and Deprecations

Existing telemetry code continues to work, but now has access to the enhanced features. Looking ahead to 0.4.0:

• bid_ingest_telemetry() will be soft-deprecated in favor of bid_telemetry().
• Layout auto-selection in bid_structure() and layout-specific bias mitigations in bid_anticipate() will be removed in favor of concept-driven approaches.

Documentation and Tests

We’ve updated the Getting Started vignette with new telemetry examples and corrected stage numbering, and expanded the Telemetry Integration vignette to show the new tidy workflow. Test coverage has been broadened across new methods, bridge functions, and migration utilities.

Install the Latest Release

You can install bidux v0.3.1 from CRAN today:

install.packages("bidux")

This release makes working with telemetry in BID smoother, tidier, and more consistent. It strengthens the framework while keeping migration straightforward, so you can spend less time adapting code and more time focusing on insights.

Why UX Is Too Often an Afterthought

In data analytics and dashboard development, we often get the logic right: The data is clean, the calculations are correct, and the visualizations are technically sound. But when the dashboard goes live, something breaks.

Users ignore insights. Or worse, they disengage entirely.

This isn’t a reflection of poor technical work. It’s a sign that something deeper is missing: A bridge between how we design interfaces and how people actually think.

Most developers aren’t trained in psychology or UX. That’s not a failing; it’s a gap in the pipeline. Users interpret our tools through human lenses: They carry cognitive limitations, rely on mental shortcuts, and make judgments shaped by emotion, context, and bias.

To design dashboards that not only work, but resonate, we need to design for the mind, not just the machine.

A New Starting Point: BID + {bidux}

The Behavior Insight Design (BID) framework offers a structured, evidence-based approach to building more intuitive, cognitively supportive dashboards. Developed at the intersection of behavioral science, data storytelling, and interface design, BID maps out five stages that reflect how users actually engage with information:

Each stage helps developers reduce friction, surface insight, and support better decision-making, even without a background in psychology or UX.

The {bidux} R package makes this framework practical for developers. It provides a step-by-step workflow, concept dictionaries, and component suggestions that bring behavioral design directly into your Shiny development process.

Together, BID and {bidux} help you turn psychological friction into flow.

What Makes BID Different?

Most design systems focus on aesthetics or layout heuristics. BID starts earlier by asking what your user needs to think, feel, and decide at each stage of interaction.

BID is grounded in cognitive psychology, decision science, and information processing theory. It doesn’t just tell you what to build; it explains why certain design choices succeed or fail, based on decades of empirical research.

And while other frameworks often isolate usability issues or user behavior, BID treats these mechanisms as dynamically linked. For instance:

• How cognitive load affects susceptibility to bias
• How early layout decisions shape later interpretations
• How interface design impacts individual and group coordination

{bidux} brings this theory into practice, giving you the tools to identify friction points, document key decisions, and structure your dashboard with the user’s cognition in mind.

The Five BID Stages (with {bidux} Examples)

stg_interpret <- bid_interpret(
  central_question = "Where are sales underperforming?",
  data_story = list(hook = "...", tension = "...", resolution = "...")
)
## Warning: ! Using deprecated list format for data_story parameter
## ℹ Please use new_data_story() constructor for new code
## ℹ Legacy format will be automatically migrated
## Warning: ! Using deprecated nested format for data_story
## ℹ The flat API is now recommended: new_data_story(hook, context, tension,
##   resolution)
## ℹ Nested format (variables, relationships) will be removed in bidux 0.4.0
## Stage 1 (Interpret) completed.
##   - Central question: Where are sales underperforming?
##   - Your data story is incomplete (25%). Consider adding these missing elements: hook, tension, resolution.
##   - Your central question is appropriately scoped.
##   - No user personas defined

# install.packages("bidux")
# library(bidux)

stg_notice <- bid_notice(
  stg_interpret,
  problem = "Users can't find the key metrics",
  evidence = "70% of testers took >30s locating the primary KPI"
)
## Auto-suggested theory: Cognitive Load Theory (confidence: 90%)
## Stage 2 (Notice) completed. (40% complete)
##   - Problem: Users can't find the key metrics
##   - Theory: Cognitive Load Theory (auto-suggested)
##   - Evidence: 70% of testers took >30s locating the primary KPI
##   - Theory confidence: 90%
##   - Next: Use bid_anticipate() for Stage 3

stg_anticipate <- bid_anticipate(stg_notice)
## Stage 3 (Anticipate) completed.
##   - Bias mitigations: 4 defined
##   - Accessibility considerations included
##   - Key suggestions: Anchoring mitigation: Always show reference points like previous period, budget, or industry average, Framing mitigation: Toggle between progress (65% complete) and gap (35% remaining) framing, Confirmation Bias mitigation: Include alternative views that might challenge the main narrative

stg_structure <- bid_structure(stg_anticipate)
## Warning: Layout auto-selection is deprecated and will be removed in bidux
## 0.4.0. The BID framework will focus on concept-based suggestions instead.
## Existing code will continue to work until 0.4.0.
## Stage 4 (Structure) completed.
##   - Auto-selected layout: breathable
##   - Concept groups generated: 3
##   - Total concepts: 3

stg_validate <- bid_validate(stg_anticipate)
## Stage 5 (Validate) completed.
##   - Summary panel: Dashboard provides clear summary of key insight...
##   - Collaboration: Enable team sharing and collaborative decision-...
##   - Next steps: 11 items defined
##   - Consider adding user empowerment tools to enhance collaboration

Try It Out

Example flow:

library(bidux)

# Align the dashboard with user goals
workflow <- bid_interpret(central_question = "Which products underperformed?") |>

  # Identifying user friction point
  bid_notice(
    problem = "Too many filters",
    evidence = "Users forget the currently selected options"
  ) |>

  # Address predictable cognitive biases (leave blank for auto-suggestions)
  bid_anticipate(
    bias_mitigations = list(
      anchoring = "Include prior year as reference",
      confirmation_bias = "Show competing explanations"
    )
  ) |>

  # Design information structure
  bid_structure() |>

  # Reinforce clarity and enable collaboration
  bid_validate(summary_panel = "Key takeaways with export")
## Warning: ! Using deprecated nested format for data_story
## ℹ The flat API is now recommended: new_data_story(hook, context, tension,
##   resolution)
## ℹ Nested format (variables, relationships) will be removed in bidux 0.4.0
## Stage 1 (Interpret) completed.
##   - Central question: Which products underperformed?
##   - Your data story is incomplete (25%). Consider adding these missing elements: hook, tension, resolution.
##   - Your central question is appropriately scoped.
##   - No user personas defined 
## Auto-suggested theory: Hick's Law (confidence: 90%)
## Stage 2 (Notice) completed. (40% complete)
##   - Problem: Too many filters
##   - Theory: Hick's Law (auto-suggested)
##   - Evidence: Users forget the currently selected options
##   - Theory confidence: 90%
##   - Next: Use bid_anticipate() for Stage 3
## Warning: ! Using deprecated list format for bias_mitigations parameter
## ℹ Please use new_bias_mitigations() constructor for new code
## ℹ Legacy format will be automatically migrated
## Stage 3 (Anticipate) completed.
##   - Bias mitigations: 4 defined
##   - Accessibility considerations included
##   - Key suggestions: Bias_type mitigation: Consider how this bias affects user decisions, Mitigation_strategy mitigation: Consider how this bias affects user decisions, Confidence_level mitigation: Consider how this bias affects user decisions
## Warning: Layout auto-selection is deprecated and will be removed in bidux
## 0.4.0. The BID framework will focus on concept-based suggestions instead.
## Existing code will continue to work until 0.4.0.
## Stage 4 (Structure) completed.
##   - Auto-selected layout: breathable
##   - Concept groups generated: 3
##   - Total concepts: 3
## Stage 5 (Validate) completed.
##   - Summary panel: Key takeaways with export
##   - Collaboration: Enable team sharing and collaborative decision-...
##   - Next steps: 11 items defined
##   - Ensure summary panel includes actionable insights Consider adding user empowerment tools to enhance collaboration

Then explore suggestions:

bid_suggest_components(workflow, package = "bslib")
## # A tibble: 8 × 7
##   package component description bid_stage_relevance cognitive_concepts use_cases
##   <chr>   <chr>     <chr>       <chr>               <chr>              <chr>    
## 1 bslib   nav_panel Create tab… Stage 1,Stage 3     Cognitive Load Th… content …
## 2 bslib   accordion Implement … Stage 1,Stage 3     Progressive Discl… FAQ sect…
## 3 bslib   value_box Display ke… Stage 2,Stage 3,St… Visual Hierarchy,… KPI disp…
## 4 bslib   card      Organize c… Stage 3,Stage 5     Principle of Prox… Content …
## 5 bslib   layout_c… Create res… Stage 3             Cognitive Load Th… responsi…
## 6 bslib   layout_c… Create fle… Stage 3             Visual Hierarchy,… precise …
## 7 bslib   card_hea… Add header… Stage 3             Information Hiera… section …
## 8 bslib   card_body Control ca… Stage 3             Breathable Layout… content …
## # ℹ 1 more variable: relevance <dbl>

Learn More

• 📦 GitHub: jrwinget/bidux
• 📚 Vignettes: introduction-to-bid, concepts-reference, getting-started
• 👀 Theory paper coming soon! Watch this space

Final Thoughts

Better dashboards aren’t just more attractive; they’re more intelligible. They reduce unnecessary decisions, anticipate user confusion, and surface what matters.

The BID framework gives developers a behavioral lens. {bidux} gives them the tools to act on it.

You don’t need a psychology degree to design with cognitive empathy, just the right questions and the right support. {bidux} helps you ask both.

Happy designing! 🚀

Import data

set.seed(20211218)
library(RSocrata)
library(tidyverse)
library(lubridate)
library(janitor)
library(tidymodels)
library(vip)
library(skimr, include.only = "skim")

# data pulled at time of post; new cases likely added to data portal since then
crashes <- read.socrata(
  "https://data.cityofchicago.org/resource/85ca-t3if.csv", # url of data set
  app_token = Sys.getenv("rsocrata_token")                 # my personal creds
) %>%
  clean_names() %>%
  select(
    crash_type, crash_date, posted_speed_limit, traffic_control_device,
    device_condition, weather_condition, lighting_condition, first_crash_type,
    trafficway_type, alignment, roadway_surface_cond, road_defect, prim_contributory_cause
  ) %>%
  mutate(
    crash_date = ymd_hms(crash_date),
    date = as_date(crash_date)
  ) %>%
  select(!crash_date)

The goal here is to build a model that predicts whether a crash will result in someone being injured and/or the vehicle being towed using the crash_type variable in the crashes data set.

From the variables listed in the Traffic Crash data set, let’s select some that are likely to have been known before the crash occurred. For example, lighting_condition is a variable that records the light condition at the time of the crash. This situational factor is likely to be known (e.g., observed by the driver, reported by others prior to the crash, etc.) before an accident occurs. At the very least, this information has a higher chance of being known prior to a crash compared to something like injuries_total. injuries_total is a variable that records the total number of people who sustained an injury as a result of the accident. Since this is a consequence of a crash, this information can only known after the crash occurs.

With this logic, let’s focus on the following variables from the initial Traffic Crash data set:

Data exploration & cleaning

Now that we have some idea of what we’ll be looking at in our model, let’s get some impressions of the data and see if anything needs to be cleaned up before going further.

glimpse(crashes)

The first thing to note is that there are 571426 observations with 13 columns in the crashes data set. And other than some potential capitalization issues with the strings, there doesn’t seem to be any obvious issues with the way the data are formatted. We’ll come back to this, but for now, let’s check for missing data.

colSums(is.na(crashes))

Great, no missing data! This will simplify data preparation later on. Next, we should examine the frequency counts of the variables we’ll use to predict the outcome class.

var_freq <- function(df) {
  map(names(df), ~ count(df, .data[[.x]]))[1:12]
}

var_freq(crashes)

Looks like there are some issues that need to be addressed here! First, the responses that are coded for some variables don’t make sense. For example, posted_speed_limit has 6967 recorded observations for a posted speed limit of 0 mph. Clearly, this is not a legitimate posted speed limit within the City of Chicago (as much as it may feel like it on the Dan Ryan at 5pm). There are some other odd speed limits recorded for this variable as well.

Another issue these frequency counts reveal is that many of the levels within a variable could be grouped together. For example, prim_contributory_cause makes a distinction between disregarding road markings, stop signs, traffic signals, yield signs, and other traffic signs. Instead, these levels could be grouped into a single level called “disregarding signs/markings”.

So, let’s address each of these problems by cleaning up the levels for each variable. And while we’re at it, let’s clean up the format of all of the strings so there is a consistent style (i.e., lower case).

crashes <- crashes %>%
  mutate(
    across(where(is.character), ~ str_to_lower(.)),
    traffic_control_device = case_when(
      traffic_control_device == "railroad crossing gate" |
       traffic_control_device == "other railroad crossing" |
        traffic_control_device == "rr crossing sign" ~ "rr crossing",
      traffic_control_device == "bicycle crossing sign" |
        traffic_control_device == "pedestrian crossing sign" |
        traffic_control_device == "school zone" ~ "pedestrian signs",
      traffic_control_device == "flashing control signal" ~ "stop sign/flasher",
      traffic_control_device == "no passing" ~ "other warning sign",
      TRUE ~ traffic_control_device
    ),
    device_condition = case_when(
      device_condition == "missing" ~ "no controls",
      device_condition == "worn reflective material" |
        device_condition == "not functioning" ~ "functioning improperly",
      TRUE ~ device_condition
    ),
    weather_condition = case_when(
      weather_condition == "blowing sand, soil, dirt" |
        weather_condition == "severe cross wind gate" |
        weather_condition == "blowing snow" ~ "blowing debris",
      weather_condition == "freezing rain/drizzle" |
        weather_condition == "sleet/hail" ~ "sleet/hail/freezing rain",
      TRUE ~ weather_condition
    ),
    prim_contributory_cause = case_when(
      prim_contributory_cause == "disregarding other traffic signs" |
        prim_contributory_cause == "disregarding road markings" |
        prim_contributory_cause == "disregarding stop sign" |
        prim_contributory_cause == "disregarding traffic signals" |
        prim_contributory_cause == "disregarding yield sign" |
        prim_contributory_cause == "passing stopped school bus" ~ "disregarding signs/markings",
      prim_contributory_cause == "distraction - from inside vehicle" |
        prim_contributory_cause == "distraction - from outside vehicle" |
        prim_contributory_cause == "distraction - other electronic device (navigation device, dvd player, etc.)" |
        prim_contributory_cause == "cell phone use other than texting" |
        prim_contributory_cause == "texting" ~ "distraction",
      prim_contributory_cause == "had been drinking (use when arrest is not made)" |
        prim_contributory_cause == "under the influence of alcohol/drugs (use when arrest is effected)" ~ "under the influence",
      prim_contributory_cause == "obstructed crosswalks" |
        prim_contributory_cause == "vision obscured (signs, tree limbs, buildings, etc.)" ~ "obstructions",
      prim_contributory_cause == "bicycle advancing legally on red light" |
        prim_contributory_cause == "motorcycle advancing legally on red light" ~ "bike/motorcycle advancing legally on red light",
      prim_contributory_cause == "animal" |
        prim_contributory_cause == "evasive action due to animal, object, nonmotorist" ~ "evasive action",
      prim_contributory_cause == "exceeding authorized speed limit" |
        prim_contributory_cause == "exceeding safe speed for conditions" ~ "speeding",
      TRUE ~ prim_contributory_cause
    ),
    across(where(is_character), ~ as_factor(.))
  )

Great! Now, the data are clean, and we can start thinking about how to set up the model. Let’s take a look at the current data summary.

skim(crashes)

And, let’s take a closer look at the dependent variable, crash_type.

crashes %>%
  count(crash_type) %>%
  mutate(prop = n / sum(n))

It looks like there might be a bit of imbalance in the data since the class proportions are skewed towards non-injury/drive-away (74.3%) crash types. Imbalance can sometimes lead to problems in an analysis, especially in severe cases of imbalance. Fortunately, there are a few approaches that try to mitigate this issue (e.g., themis). For now, let’s just analyze the data as is.

At this point, it would be helpful to know which variables in the crashes data set are associated with the different levels of the dependent variable, crash_type. One quick way of doing this for the numeric predictors is by using box plots.

crashes %>%
  ggplot(aes(x = crash_type, y = posted_speed_limit, fill = crash_type)) +
  geom_boxplot()

It looks like any differences between the crash_type levels are quite small for posted_speed_limit. So, maybe this variable won’t be so helpful in predicting injuries/towed crash types after all.

Next, let’s check the the relationship between the categorical variables and crash_type using simple counts. We’ll also filter for counts that are at least 1% of the total proportion of observations to get a better idea of the larger data patterns.

print_counts <- function(.y_var) {
  y_var <- sym(.y_var)

  crashes %>%
    count(crash_type, {{y_var}}) %>%
    group_by(crash_type) %>%
    mutate(percent = round_half_up(n / sum(n) * 100, 2))
}

y_var <- crashes %>%
  select(where(is.factor), -crash_type) %>%
  variable.names()

map(y_var, print_counts) %>%
  map(., ~ filter(., percent > 1))

It looks like any differences between the two crash_type classes are small for alignment and weather_condition as well. However, because of the small differences across multiple levels of weather_condition, it’s tough to see if really there is a relationship there or not. Another way we can look for differences between two categorical variables is by plotting a heatmap of the frequency counts.

crashes %>%
  ggplot(aes(crash_type, weather_condition)) +
  geom_bin2d()

Although there are some differences, these appear to be pretty small. So, perhaps weather isn’t important for this model either.

Data preparation

Next, we’ll do a bit of preprocessing before training the models. This is where we’ll handle feature selection, data splitting, feature engineering, feature scaling, and creating the validation set (i.e., resampling).

The first thing we’ll do here is drop the variables that did not seem to have much of a relationship with crash_type during data exploration.

crashes <- select(crashes, -c(posted_speed_limit, weather_condition, alignment))

Next, let’s split the single data set into two: a training set and a testing set. A training data set is a data set of examples used during the learning process and is used to fit the models. A test data set is a data set that is independent of the training data set and is used to evaluate the performance of the final model. If a model fit to the training data set also fits the test data set well, we can be confident minimal overfitting has taken place. On the other hand, if the model seems to fit the training set better than the test set, we might have a case of overfitting.

For a data splitting strategy, let’s set aside 25% of the data for the test set. Since the outcome variable (crash_type) is somewhat imbalanced, we’ll also use a stratified random sample.

crash_split <- initial_split(crashes, strata = crash_type)
crash_train <- training(crash_split)
crash_test <- testing(crash_split)

Next, let’s create a base recipe for all models. Note the sequence of steps does matter here: + receipe(): + Any variable on the left-hand side of the tilde (~) is considered the model outcome (here, crash_type). The predictors of the model outcome appear on the right-hand side of the tilde. Here, we use the dot (.) to indicate all the other variables will be used as predictors. + A recipe is also associated with the data set used to create the model. This will usually be the training set, so crash_train here. + step_date(): Creates predictors for the year, month, and day of the week. Here, we’re selecting only the day of the week and month since there are limited observations for earlier years (e.g., 2013, 2014) in the data. + step_rm(): Removes variables; here we use it to remove the original date variable since we no longer want it in the model. + step_normalize(): Centers and scales numeric variables. + step_dummy(): Converts characters or factors (i.e., nominal variables) into one or more numeric binary model terms for the levels of the original data. + step_zv(): Removes indicator variables that only contain a single unique value (e.g. all zeros).

crash_recipe <- recipe(crash_type ~ ., data = crash_train) %>%
  step_date(date, features = c("dow", "month")) %>%
  step_rm(date) %>%
  step_normalize(all_numeric_predictors(), -all_outcomes()) %>%
  step_dummy(all_nominal_predictors(), -all_outcomes()) %>%
  step_zv(all_predictors(), -all_outcomes())

Recall that we already partitioned our data set into a training set and test set. This lets us judge whether a given model will generalize well to new data. However, using only two partitions may be insufficient when doing many rounds of hyperparameter tuning. So, it’s usually a good idea to create a validation set as well. We’ll use k-fold cross validation to build a set of 5 validation folds with the function vfold_cv, and we’ll also use stratified sampling to maintain the outcome class proportions.

k-fold cross validation randomly allocates the 571184 observations in the training set to 5 groups of roughly equal size, called “folds”. For the first iteration of resampling, the first fold is held out for the purpose of measuring performance. The other 80% of the data are used to fit the model. This model, trained on the analysis set, is applied to the assessment set to generate predictions. Then, performance statistics are computed based on those predictions.

In this case, 5-fold cross validation iteratively moves through the folds and leaves a different 20% out each time for model assessment. At the end of this process, there are 5 sets of performance statistics that were created on 5 data sets that were not used in the modeling process. While 5 models were created, these are not used further; we do not keep the models themselves trained on these folds because their only purpose is calculating performance metrics. The final resampling estimates for the model are the averages of the performance statistics replicates.

crashes_vfold <- vfold_cv(crash_train, v = 5, strata = crash_type)

We will come back to the validation set after we specified the models.

Model 1: Logistic regression

All available models are listed at https://www.tidymodels.org/find/parsnip/. Since the outcome variable (crash_type) is categorical, a logistic regression model is a good place to start. Let’s use a model that can perform feature selection during training. The glmnet R package fits a generalized linear model via penalized maximum likelihood. This method of estimating the logistic regression slope parameters uses a penalty on the process so that less relevant predictors are driven towards a value of zero. One of the glmnet penalization methods, called the lasso method, can set the predictor slopes to zero if a large enough penalty is used.

To specify a penalized logistic regression model that uses a feature selection penalty, let’s use the parsnip package with the glmnet engine.

lr_mod <- logistic_reg(penalty = tune(), mixture = 1) %>%
  set_engine("glmnet") %>%
  set_mode("classification")

We’ll set the penalty argument to tune() as a placeholder for now. This is a model hyperparameter that we will tune to find the best value for making predictions with our data. Setting mixture to a value of 1 means the glmnet model will potentially remove irrelevant predictors and choose a simpler model (i.e., via least absolute shrinkage and selection operator).

lr_workflow <- workflow() %>%
  add_model(lr_mod) %>%
  add_recipe(crash_recipe)

lr_reg_grid <- tibble(penalty = 10^seq(-4, -1, length.out = 30))

lr_res <- lr_workflow %>%
  tune_grid(
    crashes_vfold,
    grid = lr_reg_grid,
    control = control_grid(save_pred = TRUE),
    metrics = metric_set(roc_auc, precision, recall, f_meas)
  )

lr_res %>%
  collect_metrics()

lr_res %>%
  collect_metrics() %>%
  filter(`.metric` == "roc_auc") %>%
  ggplot(aes(x = penalty, y = mean)) +
  geom_point() +
  geom_line() +
  ylab("Area under the ROC Curve") +
  scale_x_log10(labels = scales::label_number())

lr_res %>%
  show_best("roc_auc", n = 15) %>%
  arrange(penalty)

perf_metrics <- c("roc_auc", "precision", "recall", "f_meas")

get_metrics <- function(x) {
  lr_res %>%
    show_best(x, n = 15) %>%
    arrange(penalty)
}

map(perf_metrics, get_metrics)

lr_best <- lr_res %>%
  select_best(metric = "f_meas")

lr_res %>%
  collect_predictions(parameters = lr_best) %>%
  conf_mat(crash_type, .pred_class)

lr_res %>%
  collect_predictions(parameters = lr_best)  %>%
  conf_mat(crash_type, .pred_class) %>%
  autoplot(type = "heatmap")

lr_auc <- lr_res %>%
  collect_predictions(parameters = lr_best) %>%
  roc_curve(crash_type, `.pred_injury and / or tow due to crash`) %>%
  mutate(model = "Logistic Regression")

autoplot(lr_auc)

lr_res %>%
  collect_predictions(parameters = lr_best) %>%
  group_by(id) %>%
  roc_curve(crash_type, `.pred_injury and / or tow due to crash`) %>%
  autoplot()

lr_res %>%
  collect_predictions(parameters = lr_best) %>%
  ggplot() +
  geom_density(
    aes(x = `.pred_injury and / or tow due to crash`,
        fill = crash_type),
    alpha = 0.5
  )

Model 2: Random forest

An effective, low-maintenance, non-linear modeling approach is a random forest, which tends to be more flexible than logistic regression. A random forest is an ensemble model that often consists of thousands of decision trees. Each individual tree sees a slightly different version of the training set and learns a sequence of splitting rules to predict new data. Random forests require very little preprocessing and can handle many types of predictors (e.g., skewed, continuous, categorical, etc.). Although the default hyperparameters for random forests tend to give reasonable results, we’ll tune two hyperparameters that could improve performance. This should also help since we’ll be limiting the number of trees used to 20 to speed up the time it takes to fit the model.

rf_mod <- rand_forest(mtry = tune(), min_n = tune(), trees = 20) %>%
  set_engine("ranger", importance = "impurity") %>%
  set_mode("classification")

For the hyperparameters in this model, we use tune() as a placeholder for the mtry and min_n argument values. The mtry hyperparameter sets the number of predictor variables that each node in the decision tree sees and learns about. The min_n hyperparameter sets the minimum n to split at any node. We also added importance = "impurity" when setting the engine. This will provide variable importance scores for this model, which gives some insight into which predictors drive model performance.

rf_workflow <- workflow() %>%
  add_model(rf_mod) %>%
  add_recipe(crash_recipe)

rf_res <- rf_workflow %>%
  tune_grid(
    crashes_vfold,
    grid = 25,
    control = control_grid(save_pred = TRUE),
    metrics = metric_set(roc_auc, precision, recall, f_meas)
  )

rf_res %>%
  show_best(metric = "f_meas")

rf_best <- rf_res %>%
  select_best(metric = "f_meas")

rf_best

rf_res %>%
  collect_predictions() %>%
  conf_mat(crash_type, .pred_class)

rf_auc <- rf_res %>%
  collect_predictions(parameters = rf_best) %>%
  roc_curve(crash_type, `.pred_injury and / or tow due to crash`) %>%
  mutate(model = "Random Forest")

autoplot(rf_auc)

Compare models

Now, it’s time to compare the models. The first thing we’ll do is extract the performance metrics from each of the models and combine them into a single data frame.

lr_metrics <- lr_res %>%
  collect_metrics() %>%
  mutate(model = "Logistic Regression")

rf_metrics <- rf_res %>%
  collect_metrics() %>%
  mutate(model = "Random Forest")

compare_mod <- bind_rows(lr_metrics, rf_metrics)

Fist, let’s take a look at the average F1-Score for each model:

compare_mod %>%
  filter(.metric == "f_meas") %>%
  group_by(model) %>%
  summarize(avg_f_meas = mean(mean)) %>%
  mutate(model = fct_reorder(model, avg_f_meas)) %>%
  ggplot(aes(model, avg_f_meas, fill = model)) +
  geom_col() +
  coord_flip() +
  scale_fill_brewer(palette = "Blues") +
  geom_text(
    size = 5,
    aes(label = round_half_up(avg_f_meas, 2), y = avg_f_meas - .8)
  )

Not much of a difference here. So, we may also want to check out the average ROC curve for each model:

compare_mod %>%
  filter(.metric == "roc_auc") %>%
  group_by(model) %>%
  summarize(avg_roc = mean(mean)) %>%
  mutate(model = fct_reorder(model, avg_roc)) %>%
  ggplot(aes(model, avg_roc, fill = model)) +
  geom_col() +
  coord_flip() +
  scale_fill_brewer(palette = "Blues") +
  geom_text(
    size = 5,
    aes(label = round_half_up(avg_roc, 2), y = avg_roc - .7)
  )

Looks like our random forest model did a bit better here, but still pretty close. Let’s plot the validation set ROC curves for the top penalized logistic regression model and random forest model:

bind_rows(rf_auc, lr_auc) %>%
  ggplot(aes(x = 1 - specificity, y = sensitivity, col = model)) +
  geom_path(lwd = 1.5, alpha = 0.8) +
  geom_abline(lty = 3) +
  coord_equal() +
  scale_color_viridis_d(option = "plasma", end = .6)

Overall, the model results are pretty similar, but the random forest model did seem to perform better than the logistic regression model. In this case, I highlighted the ROC AUC and F1-Score performance metrics, but the “best” performance metric will always depend on the question you are trying to answer with your model. For example, in some cases, you might be much more concerned about false negatives than you are false positives (e.g., when predicting severe storms). In other situations, you might only be concerned about each these to the extent they influence a model’s precision (e.g., when predicting profitable stocks).

To keep things simple, let’s stick with the ROC AUC metric in this case. AUC stands for area under the curve. What curve, you may ask? The ROC curve, specifically. The ROC curve plots the tradeoff between the true positive rate (sensitivity) and and false positive rate (1 - specificity). Ideally, we want to maximize the true positive rate and minimize the false positive rate.

Let’s find the maximum mean ROC AUC:

compare_mod %>%
  filter(.metric == "roc_auc") %>%
  group_by(model) %>%
  summarize(avg_roc_auc = mean(mean)) %>%
  slice_max(avg_roc_auc)

Now, it’s time to fit the best model one last time to the full training set. Then, we can evaluate the resulting final model on the test set.

Last fit

Recall that our goal was to predict whether a traffic crash would result in an injury or a vehicle being towed based on a priori situational factors. Given the results, we determined the random forest model performed better than the penalized logistic regression model. We also know learned the best model hyperparameters from the rf_best object we created earlier. Now, we just need to fit the final model on all the rows of data not originally held out for testing (i.e., the training and validation sets) and evaluate the model performance one more time with the test set.

The tune package contains the function last_fit(), which fits a model to the whole training data and evaluates it on the test set. We just need to provide the workflow object of the best model and data split object (not the training data).

last_rf_mod <- rand_forest(
    mtry = rf_best$mtry,
    min_n = rf_best$min_n,
    trees = 20
  ) %>%
  set_engine("ranger", importance = "impurity") %>%
  set_mode("classification")

last_rf_workflow <- rf_workflow %>%
  update_model(last_rf_mod)

last_rf_fit <- last_rf_workflow %>%
  last_fit(crash_split)

And these are the final performance metrics:

last_rf_fit %>%
  collect_metrics()

Remember, if a model fit to the training data set also fits the test data set well, we can be reasonably confident that minimal overfitting has taken place.

To learn more about the model, we can look at the variable importance scores in the .workflow column. We pluck the first element from the column, and pull out the fit from the workflow object. Then, we can use the vip package to visualize the variable importance scores for the top features.

last_rf_fit %>%
  pluck(".workflow", 1) %>%
  extract_fit_parsnip() %>%
  vip(num_features = 10)

By far, the most important factor in whether a crash results in injuries or the vehicle being towed is if the first collision in the crash involved a pedestrian or not.

Let’s take a quick look at the confusion matrix:

last_rf_fit %>%
  collect_predictions() %>%
  conf_mat(crash_type, .pred_class) %>%
  autoplot(type = "heatmap")

And, let’s create the final ROC curve:

last_rf_fit %>%
  collect_predictions() %>%
  roc_curve(crash_type, `.pred_injury and / or tow due to crash`) %>%
  autoplot()

The results from the validation set and test set performance statistics are very close, so we can be reasonably confident the random forest model with the selected features and hyperparameters would perform well when predicting new data.

Special thanks to Drew Triplett for his helpful comments on an earlier draft of this post!

Step 1: What will the bot tweet?

The conceptual part of this step was the toughest for me: What content do I want the bot to tweet? I could have done something practical like automatically tweet new blog content or retweet important important information/news. But, I wanted to have fun with this. Others have made some pretty hilarious bots (e.g., WhyDoesR or TwoHeadlines), so I wanted to create something simple that could get a few laughs. So, I decided to make a random “Would You Rather” generator that pits outrageous or terrible situations against one another.

To do this, I set up a little “database” containing a list of the situations in a .csv file (you can view that file on the GitLab repo for the bot). I also wanted to add pictures to the posts, so I found 11 open source images online and stored them into a “img” directory. Once the database and image directory are created, they need to be loaded into R.

library(tidyverse)
library(here)

wyr <- read_csv(here("wyr-db.csv"), col_names = FALSE)
pictures <- list.files(here("img"))

Next, the bot needs to be able to randomly select two situations from the database and combine them into a sentence. A function would be perfect for this:

library(glue)

would_you_rather <- function() {
  choices <- sample_n(wyr, 2)
  a <- slice(choices, 1)
  b <- slice(choices, 2)
  sentence <- glue("Would you rather {a} or {b}?")
  return(sentence)
}

Now, the bot has a way of creating a sentence, but it still needs to actually generate one to tweet. It also needs to select a picture to tweet with the generated sentence. To create a sentence, we can use our new function and store the result in an object called “tweet”. To randomly select a picutre, we just need to sample 1 of the 11 and store the name of the file as an object called “img”.

tweet <- would_you_rather()
img <- sample(pictures, 1)

Step 2: Connect to Twitter

Because this bot will be tweeting from the R console, we have to register a new app with Twitter. Michael Kearney has a great tutorial on this using his rtweet package. Basically, load the rtweet package and connect to Twitter’s API using credentials stored in the environment. Once the credentials are stored, use the get_tokens function to fetch and load them.

library(rtweet)

token <- get_tokens()

Now, the bot can tweet a randomized “Would You Rather” situation with the post_tweet function. I decided to also include a hashtag in the tweet, which is really easy to do using the glue package. To add the randomly selected picture to the tweet, just include the file path to that picture in the media argument.

# tweet it
post_tweet(status = glue(
  "{tweet}

#wouldyourather"),
  media = glue("img/{img}"))

I also wanted to collect all of the tweets the bot produces, so I made a log file to store them.

line <- paste(as.character(Sys.time()), tweet, sep = " ")
write(line, file = here("wyr-tweets.log"), append = TRUE)

Step 3: Automate the bot

We now have a script that will randomly generate a “Would You Rather” situation along with a randomly chosen picture. However, it would be annoying to manually operate the bot every time we wanted it to tweet. Besides, doing so would undermine the entire point of making a “bot”. So let’s have the computer do this instead.

However, before the computer can understand the R script, we have to add a line of code to the top of the script (note ‘#!’ is important here):

#! /usr/bin/env Rscript

This is basically turns our script into something the computer can execute. This is good, but having the script loaded on a server would be even better because the script can run whether or not your personal computer is on. Luckily, I happened to already have a server running, so I was able to simply load everything on there and schedule a cron job. Cron jobs basically tell the computer to run a certain command at a certain time (more on cron jobs here).

If you’ve never scheduled a cron job before, it’s a relatively simple process (note: to use this method, you will need a Mac or Linux OS; for Windows OS, use Windows Task Scheduler). First, open the terminal and type:

crontab -e

This opens your personal crontab (i.e., the configuration file). In every line, you can define one command to run and its schedule. The structure of the format is:

minute hour day-of-month month day-of-week command

Using an asterisk as a value represents “any”. For example, to run a command every Monday at 8am, the format would be:

0 8 * * 1 /path/to/command

For this project, the command will tell the computer to execute the bot script we wrote in R. I chose to combine all of the files for the bot (e.g., bot script, database, pictures, etc.) into an R project on the server, so the command I created changes the working directory to the project directory (the cd command) and then runs the script (the Rscript command). I also chose to run the bot twice a day:

# m h  dom mon dow    command
0 8 * * * cd ~/2019-05-02_would-you-rather-bot; Rscript bot-script.R      # run at 8am CST
15 17 * * * cd ~/2019-05-02_would-you-rather-bot; Rscript bot-script.R    # run at 5:15pm CST

You certainly don’t have to run the bot on a server; servers just make things easier and more consistent in this case. If you don’t have access to a server, the process will be basically the same for running the bot on a personal computer. You’ll just need to make sure the computer is on (and awake!) at the scheduled time(s) for it to automatically tweet. Or, you can wake your linux up from sleep for a cron job.

Wrapping up

And, that’s it! Here’s the completed script:

#!/usr/bin/env Rscript
# would_you_rather_bot 0.1
# author: jeremy r. winget
library(tidyverse)
library(rtweet)
library(here)
library(glue)

# authenticate
token <- get_tokens()

# read in data
wyr <- read_csv(here("wyr-db.csv"), col_names = FALSE)
pictures <- list.files(here("img"))

# function to generate sentence
would_you_rather <- function() {
  choices <- sample_n(wyr, 2)
  a <- slice(choices, 1)
  b <- slice(choices, 2)
  sentence <- glue("Would you rather {a} or {b}?")
  return(sentence)
}

# generate question and picture
tweet <- would_you_rather()
img <- sample(pictures, 1)

# tweet it
post_tweet(status = glue(
  "{tweet}

#wouldyourather"),
  media = glue("img/{img}"))

# create log entry
line <- paste(as.character(Sys.time()), tweet, sep = " ")
write(line, file = here("wyr-tweets.log"), append = TRUE)

If you create your own Twitter bot with R (or if this tutorial inspired any other projects), please share it with me. I’d love to hear what you did!

Potential future features

Right now, this bot is pretty basic. I’ve had a few ideas for additional features/adjustments I may or may not end up incorporating:

1. I’d like to add more content to the the database. I basically just googled “Would You Rather” questions and chose some of the more outrageous ones. But, there aren’t a lot of different situations (and some are pretty lame) listed in the database, which can sometimes lead to repeated situations being tweeted. If anyone has any situations they’d like to add, feel free to submit merge request!
2. If people like the bot and start engaging with it, I thought it’d be fun to retweet popular comments/answers. I’m not sure what that procedure would be yet, though.
3. It might be useful to create different categories of “Would You Rather” situations (e.g., outrageous situations, relationship situations, entertainment situations, etc.). If the situations aren’t chosen from the same category, it can lead to dumb questions (like this one).

Data import

Data downloaded from the Chicago Data Portal.

library(tidyverse)
library(modelr)
(red_light_raw <- read_csv("2019-04-28_chi-red-light.csv"))
## # A tibble: 466,107 × 10
##    INTERSECTION   `CAMERA ID` ADDRESS `VIOLATION DATE` VIOLATIONS `X COORDINATE`
##    <chr>                <dbl> <chr>   <chr>                 <dbl>          <dbl>
##  1 IRVING PARK A…        2763 4700 W… 04/09/2015                4             NA
##  2 VAN BUREN AND…        2054 2400 W… 04/14/2015                5             NA
##  3 115TH AND HAL…        2552 11500 … 04/08/2015                5             NA
##  4 IRVING PARK A…        2764 4700 W… 04/19/2015                4             NA
##  5 ELSTON AND IR…        1503 3700 W… 04/23/2015                3             NA
##  6 31ST AND CALI…        2064 2800 W… 09/14/2014                3             NA
##  7 31ST AND CALI…        2064 2800 W… 12/16/2014                1             NA
##  8 31ST AND CALI…        2064 2800 W… 01/30/2015                4             NA
##  9 115TH AND HAL…        2552 11500 … 03/28/2015               14             NA
## 10 WENTWORTH AND…        2261 5500 S… 04/06/2015               11             NA
## # ℹ 466,097 more rows
## # ℹ 4 more variables: `Y COORDINATE` <dbl>, LATITUDE <dbl>, LONGITUDE <dbl>,
## #   LOCATION <chr>

These data reflect the daily volume of violations created by the City of Chicago Red Light Program for each camera since July 1, 2014.

• INTERSECTION = Intersection of the location of the red light enforcement camera(s). There may be more than one camera at each intersection
• CAMERA ID = A unique ID for each physical camera at an intersection, which may contain more than one camera
• ADDRESS = The address of the physical camera (CAMERA ID). The address may be the same for all cameras or different, based on the physical installation of each camera
• VIOLATION DATE = The date of when the violations occurred. NOTE: The citation may be issued on a different date
• VIOLATIONS = Number of violations for each camera on a particular day
• X COORDINATE = The X Coordinate, measured in feet, of the location of the camera. Geocoded using Illinois State Plane East
• Y COORDINATE = The Y Coordinate, measured in feet, of the location of the camera. Geocoded using Illinois State Plane East
• LATITUDE = The latitude of the physical location of the camera(s) based on the ADDRESS column. Geocoded using the WGS84
• LONGITUDE = The longitude of the physical location of the camera(s) based on the ADDRESS column. Geocoded using the WGS84
• LOCATION = The coordinates of the camera(s) based on the LATITUDE and LONGITUDE columns. Geocoded using the WGS84

Data clean

(red_light <- red_light_raw %>%
  janitor::clean_names() %>%
  separate(violation_date, c("month", "day", "year"), "/") %>%
  mutate_at(vars(month, day, year),
            ~ as.numeric(.)))
## # A tibble: 466,107 × 12
##    intersection      camera_id address month   day  year violations x_coordinate
##    <chr>                 <dbl> <chr>   <dbl> <dbl> <dbl>      <dbl>        <dbl>
##  1 IRVING PARK AND …      2763 4700 W…     4     9  2015          4           NA
##  2 VAN BUREN AND WE…      2054 2400 W…     4    14  2015          5           NA
##  3 115TH AND HALSTED      2552 11500 …     4     8  2015          5           NA
##  4 IRVING PARK AND …      2764 4700 W…     4    19  2015          4           NA
##  5 ELSTON AND IRVIN…      1503 3700 W…     4    23  2015          3           NA
##  6 31ST AND CALIFOR…      2064 2800 W…     9    14  2014          3           NA
##  7 31ST AND CALIFOR…      2064 2800 W…    12    16  2014          1           NA
##  8 31ST AND CALIFOR…      2064 2800 W…     1    30  2015          4           NA
##  9 115TH AND HALSTED      2552 11500 …     3    28  2015         14           NA
## 10 WENTWORTH AND GA…      2261 5500 S…     4     6  2015         11           NA
## # ℹ 466,097 more rows
## # ℹ 4 more variables: y_coordinate <dbl>, latitude <dbl>, longitude <dbl>,
## #   location <chr>

Simple EDA

I’m going to look at the number of red light violations by intersection across time.

ggplot(red_light, aes(year + month / 12, violations)) +
  geom_line(aes(group = intersection))

Turns out, this graph isn’t very useful. It’s hard to get an idea of what’s really going on here because there is so much lumped at bottom. For now, I’m going to focus on the more popular intersections (i.e., those with more violations).

Focus on popular intersections

These results might be a bit misleading–maybe popular intersections are fundamentally different (e.g., more dangerous, more lucrative). But, it will at least be a good place to start. Since there are 173 intersections in this dataset, I’m going to arbitrarily select all intersections that lead to greater than 5.5 red light violations on average.

(intersections <- red_light %>%
  group_by(intersection) %>%
  summarize(avg = mean(violations)) %>%
  arrange(desc(avg)))
## # A tibble: 183 × 2
##    intersection                avg
##    <chr>                     <dbl>
##  1 CICERO AND I55             33.8
##  2 LAKE AND UPPER WACKER      31.4
##  3 LAKE SHORE DR AND BELMONT  26.9
##  4 VAN BUREN AND WESTERN      20.8
##  5 LAFAYETTE AND 87TH         18.7
##  6 STATE AND 79TH             16.6
##  7 STONEY ISLAND AND 76TH     15.8
##  8 LINCOLN AND MCCORMICK      15.2
##  9 WENTWORTH AND GARFIELD     14.8
## 10 ARCHER AND CICERO          14.4
## # ℹ 173 more rows

(red_light_popular <- red_light %>%
  semi_join(filter(intersections, avg > 5.5)) %>%
  mutate(date = year + (month - 1) / 12))
## Joining with `by = join_by(intersection)`
## # A tibble: 135,780 × 13
##    intersection      camera_id address month   day  year violations x_coordinate
##    <chr>                 <dbl> <chr>   <dbl> <dbl> <dbl>      <dbl>        <dbl>
##  1 VAN BUREN AND WE…      2054 2400 W…     4    14  2015          5           NA
##  2 115TH AND HALSTED      2552 11500 …     4     8  2015          5           NA
##  3 115TH AND HALSTED      2552 11500 …     3    28  2015         14           NA
##  4 WENTWORTH AND GA…      2261 5500 S…     4     6  2015         11           NA
##  5 115TH AND HALSTED      2552 11500 …     9     1  2014         14           NA
##  6 115TH AND HALSTED      2552 11500 …    10    19  2014         18           NA
##  7 115TH AND HALSTED      2552 11500 …     7    12  2014         31           NA
##  8 31ST ST AND MART…      2121 3100 S…     7     7  2014         21           NA
##  9 115TH AND HALSTED      2552 11500 …    11    18  2014          9           NA
## 10 VAN BUREN AND WE…      2054 2400 W…     7    10  2014         11           NA
## # ℹ 135,770 more rows
## # ℹ 5 more variables: y_coordinate <dbl>, latitude <dbl>, longitude <dbl>,
## #   location <chr>, date <dbl>

Now, I replot the initial graph.

ggplot(red_light_popular, aes(date, violations)) +
  geom_line(aes(group = intersection))

Decreasing the sample reduced the number of intersections that were lumped at the bottom, but there are still a lot of data there. Let’s try adding some transparency and a log10 transformation.

ggplot(red_light_popular, aes(date, violations)) +
  geom_line(aes(group = intersection), alpha = 1/5) +
  scale_y_log10() +
  geom_smooth(se = FALSE)
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

The transformation does a fairly good job of shrinking the high violation intersections down and scaling the low violation intersections up. Now, it looks like there might be a reoccurring pattern occurring within a year. So, I’m wondering if there is a seasonal trend. To look at this, let’s focus on a single intersection for the moment: Lake Shore Dr. and Belmont.

What’s the pattern?

lsd_belmont <- red_light_popular %>%
  filter(intersection == "LAKE SHORE DR AND BELMONT")

ggplot(lsd_belmont, aes(date, violations)) +
  geom_point(aes(group = intersection)) +
  geom_smooth(se = FALSE) +
  geom_jitter()
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

Now, let’s see how the monthly patterns change by year for the same intersection.

ggplot(lsd_belmont, aes(month, violations)) +
  geom_point(aes(group = year)) +
  geom_jitter() +
  geom_smooth(se = FALSE)
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

Both of these graphs supports the seasonal trend idea–there is a bump in red light violations every summer, between May and August.

Now, I have a few questions:

• Are these patterns the same for all intersections?
• What’s driving these peaks? More drivers/tourists on the road in summer months?
• What’s producing the gap between the high violations (above 25 violations) and low violations (below 25 violations)?
• Is this pattern more pronounced in certain parts of the city (e.g., Lake Shore and Belmont is by a popular highway)?
• What happened in the summer/fall of 2016?

Can we remove this pattern?

belmont_mod <- lm(log(violations) ~ factor(month), data = lsd_belmont)

lsd_belmont %>%
  add_predictions(belmont_mod) %>%
  ggplot(aes(date, pred)) +
  geom_line()

This shows the model has captured the seasonal pattern, but plotting the residuals will probably be more useful.

lsd_belmont %>%
  add_residuals(belmont_mod) %>%
  ggplot(aes(date, resid)) +
  geom_hline(yintercept = 0, color = "white", size = 3) +
  geom_point() +
  geom_smooth(se = FALSE)
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

It looks like the seasonal model does a good job of explaining the data, especially for 2017 on. And, by removing the strong monthly pattern, we can see the long-term trends much more clearly. There’s a steady increase from the beginning of the data to about 2016 when the number of red light violations peak. They then take a slight dip but remain relatively stable through the present.

More questions:

• What’s driving this trend?
• What happened around 2016?
• Is this pattern the same for all intersections?

All intersections

Now, I want to extend this model to all of the intersections in the sample.

by_intersection <- red_light_popular %>%
  group_by(intersection) %>%
  nest()

intersection_model <- function(df) {
  lm(log10(violations) ~ factor(month), data = df)
}

partioned <- by_intersection %>%
  mutate(
    model = map(data, intersection_model),
    resids = map2(data, model, add_residuals)
  ) %>%
  unnest(resids)

ggplot(partioned, aes(date, resid)) +
  geom_line(aes(group = intersection), alpha = 1/5) +
  stat_summary(geom = "line", fun.y = function(x) quantile(x, 0.25), color = "blue") +
  stat_summary(geom = "line", fun.y = function(x) quantile(x, 0.75), color = "blue") +
  geom_smooth(se = FALSE, linetype = "dashed", color = "red")
## Warning: The `fun.y` argument of `stat_summary()` is deprecated as of ggplot2 3.3.0.
## ℹ Please use the `fun` argument instead.
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

After removing the seasonal pattern, the long-term trend becomes much more stable. However, some unexplained patterns remain.

Further questions:

• What drove the increase in violations between 2014 and mid-2016?
• What happened at the end of 2016/beginning of 2017?
• Do violations occur systematically throughout the city, or are certain locations more likely to lead to higher violations?

Which years had the highest ratings?

tv_rating %>%
  mutate(year = year(date)) %>%
  group_by(year) %>%
  summarize(
    n = n(),
    avg_rating = mean(av_rating)
  ) %>%
  filter(n > 25) %>%
  arrange(desc(avg_rating)) %>%
  ggplot() +
  aes(year, avg_rating) +
  geom_point() +
  geom_smooth(
    formula = y ~ x,
    method = "lm",
    se = FALSE,
    color = "red"
  ) +
  labs(
    title = "Which years had the highest ratings?",
    x = "Year",
    y = "Average rating"
  ) +
  stat_poly_eq(aes(label = paste("atop(", ..eq.label.., ",", ..adj.rr.label.., ")")),
    formula = y ~ x, color = "red", parse = TRUE
  ) +
  theme_light()

Looks like the newer the TV drama, the more likely it was to have a higher rating. Maybe some of this is variance is due to shows with multiple seasons. Let’s see how this changes when looking at individual shows and their respective run lengths.

Which titles had the highest ratings, and how long did they run?

titles <- tv_rating %>%
  group_by(title) %>%
  summarize(
    n = n(),
    first_yr = min(year(date)),
    last_yr = max(year(date)),
    num_seasons = max(seasonNumber),
    yrs_aired = (max(year(date) - min(year(date)))),
    avg_rating = mean(av_rating)
  ) %>%
  filter(n > 10) %>% # not enough cases to filter by 25 ratings per title
  arrange(desc(avg_rating))

# highest rated titles' run lengths
titles %>%
  mutate(title = fct_reorder(title, yrs_aired)) %>%
  ggplot() +
  aes(title, yrs_aired, fill = title) +
  geom_col() +
  coord_flip() +
  labs(
    title = "Most popular series' run lengths",
    x = "TV Series Title",
    y = "Number of years aired"
  ) +
  theme_light() +
  theme(legend.position = "none")

# highest rated titles rating over time
titles %>%
  ggplot() +
  aes(yrs_aired, avg_rating) +
  geom_point() +
  geom_smooth(
    formula = y ~ x,
    method = "lm",
    se = FALSE,
    color = "red"
  ) +
  labs(
    title = "Most popular series' ratings over time",
    x = "Number of years ran",
    y = "Average rating"
  ) +
  stat_poly_eq(aes(label = paste("atop(", ..eq.label.., ",", ..adj.rr.label.., ")")),
    formula = y ~ x, color = "red", parse = TRUE
  ) +
  theme_light()

I haven’t seen all of these shows, but for the most part, their titles seem to describe suspenseful dramas (e.g., mystery, crime, maybe even thriller/horror). However, King of the Hill doesn’t really fit this description, so let’s take a look at the genre variable. Keeping in mind that all of these shows are dramas, I’m conceptualizing these as sub-genres of drama.

Which sub-genres are most popular?

top_ratings <- function(df, x) {
  df %>%
    summarize(
      n = n(),
      avg_rating = mean(av_rating),
      med_rating = median(av_rating)
    ) %>%
    filter(n > 25) %>%
    arrange(desc(med_rating))
}

tv_rating %>%
  group_by(genres) %>%
  top_ratings() %>%
  mutate(genres = str_replace_all(genres, ",", ", ")) %>%
  gt() %>%
  tab_header(title = "Which drama sub-genres are most popular?") %>%
  fmt_number(
    columns = vars(avg_rating, med_rating),
    decimals = 3
  ) %>%
  cols_label(
    genres = "Sub-genres",
    n = "Number of responses",
    avg_rating = "Average rating",
    med_rating = "Median rating"
  )

These results provide some evidence of my initial impression: People tend to give higher ratings to suspenseful-like dramas (e.g., crime, thriller, horror, mystery, action). But, there’s not much variability between the values. This might be because many of the values in ‘genres’ are grouped together. Combining genres like this could hide underlying patterns among the sub-genres, so let’s split the genres variable up such that each sub-genre has its own row.

genre_split <- tv_rating %>%
  mutate(genres = str_split(genres, pattern = ",")) %>%
  unnest()

After splitting up ‘genres’, which sub-genres are most popular?

genre_split %>%
  group_by(genres) %>%
  top_ratings() %>%
  gt() %>%
  tab_header(title = "Which sub-genres are most popular?") %>%
  fmt_number(
    columns = vars(avg_rating, med_rating),
    decimals = 3
  ) %>%
  cols_label(
    genres = "Sub-genres",
    n = "Number of responses",
    avg_rating = "Average rating",
    med_rating = "Median rating"
  )

Still, very little variability between sub-genres. The overall difference between the the highest (‘Sport’) and lowest (‘Animation’) rating is around 0.49. Nevertheless, these results paint a different picture than when all of the sub-genres were grouped together.

Now, it looks like sports, history, and music are the highest rated sub-genres, and not the suspenseful ones (i.e., crime, thriller, and horror) we saw earlier. To be fair, these new sub-genres could very well be suspenseful, but they seem to be of a slightly different “theme” than the former ones.

This raises a good point: Within the dramas, there are different types, and these types could be valued for different reasons. For example, comedy dramas might be valued for certain positive connotations (e.g., laughter), whereas a crime drama might be valued for certain negative connotations (e.g., fear). So, perhaps there is a difference between comedies (defined as comedy and animation) and tragedies (defined as crime, horror, and thriller). Granted, these definitions could be debated/refined, but they should provide a rough snapshot of the idea.

Is there a difference in ratings between comedies and tragedies?

genre_split %>%
  mutate(
    com_trag = case_when(
      genres == "Comedy" |
        genres == "Animation" ~ "comedy",
      genres == "Crime" |
        genres == "Horror" |
        genres == "Thriller" ~ "tragedy"
    )
  ) %>%
  filter(!is.na(com_trag)) %>%
  group_by(com_trag) %>%
  top_ratings() %>%
  mutate(com_trag = str_to_title(com_trag)) %>%
  gt() %>%
  tab_header(title = "Mean/median differences between comedies and tragedies") %>%
  fmt_number(
    columns = vars(avg_rating, med_rating),
    decimals = 3
  ) %>%
  cols_label(
    com_trag = "Drama type",
    n = "Number of responses",
    avg_rating = "Average rating",
    med_rating = "Median rating"
  )

So, there is a difference, people tend to rate tragedies higher than comedies, but in the grand scheme of things, this difference quite small. The average distance between comedies and tragedies is only 0.07, and the median difference is 0.1. Thus, it seems there’s not much difference in viewer ratings among sub-genres, at least not in our sample. But, this isn’t actually that surprising: Our sample was already narrowed down to TV drama titles. Since all of the titles share this common characteristic, what we’re probably seeing is the consistency of viewers to rate TV dramas in a similar fashion. In other words, people tend to rate all TV dramas similarly, regardless of the story line/sub-genre.

Since sub-genres didn’t bare much useful information, let’s take a look at the actual titles within the dataset. All of the top-rated shows aired for multiple seasons, but I doubt every show that aired multiple seasons was popular. In fact, some earlier analyses showed a decline in ratings over time. So, let’s see what the data say.

How do viewer ratings changes over time by TV show title

# list most popular shows from earlier analysis (with extra picks of my own)
shows <- c("The X-Files", "Law & Order", "Midsomer Murders", "Law & Order: Special Victims Unit", "ER", "Grey's Anatomy", "CSI: Crime Scene Investigation", "Supernatural", "King of the Hill", "Doctor Who", "Criminal Minds", "Bones", "Murdoch Mysteries", "American Horror Story", "Are you Afraid of the Dark?", "Californication", "Elementary", "Lost", "Numb3rs", "Shameless", "The Walking Dead", "The Sopranos", "Scrubs", "Oz", "House", "Dexter")

tv_rating %>%
  filter(title %in% shows) %>%
  mutate(title = str_replace(title, "Special Victims Unit", "SVU")) %>%
  group_by(title) %>%
  ggplot() +
  aes(date, av_rating) +
  facet_wrap(~title) +
  geom_line() +
  labs(
    title = "Viewer ratings over time by TV show title",
    x = "Years aired",
    y = "Average rating"
  ) +
  theme_light() +
  theme(axis.text.x = element_text(angle = 90))

Okay, now we have some interesting patterns to interpret. Overall, it looks like even the most popular shows experienced a decline in enthusiasm the longer they aired. However, there are notable exceptions to this trend: Criminal Minds and Murdoch Mysteries have really taken off in the last few years, both receiving the highest ratings out of any of the tiles in this sample. American Horror Story appears to be making a comeback as well recently. Noticeably, these exceptions all fit the suspenseful-like dramas noted earlier. It seems, then, the most successful TV dramas are ones with intense or striking elements (e.g., crime, murder, horror, etc.). I wonder if this says anything about the culture of the viewers…lookin’ at you America 🤔

The data

First, let’s take a look at the structure of the data:

library(ggplot2)
str(mpg)
## tibble [234 × 11] (S3: tbl_df/tbl/data.frame)
##  $ manufacturer: chr [1:234] "audi" "audi" "audi" "audi" ...
##  $ model       : chr [1:234] "a4" "a4" "a4" "a4" ...
##  $ displ       : num [1:234] 1.8 1.8 2 2 2.8 2.8 3.1 1.8 1.8 2 ...
##  $ year        : int [1:234] 1999 1999 2008 2008 1999 1999 2008 1999 1999 2008 ...
##  $ cyl         : int [1:234] 4 4 4 4 6 6 6 4 4 4 ...
##  $ trans       : chr [1:234] "auto(l5)" "manual(m5)" "manual(m6)" "auto(av)" ...
##  $ drv         : chr [1:234] "f" "f" "f" "f" ...
##  $ cty         : int [1:234] 18 21 20 21 16 18 18 18 16 20 ...
##  $ hwy         : int [1:234] 29 29 31 30 26 26 27 26 25 28 ...
##  $ fl          : chr [1:234] "p" "p" "p" "p" ...
##  $ class       : chr [1:234] "compact" "compact" "compact" "compact" ...

Among other things, this tells us there are a 234 observations of 11 different variables. Most of these variables are fairly intuitive by their names, but for our purposes, I will only focus on three of them: displ, hwy, cyl. These are the cars’ engine displacement (in litres), highway miles per gallon, and number of cylinders.

Creating the graph

Here is the code to create the graph using the ggplot2 package:

library(ggplot2)
ggplot(mpg, aes(displ, hwy)) +
  geom_point(aes(col = factor(cyl))) +
  geom_smooth(method = lm, aes(col = factor(cyl)))
## `geom_smooth()` using formula = 'y ~ x'

And, that’s all there is to it! While it may seem pretty straightforward, this actually took me a few days to create when I first started coding in R. Indeed, one’s first ggplot seems like quiet the achievement in the moment!

If you’re scratching your head after reading this post, don’t worry! I plan to blog about plenty of neat things one can do in R (and in much more detail), so stay tuned!