創建一個符合以下參數的假數據集：N、mean、sd、min 和 max

Question

有沒有辦法創建一個符合以下參數的假數據集：N、mean、sd、min 和 max？

我想創建一個包含 187 個整數尺度分數的樣本，這些分數的平均值為 67，標准差為 17，觀察值在 [30, 210] 范圍內。 我正在嘗試展示有關統計功效的概念課程，並且我想創建具有看起來像已發布結果的分布的數據。 本示例中的量表分數是 30 個項目的總和，每個項目的范圍從 1 到 7。我不需要構成量表分數的各個項目的數據，但那會是一個獎勵。

我知道我可以使用rnorm() ，但這些值不是整數，最小值和最大值可能會超過我的可能值。

scaleScore <- rnorm(187, mean = 67, sd = 17)

我也知道我可以使用sample()來獲得保持在這個范圍內的整數，但平均值和標准偏差不會是正確的。

scaleScore <- sample(30:210, 187, replace=TRUE)

urnorm()的提示讓我urnorm()了Runuran包中的Runuran urnorm() ：

set.seed(5)
scaleScore <- urnorm(n=187, mean=67, sd=17, lb=30, ub=210)
mean(scaleScore)
# [1] 68.51758
sd(scaleScore)
# [1] 16.38056
min(scaleScore)
# [1] 32.15726
max(scaleScore)
# [1] 107.6758

當然，均值和標准差並不准確，向量也不由整數組成。

還有其他選擇嗎？

Answer 1

無模板的整數優化

由於您希望獲得精確的均值、標准差、最小值和最大值，因此我的首選不是隨機數生成，因為您的樣本不太可能與您所繪制的分布的均值和標准差完全匹配。 相反，我會采用整數優化方法。 您可以將變量x_i定義為整數i在您的樣本中出現的次數。 您將定義決策變量x_30 、 x_31 、 ...、 x_210並添加約束以確保滿足所有條件：

• 187 個樣本：這可以通過約束x_30 + x_31 + ... + x_210 = 187進行編碼
• 67 的平均值：這可以通過約束30*x_30 + 31*x_31 + ... + 210*x_210 = 187 * 67進行編碼
• 變量的邏輯約束：變量必須采用非負整數值
• “看起來像真實數據”這顯然是一個定義不明確的概念，但我們可以要求相鄰數的頻率相差不超過 1。這是x_30 - x_31 <= 1 , x_30 - x_31 >= -1形式的線性約束x_30 - x_31 >= -1 ，依此類推，對於每個連續的對。 我們還可以要求每個頻率不超過某個任意定義的上限（我將使用 10）。

最后，我們希望標准差盡可能接近 17，這意味着我們希望方差盡可能接近 17^2 = 289。我們可以定義一個變量y作為我們匹配程度的上限這個方差，我們可以最小化y：

y >= ((30-67)^2 * x_30 + (31-67)^2 * x_31 + ... + (210-67)^2 * x_210) - (289 * (187-1))
y >= -((30-67)^2 * x_30 + (31-67)^2 * x_31 + ... + (210-67)^2 * x_210) + (289 * (187-1))

這是一個非常簡單的優化問題，可以使用lpSolve類的求解器來解決：

library(lpSolve)
get.sample <- function(n, avg, stdev, lb, ub) {
  vals <- lb:ub
  nv <- length(vals)
  mod <- lp(direction = "min",
            objective.in = c(rep(0, nv), 1),
            const.mat = rbind(c(rep(1, nv), 0),
                              c(vals, 0),
                              c(-(vals-avg)^2, 1),
                              c((vals-avg)^2, 1),
                              cbind(diag(nv), rep(0, nv)),
                              cbind(diag(nv)-cbind(rep(0, nv), diag(nv)[,-nv]), rep(0, nv)),
                              cbind(diag(nv)-cbind(rep(0, nv), diag(nv)[,-nv]), rep(0, nv))),
            const.dir = c("=", "=", ">=", ">=", rep("<=", nv), rep("<=", nv), rep(">=", nv)),
            const.rhs = c(n, avg*n, -stdev^2 * (n-1), stdev^2 * (n-1), rep(10, nv), rep(1, nv), rep(-1, nv)),
            all.int = TRUE)
  rep(vals, head(mod$solution, -1))
}
samp <- get.sample(187, 67, 17, 30, 210)
summary(samp)
#    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#      30      64      69      67      74     119
sd(samp)
# [1] 17
plot(table(samp))

