Filosofia del Continuous Norming: Un esempio in R con Mini-Deco (mini batteria inventata di lettura)

Perché questa pipeline

Nella prassi psicometrica si sente spesso: “i punteggi non sono gaussiani”, vero, e allora si ripiega su percentili e punteggi non parametrici come se non ci fosse alternativa. Il problema è che i percentili sono scomodi da aggregare, e spingono verso interpretazioni a checklist di cutoff.

All’opposto, a volte si usano z-score calcolati standardizzando i grezzi anche quando la distribuzione è lontana dalla normalità. Così lo z perde l’interpretazione di posizione in una distribuzione normale, e gli aggregati diventano fragili.

Poi c’è il tema dell’età: si continua a dividere in fasce. Sulle code, proprio dove servono cutoff clinici, i percentili sono instabili, e discretizzare l’età peggiora. Il continuous norming esiste, serve, ed è una prassi compatibile con l’idea di tratto latente continuo.

Infine, si sottovaluta l’utilità di aggregare punteggi standardizzati, si finisce a contare quanti task superano cutoff distinti. È un modo povero di trattare informazione continua, mentre l’aggregazione su standard score è prassi consolidata nella misura dell’intelligenza.

Qui mostriamo una pipeline table-driven: upstream (modello + guardrail + tabelle), downstream (scoring deterministico da tabelle). Il dataset è Mini-Deco_Sample.csv. La colonna lessdecTRIALS è ridondante, la ignoriamo, ma assumiamo che la decisione lessicale sia su k = 60 trial.

1) Setup, lettura dati, check e “realtà” dei punteggi

library(gamlss)
library(gamlss.dist)
library(ggplot2)

dat <- read.csv("Mini-Deco_Sample.csv")

# teniamo solo le colonne utili, ignoriamo lessdecTRIALS (ma fissiamo k=60)
dat <- dat[, c("id","age","syllsec","lessdec")]

# range del post: 6–13 anni
dat <- dat[dat$age >= 6 & dat$age <= 13, ]

# check minimi
stopifnot(all(dat$syllsec > 0))
stopifnot(all(dat$lessdec >= 0 & dat$lessdec <= 60))

k <- 60
age_grid <- seq(6, 13, by = 0.25)

# guardrail numerici
eps <- 1e-6
clamp_prob <- function(p) pmin(1 - eps, pmax(eps, p))
ss19 <- function(z) pmin(19, pmax(1, round(10 + 3*z)))

# output sintetico: range e medie grezze per mezzi anni
age_bin <- floor(dat$age * 2) / 2
cat("Range età:", range(dat$age), "\n")

Range età: 6.01 13

cat("Range syllsec:", range(dat$syllsec), "\n")

Range syllsec: 0.6 4.99

cat("Range lessdec:", range(dat$lessdec), "\n\n")

Range lessdec: 5 58

print(aggregate(dat$syllsec, list(age_bin = age_bin), mean))

   age_bin        x
1      6.0 1.314262
2      6.5 1.693167
3      7.0 1.935522
4      7.5 2.173000
5      8.0 2.414000
6      8.5 2.471233
7      9.0 2.696125
8      9.5 3.115345
9     10.0 3.136735
10    10.5 3.303284
11    11.0 3.181757
12    11.5 3.491455
13    12.0 3.473333
14    12.5 3.561711
15    13.0 3.360000

print(aggregate(dat$lessdec, list(age_bin = age_bin), mean))

   age_bin        x
1      6.0 25.75410
2      6.5 29.80000
3      7.0 29.74627
4      7.5 33.88333
5      8.0 35.33846
6      8.5 34.78082
7      9.0 36.28750
8      9.5 39.94828
9     10.0 40.81633
10    10.5 39.34328
11    11.0 41.37838
12    11.5 41.36364
13    12.0 41.72222
14    12.5 42.22368
15    13.0 49.00000

2) Guardiamo i grezzi: non normalità e dipendenza da età

Questa sezione serve solo a ricordare perché “standardizzare i grezzi” non è una soluzione.

Grafici: distribuzioni grezze e trend con l’età (folded)

# Distribuzioni marginali
p1 <- ggplot(dat, aes(x = syllsec)) +
  geom_histogram(bins = 30) +
  labs(title = "syllsec (grezzo): distribuzione marginale", x = "sillabe/sec", y = "conteggi")

p2 <- ggplot(dat, aes(x = lessdec)) +
  geom_histogram(binwidth = 1) +
  labs(title = "lessdec (grezzo): distribuzione marginale", x = "corrette su 60", y = "conteggi")

print(p1)

