使用多个概率分布模拟R中的数据

时间:2015-11-03 11:46:43

标签: r simulation probability resampling replicate

我正在尝试通过引导来模拟数据,以使用漏斗图为我的真实数据创建置信区间。我正在接受已接受答案to a previous question的策略。我没有使用单个概率分布来模拟我的数据,而是根据所模拟数据的部分修改它以使用不同的概率分布。

我非常感谢任何能够帮助回答问题或帮助我更清楚地表达问题的人。

我的问题是编写适当的R代码来进行更复杂的数据模拟。

目前的代码是:

n <- 1e4
set.seed(42)
sims <- sapply(1:80, 
               function(k) 
                 rowSums(
                   replicate(k, sample((1:7)/10, n, TRUE, ps))) / k)

此代码模拟数据,其中每个数据点的值都是1:80观察值之间的平均值。 例如,当数据点的值是10个观测值的平均值(k = 10)时,它随机抽样10个值(可以是0.1,0.2,0.3,0.4,0.5,0.6或0.7)在概率分布ps上,它给出了每个值的概率(基于整个经验分布)。

ps看起来像这样:

ps <- prop.table(table((DF$mean_score)[DF$total_number_snps == 1]))
#        0.1         0.2         0.3         0.4         0.5         0.6         0.7 
#0.582089552 0.194029851 0.124378109 0.059701493 0.029850746 0.004975124 0.004975124 

例如,观察值为0.1的概率为0.582089552

现在不是对所有模拟使用一个频率分布,而是根据每个数据点下面的观察数量有条件地使用不同的频率分布。

我创建了一个表cond_probs,每个实际数据点都有一行。有一列有total个观测值,一列给出每个观测值的每个值的频率。

cond_probs表的示例:

gene_name   0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 total
A1  0.664   0.319   0.018   0.000   0.000   0.000   0.000   0.000   0.000   113.000
A2  0.000   1.000   0.000   0.000   0.000   0.000   0.000   0.000   0.000   1.000

因此,对于数据点A2,只有1观察值,其值为0.1。因此,0.1观察的频率为1。对于A1,有113次观察,其中大多数(0.664)的值为0.1。我们的想法是cond_probsps类似,但cond_probs对每个数据点都有一个概率分布,而不是所有数据的概率分布。

我想修改上面的代码,以便修改采样以使用cond_probs代替ps进行频率分配。并且在选择k中的哪一行进行抽样时,使用观察次数cond_probs作为标准。所以它会像这样工作:

对于k观察次数的数据点:

查看cond_probs表并随机选择total个观察数量与k:0.9k-1.1k大小相似的行。如果不存在此类行,请继续。

选择数据点后,使用cond_probs中该行的概率分布,就像在原始代码中使用ps一样,随机抽样k个观察数并输出这些观察的意思。

对于n的每个replicate次迭代,在cond_probs的值类似的所有行中随机抽样并替换total的新数据点到当前值k0.9k-1.1k)。

这个想法是,对于这个数据集,应该根据数据点下面的观察数量来调整使用哪个概率分布。这是因为在该数据集中观察的概率受观察数量的影响(由于遗传连锁和背景选择,具有更多SNP的基因倾向于每次观察得分较低)。

使用以下答案进行更新:

我尝试使用下面的答案,它适用于示例中的模拟cond_probs数据,但不适用于我的真实cond_probs文件。 我导入并将我的cond_probs文件转换为带

的矩阵
cond_probs <- read.table("cond_probs.txt", header = TRUE, check.names = FALSE)
cond_probs <- as.matrix(cond_probs)

和第一个例子十行(大约20,000行)看起来像这样:

>cond_probs
       total   0.1   0.2   0.3   0.4   0.5   0.6   0.7   0.8   0.9   1.0
[1,]     109 0.404 0.174 0.064 0.183 0.165 0.009 0.000 0.000 0.000 0.000
[2,]     181 0.564 0.221 0.144 0.066 0.006 0.000 0.000 0.000 0.000 0.000
[3,]     289 0.388 0.166 0.118 0.114 0.090 0.093 0.028 0.003 0.000 0.000
[4,]     388 0.601 0.214 0.139 0.039 0.008 0.000 0.000 0.000 0.000 0.000
[5,]     133 0.541 0.331 0.113 0.000 0.008 0.008 0.000 0.000 0.000 0.000
[6,]     221 0.525 0.376 0.068 0.032 0.000 0.000 0.000 0.000 0.000 0.000
[7,]     147 0.517 0.190 0.150 0.054 0.034 0.048 0.007 0.000 0.000 0.000
[8,]     107 0.458 0.196 0.252 0.084 0.009 0.000 0.000 0.000 0.000 0.000
[9,]      13 0.846 0.154 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000

如果我跑:

