Come valutare le tue previsioni.  Fai attenzione alla misura che scegli |  di Jeffrey Näf |  Maggio 2024

 | Intelligenza-Artificiale

Fai attenzione alla misura che scegli

fotografato da Isacco Smith SU Unsplash

TLa valutazione e il benchmarking dei modelli di machine learning confrontando le loro previsioni su un set di test, anche dopo la distribuzione, è di fondamentale importanza. Per fare questo, bisogna pensare ad una misura o punto che accetta una previsione e un punto di test e assegna un valore che misura il successo della previsione rispetto al punto di test. Tuttavia, si dovrebbe riflettere attentamente su quale misura di punteggio sia appropriata. In particolare, quando si sceglie un metodo per valutare una previsione dovremmo attenersi all'idea di regole di punteggio adeguate. Qui fornisco solo una definizione approssimativa di questa idea, ma fondamentalmente vogliamo un punteggio minimo per l'oggetto che vogliamo misurare!

COME una regola generale: è possibile utilizzare MSE per valutare le previsioni medie, MAE per valutare le previsioni mediane, il punteggio quantilico per valutare previsioni quantiliche più generali e il punteggio energetico o MMD per valutare le previsioni distribuzionali.

Considera una variabile che vuoi prevedere, ad esempio una variabile casuale Yda un vettore di covariate X. Nell'esempio seguente, Y sarà reddito e X saranno alcune caratteristiche, come ad esempio età E formazione scolastica. Abbiamo imparato un predittore F su alcuni dati di allenamento e ora prevediamo Y COME F(X). Di solito, quando vogliamo prevedere una variabile Y nel miglior modo possibile prevediamo l'aspettativa di dato Xcioè F(X) dovrebbe approssimarsi E(Y | X=X). Ma più in generale, F(X) potrebbe essere uno stimatore della mediana, di altri quantili o anche dell'intera distribuzione condizionale P(Y | X=X).

Ora per un nuovo punto di prova vogliamo dare un punteggio alla tua previsione, cioè vuoi una funzione S(y,f(X))questo è ridotto al minimo (in attesa) Quando F(X) è la cosa migliore che puoi fare. Ad esempio, se vogliamo prevedere E(Y | X=X)questo punteggio è dato come MSE: S(y, f(X))= (yf(X))².

Qui studiamo il principio del punteggio del predittore F al set di prova di (sì,X_i), i=1,…,ntest più in dettaglio. In tutti gli esempi confronteremo il metodo di stima ideale con un altro che è chiaramente sbagliato, o ingenuo, e mostreremo che i nostri punteggi fanno quello che dovrebbero.

L'esempio

Per illustrare le cose, simulerò un semplice set di dati che dovrebbe imitare i dati sul reddito. Utilizzeremo questo semplice esempio in questo articolo per illustrare i concetti.

library(dplyr)

#Create some variables:
# Simulate data for 100 individuals
n <- 5000

# Generate age between 20 and 60
age <- round(runif(n, min = 20, max = 60))

# Define education levels
education_levels <- c("High School", "Bachelor's", "Master's")

# Simulate education level probabilities
education_probs <- c(0.4, 0.4, 0.2)

# Sample education level based on probabilities
education <- sample(education_levels, n, replace = TRUE, prob = education_probs)

# Simulate experience correlated with age with some random error
experience <- age - 20 + round(rnorm(n, mean = 0, sd = 3))

# Define a non-linear function for wage
wage <- exp((age * 0.1) + (case_when(education == "High School" ~ 1,
education == "Bachelor's" ~ 1.5,
TRUE ~ 2)) + (experience * 0.05) + rnorm(n, mean = 0, sd = 0.5))

hist(wage)

Sebbene questa simulazione possa essere eccessivamente semplificata, riflette alcune caratteristiche ben note di tali dati: l’età avanzata, l’istruzione avanzata e una maggiore esperienza sono tutti collegati a salari più alti. L’uso dell’operatore “exp” si traduce in una distribuzione salariale altamente distorta, che è un’osservazione coerente in tali set di dati.