Grafici: distribuzioni grezze e trend con l’età (folded)

print(p2)

Grafici: distribuzioni grezze e trend con l’età (folded)

# Grezzi vs età (jitter leggero per il discreto)
p3 <- ggplot(dat, aes(x = age, y = syllsec)) +
  geom_point(alpha = 0.4) +
  labs(title = "syllsec vs età", x = "età", y = "sillabe/sec")

p4 <- ggplot(dat, aes(x = age, y = lessdec)) +
  geom_point(alpha = 0.35, position = position_jitter(height = 0.15, width = 0)) +
  labs(title = "lessdec vs età", x = "età", y = "corrette su 60")

print(p3)

Grafici: distribuzioni grezze e trend con l’età (folded)

print(p4)

3) Upstream: continuous norming via modelli semplici (GAMLSS)

Scelte minimali ma coerenti:

syllsec è continuo e positivo, usiamo una lognormale (LOGNO) con media monotona in età e dispersione smooth.
lessdec è un conteggio 0..60 con overdispersion, usiamo una Beta-Binomiale (BB) con probabilità monotona in età e dispersione smooth.

fit_syll <- gamlss(
  syllsec ~ pbm(age, mono = "up"),
  sigma.fo = ~ pb(age),
  family = LOGNO,
  data = dat,
  trace = FALSE
)

fit_less <- gamlss(
  cbind(lessdec, k - lessdec) ~ pbm(age, mono = "up"),
  sigma.fo = ~ pb(age),
  family = BB,
  data = dat,
  trace = FALSE
)

cat("AIC syllsec:", AIC(fit_syll), "\n")

AIC syllsec: 2091.986

cat("AIC lessdec:", AIC(fit_less), "\n")

AIC lessdec: 6662.337

Diagnostica minima: non vogliamo fare un tutorial su GAMLSS, ma almeno guardiamo residui e un worm plot.

Diagnostica minima GAMLSS (folded)

par(mfrow = c(2,2))
plot(fit_syll)

******************************************************************
          Summary of the Quantile Residuals
                           mean   =  0.0001048503 
                       variance   =  1.001112 
               coef. of skewness  =  -0.3693264 
               coef. of kurtosis  =  2.800697 
Filliben correlation coefficient  =  0.9937754 
******************************************************************

Diagnostica minima GAMLSS (folded)

plot(fit_less)

******************************************************************
     Summary of the Randomised Quantile Residuals
                           mean   =  -0.0008716 
                       variance   =  0.9937713 
               coef. of skewness  =  -0.136323 
               coef. of kurtosis  =  2.821541 
Filliben correlation coefficient  =  0.9984349 
******************************************************************

Diagnostica minima GAMLSS (folded)

par(mfrow = c(1,1))

# worm plot (se disponibile), utile per vedere bias in coda
# (non sempre essenziale in un post didattico, ma è un buon promemoria)
try(wp(fit_syll), silent = TRUE)

Diagnostica minima GAMLSS (folded)

try(wp(fit_less), silent = TRUE)

4) Upstream: costruire una riga di tabella, per capire cosa stiamo facendo

Prima di generare “tutto”, facciamo vedere l’operazione su una età (9 anni). Qui si vede l’idea: dal modello otteniamo la CDF condizionata, da lì percentili, z, SS.

4a) `syllsec` a 9 anni: raw -> percentile -> z -> SS(1..19)

age_show <- 9.00

# previsione parametri a età fissa
pA <- predictAll(fit_syll, newdata = data.frame(age = age_show))
mu <- as.numeric(pA$mu)
sg <- as.numeric(pA$sigma)

# griglia raw fine per syllsec
raw_grid_syll <- seq(floor(min(dat$syllsec)*100)/100, ceiling(max(dat$syllsec)*100)/100, by = 0.01)

# percentile condizionato (CDF)
p <- pLOGNO(raw_grid_syll, mu = mu, sigma = sg)

# guardrail: monotonia grezzo->p e clamp code
p <- clamp_prob(cummax(p))

# conversioni
z  <- qnorm(p)
ss <- ss19(z)

tab_syll_9 <- data.frame(
  measure = "syllsec",
  age_grid = age_show,
  raw = raw_grid_syll,
  p = p,
  z = z,
  ss_1_19 = ss
)

