tests/testthat/test-espn_basketball_player_core.R

In wehoop: Access Women's Basketball Play by Play Data

test_that("espn_basketball_player_core() reproduces the sdv-py oracle", {
  skip_on_cran()
  # Golden-master parity. The Python implementation
  # (sportsdataverse.{wnba,wbb}.helper_*_player_core, sdv-py 0.0.75) currently
  # produces the released player_core dataset; this R function is a port and
  # must reproduce it exactly. Fixtures + provenance:
  #   tests/testthat/fixtures/player_core/README.md
  #
  # The payloads are copied byte-for-byte from hoopR-nba-raw, never
  # hand-written -- a hand-made payload is the failure mode this guards.
  fx <- testthat::test_path("fixtures", "player_core")

  # Column types are DECLARED, never inferred, and read with base R so the
  # test adds no dependency to the package (readr is not in Imports/Suggests;
  # using it fails R CMD check on a clean machine).
  #
  # Inference guesses wrong here in both directions: `date_of_birth`
  # ("1979-11-27T08:00Z") parses as a datetime and `jersey` ("98", "", "35") as
  # a number. The second is the dangerous one -- a numeric jersey silently
  # turns "007" into 7, so the oracle would drift from the released string
  # column while the test still passed.
  #
  # na.strings = "" ONLY. The default includes "NA", which would turn the
  # literal string "NA" into a missing value -- and ESPN uses "NA" as a real
  # value: the abbreviation of its "Not Available" position is the two
  # characters N,A. Empty cells, which is what genuine nulls serialise to,
  # still read as NA.
  int_cols <- c(
    "athlete_id", "age", "position_id", "college_id", "current_team_id",
    "experience_years", "status_id", "draft_year", "draft_round",
    "draft_selection"
  )
  all_cols <- c(
    "athlete_id", "guid", "uid", "slug", "type", "first_name", "last_name",
    "full_name", "display_name", "short_name", "height", "display_height",
    "weight", "display_weight", "age", "date_of_birth", "birth_city",
    "birth_state", "birth_country", "jersey", "position_id", "position_name",
    "position_abbreviation", "position_display_name", "college_id",
    "current_team_id", "headshot_href", "experience_years", "status_id",
    "status_name", "status_type", "draft_year", "draft_round",
    "draft_selection", "active"
  )
  col_classes <- vapply(all_cols, function(col) {
    if (col %in% int_cols) "integer"
    else if (col %in% c("height", "weight")) "numeric"
    else if (col == "active") "logical"
    else "character"
  }, character(1))

  expected <- utils::read.csv(
    file.path(fx, "expected_player_core.csv"),
    colClasses = col_classes,
    na.strings = "",
    check.names = FALSE
  )

  # Both women's leagues in one oracle: the projection is league-agnostic,
  # so a divergence that only shows on college payloads (wbb) must fail here.
  specs <- list(
    list(f = "wnba_1002.json", id = 1002L),
    list(f = "wnba_1007.json", id = 1007L),
    list(f = "wbb_13905.json", id = 13905L),
    list(f = "wbb_10000.json", id = 10000L)
  )
  actual <- purrr::map_dfr(specs, function(s) {
    payload <- jsonlite::fromJSON(file.path(fx, s$f), simplifyVector = FALSE)
    espn_basketball_player_core(payload, athlete_id = s$id)
  })

  expect_equal(nrow(actual), 4L)
  expect_equal(ncol(actual), 35L)
  # Column ORDER is part of the contract: both sides feed a released parquet
  # whose consumers select positionally in places.
  expect_equal(names(actual), names(expected))

  # Ids and categoricals must match exactly -- no tolerance. A tolerance on an
  # id is how "123" and "123.0" pass as equal.
  exact_cols <- setdiff(names(expected), c("height", "weight"))
  for (col in exact_cols) {
    expect_equal(
      actual[[col]], expected[[col]],
      info = paste0("column mismatch: ", col)
    )
  }

  # height/weight are the only floats. Tolerance is 1e-9 rather than 0 because
  # the values round-trip through CSV text; they are ESPN integers-as-doubles
  # in practice, so any real divergence is far larger than this.
  for (col in c("height", "weight")) {
    expect_equal(
      actual[[col]], expected[[col]],
      tolerance = 1e-9,
      info = paste0("float column mismatch: ", col)
    )
  }
})

test_that("espn_basketball_player_core() covers the branches the fixtures encode", {
  skip_on_cran()
  fx <- testthat::test_path("fixtures", "player_core")
  .read_one <- function(file, aid) {
    espn_basketball_player_core(
      jsonlite::fromJSON(file.path(fx, file), simplifyVector = FALSE),
      athlete_id = aid
    )
  }

  # wnba 1007 has no college node: college_id NA, not 0 and not an error.
  expect_true(is.na(.read_one("wnba_1007.json", 1007L)$college_id))
  # wnba 1002 is the fully-populated pro path.
  full <- .read_one("wnba_1002.json", 1002L)
  expect_false(is.na(full$college_id))
  expect_false(is.na(full$draft_year))
  # wbb 10000 is the college case that the men's fixtures cannot reach: it has
  # NO college node yet still resolves a birth_country, because college payloads
  # carry birthCountry at the TOP LEVEL rather than nested under birthPlace.
  college <- .read_one("wbb_10000.json", 10000L)
  expect_true(is.na(college$college_id))
  expect_equal(college$birth_country, "USA")
})

