Programação R, cálculo de quadro de dados por linha com script personalizado (para cada i) para resolver o "jogo de ponte"

Nov 25 2020

Eu tenho um quadro de dados que especifica "jogos de ponte" (cada linha é um jogo independente), veja um exemplo mínimo com 4 jogos abaixo:

start <- list(c("10","15","5"), c("5") ,c("11","6"),c("6","11"))
end <- list(c("7","17","11"), c("10"), c("8","12"),c("8","12"))
ascending <- c("+","-","+","-")
position <- c(11,6,9,8)
desired_output <- c(5,5,"disqualified",3)

bridge_game <- data.frame(start = I(start), end = I(end), ascending = ascending, position = position, desired_output = desired_output)

bridge_game

Como funciona o jogo de bridge? Candidatos de todo o mundo participam de um desafio de jogo de ponte e coletamos os dados de cada jogo de ponte em um quadro de dados. Cada ponte é constituída por painéis de madeira numerados (inteiros positivos que não têm necessariamente que começar em 1) e "lacunas" de painéis partidos. O candidato pode escolher de que lado da ponte ele está começando sua caminhada (ascendente = a numeração do painel aumenta com o progresso da caminhada; ou descendente = a numeração do painel diminui com o progresso da caminhada).

Um gráfico para uma melhor compreensão do jogo de bridge pode ser encontrado aqui (exemplificado para a 1ª linha do quadro de dados): clique aqui

Para cada jogo de bridge (= linha no quadro de dados), temos as seguintes informações (= colunas):

  • bridge_game $ start : todas as posições iniciais de tratos de painéis inteiros de madeira (ordem aleatória)
  • bridge_game $ end : todas as posições finais de tratos de painéis inteiros de madeira (ordem aleatória)
  • bridge_game $ ascending : atravesse a ponte em ordem crescente (+) ou decrescente (-) dos painéis
  • bridge_game $ position : o candidato acabou no painel indicado

Qual é o desafio? Preciso escrever um script que possa executar por linha em todo o quadro de dados para obter a seguinte saída:

  • bridge_game $ needed_output : teste se o candidato caiu no rio (terminou em um painel quebrado e é "desqualificado"). E se ele não for desclassificado, preciso calcular o número de painéis inteiros de madeira cobertos pela caminhada do candidato (painéis quebrados não contam).

É importante ressaltar que ele deve funcionar para qualquer número i de trechos inteiros de painéis de madeira.

Para ser mais preciso, dou instruções passo a passo sobre como o script R solicitado deve operar a seguir:

0) resolvido

a) Converta a lista de caracteres em uma lista numérica para as colunas bridge_game $ start e bridge_game $ end.

b) Calcule i (o número de extensões de painéis inteiros de madeira; i vai de 1 a i = máximo para cada linha) e classifique as posições inicial e final para obter os valores iniciais e finais corretos para cada i .

1) Teste se a posição está em um painel quebrado: fim (i = 1 a máx-1)> posição> início (i = 2 a máx) -> se VERDADEIRO para qualquer um dos pares testados -> "desqualificado"

2) Se não, teste em qual trecho de painéis inteiros se encontra a posição dada ( i = n ): início (i = 1 ao máximo) <= posição <= fim (i = 1 ao máximo) -> se TRUE retribuir i (= n)

3)

a) Aplique esta fórmula (se a direção for ascendente "+" e n = 1): saída = posição - início (i = 1) + 1

b) Aplique esta fórmula (se a direção for descendente "-" e n = i max): output = end (i = max) - position + 1

c) Aplique esta fórmula (se a direção for ascendente "+" e n> 1): saída = posição - início (i = 1) + 1 - (início (i = 2 a n) - fim (i = 1 a n- 1) - 1x [n-1])

d) Aplique esta fórmula (se a direção for descendente "-" e n <i max): output = end (i = max) - position + 1 - (start (i = n + 1 to max) - end (i = n para máx-1) - 1x [i = máx - n])

Espero ter entendido bem a matemática. Para verificar a saída correta, criei uma coluna "desejado_output" no quadro de dados "bridge_game".

Obrigado pela ajuda!

Respostas

3 YaroslavDanko Nov 29 2020 at 03:01

Parece que tenho uma solução mais simples para a etapa 3. A função npanelscria um vetor a partir dos números do painel, determina a posição da parada do jogador nele. Se a direção do movimento for positiva (a ascendingvariável é "+"), então essa é a solução desejada; se for negativa, o valor desejado é calculado com base no comprimento desse vetor.

start <- list(c(5,10,15), c(5) ,c(6,11),c(6,11))
end <- list(c(7,11,17), c(10), c(8,12),c(8,12))
position <- c(11,6,9,8)
ascending <- c("+","-","+","-")
game <- data.frame(start = I(start), end = I(end), position = position, ascending = ascending)