Distribuzione salariale su tutta la popolazione simulata. Fonte: Autore

Fondamentalmente, questa asimmetria è presente anche quando fissiamo l’età, l’istruzione e l’esperienza a determinati valori. Immaginiamo di guardare una persona specifica, Dave, che ha 30 anni, una laurea in Economia e 10 anni di esperienza e osserviamo la sua effettiva distribuzione del reddito secondo il nostro processo di generazione dei dati :

ageDave<-30
educationDave<-"Bachelor's"
experienceDave <- 10

wageDave <- exp((ageDave * 0.1) + (case_when(educationDave == "High School" ~ 1,
educationDave == "Bachelor's" ~ 1.5,
TRUE ~ 2)) + (experienceDave * 0.05) + rnorm(n, mean = 0, sd = 0.5))

hist(wageDave, main="Wage Distribution for Dave", xlab="Wage")

Distribuzione salariale per Dave. Fonte: Autore

Pertanto la distribuzione dei possibili salari di Dave, date le informazioni che abbiamo su di lui, è ancora fortemente distorta.

Generiamo anche un set di test di diverse persone:


## Generate test set
ntest<-1000

# Generate age between 20 and 60
agetest <- round(runif(ntest, min = 20, max = 60))

# Sample education level based on probabilities
educationtest <- sample(education_levels, ntest, replace = TRUE, prob = education_probs)

# Simulate experience correlated with age with some random error
experiencetest <- agetest - 20 + round(rnorm(ntest, mean = 0, sd = 3))

## Generate ytest that we try to predict:

wagetest <- exp((agetest * 0.1) + (case_when(educationtest == "High School" ~ 1,
educationtest == "Bachelor's" ~ 1.5,
TRUE ~ 2)) + (experiencetest * 0.05) + rnorm(ntest, mean = 0, sd = 0.5))

Iniziamo ora in modo semplice e osserviamo prima i punteggi per la previsione media e mediana.

I punteggi per la previsione media e mediana

Nella scienza dei dati e nell’apprendimento automatico, l’interesse spesso si concentra su un singolo numero che indica il “centro” o il “mezzo” della distribuzione che miriamo a prevedere, vale a dire la media (condizionale) o mediana. Per fare questo abbiamo l’errore quadratico medio (MSE):

e l'errore medio assoluto (MAE):

Un aspetto importante è che l’MSE è la metrica appropriata per prevedere la media condizionale, mentre il MAE è la misura da utilizzare per la mediana condizionale. Media e mediana non sono la stessa cosa per distribuzioni asimmetriche come quella che studiamo qui.

Illustriamolo per l'esempio sopra con stimatori molto semplici (a cui non avremmo accesso nella vita reale), solo a scopo illustrativo:

conditionalmeanest <-
function(age, education, experience, N = 1000) {
mean(exp((age * 0.1) + (
case_when(
education == "High School" ~ 1,
education == "Bachelor's" ~ 1.5,
TRUE ~ 2
)
) + (experience * 0.05) + rnorm(N, mean = 0, sd = 0.5)
))
}

conditionalmedianest <-
function(age, education, experience, N = 1000) {
median(exp((age * 0.1) + (
case_when(
education == "High School" ~ 1,
education == "Bachelor's" ~ 1.5,
TRUE ~ 2
)
) + (experience * 0.05) + rnorm(N, mean = 0, sd = 0.5)
))
}

Cioè stimiamo la media e la mediana, semplicemente simulando dal modello per valori fissi di età, istruzione ed esperienza (questa sarebbe una simulazione dalla distribuzione condizionale corretta) e poi ne prendiamo semplicemente la media/mediana. Proviamolo su Dave:


