(a) 사용자 간 변동, (b) 모든 사용자 간 변경에 대한 일반적인 반응, (c) 특정 기간에서 다음 기간까지의 일반적인 변동의 주요 영향을 제거하기위한 (표준) 예비 분석을 제안하고 싶습니다. .
이 작업을 수행하는 간단한 방법 (그러나 최선의 방법은 아님)은 데이터에서 "중간 연마"를 몇 번 반복하여 사용자 중앙값과 기간 중앙값을 소거 한 다음 시간에 따라 잔차를 부드럽게하는 것입니다. 크게 변하는 스무드를 식별하십시오. 그래픽에서 강조하려는 사용자입니다.
이것들은 카운트 데이터이기 때문에 제곱근을 사용하여 다시 표현하는 것이 좋습니다.
결과에 대한 예로, 주당 10-20 개의 작업을 수행하는 240 명의 사용자로 구성된 60 주 시뮬레이션 데이터 세트가 있습니다. 모든 사용자의 변경은 40 주 후에 발생했습니다.이 중 3 개는 변경에 부정적으로 응답하기 위해 "발표되었습니다". 왼쪽 그림은 원시 데이터를 보여줍니다. 시간별 사용자 별 행동 수 (사용자가 색상으로 구분). 질문에서 주장했듯이 엉망입니다. 오른쪽 그림은 반응이 좋지 않은 사용자를 자동으로 식별하고 강조 표시 하여이 EDA의 결과를 이전과 동일한 색상으로 표시합니다. 식별은 비록 다소 임시적 이지만 완전하고 정확합니다 (이 예에서는).
다음은 R이러한 데이터를 생성하고 분석을 수행 한 코드입니다. 여러 가지 방법으로 개선 될 수 있습니다.
한 번의 반복이 아닌 잔차를 찾기 위해 완전 중앙값 광택을 사용합니다.
변경점 전후에 잔차를 따로 다듬기.
아마도 더 정교한 이상치 탐지 알고리즘을 사용하고있을 것입니다. 현재는 잔차 범위가 중간 범위의 두 배 이상인 모든 사용자에게 플래그를 지정합니다. 간단하지만 강력하고 잘 작동하는 것 같습니다. ( threshold이 식별을 다소 엄격하게하기 위해 사용자 설정 가능한 값인을 조정할 수 있습니다.)
그럼에도 불구하고 테스트에 따르면이 솔루션은 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")
