R:调整给定的时间序列,但保持汇总统计信息相等

时间:2019-03-22 12:49:33

标签: r data-generation

假设我有这样的时间序列

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

R中是否可以生成新的数据集x1,该数据集具有完全相同的摘要统计信息,例如平均,方差,峰度,偏斜为x

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

我最近读过:

  • Matejka,Justin和George Fitzmaurice。 “相同的统计信息,不同的图形:通过模拟退火生成具有不同外观和相同统计信息的数据集。” 2017年CHI关于计算系统中人为因素的会议论文集。 ACM,2017年。

  • 使用相同的统计量但图形不同的数据生成数据:Anscombe数据集的后续研究,美国统计学家,2007年,

但是,Matejka在Python中使用的代码非常科学,并且其数据比时间序列数据更复杂,所以我想知道是否存在一种方法可以更有效地实现更简单的数据集?

最诚挚的问候

1 个答案:

答案 0 :(得分:1)

我不知道可以提供给您确切所需内容的软件包。一种选择是使用JasonAizkalns指出的datasauRus包中的数据集。但是,如果要创建自己的数据集,则可以尝试以下操作: 从Johnson distribution包中拟合SuppDists,以获取数据集的矩,并从该分布中绘制新集合,直到差异足够小为止。在带有数据集的示例下面,尽管观察更多,但更容易复制摘要统计信息:

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个观察结果。然后,通过对原始序列和新序列的四个矩之间的差异求解非线性方程来添加这四个观测值。这仍然不能产生完美的匹配,请随时进行改进。

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