# mostro un estratto leggibile (non 400 righe)
print(tab_syll_9[seq(1, nrow(tab_syll_9), by = 20), ], row.names = FALSE)

 measure age_grid raw            p           z ss_1_19
 syllsec        9 0.6 4.135395e-06 -4.45805186       1
 syllsec        9 0.8 1.797832e-04 -3.56810946       1
 syllsec        9 1.0 2.002190e-03 -2.87781650       1
 syllsec        9 1.2 1.033918e-02 -2.31380608       3
 syllsec        9 1.4 3.310922e-02 -1.83694207       4
 syllsec        9 1.6 7.724297e-02 -1.42386368       6
 syllsec        9 1.8 1.446854e-01 -1.05950271       7
 syllsec        9 2.0 2.316052e-01 -0.73357072       8
 syllsec        9 2.2 3.304288e-01 -0.43872937       9
 syllsec        9 2.4 4.326780e-01 -0.16956030       9
 syllsec        9 2.6 5.311064e-01  0.07805123      10
 syllsec        9 2.8 6.206939e-01  0.30730371      11
 syllsec        9 3.0 6.987235e-01  0.52073266      12
 syllsec        9 3.2 7.643551e-01  0.72038210      12
 syllsec        9 3.4 8.180408e-01  0.90792393      13
 syllsec        9 3.6 8.609823e-01  1.08474307      13
 syllsec        9 3.8 8.947150e-01  1.25199963      14
 syllsec        9 4.0 9.208298e-01  1.41067506      14
 syllsec        9 4.2 9.408097e-01  1.56160708      15
 syllsec        9 4.4 9.559509e-01  1.70551641      15
 syllsec        9 4.6 9.673375e-01  1.84302762      16
 syllsec        9 4.8 9.758481e-01  1.97468548      16

4b) `lessdec` a 9 anni: mid-P per discreto

Per un conteggio discreto, usiamo una correzione tipo mid-P: invece di prendere P(X ≤ x), prendiamo P(X < x) + 0.5·P(X = x). È una scelta pragmatica per rendere i percentili meno “a scalini”, senza fingere che il punteggio sia continuo.

# mid-P Beta-Binomial, operazione esplicita
pA <- predictAll(fit_less, newdata = data.frame(age = age_show))
mu <- as.numeric(pA$mu)
sg <- as.numeric(pA$sigma)

raw_grid_less <- 0:k

p_le <- pBB(raw_grid_less,   mu = mu, sigma = sg, bd = k)      # P(X <= x)
p_lt <- pBB(raw_grid_less-1, mu = mu, sigma = sg, bd = k)      # P(X <  x)
p    <- p_lt + 0.5 * pmax(0, p_le - p_lt)                      # mid-P

# guardrail monotonia + clamp
p <- clamp_prob(cummax(p))

z  <- qnorm(p)
ss <- ss19(z)

tab_less_9 <- data.frame(
  measure = "lessdec",
  age_grid = age_show,
  raw = raw_grid_less,
  p = p,
  z = z,
  ss_1_19 = ss
)