hist(wageDave, main="Wage Distribution for Dave", xlab="Wage")
abline(v=conditionalmeanest(ageDave, educationDave, experienceDave), col="darkred", cex=1.2)
abline(v=conditionalmedianest(ageDave, educationDave, experienceDave), col="darkblue", cex=1.2)
Blu: mediana condizionale stimata di Dave, Rosso: media condizionale stimata di Dave. Fonte: Autore

Chiaramente la media e la mediana sono diverse, come ci si aspetterebbe da una tale distribuzione. Infatti, come è tipico per le distribuzioni del reddito, la media è più alta (più influenzata da valori elevati) rispetto alla mediana.

Ora utilizziamo questi stimatori sul set di test:

Xtest<-data.frame(age=agetest, education=educationtest, experience=experiencetest)

meanest<-sapply(1:nrow(Xtest), function(j) conditionalmeanest(Xtest$age(j), Xtest$education(j), Xtest$experience(j)) )
median<-sapply(1:nrow(Xtest), function(j) conditionalmedianest(Xtest$age(j), Xtest$education(j), Xtest$experience(j)) )

Ciò fornisce una gamma diversificata di valori medi/mediani condizionati. Ora calcoliamo MSE e MAE:

(MSE1<-mean((meanest-wagetest)^2))
(MSE2<-mean((median-wagetest)^2))

MSE1 < MSE2
### Method 1 (the true mean estimator) is better than method 2!

# but the MAE is actually worse of method 1!
(MAE1<-mean(abs(meanest-wagetest)) )
(MAE2<-mean( abs(median-wagetest)))

MAE1 < MAE2
### Method 2 (the true median estimator) is better than method 1!

Ciò dimostra ciò che è noto teoricamente: MSE è minimizzato per l'aspettativa (condizionata). E(Y | X=X)mentre il MAE è minimizzato alla mediana condizionale. In generale, non ha senso utilizzare il MAE quando si tenta di valutare la previsione media. In molta ricerca applicata e scienza dei dati, le persone usano il MAE o entrambi per valutare le previsioni medie (lo so perché l'ho fatto io stesso). Sebbene ciò possa essere giustificato in alcune applicazioni, ciò può avere gravi conseguenze per distribuzioni non simmetriche, come abbiamo visto in questo esempio: quando si osserva il MAE, il metodo 1 sembra peggiore del metodo 2, anche se il primo stima correttamente la media . Infatti, in questo esempio altamente distorto, il metodo 1 dovrebbe avere un MAE inferiore rispetto al metodo 2.

Per ottenere il punteggio della previsione media condizionale utilizzare l'errore quadratico medio (MSE) e non l'errore medio assoluto (MAE). Il MAE è ridotto al minimo per la mediana condizionale.

Punteggi per la previsione quantile e di intervallo

Supponiamo di voler ottenere una stima F(X) del quantile Q_X tale che

Illustrazione quantile semplice. Fonte: Autore

In questo caso possiamo considerare il punteggio quantile:

per cui

Per scompattare questa formula, possiamo considerare due casi:

(1) è più piccolo di F(X):

cioè incorriamo in una penalità tanto più grande quanto più ci si allontana è da F(X).

(2) è più grande di F(X):

cioè una sanzione tanto più grande quanto più ci si allontana è da F(X).

Si noti che il peso è tale da essere elevato alfaavendo il quantile stimato F(X) più piccolo di viene penalizzato di più. Questo è previsto dalla progettazione e garantisce che il quantile corretto sia effettivamente il minimo del valore atteso di S(y,f(X)) oltre y. Questo punteggio è infatti il perdita quantilica (fino a un fattore 2), vedere ad esempio questo bell'articolo. È implementato in punteggio_quantile funzione del pacchetto scoringutils in R. Si noti infine che for alfa=0,5:

semplicemente il MAE! Ciò ha senso, poiché il quantile 0,5 è la mediana.

Grazie alla possibilità di prevedere i quantili, possiamo anche costruire intervalli di previsione. Prendere in considerazione (io_Xu_X)Dove io_X ≤ u_X sono quantili tali che

