为什么我要这样做

我想建议一个（标准）初步分析，以消除（a）用户之间的变化，（b）所有用户对变化的典型反应，以及（c）从一个时间段到下一个时间段的典型变化的主要影响.

一个简单（但绝不是最好）的方法是对数据执行几次“中值抛光”迭代，以清除用户中值和时间段中值，然后随着时间的推移平滑残差。确定变化很大的平滑：它们是您要在图形中强调的用户。

因为这些是计数数据，所以使用平方根重新表达它们是个好主意。

作为可能产生的结果的一个例子，这里是一个模拟的 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")

一般来说，我发现情节的一个方面超过两三行开始难以阅读（尽管我仍然一直这样做）。所以这是一个有趣的例子，说明当你有一些概念上可能是 100 面图的东西时该怎么做。一种可能的方法是绘制所有 100 个面，而不是试图一次将它们全部放在页面上，而是在动画中一次查看它们。

我们实际上在我的工作中使用了这种技术——我们最初制作的动画显示 60 个不同的线图作为事件的背景（新数据系列的发布），然后发现这样做我们实际上提取了数据的一些特征在每页 15 或 30 个方面的分面图中不可见。

因此，在您按照@whuber 的建议开始删除用户和典型时间效应之前，这是呈现原始数据的另一种方式。这只是作为他对原始数据的介绍的另一种选择——我完全建议您然后按照他建议的方式进行分析。

解决此问题的一种方法是分别生成 100 个（或@whuber 示例中的 240 个）时间序列图，并将它们组合成动画。下面的代码将生成 240 张此类单独的图像，然后您可以使用免费的电影制作软件将其变成电影。不幸的是，我可以做到这一点并保持可接受的质量的唯一方法是 9MB 文件，但如果你不需要通过互联网发送它可能不是问题，无论如何我相信有更多的方法可以解决这个问题动画精通​​。R 中的动画包在这里可能很有用（让您在 R 的调用中完成所有操作），但我在此插图中保持简单。

我制作了动画，它用深黑色绘制每条线，然后在后面留下一个浅色的半透明绿色阴影，这样眼睛就会逐渐看到积累的数据。这其中既有风险也有机会——添加线条的顺序会留下不同的印象，因此您应该考虑以某种方式使其有意义。

以下是电影中的一些剧照，它们使用了与@whuber 生成的相同数据：

# ---------------------------- Data generation - by @whuber ----------------------------#

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 ----------------------------#

# Alternative presentation of original data 
# 
setwd("eg animation")

for (i in 1:n.users){
    png(paste("line plot", i, ".png"),600,600,res=60)
    plot(c(1,n.periods), c(min(observed), max(observed)), 
        xlab="Time period", ylab="Number of actions", 
        main="Raw data", bty="l", type="n")
    if(i>1){apply(observed[1:i,], 1, function(a) {lines(a, col=rgb(0,100,0,50,maxColorValue=255))})}
    lines(observed[i,], col="black", lwd=2)
    abline(v = i.break, col="Gray")  # Mark the last period before a change
    text(1,60,i)
    dev.off()
}

##
# Then proceed to further analysis eg as set out by @whuber

最简单的事情之一是箱线图。您可以立即看到您的样本中位数如何移动以及哪些日期的异常值最多。

day <- rep(1:10, 100)
likes <- rpois(1000, 10)
d <- data.frame(day, likes)
library(ggplot2)
qplot(x=day, y=likes, data=d, geom="boxplot", group=day)

对于个人分析，我建议从您的数据中随机抽取一个小样本并分析单独的时间序列。

当然。首先，按平均操作数排序。然后制作（比方说）4 张图，每张图有 25 条线，每个四分位数一个。这意味着您可以缩小 y 轴（但使 y 轴标签清晰）。并且有 25 条线，您可以通过线型和颜色来改变它们，也许还可以绘制符号并获得一些清晰度

然后用单个时间轴垂直堆叠图表。

这在 R 或 SAS 中非常容易（至少如果你有 SAS 的第 9 版）。