print(tab_less_9, row.names = FALSE)

 measure age_grid raw            p            z ss_1_19
 lessdec        9   0 1.000000e-06 -4.753424309       1
 lessdec        9   1 4.860349e-06 -4.423294737       1
 lessdec        9   2 1.930190e-05 -4.115680995       1
 lessdec        9   3 5.628914e-05 -3.861748830       1
 lessdec        9   4 1.352133e-04 -3.642096562       1
 lessdec        9   5 2.838744e-04 -3.446571299       1
 lessdec        9   6 5.395198e-04 -3.269063845       1
 lessdec        9   7 9.495783e-04 -3.105565328       1
 lessdec        9   8 1.572072e-03 -2.953282194       1
 lessdec        9   9 2.475698e-03 -2.810178966       2
 lessdec        9  10 3.739583e-03 -2.674720127       2
 lessdec        9  11 5.452718e-03 -2.545714431       2
 lessdec        9  12 7.713089e-03 -2.422216005       3
 lessdec        9  13 1.062652e-02 -2.303458849       3
 lessdec        9  14 1.430526e-02 -2.188811942       3
 lessdec        9  15 1.886631e-02 -2.077747555       4
 lessdec        9  16 2.442960e-02 -1.969818322       4
 lessdec        9  17 3.111592e-02 -1.864640278       4
 lessdec        9  18 3.904478e-02 -1.761880077       5
 lessdec        9  19 4.833211e-02 -1.661245175       5
 lessdec        9  20 5.908793e-02 -1.562476175       5
 lessdec        9  21 7.141398e-02 -1.465340769       6
 lessdec        9  22 8.540139e-02 -1.369628867       6
 lessdec        9  23 1.011283e-01 -1.275148631       6
 lessdec        9  24 1.186578e-01 -1.181723194       6
 lessdec        9  25 1.380355e-01 -1.089187901       7
 lessdec        9  26 1.592881e-01 -0.997387962       7
 lessdec        9  27 1.824212e-01 -0.906176410       7
 lessdec        9  28 2.074182e-01 -0.815412289       8
 lessdec        9  29 2.342386e-01 -0.724959028       8
 lessdec        9  30 2.628176e-01 -0.634682916       8
 lessdec        9  31 2.930653e-01 -0.544451675       8
 lessdec        9  32 3.248665e-01 -0.454133050       9
 lessdec        9  33 3.580808e-01 -0.363593407       9
 lessdec        9  34 3.925433e-01 -0.272696282       9
 lessdec        9  35 4.280657e-01 -0.181300848       9
 lessdec        9  36 4.644375e-01 -0.089260247      10
 lessdec        9  37 5.014283e-01  0.003580258      10
 lessdec        9  38 5.387898e-01  0.097385388      10
 lessdec        9  39 5.762590e-01  0.192332285      11
 lessdec        9  40 6.135614e-01  0.288613377      11
 lessdec        9  41 6.504145e-01  0.386439823      11
 lessdec        9  42 6.865326e-01  0.486045691      11
 lessdec        9  43 7.216309e-01  0.587693130      12
 lessdec        9  44 7.554305e-01  0.691678849      12
 lessdec        9  45 7.876641e-01  0.798342358      12
 lessdec        9  46 8.180811e-01  0.908076627      13
 lessdec        9  47 8.464538e-01  1.021342092      13
 lessdec        9  48 8.725828e-01  1.138685419      13
 lessdec        9  49 8.963033e-01  1.260765132      14
 lessdec        9  50 9.174905e-01  1.388387459      14
 lessdec        9  51 9.360653e-01  1.522557772      15
 lessdec        9  52 9.519994e-01  1.664556735      15
 lessdec        9  53 9.653192e-01  1.816057150      15
 lessdec        9  54 9.761095e-01  1.979311258      16
 lessdec        9  55 9.845154e-01  2.157467643      16
 lessdec        9  56 9.907423e-01  2.355145482      17
 lessdec        9  57 9.950539e-01  2.579574152      18
 lessdec        9  58 9.977666e-01  2.843162436      19
 lessdec        9  59 9.992392e-01  3.170548263      19
 lessdec        9  60 9.998563e-01  3.626469843      19

5) Upstream: generare le tabelle complete (auditabili) su griglia d’età

Qui facciamo la parte “meccanica”: generiamo raw_to_norm per ogni età in griglia. Questo chunk è lungo, quindi lo teniamo folded, ma l’output lo useremo sotto.

Generazione tabelle complete raw_to_norm (folded)

raw_to_norm <- NULL

raw_grid_syll <- seq(floor(min(dat$syllsec)*100)/100, ceiling(max(dat$syllsec)*100)/100, by = 0.01)
raw_grid_less <- 0:k

for (a in age_grid) {

  # --- syllsec ---
  pA <- predictAll(fit_syll, newdata = data.frame(age = a))
  mu <- as.numeric(pA$mu); sg <- as.numeric(pA$sigma)

  p  <- pLOGNO(raw_grid_syll, mu = mu, sigma = sg)
  p  <- clamp_prob(cummax(p))
  z  <- qnorm(p)
  ss <- ss19(z)

  tmp <- data.frame(measure="syllsec", age_grid=a, raw=raw_grid_syll, p=p, z=z, ss_1_19=ss)
  raw_to_norm <- rbind(raw_to_norm, tmp)

  # --- lessdec ---
  pA <- predictAll(fit_less, newdata = data.frame(age = a))
  mu <- as.numeric(pA$mu); sg <- as.numeric(pA$sigma)

  p_le <- pBB(raw_grid_less,   mu = mu, sigma = sg, bd = k)
  p_lt <- pBB(raw_grid_less-1, mu = mu, sigma = sg, bd = k)
  p    <- p_lt + 0.5 * pmax(0, p_le - p_lt)

  p  <- clamp_prob(cummax(p))
  z  <- qnorm(p)
  ss <- ss19(z)

  tmp <- data.frame(measure="lessdec", age_grid=a, raw=raw_grid_less, p=p, z=z, ss_1_19=ss)
  raw_to_norm <- rbind(raw_to_norm, tmp)
}

# write.csv(raw_to_norm, "raw_to_norm.csv", row.names = FALSE)

6) Visualizzare davvero la tabella di conversione (raw -> standardizzato)

Qui estraiamo un’età e mostriamo la conversione in modo leggibile.

age_show <- 9.00

