R: корректировка заданного временного ряда, но сохранение итоговой статистики равной - PullRequest
3 голосов
/ 22 марта 2019

Допустим, у меня есть временной ряд, подобный этому

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

Возможно ли в R сгенерировать новый набор данных x1, который имеет точно такую ​​же сводную статистику, например, среднее значение, дисперсия, эксцесс,перекошен как x?

Причина, по которой я спрашиваю, состоит в том, что я хотел бы провести эксперимент, в котором я хочу проверить, как субъекты реагируют на разные графики данных, которые содержат одну и ту же информацию.

Я недавно прочитал:

  • Матейка, Джастин и Джордж Фицморис.«Одинаковая статистика, разные графики: создание наборов данных с различным внешним видом и идентичной статистикой посредством имитации отжига».Материалы конференции ОМС 2017 года по человеческому фактору в вычислительных системах.ACM, 2017.

  • Генерация данных с идентичными статистическими данными, но с разнородной графикой: A Продолжение работы с набором данных Anscombe, The American Statistician, 2007,

Однако Матейка использует код на Python, который является довольно научным, и их данные более сложны, чем данные временных рядов, поэтому мне было интересно, есть ли способ сделать это более эффективно для более простого набора данных?

С наилучшими пожеланиями

1 Ответ

1 голос
/ 22 марта 2019

Мне не известно о пакете, который может дать вам именно то, что вы ищете. Одним из вариантов является использование наборов данных в пакете datasauRus, как указал JasonAizkalns. Однако, если вы хотите создать свой собственный набор данных, вы можете попробовать это: Подберите 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 наблюдения. Эти 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
...