Programowanie w języku R, wiersze obliczanie ramki danych z niestandardowym skryptem (dla każdego i) w celu rozwiązania „gry w brydża”

Nov 25 2020

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

3 YaroslavDanko Nov 29 2020 at 03:01

Wygląda na to, że mam prostsze rozwiązanie dla kroku 3. Funkcja npanelstworzy wektor z numerów paneli, wyznacza w nim pozycję postoju gracza. Jeśli kierunek ruchu jest dodatni ( ascendingzmienna 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
4 ekoam Nov 29 2020 at 02:52

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”.

2 Ben Nov 29 2020 at 02:09

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 positionmiędzy starta end.

W przeciwnym razie możesz dołączyć kombinacje 2x2 if elsepatrzenia ascendingi n. Równania wykorzystują podobne wyodrębnianie wartości z x. Warto zauważyć, że wygląda na to, że chcesz sumwartości, w których istnieje zakres indeksów (np. Kiedy mówisz „start (i = 2 do n)”, chcesz sumwartoś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
Quad89 Nov 27 2020 at 01:05

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 ...