tab9_syll <- raw_to_norm[raw_to_norm$measure=="syllsec" & raw_to_norm$age_grid==age_show, ]
tab9_less <- raw_to_norm[raw_to_norm$measure=="lessdec" & raw_to_norm$age_grid==age_show, ]

# per syllsec mostro una sottogriglia per non stampare troppo
tab9_syll_small <- tab9_syll[seq(1, nrow(tab9_syll), by = 20), ]
print(tab9_syll_small, row.names = FALSE)

 measure age_grid raw            p           z ss_1_19
 syllsec        9 0.6 4.135395e-06 -4.45805186       1
 syllsec        9 0.8 1.797832e-04 -3.56810946       1
 syllsec        9 1.0 2.002190e-03 -2.87781650       1
 syllsec        9 1.2 1.033918e-02 -2.31380608       3
 syllsec        9 1.4 3.310922e-02 -1.83694207       4
 syllsec        9 1.6 7.724297e-02 -1.42386368       6
 syllsec        9 1.8 1.446854e-01 -1.05950271       7
 syllsec        9 2.0 2.316052e-01 -0.73357072       8
 syllsec        9 2.2 3.304288e-01 -0.43872937       9
 syllsec        9 2.4 4.326780e-01 -0.16956030       9
 syllsec        9 2.6 5.311064e-01  0.07805123      10
 syllsec        9 2.8 6.206939e-01  0.30730371      11
 syllsec        9 3.0 6.987235e-01  0.52073266      12
 syllsec        9 3.2 7.643551e-01  0.72038210      12
 syllsec        9 3.4 8.180408e-01  0.90792393      13
 syllsec        9 3.6 8.609823e-01  1.08474307      13
 syllsec        9 3.8 8.947150e-01  1.25199963      14
 syllsec        9 4.0 9.208298e-01  1.41067506      14
 syllsec        9 4.2 9.408097e-01  1.56160708      15
 syllsec        9 4.4 9.559509e-01  1.70551641      15
 syllsec        9 4.6 9.673375e-01  1.84302762      16
 syllsec        9 4.8 9.758481e-01  1.97468548      16

# per lessdec ha senso vedere tutto (0..60)
print(tab9_less, row.names = FALSE)

 measure age_grid raw            p            z ss_1_19
 lessdec        9   0 1.000000e-06 -4.753424309       1
 lessdec        9   1 4.860349e-06 -4.423294737       1
 lessdec        9   2 1.930190e-05 -4.115680995       1
 lessdec        9   3 5.628914e-05 -3.861748830       1
 lessdec        9   4 1.352133e-04 -3.642096562       1
 lessdec        9   5 2.838744e-04 -3.446571299       1
 lessdec        9   6 5.395198e-04 -3.269063845       1
 lessdec        9   7 9.495783e-04 -3.105565328       1
 lessdec        9   8 1.572072e-03 -2.953282194       1
 lessdec        9   9 2.475698e-03 -2.810178966       2
 lessdec        9  10 3.739583e-03 -2.674720127       2
 lessdec        9  11 5.452718e-03 -2.545714431       2
 lessdec        9  12 7.713089e-03 -2.422216005       3
 lessdec        9  13 1.062652e-02 -2.303458849       3
 lessdec        9  14 1.430526e-02 -2.188811942       3
 lessdec        9  15 1.886631e-02 -2.077747555       4
 lessdec        9  16 2.442960e-02 -1.969818322       4
 lessdec        9  17 3.111592e-02 -1.864640278       4
 lessdec        9  18 3.904478e-02 -1.761880077       5
 lessdec        9  19 4.833211e-02 -1.661245175       5
 lessdec        9  20 5.908793e-02 -1.562476175       5
 lessdec        9  21 7.141398e-02 -1.465340769       6
 lessdec        9  22 8.540139e-02 -1.369628867       6
 lessdec        9  23 1.011283e-01 -1.275148631       6
 lessdec        9  24 1.186578e-01 -1.181723194       6
 lessdec        9  25 1.380355e-01 -1.089187901       7
 lessdec        9  26 1.592881e-01 -0.997387962       7
 lessdec        9  27 1.824212e-01 -0.906176410       7
 lessdec        9  28 2.074182e-01 -0.815412289       8
 lessdec        9  29 2.342386e-01 -0.724959028       8
 lessdec        9  30 2.628176e-01 -0.634682916       8
 lessdec        9  31 2.930653e-01 -0.544451675       8
 lessdec        9  32 3.248665e-01 -0.454133050       9
 lessdec        9  33 3.580808e-01 -0.363593407       9
 lessdec        9  34 3.925433e-01 -0.272696282       9
 lessdec        9  35 4.280657e-01 -0.181300848       9
 lessdec        9  36 4.644375e-01 -0.089260247      10
 lessdec        9  37 5.014283e-01  0.003580258      10
 lessdec        9  38 5.387898e-01  0.097385388      10
 lessdec        9  39 5.762590e-01  0.192332285      11
 lessdec        9  40 6.135614e-01  0.288613377      11
 lessdec        9  41 6.504145e-01  0.386439823      11
 lessdec        9  42 6.865326e-01  0.486045691      11
 lessdec        9  43 7.216309e-01  0.587693130      12
 lessdec        9  44 7.554305e-01  0.691678849      12
 lessdec        9  45 7.876641e-01  0.798342358      12
 lessdec        9  46 8.180811e-01  0.908076627      13
 lessdec        9  47 8.464538e-01  1.021342092      13
 lessdec        9  48 8.725828e-01  1.138685419      13
 lessdec        9  49 8.963033e-01  1.260765132      14
 lessdec        9  50 9.174905e-01  1.388387459      14
 lessdec        9  51 9.360653e-01  1.522557772      15
 lessdec        9  52 9.519994e-01  1.664556735      15
 lessdec        9  53 9.653192e-01  1.816057150      15
 lessdec        9  54 9.761095e-01  1.979311258      16
 lessdec        9  55 9.845154e-01  2.157467643      16
 lessdec        9  56 9.907423e-01  2.355145482      17
 lessdec        9  57 9.950539e-01  2.579574152      18
 lessdec        9  58 9.977666e-01  2.843162436      19
 lessdec        9  59 9.992392e-01  3.170548263      19
 lessdec        9  60 9.998563e-01  3.626469843      19

