8

Existe algum método que se possa somar linha a linha em um data.table no R sem que necessite usar um 'for', de modo que o valor da próxima linha em uma coluna, seja o valor da linha anterior somado com um valor diferente a cada linha?

Tentando resolver um exercício de urnas em R, me deparei com o seguinte problema: tenho um data.table com uma coluna com o primeiro valor igual a 50 e o restante 0 (10^6 linhas), e a outra coluna contem -1 ou 1, correspondendo somar ou subtrair 1 desse número inicial. Porém, após somar ou subtrair, não pode ficar menor que zero ou maior que 100.

# Valores iniciais:
N <- 100             # Número total de bolas
nRetiradas <- 1e6   # Número de inteirações (retiradas) do problema
q <- 0.35            # Probabilidade de transferência para urna com n <= N/2
p <- 1.0 - q           # Probabilidade de transferência para urna com n > N/2

# A tabela urnas[] armazena o número de bolas em cada passo em cada retirada
urnas <- data.table(A <- rep(0, nRetiradas), B <- rep(0, nRetiradas))
setnames(urnas, names(urnas), c("A", "B"))
rm(A, B)

# Condição inicial das urnas A e B:
urnas$A[[1]] <- N/2
urnas$B[[1]] <- N/2

# Escolha aleatória: considero que 1 represente uma bola retirada de uma urna
# com n > N/2, e -1 para uma urna com n <= N/2. Gero uma sequência inicial 
# para uma das urnas e multiplico esta por -1 para a outra urna
retiradas_A <- ifelse(runif(nRetiradas)<q,-1,1)
retiradas_B <- (-1)*retiradas_A

foreach(i=2:nRetiradas) %do% {
  if(min(urnas$A[[i-1]] + retiradas_A[i], urnas$B[[i-1]] + 
         retiradas_B[i]) >= 0){
    urnas$A[[i]] <- urnas$A[[i-1]] + retiradas_A[i]
    urnas$B[[i]] <- urnas$B[[i-1]] + retiradas_B[i]    

  } else {
    urnas$A[[i]] <- urnas$A[[i-1]] + retiradas_B[i]
    urnas$B[[i]] <- urnas$B[[i-1]] + retiradas_A[i]   
  }
}

Da forma que implementei, cada linha do data.table dependerá da linha anterior e, por isso, só consegui resolver utilizando um for bem demorado. Mas para percorrer 10^6 linhas do data.table está demorando horrores. Há alguma solução mais eficiente? (mesmo que envolva modificar totalmente minha abordagem)

2
  • Deixa eu entender melhor: Vc tem um data frame com duas colunas (urna_a e urna_b) onde cada linha corresponde ao estado (número de bolas) de cada repetição do seguinte experimento: jogo uma moeda e transfiro uma bola da urna_a para a urna_b se for cara (com probabilidade p de ser cara). O que deve acontecer se a quantidade de bolas na urna estourar? Eu paro a simulação? 26/06/2017 às 19:01
  • Se a quantidade de bolas chegar à 0 em uma urna, eu removo da outra. E se chegar a 100, eu removo ao invés de adicionar. Não foi especificado no enunciado, mas adotei esta solução ou também ignorar até que se encontre uma remoção (no caso da urna estiver cheia).
    – mbranbilla
    26/06/2017 às 20:57

1 Resposta 1

3

Consegui otimizar MUITO a execução utilizando matrizes ao invés de data.table (não havia nada no meu programa que justificasse a necessidade de um data.table).

Segue o código com solução que encontrei:

# Valores iniciais:
N <- 100             # Número total de bolas
nRetiradas <- 1e6   # Número de inteirações (retiradas) do problema
nDescarte <- 1e4    # Número de descartes no início da sequência
q <- 0.35            # Probabilidade de transferência para urna com n <= N/2
p <- 1.0 - q           # Probabilidade de transferência para urna com n > N/2

# A tabela urnas[] armazena o número de bolas em cada passo em cada retirada
urnas <- matrix(data = NA, nrow = nRetiradas, ncol = 2)

# Condição inicial das urnas A e B:
urnas[1,1] <- N/2
urnas[1,2] <- N/2

# Escolha aleatória: considero que 1 represente uma bola retirada de uma urna
# com n > N/2, e -1 para uma urna com n <= N/2. Gero uma sequência inicial 
# para uma das urnas e multiplico esta por -1 para a outra urna
retiradas_A <- ifelse(runif(nRetiradas)<q,-1,1)
retiradas_B <- (-1)*retiradas_A

tempoInicio <- Sys.time()

# foreach é um comando para realizar um laço 'for' utilizando 
# paralelismo entre os multiplos Cores disponíveis no hardware.
for(i in 2:nRetiradas) {
  if(min(urnas[i-1, 1] + retiradas_A[i], urnas[i-1,2] + 
         retiradas_B[i]) >= 0){
    urnas[i,1] <- urnas[i-1,1] + retiradas_A[i]
    urnas[i,2] <- urnas[i-1,2] + retiradas_B[i]    

  } else {
    urnas[i,1] <- urnas[i-1, 1]+ retiradas_B[i]
    urnas[i,2] <- urnas[i-1, 2] + retiradas_A[i]   
  }
}

Espero que em algum momento isso possa ajudar a quem se deparar com um problema semelhante!

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .