Генерация дополнительных случайных выборок данных на основе моего существующего набора данных

Как @ d.b. Как было указано несколько часов назад, вы стоите перед выбором: выборка существующих данных или предположение, что они соответствуют некоторому теоретическому распределению, например rnorm. Совершенно очевидно, что автор статьи, которую вы подражаете, выбрал более позднее. Сводка нового набора данных ясно показывает значения, которых нет в исходных iris и NAs для некоторой setosa Petal.Width, потому что в большой выборке мы обязательно опускаемся ниже 0 для измерения.

Вот быстрый и грязный набор кода, который вы должны иметь возможность согласовать с вашими собственными данными.

set.seed(2020)
library(dplyr)

testing <- iris %>% 
  group_by(Species) %>% 
  summarise_at(vars(Sepal.Length:Petal.Width), list(mean = mean, 
                                                    sd = sd)) %>%
  rowwise() %>%
  group_by(Species) %>%
  summarise(Sepal.Length = rnorm(1500, 
                                 mean = Sepal.Length_mean, 
                                 sd = Sepal.Length_sd),
            Sepal.Width = rnorm(1500, 
                                mean = Sepal.Width_mean, 
                                sd = Sepal.Width_sd),
            Petal.Length = rnorm(1500, 
                                 mean = Petal.Length_mean, 
                                 sd = Petal.Length_sd),
            Petal.Width = rnorm(1500, 
                                mean = Petal.Width_mean, 
                                sd = Petal.Width_sd)) %>%
  ungroup %>% # so we stop being rowwise
  filter_at(vars(Sepal.Length:Petal.Width), ~ . > .1) # to eliminate ridiculously small or negative values


summary(testing)
#>        Species      Sepal.Length    Sepal.Width     Petal.Length   
#>  setosa    :1368   Min.   :3.784   Min.   :1.719   Min.   :0.8857  
#>  versicolor:1500   1st Qu.:5.168   1st Qu.:2.746   1st Qu.:1.6116  
#>  virginica :1500   Median :5.834   Median :3.014   Median :4.2998  
#>                    Mean   :5.855   Mean   :3.047   Mean   :3.8148  
#>                    3rd Qu.:6.443   3rd Qu.:3.322   3rd Qu.:5.2312  
#>                    Max.   :8.304   Max.   :4.547   Max.   :7.5825  
#>   Petal.Width    
#>  Min.   :0.1001  
#>  1st Qu.:0.3373  
#>  Median :1.3439  
#>  Mean   :1.2332  
#>  3rd Qu.:1.8460  
#>  Max.   :3.0523

Кто-то более беглый, чем я, вероятно, сможет лучше справиться с помощью pivot_longer или специальной функции, позволяющей избежать 4 повторяющихся вызовов rnorm. Вам решать, искать необоснованные значения и обосновывать, почему rnorm хорошо подходит для ваших данных.

Добавление более сложного решения с использованием MASS::mvrnorm для учета корреляций, которые Реми упоминает в своем ответе. Извините, слишком ленив, чтобы продумать лучший код, просто повторение грубой силы здесь.

library(dplyr)

# Get the covariance matrix by species
sigma.setosa <- iris %>% 
   filter(Species == "setosa") %>% 
   select(-Species) %>% 
   cov
sigma.versicolor <- iris %>% 
   filter(Species == "versicolor") %>% 
   select(-Species) %>% 
   cov
sigma.virginica <- iris %>% 
   filter(Species == "virginica") %>% 
   select(-Species) %>% 
   cov

# generate samples based on those covariance matricies
set.seed(2020)

setosa.rows <- MASS::mvrnorm(n = 1500, 
                             c(mean(iris$Sepal.Length), mean(iris$Sepal.Width), mean(iris$Petal.Length), mean(iris$Petal.Width)), 
                             sigma.setosa, 
                             empirical = TRUE)
versicolor.rows <- MASS::mvrnorm(n = 1500, 
                             c(mean(iris$Sepal.Length), mean(iris$Sepal.Width), mean(iris$Petal.Length), mean(iris$Petal.Width)), 
                             sigma.versicolor, 
                             empirical = TRUE)
virginica.rows <- MASS::mvrnorm(n = 1500, 
                                 c(mean(iris$Sepal.Length), mean(iris$Sepal.Width), mean(iris$Petal.Length), mean(iris$Petal.Width)), 
                                 sigma.virginica, 
                                 empirical = TRUE)

