Programación R, cálculo del marco de datos por filas con un script personalizado (para cada i) para resolver el "juego de bridge"
Tengo un marco de datos que especifica "juegos de puente" (cada fila es un juego independiente), vea un ejemplo mínimo con 4 juegos a continuación:
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
¿Cómo funciona el juego de bridge? Los candidatos de todo el mundo participan en un desafío de juego de bridge y hemos recopilado los datos de cada juego de bridge en un marco de datos. Cada puente consta de paneles de madera numerados (números enteros positivos que no necesariamente tienen que empezar en 1) y "huecos" de paneles rotos. El candidato puede elegir desde qué lado del puente está comenzando su caminata (ascendente = la numeración del panel aumenta a medida que avanza la caminata; o descendente = la numeración del panel disminuye a medida que avanza la caminata).
Puede encontrar un gráfico para una mejor comprensión del juego de bridge aquí (ejemplificado para la primera fila en el marco de datos): haga clic aquí
Para cada juego de bridge (= fila en el marco de datos) tenemos la siguiente información (= columnas):
- bridge_game $ start : todas las posiciones iniciales de tractos de paneles de madera enteros (orden aleatorio)
- bridge_game $ end : todas las posiciones finales de tramos de paneles de madera enteros (orden aleatorio)
- bridge_game $ ascendente : camina por el puente en orden ascendente (+) o descendente (-) de paneles
- bridge_game $ position : el candidato terminó en el panel indicado
¿Cuál es el desafío? Necesito escribir un script que pueda ejecutar en filas en todo el marco de datos para obtener el siguiente resultado:
- bridge_game $ deseado_output : prueba si el candidato se cayó al río (terminó en un panel roto y está "descalificado"). Y si no está descalificado, necesito calcular la cantidad de paneles de madera enteros cubiertos por el camino del candidato (los paneles rotos no cuentan).
Es importante destacar, que debería funcionar para cualquier número i de grandes extensiones de paneles de madera.
Para ser más precisos, doy una instrucción paso a paso sobre cómo debe funcionar el script R solicitado a continuación:
0) resuelto
a) Convierta la lista de caracteres en una lista numérica para las columnas bridge_game $ start y bridge_game $ end.
b) Calcule i (el número de secciones de paneles de madera enteros; i va de 1 a i = máximo para cada fila) y ordene las posiciones inicial y final para obtener los valores iniciales y finales correctos para cada i .
1) Pruebe si la posición está en un panel roto: final (i = 1 a max-1)> posición> inicio (i = 2 a max) -> si es VERDADERO para cualquiera de los pares probados -> "descalificado"
2) Si no, pruebe en qué tramo de paneles completos se encuentra la posición dada ( i = n ): inicio (i = 1 a máx.) <= Posición <= fin (i = 1 a máx.) -> si es VERDADERO, devolver yo (= n)
3)
a) Aplicar esta fórmula (si la dirección es ascendente "+" yn = 1): salida = posición - inicio (i = 1) + 1
b) Aplicar esta fórmula (si la dirección es descendente "-" y n = i max): salida = final (i = max) - posición + 1
c) Aplicar esta fórmula (si la dirección es ascendente "+" y n> 1): salida = posición - inicio (i = 1) + 1 - (inicio (i = 2 an) - final (i = 1 an- 1) - 1x [n-1])
d) Aplicar esta fórmula (si la dirección es descendente "-" y n <i max): salida = final (i = max) - posición + 1 - (inicio (i = n + 1 a max) - final (i = n to max-1) - 1x [i = max - n])
Espero haber aprendido las matemáticas allí mismo. Para comprobar la salida correcta, he creado una columna "deseada_salida" en el marco de datos "bridge_game".
¡Gracias por tu ayuda!
Respuestas
Parece que tengo una solución más simple para el paso 3. La función npanelscrea un vector a partir de los números del panel, determina la posición de la parada del jugador en él. Si la dirección del movimiento es positiva (la ascendingvariable es "+"), entonces esta es la solución deseada, si es negativa, entonces el valor deseado se calcula en base a la longitud de este vector.
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
Has complicado demasiado este problema. Considere la siguiente implementación
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)
}
Salida
> with(bridge_game, play_games(start, end, ascending, position))
[1] "5" "5" "disqualified" "3"
La clave aquí es que podemos usar un vector lógico para representar un puente, donde un panel roto / completo está indexado por F/ T. Luego, solo probamos si la posición de parada está en un panel completo o no. Devuelve la suma de paneles desde la posición inicial hasta la final si es así (los paneles rotos no afectarán la suma ya que son solo ceros) o "descalificados" en caso contrario.
Esto podría proporcionarle lo que necesita para su tercer paso. Modifiqué la función de tu otra publicación .
Primero, comprobaría si n(o region) lo es NA. Si es así, entonces no hubo coincidencia para el positionentre starty end.
De lo contrario, puede incluir combinaciones 2x2 de if elsemirar ascendingy n. Las ecuaciones utilizan una extracción similar de valores de x. Es de destacar que parece que desea sumlos valores donde hay un rango de índices (por ejemplo, cuando dice "inicio (i = 2 an)" desea sumlos valores, como sum(start[2:n])).
Tenga en cuenta que esto traduce su ecuación en código directamente como parecía deseado. Sin embargo, existen alternativas más simples basadas en la lógica descrita en las otras respuestas.
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)
Salida
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
Actualizar:
Paso 0) está hecho:
#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)
Luchando desde el paso 1) en ...