Я хотел бы предложить (стандартный) предварительный анализ, чтобы устранить основные последствия (а) различий между пользователями, (б) типичного ответа всех пользователей на изменение и (в) типичного отклонения от одного периода времени к следующему ,
Простой (но ни в коем случае не лучший) способ сделать это - выполнить несколько итераций «полировки среднего значения» для данных, чтобы вычистить медианы пользователя и медианы периода времени, а затем сгладить невязки во времени. Определите сглаживания, которые сильно меняются: это пользователи, которых вы хотите подчеркнуть на графике.
Поскольку это данные подсчета, хорошей идеей является их повторное выражение с использованием квадратного корня.
В качестве примера того, что может привести, приведем смоделированный 60-недельный набор данных из 240 пользователей, которые обычно выполняют от 10 до 20 действий в неделю. Изменения во всех пользователях произошли после 40 недели. Трем из них «сказали» негативно отреагировать на изменение. На левом графике показаны необработанные данные: количество действий пользователя (с выделением пользователей по цвету) с течением времени. Как утверждается в вопросе, это беспорядок. Правый график показывает результаты этого 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")
