lighthouse.r

# This code is a vectorized R version of the Lighthouse scoring code
# that you can find here:
# https://github.com/GoogleChrome/lighthouse/blob/9e0e9dfb67a3dd38b611b02d1129b197da8a2b0c/lighthouse-core/lib/statistics.js#L75-L97

INVERSE_ERFC_ONE_FIFTH <- 0.9061938024368232

erf <- function(x) {
  s <- sign(x)
  x <- abs(x)
  a1 <- 0.254829592
  a2 <- -0.284496736
  a3 <- 1.421413741
  a4 <- -1.453152027
  a5 <- 1.061405429
  p <- 0.3275911
  t <- 1 / (1 + p * x)
  y <- t * (a1 + t * (a2 + t * (a3 + t * (a4 + t * a5))))
  s * (1 - y * exp(-x * x))
}

# Vectorized Math.min
amin <- function(a, b) {
  if_else(a <= b, a, b)
}

# Vectorized Math.max
amax <- function(a, b) {
  if_else(a <= b, b, a)
}

# vectorized version.
log_normal_score <- function(p10, median, values) {
  if (median <= 0) stop("median must be greater than 0")
  if (p10 <= 0) stop("p10 must be greater than 0")
  if (p10 >= median) stop("p10 must be less than median")
  # Shape (σ) is `log(p10/median) / (sqrt(2)*erfc^-1(2 * 1/10))` and
  # standardizedX is `1/2 erfc(log(value/median) / (sqrt(2)*σ))`, so simplify a bit.
  xLogRatio <- log(values / median)
  p10LogRatio <- -log(p10 / median) # negate to keep σ positive.
  standardizedX <- xLogRatio * INVERSE_ERFC_ONE_FIFTH / p10LogRatio
  complementaryPercentile <- (1 - erf(standardizedX)) / 2
  # Clamp to [0, 1] to avoid any floating-point out-of-bounds issues.
  amin(1, amax(0, complementaryPercentile))
}

# Use these on "flat" metrics to convert them into [0, 1] scores. Like
# lightouse uses internally
#
# @example
# dataset %>%
#   mutate(
#     first_contentful_paint_score = fcp_score(first_contenful_paint) * 100,
#     largest_contentful_paint_score = lcp_score(largest_contentful_paint) * 100
#   )
fcp_score <- function(values) log_normal_score(2336, 4000, values)
lcp_score <- function(values) log_normal_score(2500, 4000, values)
si_score <- function(values) log_normal_score(3387, 5800, values)
tbt_score <- function(values) log_normal_score(287, 600, values)
tti_score <- function(values) log_normal_score(3785, 7300, values)