In effetti, questo è soddisfatto se io_X È IL alfa/2 quantile e u_X è il 1-alfa/2 quantile. Quindi ora stimiamo e attribuiamo un punteggio a questi due quantili. Prendere in considerazione F(X)=(f_1(X), f_2(X))per cui f_1(X) essere una stima di io_X E f_2(X) una stima di u_X. Forniamo due stimatori, quello “ideale” che simula nuovamente dal processo reale per poi stimare i quantili richiesti e uno “naive”, che ha la giusta copertura ma è troppo grande:

library(scoringutils)

## Define conditional quantile estimation
conditionalquantileest <-
function(probs, age, education, experience, N = 1000) {
quantile(exp((age * 0.1) + (
case_when(
education == "High School" ~ 1,
education == "Bachelor's" ~ 1.5,
TRUE ~ 2
)
) + (experience * 0.05) + rnorm(N, mean = 0, sd = 0.5)
)
, probs =
probs)
}

## Define a very naive estimator that will still have the required coverage
lowernaive <- 0
uppernaive <- max(wage)

# Define the quantile of interest
alpha <- 0.05

lower <-
sapply(1:nrow(Xtest), function(j)
conditionalquantileest(alpha / 2, Xtest$age(j), Xtest$education(j), Xtest$experience(j)))
upper <-
sapply(1:nrow(Xtest), function(j)
conditionalquantileest(1 - alpha / 2, Xtest$age(j), Xtest$education(j), Xtest$experience(j)))

## Calculate the scores for both estimators

# 1. Score the alpha/2 quantile estimate
qs_lower <- mean(quantile_score(wagetest,
predictions = lower,
quantiles = alpha / 2))
# 2. Score the alpha/2 quantile estimate
qs_upper <- mean(quantile_score(wagetest,
predictions = upper,
quantiles = 1 - alpha / 2))

# 1. Score the alpha/2 quantile estimate
qs_lowernaive <- mean(quantile_score(wagetest,
predictions = rep(lowernaive, ntest),
quantiles = alpha / 2))
# 2. Score the alpha/2 quantile estimate
qs_uppernaive <- mean(quantile_score(wagetest,
predictions = rep(uppernaive, ntest),
quantiles = 1 - alpha / 2))

# Construct the interval score by taking the average
(interval_score <- (qs_lower + qs_upper) / 2)
# Score of the ideal estimator: 187.8337

# Construct the interval score by taking the average
(interval_scorenaive <- (qs_lowernaive + qs_uppernaive) / 2)
# Score of the naive estimator: 1451.464

Anche in questo caso possiamo vedere chiaramente che, in media, lo stimatore corretto ha un punteggio molto più basso di quello ingenuo!

Pertanto, con il punteggio quantile, abbiamo un modo affidabile per valutare le singole previsioni quantiliche. Tuttavia, il modo di calcolare la media del punteggio dei quantili superiore e inferiore per l'intervallo di previsione potrebbe sembrare ad hoc. Fortunatamente si scopre che questo porta al cosiddetto punteggio dell'intervallo:

Pertanto, attraverso qualche magia algebrica, possiamo segnare un intervallo di previsione facendo la media dei punteggi per alfa/2 e il 1-alfa/2 quantili come abbiamo fatto noi. È interessante notare che il punteggio dell'intervallo risultante premia gli intervalli di previsione ristretti e induce una penalità, la cui dimensione dipende da alfase l'osservazione non rientra nell'intervallo. Invece di utilizzare la media dei punteggi quantili, possiamo anche calcolare direttamente questo punteggio con il pacchetto scoringutils.

alpha <- 0.05
mean(interval_score(
wagetest,
lower=lower,
upper=upper,
interval_range=(1-alpha)*100,
weigh = T,
separate_results = FALSE
))
#Score of the ideal estimator: 187.8337

Questo è esattamente lo stesso numero che abbiamo ottenuto sopra calcolando la media dei punteggi dei due intervalli.

