R 创建符合以下参数的假数据集：N、平均值、sd、最小值和最大值

有没有办法创建一个符合以下参数的假数据集：N、mean、sd、min和max

我想创建一个187个整型量表分数的样本，平均值为67，标准偏差为17，观察值在[30210]范围内。我试图演示一个关于统计能力的概念课程，我想创建一个分布类似于已发布结果的数据。本例中的量表分数是30个项目的总和，每个项目的范围为1到7。我不需要构成量表分数的单个项目的数据，但这将是一个奖励

我知道我可以使用

rnorm（）

，但值不是整数，最小值和最大值可能会超过我可能的值

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

@帕斯卡的提示让我在

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

set.seed（5）
scaleScore我能够使用蛮力接近目标，即
method=“SANN”
中的
optim（）
：

目标值/限制：

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

m0无模板整数优化
因为你想要一个精确的平均值、标准偏差、最小值和最大值，我的第一选择不是随机数生成，因为你的样本不太可能精确匹配你所绘制的分布的平均值和标准偏差。相反，我将采用整数优化方法。您可以将变量
xi
定义为整数
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。这是形式为
xu30-xu31=-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.1秒），并且仍然返回完全满足所需平均值和标准偏差的分布。此外，如果从连续分布中获得足够高质量的样本，这可以用来获得不同形状的分布，这些分布采用整数值并满足所需的统计特性。
可能有兴趣，也可能有兴趣。@Pascal第一个链接中的一个答案指向
urnorm（）
Runuran
包中的
。这让我更亲近；除了整数以外的所有数字。我会用这个更新我的问题…非常好！很难看出这是如何做到的。一个问题：为什么需要设置.seed（101）
两次？这根本不是必要的，但我在玩游戏的时候是这样做的，然后我不想重新运行10^6 SANN迭代（这需要几分钟），所以为了重现性，我保留了它们
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))

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))

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))

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))