Un grafico didattico utile è raw -> SS per un’età (si vede subito monotonicità e “granularità” del discreto).

Grafici: raw -> SS a età fissa (folded)

p1 <- ggplot(tab9_syll, aes(x = raw, y = ss_1_19)) +
  geom_line(linewidth = 1) +
  labs(title = paste0("syllsec: raw -> SS (età ", age_show, ")"),
       x = "syllsec (grezzo)", y = "SS 1..19")

p2 <- ggplot(tab9_less, aes(x = raw, y = ss_1_19)) +
  geom_step(linewidth = 1) +
  labs(title = paste0("lessdec: raw -> SS (età ", age_show, ")"),
       x = "lessdec (grezzo, 0..60)", y = "SS 1..19")

print(p1)

Grafici: raw -> SS a età fissa (folded)

print(p2)

7) Tabella inversa “ideale”: SS -> intervallo di grezzo

Per syllsec (continuo) usiamo gli intervalli indotti da SS = round(10 + 3z). Per lessdec (discreto) invertiamo la tabella raw -> SS e prendiamo min/max.

Chunk lungo, quindi folded.

Generazione ss_to_raw_intervals (folded)

SS <- 1:19
ss_to_raw_intervals <- NULL

for (a in age_grid) {

  # --- syllsec: soglie in z, poi quantili lognormali ---
  pA <- predictAll(fit_syll, newdata = data.frame(age = a))
  mu <- as.numeric(pA$mu); sg <- as.numeric(pA$sigma)

  z_lo <- (SS - 0.5 - 10) / 3
  z_hi <- (SS + 0.5 - 10) / 3

  raw_min <- qLOGNO(clamp_prob(pnorm(z_lo)), mu = mu, sigma = sg)
  raw_max <- qLOGNO(clamp_prob(pnorm(z_hi)), mu = mu, sigma = sg)

  raw_min[SS == 1]  <- 0
  raw_max[SS == 19] <- Inf

  ss_to_raw_intervals <- rbind(ss_to_raw_intervals,
    data.frame(measure="syllsec", age_grid=a, ss_1_19=SS, raw_min=raw_min, raw_max=raw_max))

  # --- lessdec: inversione discreta ---
  tab <- raw_to_norm[raw_to_norm$measure=="lessdec" & raw_to_norm$age_grid==a, ]
  ss_by_raw <- cummax(tab$ss_1_19)  # guardrail monotonia

  rmin <- rmax <- rep(NA, 19)
  for (s in SS) {
    idx <- which(ss_by_raw == s)
    if (length(idx) > 0) {
      rmin[s] <- min(tab$raw[idx])
      rmax[s] <- max(tab$raw[idx])
    }
  }

  ss_to_raw_intervals <- rbind(ss_to_raw_intervals,
    data.frame(measure="lessdec", age_grid=a, ss_1_19=SS, raw_min=rmin, raw_max=rmax))
}

