Saya ingin menyarankan analisis awal (standar) untuk menghapus efek utama dari (a) variasi di antara pengguna, (b) respons khas di antara semua pengguna terhadap perubahan, dan (c) variasi khas dari satu periode waktu ke periode berikutnya .
Cara sederhana (tetapi tidak berarti yang terbaik) untuk melakukan ini adalah dengan melakukan beberapa iterasi "median polesan" pada data untuk menyapu rata-rata median pengguna dan median periode waktu, kemudian menghaluskan residu dari waktu ke waktu. Identifikasi smooths yang banyak berubah: mereka adalah pengguna yang ingin Anda tekankan dalam grafik.
Karena ini adalah data jumlah, ide yang bagus untuk mengekspresikannya kembali menggunakan akar kuadrat.
Sebagai contoh dari apa yang dapat terjadi, berikut ini adalah dataset 60 minggu yang disimulasikan dari 240 pengguna yang biasanya melakukan 10 hingga 20 tindakan per minggu. Perubahan dalam semua pengguna terjadi setelah minggu ke-40. Tiga di antaranya "diberitahu" untuk merespons negatif terhadap perubahan tersebut. Plot kiri menunjukkan data mentah: jumlah tindakan oleh pengguna (dengan pengguna dibedakan berdasarkan warna) dari waktu ke waktu. Seperti ditegaskan dalam pertanyaan, itu berantakan. Plot yang tepat menunjukkan hasil EDA ini - dengan warna yang sama seperti sebelumnya - dengan pengguna yang luar biasa responsif secara otomatis diidentifikasi dan disorot. Identifikasi - meskipun agak ad hoc - lengkap dan benar (dalam contoh ini).
Berikut adalah Rkode yang menghasilkan data ini dan melakukan analisis. Ini dapat ditingkatkan dalam beberapa cara, termasuk
Gunakan semir penuh untuk menemukan residu, bukan hanya satu iterasi.
Menghaluskan residunya secara terpisah sebelum dan sesudah titik perubahan.
Mungkin menggunakan algoritma pendeteksian pencilan yang lebih canggih. Yang saat ini hanya menandai semua pengguna yang rentang residunya lebih dari dua kali rentang median. Meskipun sederhana, itu kuat dan tampaknya berfungsi dengan baik. (Nilai yang thresholddapat diatur pengguna ,, dapat disesuaikan untuk membuat identifikasi ini lebih atau kurang ketat.)
Namun pengujian menyarankan solusi ini bekerja dengan baik untuk berbagai jumlah pengguna, 12 - 240 atau lebih.
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")
