tests/testthat/test-bid_interpret.R

In bidux: Behavior Insight Design: A Toolkit for Integrating Behavioral Science in UI/UX Design

test_that("bid_interpret returns a tibble with stage 'Interpret'", {
  local_mocked_bindings(
    validate_required_params = function(...) invisible(TRUE),
    validate_previous_stage = function(...) invisible(TRUE),
    bid_message = function(...) invisible(NULL),
    safe_column_access = function(df, column_name, default = NA) {
      if (column_name %in% names(df)) df[[column_name]][1] else default
    },
    bid_stage = function(stage_name, data, metadata) {
      attr(data, "class") <- c("bid_stage", class(data))
      attr(data, "stage_name") <- stage_name
      attr(data, "metadata") <- metadata
      data
    }
  )

  previous_stage <- tibble(
    stage = "Notice",
    problem = "Users struggle with complex data",
    theory = "Cognitive Load Theory",
    evidence = "Test results indicate delays",
    target_audience = "Data Analysts"
  )

  result <- bid_interpret(previous_stage)

  expect_s3_class(result, "bid_stage")
  expect_equal(result$stage[1], "Interpret")
  expect_true("central_question" %in% names(result))
})

test_that("bid_interpret uses provided central_question", {
  local_mocked_bindings(
    validate_user_personas = function(personas) invisible(NULL),
    bid_concepts = function(search = NULL) {
      tibble::tibble(
        concept = "Data Storytelling Framework",
        description = "Dummy description",
        category = "Stage 2",
        reference = NA_character_,
        example = NA_character_
      )
    }
  )

  previous_stage <- tibble::tibble(
    stage = "Notice",
    problem = "Users struggle with complex data",
    theory = "Cognitive Load Theory",
    evidence = "Test results indicate delays"
  )

  my_question <- "What is causing data complexity issues?"
  result <- bid_interpret(previous_stage, central_question = my_question)

  expect_equal(result$central_question[1], my_question)
})

test_that("bid_interpret errors when data_story is not a list", {
  local_mocked_bindings(
    validate_user_personas = function(personas) invisible(NULL)
  )

  previous_stage <- tibble::tibble(
    stage = "Notice",
    problem = "Users struggle with complex data",
    theory = "Cognitive Load Theory",
    evidence = "Test results indicate delays"
  )

  expect_error(
    bid_interpret(previous_stage, data_story = "not a list"),
    regexp = "'data_story' must be a list"
  )
})

test_that("bid_interpret errors when personas is invalid", {
  local_mocked_bindings(
    validate_user_personas = function(personas) {
      cli::cli_abort("Invalid personas provided")
    }
  )

  previous_stage <- tibble::tibble(
    stage = "Notice",
    problem = "Users struggle with complex data",
    theory = "Cognitive Load Theory",
    evidence = "Test results indicate delays"
  )

  expect_error(
    bid_interpret(previous_stage, user_personas = "not a list"),
    regexp = "Invalid personas provided"
  )
})

test_that("bid_interpret auto-suggests central_question when NULL", {
  previous_stage <- tibble::tibble(
    stage = "Notice",
    problem = "Users struggle to find important metrics",
    theory = "Visual Hierarchies",
    evidence = "User feedback from interviews",
    target_audience = "Marketing team",
    suggestions = "Example suggestions",
    timestamp = Sys.time()
  )

  suppressMessages(
    result <- bid_interpret(previous_stage, central_question = NULL)
  )

  expect_s3_class(result, "bid_stage")
  expect_false(is.na(result$central_question[1]))
  expect_true(nchar(result$central_question[1]) > 0)
  expect_match(
    result$central_question[1],
    "metrics|find|important",
    perl = TRUE
  )
})

test_that("bid_interpret auto-suggests data_story when NULL", {
  previous_stage <- tibble::tibble(
    stage = "Notice",
    problem = "Dashboard has too many visualizations",
    theory = "Cognitive Load Theory",
    evidence = "User testing revealed confusion",
    target_audience = "Data analysts",
    suggestions = "Example suggestions",
    timestamp = Sys.time()
  )

  suppressMessages(
    result <- bid_interpret(
      previous_stage,
      central_question = "How can we simplify the dashboard?"
    )
  )

  expect_s3_class(result, "bid_stage")
  expect_false(is.na(result$hook[1]))
  expect_false(is.na(result$context[1]))
  expect_false(is.na(result$tension[1]))
  expect_false(is.na(result$resolution[1]))
  expect_match(
    paste(result$hook[1], result$context[1], result$tension[1]),
    "visualizations|dashboard|confusion",
    perl = TRUE
  )
})