Il punteggio quantile implementato in R nel pacchetto scoringutils può essere utilizzato per valutare le previsioni quantiliche. Se si desidera assegnare direttamente un punteggio a un intervallo di previsione, è possibile utilizzare la funzione interval_score.

Punteggi per la previsione distributiva

Sono sempre di più i campi da affrontare previsione distributiva. Fortunatamente ci sono anche punteggi per questo problema. In particolare, qui mi concentrerò su quello che viene chiamato il punteggio energetico:

per F(X) essendo una stima della distribuzione P(Y | X=X). Il secondo termine prende l'aspettativa della distanza euclidea tra due campioni indipendenti F(X). Questo è simile a un termine normalizzante, che stabilisce il valore se viene confrontata la stessa distribuzione. Il primo termine confronta quindi il punto campione al pareggio X da F(X). In attesa (finita Y tratto da P(Y | X=X)) questo sarà ridotto al minimo se F(X)=P(Y | X=X).

Pertanto, invece di limitarsi a prevedere la media o i quantili, ora proviamo a prevedere l’intera distribuzione dei salari in ciascun punto di test. Essenzialmente cerchiamo di prevedere e valutare la distribuzione condizionale che abbiamo tracciato per Dave sopra. Questo è un po' più complicato; come rappresentiamo esattamente una distribuzione appresa? In pratica questo viene risolto assumendo di poter ottenere un campione dalla distribuzione prevista. Quindi confrontiamo un campione di Nottenuto dalla distribuzione prevista, ad un singolo punto di test. Questo può essere fatto in R usando en_campione dal punteggioRegole pacchetto:

library(scoringRules)

## Ideal "estimate": Simply sample from the true conditional distribution
## P(Y | X=x) for each sample point x
distributionestimate <-
function(age, education, experience, N = 100) {
exp((age * 0.1) + (
case_when(
education == "High School" ~ 1,
education == "Bachelor's" ~ 1.5,
TRUE ~ 2
)
) + (experience * 0.05) + rnorm(N, mean = 0, sd = 0.5))
}

## Naive Estimate: Only sample from the error distribution, without including the
## information of each person.
distributionestimatenaive <-
function(age, education, experience, N = 100) {
exp(rnorm(N, mean = 0, sd = 0.5))
}

scoretrue <- mean(sapply(1:nrow(Xtest), function(j) {
wageest <-
distributionestimate(Xtest$age(j), Xtest$education(j), Xtest$experience(j))
return(scoringRules::es_sample(y = wagetest(j), dat = matrix(wageest, nrow=1)))
}))

scorenaive <- mean(sapply(1:nrow(Xtest), function(j) {
wageest <-
distributionestimatenaive(Xtest$age(j), Xtest$education(j), Xtest$experience(j))
return(scoringRules::es_sample(y = wagetest(j), dat = matrix(wageest, nrow=1)))
}))

## scoretrue: 761.026
## scorenaive: 2624.713

Nel codice precedente, confrontiamo nuovamente la stima “perfetta” (ovvero il campionamento dalla distribuzione reale P(Y | X=X)) a uno molto ingenuo, cioè uno che non tiene conto di alcuna informazione su salario, istruzione o esperienza. Ancora una volta, il punteggio identifica in modo affidabile il migliore tra i due metodi.

Il punteggio energetico, implementato nel pacchetto R scoringRules, può essere utilizzato per valutare la previsione distribuzionale, se è disponibile un campione della distribuzione prevista.

Conclusione

Abbiamo esaminato diversi modi per valutare i pronostici. Pensare alla misura giusta per testare le previsioni è importante, poiché la misura sbagliata potrebbe portarci a scegliere e mantenere il modello sbagliato per il nostro compito di previsione.

