Eu gostaria de sugerir uma análise preliminar (padrão) para remover os principais efeitos de (a) variação entre usuários, (b) resposta típica entre todos os usuários à mudança e (c) variação típica de um período para o próximo .
Uma maneira simples (mas de nenhuma maneira a melhor) de fazer isso é executar algumas iterações de "polimento mediano" nos dados para varrer as medianas do usuário e medianas do período e suavizar os resíduos ao longo do tempo. Identifique os suaves que mudam muito: eles são os usuários que você deseja enfatizar no gráfico.
Como esses são dados de contagem, é uma boa ideia expressá-los novamente usando uma raiz quadrada.
Como exemplo do que pode resultar, aqui está um conjunto de dados simulado de 60 semanas de 240 usuários que normalmente realizam de 10 a 20 ações por semana. Uma mudança em todos os usuários ocorreu após a semana 40. Três deles foram "instruídos" a responder negativamente à mudança. O gráfico à esquerda mostra os dados brutos: contagem de ações do usuário (com usuários diferenciados por cor) ao longo do tempo. Como afirmado na pergunta, é uma bagunça. A plotagem correta mostra os resultados dessa EDA - nas mesmas cores de antes - com os usuários incomumente responsivos identificados e destacados automaticamente . A identificação - embora seja um pouco ad hoc - está completa e correta (neste exemplo).
Aqui está o R
código que produziu esses dados e realizou a análise. Poderia ser melhorado de várias maneiras, incluindo
Usando um polonês mediano completo para encontrar os resíduos, em vez de apenas uma iteração.
Suavização dos resíduos separadamente antes e depois do ponto de mudança.
Talvez usando um algoritmo de detecção de outlier mais sofisticado. O atual apenas sinaliza todos os usuários cujo intervalo de resíduos é mais do que o dobro do intervalo médio. Embora simples, é robusto e parece funcionar bem. (Um valor configurável pelo usuário,, threshold
pode ser ajustado para tornar essa identificação mais ou menos rigorosa.)
No entanto, os testes sugerem que esta solução funciona bem para uma ampla variedade de contagens de usuários, 12 - 240 ou mais.
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")