Programowanie w języku R, wiersze obliczanie ramki danych z niestandardowym skryptem (dla każdego i) w celu rozwiązania „gry w brydża”
Mam ramkę danych, która określa „gry brydżowe” (każdy wiersz to jedna niezależna gra), zobacz minimalny przykład z 4 grami poniżej:
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
Jak działa gra w brydża? Kandydaci z całego świata uczestniczą w wyzwaniu gry w brydża, a my zebraliśmy dane z każdej gry w brydża w ramce danych. Każdy most składa się z ponumerowanych drewnianych paneli (dodatnie liczby całkowite, które niekoniecznie muszą zaczynać się od 1) i „przerw” z połamanych paneli. Kandydat może wybrać, od której strony mostu zaczyna spacer (rosnąco = numeracja panelu rośnie wraz z postępem spaceru; lub malejąca = numeracja panelu maleje wraz z postępem spaceru).
Grafikę dla lepszego zrozumienia gry w brydża można znaleźć tutaj (na przykładzie pierwszego wiersza w ramce danych): kliknij tutaj
Dla każdej gry w brydża (= wiersz w ramce danych) mamy następujące informacje (= kolumny):
- bridge_game $ start : wszystkie pozycje początkowe połaci całych paneli drewnianych (kolejność losowa)
- bridge_game $ end : wszystkie końcowe pozycje połaci całych paneli drewnianych (kolejność losowa)
- bridge_game $ ascending : przejdź przez most w kolejności rosnącej (+) lub malejącej (-) paneli
- bridge_game $ pozycja : kandydat znalazł się we wskazanym panelu
Jakie jest wyzwanie? Muszę napisać skrypt, który mogę uruchomić wierszami w całej ramce danych, aby uzyskać następujące dane wyjściowe:
- bridge_game $ allowed_output : test, czy kandydat wpadł do rzeki (wylądował na zepsutym panelu i został „zdyskwalifikowany”). A jeśli nie zostanie zdyskwalifikowany, muszę obliczyć liczbę całych drewnianych paneli pokonanych przez kandydata (pęknięte panele się nie liczą).
Co ważne, to powinno działać na każdym numerem I całych połaci drewnianych paneli.
Aby być bardziej precyzyjnym, poniżej podam instrukcję krok po kroku, jak powinien działać żądany skrypt R:
0) rozwiązany
a) Konwertuj listę znaków na listę numeryczną dla kolumn gra_brydża $ start i gra_brydża $ koniec.
b) Oblicz i (liczba połaci całych paneli drewnianych; i wynosi od 1 do i = maks. dla każdego rzędu) i posortuj pozycje początkową i końcową, aby uzyskać prawidłowe wartości początkowe i końcowe dla każdego i .
1) Sprawdź, czy pozycja jest na zepsutym panelu: koniec (i = 1 do max-1)> pozycja> początek (i = 2 do max) -> jeśli PRAWDA dla którejkolwiek z testowanych par -> „zdyskwalifikowany”
2) Jeśli nie, sprawdź, w jakim odcinku całych paneli znajduje się dana pozycja ( i = n ): start (i = 1 do max) <= pozycja <= koniec (i = 1 do max) -> jeśli TRUE oddaj i (= n)
3)
a) Zastosuj tę formułę (jeśli kierunek jest rosnący „+” i n = 1): wyjście = pozycja - początek (i = 1) + 1
b) Zastosuj tę formułę (jeśli kierunek jest malejący „-” i n = i max): wyjście = koniec (i = max) - pozycja + 1
c) Zastosuj tę formułę (jeśli kierunek jest rosnący „+” i n> 1): wyjście = pozycja - początek (i = 1) + 1 - (początek (i = 2 do n) - koniec (i = 1 do n- 1) - 1x [n-1])
d) Zastosuj tę formułę (jeśli kierunek jest malejący "-" i n <i max): wyjście = koniec (i = max) - pozycja + 1 - (początek (i = n + 1 do max) - koniec (i = n do max-1) - 1x [i = max - n])
Mam nadzieję, że mam już matematykę. Aby sprawdzić poprawność danych wyjściowych, utworzyłem kolumnę „selected_output” w ramce danych „bridge_game”.
Dzięki za pomoc!
Odpowiedzi
Wygląda na to, że mam prostsze rozwiązanie dla kroku 3. Funkcja npanels
tworzy wektor z numerów paneli, wyznacza w nim pozycję postoju gracza. Jeśli kierunek ruchu jest dodatni ( ascending
zmienna jest "+"
), to jest to pożądane rozwiązanie, jeśli jest ujemna, to żądana wartość jest obliczana na podstawie długości tego wektora.
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
Zbyt skomplikowałeś ten problem. Rozważ następującą implementację
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)
}
Wynik
> with(bridge_game, play_games(start, end, ascending, position))
[1] "5" "5" "disqualified" "3"
Kluczowe jest tutaj to, że możemy użyć wektora logicznego do reprezentacji mostu, w którym uszkodzony / cały panel jest indeksowany przez F
/ T
. Następnie po prostu sprawdzamy, czy pozycja zatrzymania znajduje się na całym panelu, czy nie. Zwróć sumę paneli z pozycji początkowej do końcowej, jeśli tak (uszkodzone panele nie wpłyną na sumę, ponieważ są to tylko zera) lub w przeciwnym razie „zdyskwalifikowano”.
Może to zapewnić Ci to, czego potrzebujesz na trzeci krok. Zmodyfikowałem funkcję z twojego innego postu .
Najpierw sprawdzi, czy n
(lub region
) jest NA
. Jeśli tak, oznacza to, że nie znaleziono dopasowania position
między start
a end
.
W przeciwnym razie możesz dołączyć kombinacje 2x2 if
else
patrzenia ascending
i n
. Równania wykorzystują podobne wyodrębnianie wartości z x
. Warto zauważyć, że wygląda na to, że chcesz sum
wartości, w których istnieje zakres indeksów (np. Kiedy mówisz „start (i = 2 do n)”, chcesz sum
wartości, takie jak sum(start[2:n])
).
Zauważ, że przekłada to twoje równanie bezpośrednio na kod, tak jak wydawało się to pożądane. Istnieją jednak prostsze alternatywy oparte na logice opisanej w innych odpowiedziach.
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)
Wynik
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
Aktualizacja:
Krok 0) jest zakończony:
#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)
Walcząc od kroku 1) do ...