（a）ユーザー間の変動、（b）変更に対するすべてのユーザー間の典型的な反応、および（c）ある期間から次の期間への典型的な変動の主な影響を除去するための（標準）予備分析を提案したい。
これを行うための簡単な（しかし最善の方法ではありません）方法は、データに対して「中央値ポリッシュ」を数回繰り返して、ユーザーの中央値と期間の中央値を掃引し、時間の経過とともに残差を平滑化することです。大きく変化するスムースを特定します。彼らは、グラフィックで強調したいユーザーです。
これらはカウントデータであるため、平方根を使用して再表現することをお勧めします。
結果の例として、通常は週に10〜20のアクションを実行する240人のユーザーの60週間のデータセットをシミュレートします。すべてのユーザーの変更は、40週以降に発生しました。これらの3つは、変更に否定的に応答するように「言われました」。左側のプロットは、生データを示しています。ユーザーによるアクションの数（ユーザーは色で区別されます）。質問で主張したように、それは混乱です。右側のプロットは、このEDAの結果を（以前と同じ色で）表示し、異常に反応するユーザーを自動的に識別して強調表示します。識別は（多少アドホックですが）完全で正確です（この例では）。
Rこれらのデータを生成し、分析を実行したコードを次に示します。以下を含むいくつかの方法で改善できます。
それでも、テストでは、このソリューションが12〜240人以上の幅広いユーザー数に対して適切に機能することが示唆されています。
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")