test_that("bid_interpret handles edge cases in data_story parameter", {
  previous_stage <- tibble::tibble(
    stage = "Notice",
    problem = "Test problem",
    evidence = "Test evidence",
    timestamp = Sys.time()
  )

  suppressMessages(
    result <- bid_interpret(
      previous_stage,
      central_question = "Test question",
      data_story = list(
        hook = "Test hook",
        context = "Test context"
        # intentionally missing tension and resolution
      )
    )
  )

  expect_s3_class(result, "bid_stage")
  expect_equal(result$hook[1], "Test hook")
  expect_equal(result$context[1], "Test context")
  expect_true(is.na(result$tension[1]))
  expect_true(is.na(result$resolution[1]))

  suppressMessages(
    result <- bid_interpret(
      previous_stage,
      central_question = "Test question",
      data_story = list(
        hook = "",
        context = "  ", # just whitespace
        tension = "Test tension",
        resolution = "Test resolution"
      )
    )
  )

  expect_s3_class(result, "bid_stage")
  expect_true(is.na(result$hook[1]) || result$hook[1] == "")
  expect_true(is.na(result$context[1]) || result$context[1] == "  ")

  suppressMessages(
    result <- bid_interpret(
      previous_stage,
      central_question = "Test question",
      data_story = list(
        hook = "Test hook",
        context = "Test context",
        tension = "Test tension",
        resolution = "Test resolution",
        extra_field = "This is not a standard field",
        another_extra = "Another non-standard field"
      )
    )
  )

  expect_s3_class(result, "bid_stage")
  expect_equal(result$hook[1], "Test hook")
  expect_equal(result$resolution[1], "Test resolution")
})

test_that("bid_interpret handles edge cases in personas parameter", {
  previous_stage <- tibble::tibble(
    stage = "Notice",
    problem = "Test problem",
    evidence = "Test evidence",
    timestamp = Sys.time()
  )

  suppressWarnings(
    result <- bid_interpret(
      previous_stage,
      central_question = "Test question",
      user_personas = list(
        list(name = "Minimal Persona")
      )
    )
  )

  expect_s3_class(result, "bid_stage")
  expect_false(is.na(result$personas[1]))

  suppressWarnings(
    result <- bid_interpret(
      previous_stage,
      central_question = "Test question",
      user_personas = list()
    )
  )

  expect_s3_class(result, "bid_stage")
  expect_true(is.na(result$personas[1]))

  suppressWarnings(
    result <- bid_interpret(
      previous_stage,
      central_question = "Test question",
      user_personas = list(
        list(
          name = "Complete Persona",
          goals = "Test goals",
          pain_points = "Test pain points",
          technical_level = "Advanced"
        ),
        list(
          name = "Partial Persona",
          goals = "Test goals"
        )
      )
    )
  )

  expect_s3_class(result, "bid_stage")
  expect_false(is.na(result$personas[1]))
  expect_match(result$personas[1], "Complete Persona")
  expect_match(result$personas[1], "Partial Persona")
})

test_that("bid_interpret handles NA values in previous_stage", {
  previous_stage <- tibble::tibble(
    stage = "Notice",
    problem = NA_character_, # NA problem
    theory = "Cognitive Load Theory",
    evidence = "Test evidence",
    target_audience = NA_character_, # NA audience
    timestamp = Sys.time()
  )

  suppressMessages(
    result <- bid_interpret(previous_stage)
  )

  expect_s3_class(result, "bid_stage")
  expect_false(is.na(result$central_question[1]))
  expect_true(is.na(result$previous_problem[1]))
  expect_true(is.na(result$previous_audience[1]))
})

test_that("bid_interpret validates personas structure correctly", {
  previous_stage <- tibble::tibble(
    stage = "Notice",
    problem = "Test problem",
    evidence = "Test evidence",
    timestamp = Sys.time()
  )

  expect_error(
    bid_interpret(
      previous_stage,
      central_question = "Test question",
      user_personas = list(
        list(
          # missing required persona 'name' field
          goals = "Test goals",
          pain_points = "Test pain points"
        )
      )
    )
  )

  # multiple personas with missing recommended fields should warn but not error
  suppressWarnings(
    result <- bid_interpret(
      previous_stage,
      central_question = "Test question",
      user_personas = list(
        list(name = "Persona 1"),
        list(name = "Persona 2", technical_level = "Advanced")
      )
    )
  )

  expect_s3_class(result, "bid_stage")
  expect_match(result$personas, "Persona 1", fixed = TRUE)
  expect_match(result$personas, "Persona 2", fixed = TRUE)
})