Tôi muốn đề xuất phân tích sơ bộ (tiêu chuẩn) để loại bỏ các tác động chính của (a) biến thể giữa các người dùng, (b) phản ứng điển hình giữa tất cả người dùng đối với thay đổi và (c) biến đổi điển hình từ một khoảng thời gian tiếp theo .
Một cách đơn giản (nhưng không có nghĩa là tốt nhất) để thực hiện việc này là thực hiện một vài lần lặp lại "đánh bóng trung bình" trên dữ liệu để quét trung bình người dùng và trung bình khoảng thời gian, sau đó làm mịn phần dư theo thời gian. Xác định độ mượt mà thay đổi rất nhiều: họ là người dùng bạn muốn nhấn mạnh trong đồ họa.
Vì đây là dữ liệu đếm, nên thể hiện lại chúng bằng cách sử dụng căn bậc hai.
Ví dụ về những gì có thể dẫn đến, đây là bộ dữ liệu mô phỏng 60 tuần gồm 240 người dùng thường thực hiện 10 đến 20 hành động mỗi tuần. Một sự thay đổi trong tất cả người dùng đã xảy ra sau tuần 40. Ba trong số này đã được "bảo" phản ứng tiêu cực với thay đổi. Biểu đồ bên trái hiển thị dữ liệu thô: số lượng hành động của người dùng (với người dùng được phân biệt bằng màu sắc) theo thời gian. Như đã khẳng định trong câu hỏi, đó là một mớ hỗn độn. Biểu đồ bên phải hiển thị kết quả của EDA này - có cùng màu với trước đây - với người dùng phản ứng bất thường được tự động xác định và tô sáng. Việc xác định - mặc dù nó hơi ad hoc - là hoàn chỉnh và chính xác (trong ví dụ này).
Đây là Rmã đã tạo ra những dữ liệu này và tiến hành phân tích. Nó có thể được cải thiện theo nhiều cách, bao gồm
Sử dụng một đánh bóng trung bình đầy đủ để tìm phần dư, thay vì chỉ một lần lặp.
Làm mịn phần dư riêng trước và sau điểm thay đổi.
Có lẽ sử dụng một thuật toán phát hiện ngoại lệ tinh vi hơn. Cái hiện tại chỉ đơn thuần gắn cờ tất cả người dùng có phạm vi dư nhiều hơn hai lần phạm vi trung bình. Mặc dù đơn giản, nó mạnh mẽ và dường như hoạt động tốt. (Giá trị thresholdcó thể đặt của người dùng , có thể được điều chỉnh để làm cho nhận dạng này ít nhiều nghiêm ngặt hơn.)
Tuy nhiên, thử nghiệm cho thấy giải pháp này hoạt động tốt đối với nhiều loại người dùng, từ 12 - 240 trở lên.
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")
