Vorrei suggerire un'analisi preliminare (standard) per rimuovere i principali effetti di (a) variazione tra utenti, (b) la risposta tipica tra tutti gli utenti alla modifica e (c) variazione tipica da un periodo di tempo all'altro .
Un modo semplice (ma non il migliore) per farlo è quello di eseguire alcune iterazioni di "smalto mediano" sui dati per spazzare via le mediane degli utenti e le mediane del periodo di tempo, quindi lisciare i residui nel tempo. Identifica i smooth che cambiano molto: sono gli utenti che vuoi enfatizzare nella grafica.
Poiché si tratta di dati di conteggio, è una buona idea riesprimerli utilizzando una radice quadrata.
Come esempio di ciò che può derivare, ecco un set di dati simulato di 60 settimane di 240 utenti che in genere eseguono da 10 a 20 azioni alla settimana. Si è verificato un cambiamento in tutti gli utenti dopo la settimana 40. Tre di questi sono stati "informati" di rispondere negativamente al cambiamento. La trama a sinistra mostra i dati grezzi: conteggi dell'azione per utente (con utenti distinti per colore) nel tempo. Come affermato nella domanda, è un casino. La trama giusta mostra i risultati di questo EDA - negli stessi colori di prima - con gli utenti insolitamente sensibili automaticamente identificati ed evidenziati. L'identificazione, sebbene sia in qualche modo ad hoc, è completa e corretta (in questo esempio).
Ecco il R
codice che ha prodotto questi dati ed effettuato l'analisi. Potrebbe essere migliorato in diversi modi, tra cui
Utilizzando uno smalto mediano completo per trovare i residui, piuttosto che una sola iterazione.
Levigare i residui separatamente prima e dopo il punto di cambio.
Forse usando un algoritmo di rilevamento anomalo più sofisticato. Quello attuale contrassegna semplicemente tutti gli utenti la cui gamma di residui è più del doppio dell'intervallo mediano. Anche se semplice, è robusto e sembra funzionare bene. (Un valore impostabile dall'utente threshold
può essere regolato per rendere questa identificazione più o meno rigorosa.)
I test suggeriscono tuttavia che questa soluzione funziona bene per una vasta gamma di conteggi degli utenti, 12 - 240 o più.
n.users <- 240 # Number of users (here limited to 657, the number of colors)
n.periods <- 60 # Number of time periods
i.break <- 40 # Period after which change occurs
n.outliers <- 3 # Number of greatly changed users
window <- 1/5 # Temporal smoothing window, fraction of total period
response.all <- 1.1 # Overall response to the change
threshold <- 2 # Outlier detection threshold
# Create a simulated dataset
set.seed(17)
base <- exp(rnorm(n.users, log(10), 1/2))
response <- c(rbeta(n.users - n.outliers, 9, 1),
rbeta(n.outliers, 5, 45)) * response.all
actual <- cbind(base %o% rep(1, i.break),
base * response %o% rep(response.all, n.periods-i.break))
observed <- matrix(rpois(n.users * n.periods, actual), nrow=n.users)
# ---------------------------- The analysis begins here ----------------------------#
# Plot the raw data as lines
set.seed(17)
colors = sample(colors(), n.users) # (Use a different method when n.users > 657)
par(mfrow=c(1,2))
plot(c(1,n.periods), c(min(observed), max(observed)), type="n",
xlab="Time period", ylab="Number of actions", main="Raw data")
i <- 0
apply(observed, 1, function(a) {i <<- i+1; lines(a, col=colors[i])})
abline(v = i.break, col="Gray") # Mark the last period before a change
# Analyze the data by time period and user by sweeping out medians and smoothing
x <- sqrt(observed + 1/6) # Re-express the counts
mean.per.period <- apply(x, 2, median)
residuals <- sweep(x, 2, mean.per.period)
mean.per.user <- apply(residuals, 1, median)
residuals <- sweep(residuals, 1, mean.per.user)
smooth <- apply(residuals, 1, lowess, f=window) # Smooth the residuals
smooth.y <- sapply(smooth, function(s) s$y) # Extract the smoothed values
ends <- ceiling(window * n.periods / 4) # Prepare to drop near-end values
range <- apply(smooth.y[-(1:ends), ], 2, function(x) max(x) - min(x))
# Mark the apparent outlying users
thick <- rep(1, n.users)
thick[outliers <- which(range >= threshold * median(range))] <- 3
type <- ifelse(thick==1, 3, 1)
cat(outliers) # Print the outlier identifiers (ideally, the last `n.outliers`)
# Plot the residuals
plot(c(1,n.periods), c(min(smooth.y), max(smooth.y)), type="n",
xlab="Time period", ylab="Smoothed residual root", main="Residuals")
i <- 0
tmp <- lapply(smooth,
function(a) {i <<- i+1; lines(a, lwd=thick[i], lty=type[i], col=colors[i])})
abline(v = i.break, col="Gray")