sampleSize <- 20
set.seed(42)
#replace 1:80 with 1: max number of SNPs in gene in dataset
sims_test <- sapply( 1:50, simulateData, sampleSize )

然后看一下采样的方法,用x个观察数我只得到一个结果,当应该有20个。

例如:

> sims_test[[31]]
[1] 0.1

sims_test的排序方式与sims的排序方式相同:

>sims_test
   [,1] [,2]      [,3]  [,4] [,5]      [,6]      [,7]   [,8]      [,9]
 [1,]  0.1  0.1 0.1666667 0.200 0.14 0.2666667 0.2000000 0.2375 0.1888889
 [2,]  0.1  0.1 0.1333333 0.200 0.14 0.2333333 0.1571429 0.2625 0.1222222
 [3,]  0.1  0.1 0.3333333 0.225 0.14 0.1833333 0.2285714 0.2125 0.1555556
 [4,]  0.1  0.1 0.2666667 0.250 0.10 0.1500000 0.2000000 0.2625 0.2777778
 [5,]  0.1  0.1 0.3000000 0.200 0.16 0.2000000 0.2428571 0.1750 0.1000000
 [6,]  0.1  0.1 0.3666667 0.250 0.16 0.1666667 0.2142857 0.2500 0.2000000
 [7,]  0.1  0.1 0.4000000 0.300 0.12 0.2166667 0.1857143 0.2375 0.1666667
 [8,]  0.1  0.1 0.4000000 0.250 0.10 0.2500000 0.2714286 0.2375 0.2888889
 [9,]  0.1  0.1 0.1333333 0.300 0.14 0.1666667 0.1714286 0.2750 0.2888889

更新2

使用cond_probs <- head(cond_probs,n)我已经确定代码在n = 517之前有效,然后对于大于此的所有大小,它产生与上面相同的输出。我不确定这是文件本身的问题还是内存问题。我发现如果我删除第518行并在几次之前复制这些行来制作一个更大的文件,它就会起作用,这表明该行本身就是导致问题的原因。第518行看起来像这样:

9.000   0.889   0.000   0.000   0.000   0.111   0.000   0.000   0.000   0.000   0.000

我发现另外4条违规行:

9.000   0.444   0.333   0.111   0.111   0.000   0.000   0.000   0.000   0.000   0.000

9.000   0.444   0.333   0.111   0.111   0.000   0.000   0.000   0.000   0.000   0.000

9.000   0.111   0.222   0.222   0.111   0.111   0.222   0.000   0.000   0.000   0.000

9.000   0.667   0.111   0.000   0.000   0.000   0.222   0.000   0.000   0.000   0.000

我没有注意到他们的任何异常。他们都有一个&#39;总计&#39;共有9个网站。如果我删除这些行并运行&#39; cond_probs&#39;文件只包含行之前的代码然后代码工作。但是必须有其他有问题的行,因为整个&#39; cond_probs&#39;仍然没有工作。

我尝试将这些有问题的行重新放回一个较小的&cond_probs&#39;文件和这个文件然后工作,所以我很困惑,因为它似乎没有线本质上有问题。另一方面,它们共有9个站点的事实暗示了某种致使模式。

我很乐意私下分享整个文件,如果这有帮助,因为我不知道接下来要做什么来排除故障。

出现的另一个问题是我不确定代码是否按预期工作。我制作了一个虚拟cond_probs文件,其中有两个数据点,总数为&#39; &#39; 1&#39;观察:

total   0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0
1.000   0.000   0.000   0.000   0.000   0.000   1.000   0.000   0.000   0.000   0.000
1.000   0.000   1.000   0.000   0.000   0.000   0.000   0.000   0.000   0.000   0.000

所以我希望它们都可以用&#39; 1&#39;来对数据点进行采样。观察并因此获得大约50%的观察结果,平均值为0.2&#39; 50%,平均值为0.6&#39;然而,平均值始终为0.2:

sims_test[[1]]
 [1] 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2 0.2

即使我采样10000次,所有观察结果都是0.2,而不是0.6。我对代码的理解是它应该从cond_probs中随机选择一个具有相似大小的新行,但是在这种情况下似乎并没有这样做。我是否误解了代码,或者我的输入不正确仍然存在问题?

可以在以下地址找到整个cond_probs文件:

cond_probs

更新3

运行模拟时将sapply更改为lapply解决了此问题。

我认为离开cond_probs并选择分配sampleSize次数的另一个原因可能是最佳解决方案:选择分布的概率应该与其{{1}的频率相关}}。如果我们合并分布,则使用cond_probs total9选择分布的几率将不再取决于具有这些总数的观察数量。示例:如果10分配90total=10分配10total=9分配90%的分配应该total=10。如果我们将分布组合起来,那么选择分配总数为9或10(这不太理想)的分布的概率不会达到50/50?

1 个答案:

答案 0 :(得分:2)