test_that("espn_basketball_player_core() applies both documented fallbacks", {
  skip_on_cran()
  # Neither fallback is reachable from the fixtures: all three real athletes
  # carry displayName, and all three nest birthPlace$country. Mutation-testing
  # the port proved it -- deleting the displayName->fullName fallback left the
  # golden-master test at 54/54 green. These assertions are what make the
  # fallbacks load-bearing rather than decorative.

  # displayName absent -> fall back to fullName.
  out <- espn_basketball_player_core(
    list(fullName = "Jane Doe"), athlete_id = 1L
  )
  expect_equal(out$display_name, "Jane Doe")
  # ...and when present it wins.
  out2 <- espn_basketball_player_core(
    list(fullName = "Jane Doe", displayName = "J. Doe"), athlete_id = 1L
  )
  expect_equal(out2$display_name, "J. Doe")

  # birth_country: college payloads carry a TOP-LEVEL birthCountry, pro
  # payloads nest it under birthPlace.
  nested <- espn_basketball_player_core(
    list(birthPlace = list(country = "USA")), athlete_id = 1L
  )
  expect_equal(nested$birth_country, "USA")
  top <- espn_basketball_player_core(
    list(birthCountry = "Canada"), athlete_id = 1L
  )
  expect_equal(top$birth_country, "Canada")
  # nested wins when both are present
  both <- espn_basketball_player_core(
    list(birthPlace = list(country = "USA"), birthCountry = "Canada"),
    athlete_id = 1L
  )
  expect_equal(both$birth_country, "USA")
})

test_that("espn_basketball_player_core() returns a stable empty schema", {
  skip_on_cran()
  # No payload in the 2,577-file tree is sparse enough to fixture, so the
  # empty/non-dict path is asserted directly. A caller chaining onto this must
  # see the documented column set rather than a zero-column tibble.
  for (empty in list(list(), NULL, "not a payload")) {
    out <- espn_basketball_player_core(empty, athlete_id = 1L)
    expect_s3_class(out, "tbl_df")
    expect_equal(nrow(out), 0L)
  }
})

test_that("espn_basketball_player_core() parses $ref ids without fetching", {
  skip_on_cran()
  # The ids live in the core-v2 $ref URL. Parsing is required; fetching would
  # make a compile stage hit the network and would break the one-way
  # raw -> data boundary.
  payload <- list(
    id = "7",
    college = list(`$ref` = "http://sports.core.api.espn.com/v2/colleges/153?lang=en"),
    team = list(`$ref` = "http://sports.core.api.espn.com/v2/sports/basketball/leagues/nba/seasons/2025/teams/22?lang=en")
  )
  out <- espn_basketball_player_core(payload, athlete_id = 7L)
  expect_equal(out$college_id, 153L)
  expect_equal(out$current_team_id, 22L)

  # A $ref with no /colleges/ or /teams/ segment yields NA, not a wrong id.
  bare <- espn_basketball_player_core(
    list(college = list(`$ref` = "http://example.com/v2/something/9")),
    athlete_id = 7L
  )
  expect_true(is.na(bare$college_id))
})

test_that("espn_basketball_player_core() keeps athlete_id an integer join key", {
  skip_on_cran()
  # athlete_id joins to player_box / player_season_stats. A float-origin id
  # stringifies as "123.0" and joins to nothing -- the recurring port bug.
  out <- espn_basketball_player_core(list(guid = "g"), athlete_id = "1966")
  expect_equal(out$athlete_id, 1966L)
  expect_false(is.character(out$athlete_id))
})

test_that("espn_basketball_player_core() finalizes both paths as wehoop_data", {
  skip_on_cran()
  # Without these assertions the suite passes even if make_wehoop_data() is deleted: the
  # golden-master test compares values and column names, and neither changes
  # when the class and attributes are dropped. The finalized contract was added
  # in response to review, so it needs a test that fails when it regresses.
  fx <- testthat::test_path("fixtures", "player_core")
  populated <- espn_basketball_player_core(
    jsonlite::fromJSON(file.path(fx, "wnba_1002.json"), simplifyVector = FALSE),
    athlete_id = 1002L
  )
  empty <- espn_basketball_player_core(list(), athlete_id = 1L)

  for (out in list(populated, empty)) {
    expect_s3_class(out, "wehoop_data")
    expect_equal(attr(out, "wehoop_type"),
                 "ESPN Basketball Player Core from ESPN.com")
    expect_s3_class(attr(out, "wehoop_timestamp"), "POSIXct")
    # The finalizer must not disturb the 35-column contract it wraps.
    expect_equal(ncol(out), 35L)
  }
  expect_equal(nrow(populated), 1L)
  expect_equal(nrow(empty), 0L)
})