# convert to dataframes
setosa.df <- data.frame(setosa.rows, Species = "setosa")
versicolor.df <- data.frame(setosa.rows, Species = "versicolor")
virginica.df <- data.frame(setosa.rows, Species = "virginica")

# bind them return species to a factor
newiris <- rbind(setosa.df, versicolor.df, virginica.df) 
newiris$Species <- factor(newiris$Species)

summary(newiris)
#>   Sepal.Length    Sepal.Width     Petal.Length    Petal.Width   
#>  Min.   :4.669   Min.   :1.759   Min.   :3.183   Min.   :0.820  
#>  1st Qu.:5.598   1st Qu.:2.805   1st Qu.:3.637   1st Qu.:1.130  
#>  Median :5.848   Median :3.064   Median :3.761   Median :1.199  
#>  Mean   :5.843   Mean   :3.057   Mean   :3.758   Mean   :1.199  
#>  3rd Qu.:6.083   3rd Qu.:3.306   3rd Qu.:3.878   3rd Qu.:1.267  
#>  Max.   :6.969   Max.   :4.288   Max.   :4.342   Max.   :1.578  
#>        Species    
#>  setosa    :1500  
#>  versicolor:1500  
#>  virginica :1500  
#>                   
#>                   
#> 
summary(iris)
#>   Sepal.Length    Sepal.Width     Petal.Length    Petal.Width   
#>  Min.   :4.300   Min.   :2.000   Min.   :1.000   Min.   :0.100  
#>  1st Qu.:5.100   1st Qu.:2.800   1st Qu.:1.600   1st Qu.:0.300  
#>  Median :5.800   Median :3.000   Median :4.350   Median :1.300  
#>  Mean   :5.843   Mean   :3.057   Mean   :3.758   Mean   :1.199  
#>  3rd Qu.:6.400   3rd Qu.:3.300   3rd Qu.:5.100   3rd Qu.:1.800  
#>  Max.   :7.900   Max.   :4.400   Max.   :6.900   Max.   :2.500  
#>        Species  
#>  setosa    :50  
#>  versicolor:50  
#>  virginica :50  
#>                 
#>                 
#> 

Ваш вопрос совершенно ясен, и я не знаю, правда ли то, что я напишу в этом посте.

Самый простой способ сделать это - ускорить выборку, используя случайное повторение ваших наблюдений, например:

SimIris <- iris[sample(1:150, 5000, replace = T),]

Но когда вы представляете свою проблему, мне было интересно, сколько мы можем генерировать случайные наблюдения без повторения.

Идея состоит в том, чтобы использовать классическую статистическую структуру, учитывающую переменную отклика Y и матрицу плана X с независимой переменной. Вам нужно найти функцию f такую, что:

Y = f(X) + eps

Когда он у вас есть, вам нужно только смоделировать X, что не слишком странно. Но на самом деле в вашем случае вам нужно позаботиться о зависимости между переменными, что немного усложнило историю. Мы сделаем неверное предположение, что переменные независимы. Одна из областей теории вероятностей - это забота о зависимости благодаря связке.

1. Найдите хорошее приближение f;

2. Смоделируйте X с помощью базовой теории вероятностей мы предполагаем, что каждая переменная независима и происходит от гауссовской переменной. Если вы вычислите корреляцию и гистограмму, вы поймете, что это неверно.

   library(randomForest)
   data("iris")
   
   # your model
   rf <- randomForest(Species ~ ., data = iris, family = )
   
   # you simulate X
   simulate_wrong <- function(X, n){
       return(rnorm(n, mean = mean(X), sd = sd(X)))
   }
   
   irisSim <- apply(iris[,-ncol(iris)], 2, simulate_wrong, n = 5000)
   
   # your Y
   SpeciesSim <- predict(rf, newdata = irisSim)
   
   # Sanity check : we absolutly need to take care of dependency inside X variables
   table(SpeciesSim)
   setosa versicolor  virginica 
     1319       2333       1348 
   table(iris$Species)
   setosa versicolor  virginica 
       50         50         50 
   

Мы моделируем набор данных со слишком большим количеством versicolor платы за проезд, нам нужно позаботиться о корреляционной структуре X. Может быть, для редактирования позже.

Для информации: корреляционная таблица:

              Sepal.Length Sepal.Width Petal.Length Petal.Width
Sepal.Length         1.00       -0.12         0.87        0.82
Sepal.Width         -0.12        1.00        -0.43       -0.37
Petal.Length         0.87       -0.43         1.00        0.96
Petal.Width          0.82       -0.37         0.96        1.00

Goog удачи