對於您提供的參數，我們能夠在返回所有整數值的同時獲得准確的均值和標准差，並且在我的計算機中計算在 0.4 秒內完成。

使用模板進行整數優化

獲得類似於“真實數據”的東西的另一種方法是定義一個起始連續分布（例如，您在原始帖子中包含的urnorm函數的結果）並以最能達到您的平均值的方式將值四舍五入為整數和標准差目標。 這實際上只引入了兩類新的約束：某個值的樣本數的上限是可以向上或向下舍入以達到該值的樣本數，兩個連續頻率之和的下限是落在這兩個整數之間的連續樣本數。 同樣，這很容易用 lpSolve 實現，而且運行效率並不低：

library(lpSolve)
get.sample2 <- function(n, avg, stdev, lb, ub, init.dist) {
  vals <- lb:ub
  nv <- length(vals)
  lims <- as.vector(table(factor(c(floor(init.dist), ceiling(init.dist)), vals)))
  floors <- as.vector(table(factor(c(floor(init.dist)), vals)))
  mod <- lp(direction = "min",
            objective.in = c(rep(0, nv), 1),
            const.mat = rbind(c(rep(1, nv), 0),
                              c(vals, 0),
                              c(-(vals-avg)^2, 1),
                              c((vals-avg)^2, 1),
                              cbind(diag(nv), rep(0, nv)),
                              cbind(diag(nv) + cbind(rep(0, nv), diag(nv)[,-nv]), rep(0, nv))),
            const.dir = c("=", "=", ">=", ">=", rep("<=", nv), rep(">=", nv)),
            const.rhs = c(n, avg*n, -stdev^2 * (n-1), stdev^2 * (n-1), lims, floors),
            all.int = TRUE)
  rep(vals, head(mod$solution, -1))
}

library(Runuran)
set.seed(5)
init.dist <- urnorm(n=187, mean=67, sd=17, lb=30, ub=210)
samp2 <- get.sample2(187, 67, 17, 30, 210, init.dist)
summary(samp2)
#    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#      32      57      66      67      77     107
sd(samp2)
# [1] 17
plot(table(samp2))

這種方法甚至更快（不到 0.1 秒）並且仍然返回完全滿足所需均值和標准差的分布。 此外，給定來自連續分布的足夠高質量的樣本，這可用於獲得采用整數值並滿足所需統計屬性的不同形狀的分布。

Answer 2

我能夠使用蠻力相當接近，即optim() method="SANN" ：

目標值/約束：

m0 <- 67
sd0 <- 17
min <- 30
max <- 210
n <- 187

設置初始值：

set.seed(101)
mm <- min:max
x0 <- sample(mm,size=n,replace=TRUE)

目標函數（與所需均值/標准差的距離；范圍和 N 將受到約束）

objfun <- function(x) {
    (mean(x)-m0)^2+(sd(x)-sd0)^2
}

新參數集的候選分布：隨機重采樣一個值

candfun <- function(x) {
    x[sample(n,size=1)] <- sample(mm,size=1)
    return(x)
}
objfun(x0)  ## initial badness: 4088.621
set.seed(101)
o1 <- optim(par=x0,fn=objfun,gr=candfun,
      method="SANN",control=list(maxit=1e6))
mean(o1$par) ## 66.978
sd(o1$par) ## 17.22
plot(table(o1$par))