# write.csv(ss_to_raw_intervals, "ss_to_raw_intervals.csv", row.names = FALSE)

Mostriamo un estratto per età 9, che è quello che tipicamente si mette in appendice o si distribuisce come CSV.

age_show <- 9.00
sub <- ss_to_raw_intervals[ss_to_raw_intervals$age_grid==age_show, ]
sub <- sub[order(sub$measure, sub$ss_1_19), ]
print(sub, row.names = FALSE)

 measure age_grid ss_1_19   raw_min   raw_max
 lessdec        9       1  0.000000  8.000000
 lessdec        9       2  9.000000 11.000000
 lessdec        9       3 12.000000 14.000000
 lessdec        9       4 15.000000 17.000000
 lessdec        9       5 18.000000 20.000000
 lessdec        9       6 21.000000 24.000000
 lessdec        9       7 25.000000 27.000000
 lessdec        9       8 28.000000 31.000000
 lessdec        9       9 32.000000 35.000000
 lessdec        9      10 36.000000 38.000000
 lessdec        9      11 39.000000 42.000000
 lessdec        9      12 43.000000 45.000000
 lessdec        9      13 46.000000 48.000000
 lessdec        9      14 49.000000 50.000000
 lessdec        9      15 51.000000 53.000000
 lessdec        9      16 54.000000 55.000000
 lessdec        9      17 56.000000 56.000000
 lessdec        9      18 57.000000 57.000000
 lessdec        9      19 58.000000 60.000000
 syllsec        9       1  0.000000  1.014483
 syllsec        9       2  1.014483  1.129904
 syllsec        9       3  1.129904  1.258456
 syllsec        9       4  1.258456  1.401634
 syllsec        9       5  1.401634  1.561102
 syllsec        9       6  1.561102  1.738713
 syllsec        9       7  1.738713  1.936531
 syllsec        9       8  1.936531  2.156855
 syllsec        9       9  2.156855  2.402246
 syllsec        9      10  2.402246  2.675556
 syllsec        9      11  2.675556  2.979961
 syllsec        9      12  2.979961  3.318999
 syllsec        9      13  3.318999  3.696611
 syllsec        9      14  3.696611  4.117184
 syllsec        9      15  4.117184  4.585607
 syllsec        9      16  4.585607  5.107324
 syllsec        9      17  5.107324  5.688398
 syllsec        9      18  5.688398  6.335582
 syllsec        9      19  6.335582       Inf

8) Quantili per età: l’oggetto “continuous norming” (p10, p50, p90)

Questi grafici rendono esplicita l’idea: la distribuzione condizionata cambia con l’età, senza spezzare in fasce.

Grafici: curve di quantili per età (folded)

probs <- c(0.10, 0.50, 0.90)

# syllsec: quantili lognormali
Q_syll <- NULL
for (a in age_grid) {
  pA <- predictAll(fit_syll, newdata = data.frame(age = a))
  mu <- as.numeric(pA$mu); sg <- as.numeric(pA$sigma)
  q  <- qLOGNO(probs, mu = mu, sigma = sg)
  Q_syll <- rbind(Q_syll, data.frame(age = a, prob = probs, q = q))
}
p1 <- ggplot(Q_syll, aes(x = age, y = q, group = prob)) +
  geom_line(linewidth = 1) +
  scale_x_continuous(breaks = seq(6, 13, 1)) +
  labs(title = "syllsec: quantili condizionati (p10, p50, p90)",
       x = "età", y = "syllsec")
print(p1)

Grafici: curve di quantili per età (folded)

# lessdec: quantili beta-binomiale
Q_less <- NULL
for (a in age_grid) {
  pA <- predictAll(fit_less, newdata = data.frame(age = a))
  mu <- as.numeric(pA$mu); sg <- as.numeric(pA$sigma)
  q  <- qBB(probs, mu = mu, sigma = sg, bd = k)
  Q_less <- rbind(Q_less, data.frame(age = a, prob = probs, q = q))
}
p2 <- ggplot(Q_less, aes(x = age, y = q, group = prob)) +
  geom_line(linewidth = 1) +
  scale_x_continuous(breaks = seq(6, 13, 1)) +
  labs(title = "lessdec: quantili condizionati (p10, p50, p90)",
       x = "età", y = "lessdec (0..60)")
print(p2)

9) Downstream: scoring di un caso individuale, passo per passo (senza funzioni)

Scoring da tabella significa: dato (età, raw), ottenere z e SS.
Se l’età non è in griglia, interpoliamo in z tra le due età adiacenti.

