R programming, row-wise data frame calculation with custom script (for every i) to solve "bridge game"

Question

I have a data frame which specifies "bridge games" (every row is one independent game), see a minimal example with 4 games below:

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

How does the bridge game work? Candidates all over the world participate in a bridge game challenge and we have collected the data of every bridge game in a data frame. Every bridge consists of numbered wooden panels (positive integers that not necessarily have to start at 1) and "gaps" of broken panels. The candidate can choose from which side of the bridge he is starting his walk (ascending = the numbering of the panel increases as the walk progresses; or descending = the numbering of the panel decreases as the walk progresses).

A graphic for a better understanding of the bridge game can be found here (exemplified for the 1st row in the data frame): click here

For every bridge game (= row in the data frame) we have the following information (= columns):

• bridge_game$start: all start positions of tracts of whole wooden panels (random order)
• bridge_game$end: all end positions of tracts of whole wooden panels (random order)
• bridge_game$ascending: walk across the bridge in ascending (+) or descending (-) order of panels
• bridge_game$position: candidate ended up at the indicated panel

What is the challenge? I need to write a script that I can run row-wise over the whole data frame to get the following output:

• bridge_game$desired_output: test whether candidate fell down into the river (ended up at a broken panel and is "disqualified"). And if he is not disqualified I need to calculate the number of whole wooden panels covered by the candidate's walk (broken panels don't count).

Importantly, it should work for any number i of whole tracts of wooden panels.

To be more precise I give a step-by-step instruction how the requested R script should operate below:

0) solved

a) Convert list of characters into numeric list for columns bridge_game$start and bridge_game$end.

b) Calculate i (the number of tracts of whole wooden panels; i goes from 1 to i=max for every row) and sort the start and end positions to get the correct start and end values for every i.

1) Test whether the position is at a broken panel: end(i=1 to max-1) > position > start(i=2 to max) --> if TRUE for any of the tested pairs --> "disqualified"

2) If no, test in which tract of whole panels the given position lies (i = n): start(i=1 to max) <= position <= end(i=1 to max) --> if TRUE give back i (= n)

3)

a) Apply this formula (if direction is ascending "+" and n = 1): output = position - start(i=1) + 1

b) Apply this formula (if direction is descending "-" and n = i max): output = end(i=max) - position + 1

c)Apply this formula (if direction is ascending "+" and n > 1): output = position - start(i=1) + 1 - (start(i=2 to n) - end(i=1 to n-1) - 1x[n-1])

d) Apply this formula (if direction is descending "-" and n < i max): output = end(i=max) - position + 1 - (start(i=n+1 to max) - end(i=n to max-1) - 1x[i=max - n])

I hope I got the math right there. To check for the correct output I have created a "desired_output" column in the "bridge_game" data frame.

Thanks for your help!

Answer 1

It seems i have more simple solution for step #3. Function npanels creates a vector from the panel numbers, determines the position of the player's stop in it. If the direction of movement is positive (ascending variable is "+"), then this is the desired solution, if negative, then the desired value is calculated based on the length of this 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

Answer 2

Update:

Step 0) is done:

#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)

Struggling from step 1) on...

Answer 3

This might provide you with what you need for your third step. I modified the function from your other post.

First, would check if n (or region) is NA. If it is, then there was no match for the position between start and end.

Otherwise, you can include 2x2 combinations of if else looking at ascending and n. The equations use similar extraction of values from x. Of note, it looks like you want to sum the values where there is a range of indices (e.g., when you say "start(i=2 to n)" you want to sum the values, such as sum(start[2:n])).

Note that this translates your equation into code directly as it seemed was desired. However, there are simpler alternatives based on the logic described in the other answers.

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) 

Output

      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

Answer 4

You have overcomplicated this problem. Consider the following implementation

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)
}

Output

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

The key here is that we can use a logical vector to represent a bridge, where a broken/whole panel is indexed by F/T. Then we just test whether the stop position is on a whole panel or not. Return the sum of panels from the start to end position if so (broken panels will not affect the sum as they are just zeros) or "disqualified" otherwise.