npanels <- function (data) {
  v <- unlist(Map(":",
                  unlist(data[["start"]]),
                  unlist(data[["end"]])))
  p <- which(v == data[["position"]])
  l <- length(v)
  b <- 1+l-p
  d <- data[["ascending"]]
  n <- ifelse(d == "+", p, b)
  n <- if(is.na(n)) "disqualified" else n
  return(n)
}

game$solution <- apply(game, 1, npanels)

game
4 ekoam Nov 29 2020 at 02:52

Você complicou demais este problema. Considere a seguinte implementação

parse_pos <- function(x) sort(as.integer(x))

construct_bridge <- function(starts, ends) {
  starts <- parse_pos(starts); ends <- parse_pos(ends)
  bridge <- logical(tail(ends, 1L))
  whole_panels <- sequence(ends - starts + 1L, starts)
  bridge[whole_panels] <- TRUE
  bridge
}

count_steps <- function(bridge, direction, stop_pos) {
  if (isFALSE(bridge[[stop_pos]]))
    return("disqualified")
  start_pos = c("+" = 1L, "-" = length(bridge))[[direction]]
  sum(bridge[start_pos:stop_pos])
}

play_games <- function(starts, ends, direction, stop_pos) {
  mapply(function(s, e, d, sp) {
    bridge <- construct_bridge(s, e)
    count_steps(bridge, d, sp)
  }, starts, ends, direction, stop_pos)
}

Resultado

> with(bridge_game, play_games(start, end, ascending, position))
[1] "5"            "5"            "disqualified" "3" 

A chave aqui é que podemos usar um vetor lógico para representar uma ponte, onde um painel quebrado / inteiro é indexado por F/ T. Em seguida, apenas testamos se a posição de parada está em um painel inteiro ou não. Retorne a soma dos painéis da posição inicial até a posição final em caso afirmativo (painéis quebrados não afetarão a soma, pois são apenas zeros) ou "desqualificados" caso contrário.

2 Ben Nov 29 2020 at 02:09

Isso pode fornecer o que você precisa para sua terceira etapa. Eu modifiquei a função de sua outra postagem .

Primeiro, verificaria se n(ou region) é NA. Se for, então não houve correspondência positionentre starte end.

Caso contrário, você pode incluir combinações 2x2 de if elseolhar ascendinge n. As equações usam extrações semelhantes de valores de x. É importante ressaltar que parece que você deseja sumos valores onde há uma faixa de índices (por exemplo, quando você diz "início (i = 2 an)", você deseja sumos valores, como sum(start[2:n])).

Observe que isso traduz sua equação em código diretamente como parecia desejado. No entanto, existem alternativas mais simples com base na lógica descrita nas outras respostas.

start <- list(c(5,10,15), c(5) ,c(6,11),c(6,11))
end <- list(c(7,11,17), c(10), c(8,12),c(8,12))
ascending <- c("+","-","+","-")
imax <- c(3,1,2,2)
position <- c(11,6,9,8)

example <- data.frame(start = I(start), end = I(end), ascending = ascending, imax = imax, position = position)

my_fun <- function(x) {
  n <- NA
  out <- NA
  start <- as.numeric(unlist(x[["start"]]))
  end <- as.numeric(unlist(x[["end"]]))
  for (i in 1:x[["imax"]]) {
    if (between(x[["position"]], start[i], end[i])) n <- i
  }
  if (!is.na(n)) {
    if (x[["ascending"]] == "+") {
      if (n == 1) {
        out <- x[["position"]] - start[1] + 1
      } else if (n > 1) {
        out <- x[["position"]] - start[1] + 1 - (sum(start[2:n]) - sum(end[1:(n-1)]) - (n - 1))
      }
    } else if (x[["ascending"]] == "-") {
      if (n == x[["imax"]]) {
        out <- end[x[["imax"]]] - x[["position"]] + 1  
      } else if (n < x[["imax"]]) {
        out <- end[x[["imax"]]] - x[["position"]] + 1 - (sum(start[(n+1):x[["imax"]]]) - sum(end[n:(x[["imax"]] - 1)]) - (x[["imax"]] - n))
      }
    }
  }
  out
}

example$desired_output <- apply(example, 1, my_fun) 

Resultado

      start       end ascending imax position desired_output
1 5, 10, 15 7, 11, 17         +    3       11              5
2         5        10         -    1        6              5
3     6, 11     8, 12         +    2        9             NA
4     6, 11     8, 12         -    2        8              3
Quad89 Nov 27 2020 at 01:05

Atualizar:

Etapa 0) está concluída:

#Change to numeric
bridge_game$start <- lapply(bridge_game$start, as.numeric)
bridge_game$end <- lapply(bridge_game$end, as.numeric)

#Calculate number of tracts of whole wooden panels
bridge_game$tracts <- lapply(bridge_game$start, length)

#Sort start and end positions
bridge_game$start <- lapply(bridge_game$start, sort)
bridge_game$end <- lapply(bridge_game$end, sort)

#Calculate number of tracts of whole wooden panels
bridge_game$tracts <- lapply(bridge_game$start, length)

Lutando da etapa 1) em ...