Me gustaría sugerir un análisis preliminar (estándar) para eliminar los efectos principales de (a) la variación entre los usuarios, (b) la respuesta típica de todos los usuarios al cambio, y (c) la variación típica de un período de tiempo al siguiente .
Una manera simple (pero de ninguna manera la mejor) de hacer esto es realizar algunas iteraciones de "pulido medio" en los datos para barrer las medianas del usuario y las medianas del período de tiempo, luego suavizar los residuos con el tiempo. Identifique los suavizados que cambian mucho: son los usuarios que desea enfatizar en el gráfico.
Debido a que estos son datos de conteo, es una buena idea volver a expresarlos usando una raíz cuadrada.
Como ejemplo de lo que puede resultar, aquí hay un conjunto de datos simulados de 60 semanas de 240 usuarios que generalmente realizan entre 10 y 20 acciones por semana. Se produjo un cambio en todos los usuarios después de la semana 40. A tres de ellos se les "dijo" que respondieran negativamente al cambio. El gráfico de la izquierda muestra los datos sin procesar: recuentos de acciones por usuario (con usuarios distinguidos por color) a lo largo del tiempo. Como se afirma en la pregunta, es un desastre. El gráfico de la derecha muestra los resultados de este EDA, en los mismos colores que antes, con los usuarios inusualmente sensibles identificados y resaltados automáticamente . La identificación, aunque es algo ad hoc, es completa y correcta (en este ejemplo).
Aquí está el R
código que produjo estos datos y llevó a cabo el análisis. Se podría mejorar de varias maneras, incluyendo
Usando un pulido mediano completo para encontrar los residuos, en lugar de solo una iteración.
Alisar los residuos por separado antes y después del punto de cambio.
Quizás utilizando un algoritmo de detección de valores atípicos más sofisticado. El actual simplemente marca a todos los usuarios cuyo rango de residuos es más del doble del rango medio. Aunque simple, es robusto y parece funcionar bien. (Un valor configurable por el usuario threshold
, se puede ajustar para que esta identificación sea más o menos estricta).
Sin embargo, las pruebas sugieren que esta solución funciona bien para una amplia gama de usuarios, de 12 a 240 o más.
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")