我只是写了一个函数ps,从cond_probs中选择一个合适的分布:

N <- 10  # The sampled values are 0.1, 0.2, ... , N/10
M <- 8   # number of distributions in "cond_probs"

#-------------------------------------------------------------------
# Example data:

set.seed(1)

cond_probs <- matrix(0,M,N)

is.numeric(cond_probs)

for(i in 1:nrow(cond_probs)){ cond_probs[i,] <- dnorm((1:N)/M,i/M,0.01*N) }

is.numeric(cond_probs)

total <- sort( sample(1:80,nrow(cond_probs)) )
cond_probs <- cbind( total, cond_probs/rowSums(cond_probs) )

colnames(cond_probs) <- c( "total", paste("P",1:N,sep="") )

#---------------------------------------------------------------------
# A function that chooses an appropiate distribution from "cond_prob",
# depending on the number of observations "numObs":

ps <- function( numObs,
                similarityLimit = 0.1 )
{
  similar <- which( abs(cond_probs[,"total"] - numObs) / numObs < similarityLimit )

  if ( length(similar) == 0 )
  { 
    return(NA)
  }
  else
  {
    return( cond_probs[similar[sample(1:length(similar),1)],-1] )
  }
}

#-----------------------------------------------------------------
# A function that simulates data using a distribution that is
# appropriate to the number of observations, if possible:

simulateData <- function( numObs, sampleSize )
{
  if (any(is.na(ps(numObs))))
  {
    return (NA)
  }
  else
  {
    return( rowSums(
              replicate(
                numObs,
                replicate( sampleSize, sample((1:N)/10, 1, prob = ps(numObs))))
            ) / numObs )
  }
}

#-----------------------------------------------------------------
# Test:

sampleSize <- 30
set.seed(42)
sims <- lapply( 1:80, simulateData, sampleSize )

cond_probs中的分发:

    total           P1           P2           P3           P4           P5           P6           P7           P8           P9          P10
[1,]    16 6.654875e-01 3.046824e-01 2.923948e-02 5.881753e-04 2.480041e-06 2.191926e-09 4.060763e-13 1.576900e-17 1.283559e-22 2.189990e-28
[2,]    22 2.335299e-01 5.100762e-01 2.335299e-01 2.241119e-02 4.508188e-04 1.900877e-06 1.680045e-09 3.112453e-13 1.208647e-17 9.838095e-23
[3,]    30 2.191993e-02 2.284110e-01 4.988954e-01 2.284110e-01 2.191993e-02 4.409369e-04 1.859210e-06 1.643219e-09 3.044228e-13 1.182153e-17
[4,]    45 4.407425e-04 2.191027e-02 2.283103e-01 4.986755e-01 2.283103e-01 2.191027e-02 4.407425e-04 1.858391e-06 1.642495e-09 3.042886e-13
[5,]    49 1.858387e-06 4.407417e-04 2.191023e-02 2.283099e-01 4.986746e-01 2.283099e-01 2.191023e-02 4.407417e-04 1.858387e-06 1.642492e-09
[6,]    68 1.642492e-09 1.858387e-06 4.407417e-04 2.191023e-02 2.283099e-01 4.986746e-01 2.283099e-01 2.191023e-02 4.407417e-04 1.858387e-06
[7,]    70 3.042886e-13 1.642495e-09 1.858391e-06 4.407425e-04 2.191027e-02 2.283103e-01 4.986755e-01 2.283103e-01 2.191027e-02 4.407425e-04
[8,]    77 1.182153e-17 3.044228e-13 1.643219e-09 1.859210e-06 4.409369e-04 2.191993e-02 2.284110e-01 4.988954e-01 2.284110e-01 2.191993e-02

分配方式:

> cond_probs[,-1] %*% (1:10)/10
          [,1]
[1,] 0.1364936
[2,] 0.2046182
[3,] 0.3001330
[4,] 0.4000007
[5,] 0.5000000
[6,] 0.6000000
[7,] 0.6999993
[8,] 0.7998670

31次观测的模拟数据的平均值:

> sims[[31]]
 [1] 0.2838710 0.3000000 0.2935484 0.3193548 0.3064516 0.2903226 0.3096774 0.2741935 0.3161290 0.3193548 0.3032258 0.2967742 0.2903226 0.3032258 0.2967742
[16] 0.3129032 0.2967742 0.2806452 0.3129032 0.3032258 0.2935484 0.2935484 0.2903226 0.3096774 0.3161290 0.2741935 0.3161290 0.3193548 0.2935484 0.3032258

适当的分发是第三个:

> ps(31)
          P1           P2           P3           P4           P5           P6           P7           P8           P9          P10 
2.191993e-02 2.284110e-01 4.988954e-01 2.284110e-01 2.191993e-02 4.409369e-04 1.859210e-06 1.643219e-09 3.044228e-13 1.182153e-17