Skip to content

Instantly share code, notes, and snippets.

@charlespwd
Created February 9, 2021 14:49
Show Gist options
  • Save charlespwd/d158b99cef96d9ac4c0d6128a12dae9c to your computer and use it in GitHub Desktop.
Save charlespwd/d158b99cef96d9ac4c0d6128a12dae9c to your computer and use it in GitHub Desktop.
# 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment