R：调整给定的时间序列但保持汇总统计相等

Question

假设我有这样的时间序列

t       x
1       100
2       50
3       200
4       210
5       90
6       80
7       300

是否可以在 R 中生成一个新的数据集 x1，它具有完全相同的汇总统计信息，例如均值、方差、峰度、偏斜为x？

我问的原因是我想做一个实验，测试受试者对包含相同信息的不同数据图的反应。

我最近阅读：

• Matejka、贾斯汀和乔治·菲茨莫里斯。 “相同的统计数据，不同的图表：通过模拟退火生成具有不同外观和相同统计数据的数据集。” 2017 CHI 计算系统中的人为因素会议论文集。 ACM，2017 年。

• 生成具有相同统计数据但图形不同的数据：Anscombe 数据集的后续行动，美国统计学家，2007 年，

但是，Matejka 在 Python 中使用的代码非常科学，而且它们的数据比时间序列数据更复杂，所以我想知道是否有一种方法可以更有效地处理更简单的数据集？

最好的问候

Answer 1

我不知道有什么软件包可以准确地为您提供所需的内容。正如 JasonAizkalns 指出的那样，一种选择是使用 datasauRus 包中的数据集。但是，如果你想创建自己的数据集，你可以试试这个： 拟合 SuppDists 包中的 Johnson distribution 以获取数据集的矩并从该分布中绘制新的集合，直到差异足够小。下面是您的数据集示例，尽管更多的观察可以更容易地复制汇总统计数据：

library(SuppDists)
a <- c(100,50,200,210,90,80,300)

momentsDiffer <- function(x1,x2){
  diff <- sum(abs(moments(x1)- moments(x2)))
  return(diff)
}

repDataset <- function(x,n){
  # fit Johnson distribution
  parms<-JohnsonFit(a, moment="quant")
  # generate from distribution n times storing if improved
  current <- rJohnson(length(a),parms)
  momDiff <- momentsDiffer(x,current)
  for(i in 1:n){
    temp <- rJohnson(length(a),parms)
    tempDiff <- momentsDiffer(x,temp)
    if(tempDiff < momDiff){
      current <- temp
      momDiff <- tempDiff
    }
  }
  return(current)
}

# Drawing 1000 times to allow improvement
b <- repDataset(a,1000)
> moments(b)
        mean        sigma         skew         kurt 
148.14048691  84.24884165   1.04201116  -0.05008629 

> moments(a)
       mean       sigma        skew        kurt 
147.1428571  84.1281821   0.5894543  -1.0198303 

编辑 - 添加其他方法 根据@Jj Blevins 的建议，下面的方法会根据原始序列生成一个随机序列，省略 4 个观察值。然后通过求解关于原始序列和新序列的四个矩之间差异的非线性方程来添加这 4 个观察值。这仍然不能产生完美的匹配，请随时改进。

library(nleqslv)
library(e1071)
set.seed(1)
a <- c(100,50,200,210,90,80,300)
#a <- floor(runif(1000,0,101))

init <- floor(runif(length(a)-4,min(a),max(a)+1))
moments <- moments(a)

f <- function(x) {
  a <- mean(c(init,x))
  b <- var(c(init,x))
  c <- skewness(c(init,x))
  d <- kurtosis(c(init,x))
  c(a-moments[1],b-moments[2],c-moments[3],d-moments[4])
}
result <- nleqslv(runif(4,min(a),max(a)+1), f,control=list(ftol=.00000001, allowSingular=TRUE))

> moments(c(init,result$x))
       mean       sigma        skew        kurt 
49.12747961 29.85435993  0.03327868 -1.25408078 

> moments(a)
       mean       sigma        skew        kurt 
49.96600000 29.10805462  0.03904256 -1.18250616