Je voudrais suggérer une analyse préliminaire (standard) pour éliminer les principaux effets de (a) la variation parmi les utilisateurs, (b) la réponse typique parmi tous les utilisateurs au changement, et (c) la variation typique d'une période à l'autre .
Une façon simple (mais nullement la meilleure) de procéder consiste à effectuer quelques itérations de "polissage médian" sur les données pour balayer les médianes des utilisateurs et les médianes des périodes, puis lisser les résidus au fil du temps. Identifiez les lissés qui changent beaucoup: ce sont les utilisateurs que vous souhaitez mettre en valeur dans le graphique.
Parce que ce sont des données de comptage, c'est une bonne idée de les ré-exprimer en utilisant une racine carrée.
À titre d'exemple de ce qui peut en résulter, voici un ensemble de données simulé sur 60 semaines de 240 utilisateurs qui entreprennent généralement 10 à 20 actions par semaine. Un changement dans tous les utilisateurs s'est produit après la semaine 40. Trois d'entre eux ont été «invités» à répondre négativement au changement. Le graphique de gauche montre les données brutes: nombre d'actions par utilisateur (avec des utilisateurs distingués par leur couleur) dans le temps. Comme l'affirme la question, c'est un gâchis. Le graphique de droite montre les résultats de cet EDA - dans les mêmes couleurs qu'avant - avec les utilisateurs inhabituellement réactifs automatiquement identifiés et mis en évidence. L'identification - bien qu'elle soit quelque peu ponctuelle - est complète et correcte (dans cet exemple).
Voici le Rcode qui a produit ces données et effectué l'analyse. Il pourrait être amélioré de plusieurs manières, notamment
Utiliser un polish médian complet pour trouver les résidus, plutôt qu'une seule itération.
Lissage des résidus séparément avant et après le point de changement.
Peut-être en utilisant un algorithme de détection des valeurs aberrantes plus sophistiqué. L'actuel marque simplement tous les utilisateurs dont la plage de résidus est plus de deux fois la plage médiane. Bien que simple, il est robuste et semble bien fonctionner. (Une valeur réglable par l'utilisateur,threshold peut être ajustée pour rendre cette identification plus ou moins stricte.)
Les tests suggèrent néanmoins que cette solution fonctionne bien pour un large éventail de comptes d'utilisateurs, de 12 à 240 ou plus.
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")