Va notato che, soprattutto per la previsione distribuzionale, questo punteggio è un compito difficile e il punteggio potrebbe non avere molto potere nella pratica. Cioè, anche un metodo che porta ad un grande miglioramento potrebbe avere solo un punteggio leggermente inferiore. Tuttavia, questo non è un problema di per sé, a patto che il punteggio sia in grado di identificare in modo affidabile il migliore dei due metodi.

Riferimenti

(1) Tilmann Gneiting & Adrian E Raftery (2007) Strictly Proper Scoring Rules, Prediction, and Estimation, Journal of the American Statistical Association, 102:477, 359–378, DOI: 10.1198/016214506000001437

Appendice: tutto il codice in un unico posto

library(dplyr)

#Create some variables:
# Simulate data for 100 individuals
n <- 5000

# Generate age between 20 and 60
age <- round(runif(n, min = 20, max = 60))

# Define education levels
education_levels <- c("High School", "Bachelor's", "Master's")

# Simulate education level probabilities
education_probs <- c(0.4, 0.4, 0.2)

# Sample education level based on probabilities
education <- sample(education_levels, n, replace = TRUE, prob = education_probs)

# Simulate experience correlated with age with some random error
experience <- age - 20 + round(rnorm(n, mean = 0, sd = 3))

# Define a non-linear function for wage
wage <- exp((age * 0.1) + (case_when(education == "High School" ~ 1,
education == "Bachelor's" ~ 1.5,
TRUE ~ 2)) + (experience * 0.05) + rnorm(n, mean = 0, sd = 0.5))

hist(wage)

ageDave<-30
educationDave<-"Bachelor's"
experienceDave <- 10

wageDave <- exp((ageDave * 0.1) + (case_when(educationDave == "High School" ~ 1,
educationDave == "Bachelor's" ~ 1.5,
TRUE ~ 2)) + (experienceDave * 0.05) + rnorm(n, mean = 0, sd = 0.5))

hist(wageDave, main="Wage Distribution for Dave", xlab="Wage")

## Generate test set
ntest<-1000

# Generate age between 20 and 60
agetest <- round(runif(ntest, min = 20, max = 60))

# Sample education level based on probabilities
educationtest <- sample(education_levels, ntest, replace = TRUE, prob = education_probs)

# Simulate experience correlated with age with some random error
experiencetest <- agetest - 20 + round(rnorm(ntest, mean = 0, sd = 3))

## Generate ytest that we try to predict:

wagetest <- exp((agetest * 0.1) + (case_when(educationtest == "High School" ~ 1,
educationtest == "Bachelor's" ~ 1.5,
TRUE ~ 2)) + (experiencetest * 0.05) + rnorm(ntest, mean = 0, sd = 0.5))

conditionalmeanest <-
function(age, education, experience, N = 1000) {
mean(exp((age * 0.1) + (
case_when(
education == "High School" ~ 1,
education == "Bachelor's" ~ 1.5,
TRUE ~ 2
)
) + (experience * 0.05) + rnorm(N, mean = 0, sd = 0.5)
))
}

conditionalmedianest <-
function(age, education, experience, N = 1000) {
median(exp((age * 0.1) + (
case_when(
education == "High School" ~ 1,
education == "Bachelor's" ~ 1.5,
TRUE ~ 2
)
) + (experience * 0.05) + rnorm(N, mean = 0, sd = 0.5)
))
}

hist(wageDave, main="Wage Distribution for Dave", xlab="Wage")
abline(v=conditionalmeanest(ageDave, educationDave, experienceDave), col="darkred", cex=1.2)
abline(v=conditionalmedianest(ageDave, educationDave, experienceDave), col="darkblue", cex=1.2)

Xtest<-data.frame(age=agetest, education=educationtest, experience=experiencetest)

meanest<-sapply(1:nrow(Xtest), function(j) conditionalmeanest(Xtest$age(j), Xtest$education(j), Xtest$experience(j)) )
median<-sapply(1:nrow(Xtest), function(j) conditionalmedianest(Xtest$age(j), Xtest$education(j), Xtest$experience(j)) )