# scelgo un caso vicino a 9.30 anni (riproducibile, nessun seed necessario)
i0 <- which.min(abs(dat$age - 9.30))
id0 <- dat$id[i0]
age0 <- dat$age[i0]
raw_syll <- dat$syllsec[i0]
raw_less <- dat$lessdec[i0]

cat("Caso:", id0, "età:", age0, "syllsec:", raw_syll, "lessdec:", raw_less, "\n\n")

Caso: 360 età: 9.3 syllsec: 1.61 lessdec: 36

# età adiacenti in griglia
a0 <- max(age_grid[age_grid <= age0])
a1 <- min(age_grid[age_grid >= age0])
w  <- if (a0 == a1) 0 else (age0 - a0)/(a1 - a0)

# --- syllsec: z da tabella via interpolazione sul raw, poi interpolazione sull’età ---
tab0 <- raw_to_norm[raw_to_norm$measure=="syllsec" & raw_to_norm$age_grid==a0, ]
tab1 <- raw_to_norm[raw_to_norm$measure=="syllsec" & raw_to_norm$age_grid==a1, ]

z0 <- approx(tab0$raw, tab0$z, xout = raw_syll, rule = 2)$y
z1 <- approx(tab1$raw, tab1$z, xout = raw_syll, rule = 2)$y
z_syll <- z0 + (z1 - z0) * w

p_syll <- clamp_prob(pnorm(z_syll))
ss_syll <- ss19(z_syll)

# --- lessdec: z da tabella via lookup sul raw discreto, poi interpolazione sull’età ---
tab0 <- raw_to_norm[raw_to_norm$measure=="lessdec" & raw_to_norm$age_grid==a0, ]
tab1 <- raw_to_norm[raw_to_norm$measure=="lessdec" & raw_to_norm$age_grid==a1, ]

z0 <- tab0$z[tab0$raw == raw_less]
z1 <- tab1$z[tab1$raw == raw_less]
z_less <- z0 + (z1 - z0) * w

p_less <- clamp_prob(pnorm(z_less))
ss_less <- ss19(z_less)

# tabella risultato individuo
out <- data.frame(
  id = id0,
  age = age0,
  measure = c("syllsec","lessdec"),
  raw = c(raw_syll, raw_less),
  percentile = c(100*p_syll, 100*p_less),
  z = c(z_syll, z_less),
  ss_1_19 = c(ss_syll, ss_less)
)
print(out, row.names = FALSE)

  id age measure   raw percentile          z ss_1_19
 360 9.3 syllsec  1.61   5.966636 -1.5575805       5
 360 9.3 lessdec 36.00  43.226593 -0.1706082       9

# composito: media degli z, poi standard score 100/15 (tipo QI)
z_comp <- mean(out$z)
SS_100_15 <- round(100 + 15*z_comp)
cat("\nComposite:\n")


Composite:

print(data.frame(id=id0, age=age0, z_comp=z_comp, SS_100_15=SS_100_15), row.names = FALSE)

  id age     z_comp SS_100_15
 360 9.3 -0.8640943        87

Take-home (operativo)

I grezzi possono essere non gaussiani, e va bene, il punto è modellare una distribuzione condizionata plausibile e poi standardizzare in modo interpretabile.
Il continuous norming evita “fasce di età” e riduce instabilità sulle code.
Distribuire tabelle (CSV) invece del modello rende lo scoring auditabile e stabile.
Una volta ottenuti z e SS coerenti, l’aggregazione diventa naturale, invece di contare cutoff indipendenti.

Perché questa pipeline

1) Setup, lettura dati, check e “realtà” dei punteggi

2) Guardiamo i grezzi: non normalità e dipendenza da età

3) Upstream: continuous norming via modelli semplici (GAMLSS)

4) Upstream: costruire una riga di tabella, per capire cosa stiamo facendo

4a) syllsec a 9 anni: raw -> percentile -> z -> SS(1..19)

4b) lessdec a 9 anni: mid-P per discreto

5) Upstream: generare le tabelle complete (auditabili) su griglia d’età

6) Visualizzare davvero la tabella di conversione (raw -> standardizzato)

7) Tabella inversa “ideale”: SS -> intervallo di grezzo

8) Quantili per età: l’oggetto “continuous norming” (p10, p50, p90)

9) Downstream: scoring di un caso individuale, passo per passo (senza funzioni)

Take-home (operativo)

4a) `syllsec` a 9 anni: raw -> percentile -> z -> SS(1..19)

4b) `lessdec` a 9 anni: mid-P per discreto