[R-es] optimización de código en R

[Carlos J. Gil Bellosta]

O incluso esto (aún mejor):

sim2 <- function(nreps)  {
  nb1 <- 10  # 10 blue marbles in Urn 1
  nb2 <- 6  # 6 blue marbles orig. in Urn 2
  n1 <- 18  # number of marbles in Urn 1 at 1st pick
  n2 <- 13  # number of marbles in Urn 2 at 2nd pick
  count <- 0  # number of repetitions in which get blue from Urn 2

  nb2 <- nb2 + (runif(nreps) < nb1 / n1)
  rbinom(1, nreps, nb2/n2) / nreps
}

Un saludo,

Carlos J. Gil Bellosta
http://www.datanalytics.com

2013/1/17 Carlos J. Gil Bellosta <cgb en datanalytics.com>:
> Hola, ¿qué tal?
>
> Prueba esta alternativa:
>
> sim2 <- function(nreps)  {
>   nb1 <- 10  # 10 blue marbles in Urn 1
>   nb2 <- 6  # 6 blue marbles orig. in Urn 2
>   n1 <- 18  # number of marbles in Urn 1 at 1st pick
>   n2 <- 13  # number of marbles in Urn 2 at 2nd pick
>   count <- 0  # number of repetitions in which get blue from Urn 2
>
>   nb2 <- nb2 + (runif(nreps) < nb1 / n1)
>   mean( runif(nreps) < nb2 / n2  )
>
>   #return(count/nreps)  # est. P(pick blue from Urn 2)
> }
>
>> system.time(sim1(10000))
>    user  system elapsed
>   0.092   0.000   0.094
>> system.time(sim2(10000))
>    user  system elapsed
>   0.000   0.000   0.001
>
> Un saludo,
>
> Carlos J. Gil Bellosta
> http://www.datanalytics.com
>
>
>
> 2013/1/17 Tania Patiño <taniuxpc en gmail.com>:
>> Hola, me gustaria saber como óptimizar el siguiente código para que corra
>> en menos tiempo de ejecución:
>>
>> sim1 <- function(nreps)  {
>>    nb1 <- 10  # 10 blue marbles in Urn 1
>>    n1 <- 18  # number of marbles in Urn 1 at 1st pick
>>    n2 <- 13  # number of marbles in Urn 2 at 2nd pick
>>    count <- 0  # number of repetitions in which get blue from Urn 2
>>    for (i in 1:nreps)  {
>>       nb2 <- 6  # 6 blue marbles orig. in Urn 2
>>       # pick from Urn 1 and put in Urn 2; is it blue?
>>       if (runif(1) < nb1/n1) nb2 <- nb2 + 1
>>       # pick from Urn 2; is it blue?
>>       if (runif(1) < nb2/n2) count <- count + 1
>>    }
>>    return(count/nreps)  # est. P(pick blue from Urn 2)
>> }
>>
>>
>> Gracias,
>>
>> Tania
>>
>>         [[alternative HTML version deleted]]
>>
>>
>> _______________________________________________
>> R-help-es mailing list
>> R-help-es en r-project.org
>> https://stat.ethz.ch/mailman/listinfo/r-help-es
>>