(MSE1<-mean((meanest-wagetest)^2))
(MSE2<-mean((median-wagetest)^2))

MSE1 < MSE2
### Method 1 (the true mean estimator) is better than method 2!

# but the MAE is actually worse of method 1!
(MAE1<-mean(abs(meanest-wagetest)) )
(MAE2<-mean( abs(median-wagetest)))

MAE1 < MAE2
### Method 2 (the true median estimator) is better than method 1!

library(scoringutils)

## Define conditional quantile estimation
conditionalquantileest <-
function(probs, age, education, experience, N = 1000) {
quantile(exp((age * 0.1) + (
case_when(
education == "High School" ~ 1,
education == "Bachelor's" ~ 1.5,
TRUE ~ 2
)
) + (experience * 0.05) + rnorm(N, mean = 0, sd = 0.5)
)
, probs =
probs)
}

## Define a very naive estimator that will still have the required coverage
lowernaive <- 0
uppernaive <- max(wage)

# Define the quantile of interest
alpha <- 0.05

lower <-
sapply(1:nrow(Xtest), function(j)
conditionalquantileest(alpha / 2, Xtest$age(j), Xtest$education(j), Xtest$experience(j)))
upper <-
sapply(1:nrow(Xtest), function(j)
conditionalquantileest(1 - alpha / 2, Xtest$age(j), Xtest$education(j), Xtest$experience(j)))

## Calculate the scores for both estimators

# 1. Score the alpha/2 quantile estimate
qs_lower <- mean(quantile_score(wagetest,
predictions = lower,
quantiles = alpha / 2))
# 2. Score the alpha/2 quantile estimate
qs_upper <- mean(quantile_score(wagetest,
predictions = upper,
quantiles = 1 - alpha / 2))

# 1. Score the alpha/2 quantile estimate
qs_lowernaive <- mean(quantile_score(wagetest,
predictions = rep(lowernaive, ntest),
quantiles = alpha / 2))
# 2. Score the alpha/2 quantile estimate
qs_uppernaive <- mean(quantile_score(wagetest,
predictions = rep(uppernaive, ntest),
quantiles = 1 - alpha / 2))

# Construct the interval score by taking the average
(interval_score <- (qs_lower + qs_upper) / 2)
# Score of the ideal estimator: 187.8337

# Construct the interval score by taking the average
(interval_scorenaive <- (qs_lowernaive + qs_uppernaive) / 2)
# Score of the naive estimator: 1451.464

library(scoringRules)

## Ideal "estimate": Simply sample from the true conditional distribution
## P(Y | X=x) for each sample point x
distributionestimate <-
function(age, education, experience, N = 100) {
exp((age * 0.1) + (
case_when(
education == "High School" ~ 1,
education == "Bachelor's" ~ 1.5,
TRUE ~ 2
)
) + (experience * 0.05) + rnorm(N, mean = 0, sd = 0.5))
}

## Naive Estimate: Only sample from the error distribution, without including the
## information of each person.
distributionestimatenaive <-
function(age, education, experience, N = 100) {
exp(rnorm(N, mean = 0, sd = 0.5))
}

scoretrue <- mean(sapply(1:nrow(Xtest), function(j) {
wageest <-
distributionestimate(Xtest$age(j), Xtest$education(j), Xtest$experience(j))
return(scoringRules::es_sample(y = wagetest(j), dat = matrix(wageest, nrow=1)))
}))

scorenaive <- mean(sapply(1:nrow(Xtest), function(j) {
wageest <-
distributionestimatenaive(Xtest$age(j), Xtest$education(j), Xtest$experience(j))
return(scoringRules::es_sample(y = wagetest(j), dat = matrix(wageest, nrow=1)))
}))

## scoretrue: 761.026
## scorenaive: 2624.713

Fonte: towardsdatascience.com

Lascia un commento

Il tuo indirizzo email non sarà pubblicato. I campi obbligatori sono contrassegnati *