R Shiny conditionalPanel in while loop based on previous inputs

Question

I want to have something like a while loop over the conditional panels in Shiny, where the condition for the loop is based on the previous inputs.

In details: a user chooses a country from which he wants to start and another where he wants to finish. They are also required to choose which borders the route should go through. What I want to achieve, is first to update the choices in Select Input so the first contains only borders of the country "From", then the borders of the country they chose to go etc. Also, I want the second and following Select Inputs to show only up to the point where user selects a border with the country "To".

I thought about the following pseudocode:

bord_to=sub(".*-", "", input$b_dir_1)
i=2
while(bord_to!=input$cou_to){
      conditionalPanel(condition = 'bord_to != input$cou_to',
                       selectInput("b_dir[i]",
                                   "",
                                   "")
bord_to=sub(".*-", "", input$b_dir[i])
i=i+1
}

I want also to name the inputs like "b_dir_i".

I created the following code, which at least handles updating the input, but I still miss a way to conditionally show the inputs:

library(shiny)

countries <- c( "AT", "BG", "CH", "CZ", "DE", "FR", "GR", "HR", "HU", "IT-GREC", "IT-NORD", "PL", "RO", "RS", "SI", "SK", "TR" )
borders   <- c( "MK-RS", "RS-MK", "AL-GR", "GR-AL", "AL-ME", "ME-AL", "BA-HR", "HR-BA", "BA-ME", "ME-BA", "GR-MK", "MK-GR", "GR-TR", "TR-GR", "RS-BA", "BA-RS", "HU-RS", "RS-HU", "RO-RS", "RS-RO", "HU-UA", "UA-HU", "SK-UA", "UA-SK", "AT-CZ", "CZ-AT", "AT-HU", "HU-AT", "DETE-CZ", "CZ-DETE", "HR-HU" , "HU-HR", "HR-SI", "SI-HR" , "HR-RS", "RS-HR", "GR-IT", "IT-GR", "CH-IT", "IT-CH", "CH-FR" , "FR-CH", "CH-AT", "AT-CH", "CH-DE", "DE-CH", "DE50-CZ", "CZ-DE50", "PL-CZ", "CZ-PL", "DE50-PL", "PL-DE50", "PL-SK", "SK-PL", "BG-MK", "BG-TR", "MK-BG", "TR-BG", "BG-RS", "RS-BG", "BG-GR", "GR-BG", "RO-BG", "BG-RO" )

ui<-fluidPage(

    fluidRow( column( 6,
                      h4("Select countries:"),
                      selectInput("cou_from", "From:", c("", countries)),
                      selectInput("cou_to", "To:", c("", countries)) ) ),

    h4("Select borders:"),

    fluidRow(
        column( 3, selectInput("b_dir_1", "", ""), ),
      # this is the fragment I want to go on the loop
        column( 3,   
            conditionalPanel(
                condition = 'sub(".*-", "", input$b_dir_1) != input$cou_to ',
                             selectInput("b_dir_2", "", "") ) ) ),

    actionButton( "run_anl",
                  "Run Analysis",
                  width = "100%",
                  style = "color: #fff; background-color: #337ab7;
                           border-color: #2e6da4" )
)

server<-function(input, output, session){
    observe({
        cou_1<-input$cou_from
        choice1<-c("", borders[grepl(paste0("^", cou_1), borders)])
        updateSelectInput(session, "b_dir_1", choices=choice1)
    })
    observe({
        bor_ch_1<-input$b_dir_1
        choice2<-c("", borders[grepl(paste0("^", sub(".*-", "", bor_ch_1)), borders)])
        updateSelectInput(session, "b_dir_2", choices=choice2)
    })
}

shinyApp(ui = ui, server = server)

I want the UI to look similar to this:

Answer 1

Here is an approach using shiny::insertUI / removeUI. The first border input is generated as in the original app, but instead of selecting two country abbreviation (e.g., DE-CH) we just select the countries that the from country shares a border with. Then, to generate the subsequent border crossings, we filter a from-to data frame based on the most recent b_dir_*. We keep track of the most recently activated selectInput via a reactive value (index_selection). For finer control and to avoid infinite loops, I added control buttons so that the user can click for the next border crossing and to clear the selected route. (I used tidyverse functions to prepare the dataset and to filter, but you can easily remove these dependencies with base R code if needed.)

---

Here is a gif of the app. I think it gets you very close, if not all the way, to the desired behavior.

---

Code:

library(shiny)
library(dplyr)
library(tidyr)

countries <- c( "AT", "BG", "CH", "CZ", "DE", "FR", "GR", "HR", "HU", "IT-GREC", "IT-NORD", "PL", "RO", "RS", "SI", "SK", "TR" )
borders   <- c( "MK-RS", "RS-MK", "AL-GR", "GR-AL", "AL-ME", "ME-AL", "BA-HR", "HR-BA", "BA-ME", "ME-BA", "GR-MK", "MK-GR", "GR-TR", "TR-GR", "RS-BA", "BA-RS", "HU-RS", "RS-HU", "RO-RS", "RS-RO", "HU-UA", "UA-HU", "SK-UA", "UA-SK", "AT-CZ", "CZ-AT", "AT-HU", "HU-AT", "DETE-CZ", "CZ-DETE", "HR-HU" , "HU-HR", "HR-SI", "SI-HR" , "HR-RS", "RS-HR", "GR-IT", "IT-GR", "CH-IT", "IT-CH", "CH-FR" , "FR-CH", "CH-AT", "AT-CH", "CH-DE", "DE-CH", "DE50-CZ", "CZ-DE50", "PL-CZ", "CZ-PL", "DE50-PL", "PL-DE50", "PL-SK", "SK-PL", "BG-MK", "BG-TR", "MK-BG", "TR-BG", "BG-RS", "RS-BG", "BG-GR", "GR-BG", "RO-BG", "BG-RO")

borders_left_right <-
  tibble(borders) %>% separate(
    borders,
    into = c("from", "to"),
    sep = "-",
    remove = FALSE
  )

ui <- fluidPage(
  fluidRow(column(
    6,
    h4("Select countries:"),
    selectInput("cou_from", "From:", c("", countries)),
    selectInput("cou_to", "To:", c("", countries))
  )),

  h4("Select borders:"),

  fluidRow(
    column(3, selectInput("b_dir_1", "Border", "")),
    div(id="placeholder"),
    column(1, actionButton("next_border", "Next border")),
    column(1, actionButton("clear", "Clear route"))
    ),

  actionButton(
    "run_anl",
    "Run Analysis",
    width = "100%",
    style = "color: #fff; background-color: #337ab7;
    border-color: #2e6da4"
  )
)

server <- function(input, output, session) {
  observe({
    cou_1 <- input$cou_from
    choice1 <-
      filter(borders_left_right, from == cou_1) %>% pull(to)
    updateSelectInput(session,
                      "b_dir_1",
                      label = paste("Borders of", cou_1),
                      choices = choice1)
  })

  # observer to update a reactive value for the selection in the last generated box
  index_selection <- reactiveVal(1)

  observeEvent(input$next_border, {
    last_selection <- paste0("b_dir_", index_selection())

    if (req(input[[last_selection]]) != input$cou_to) {

      adjacent_countries <-
        filter(borders_left_right, from == input[[last_selection]]) %>% pull(to)

      insertUI(selector = "#placeholder",
               where = "beforeBegin",
               ui = tagList(column(3,
                 selectInput(
                   inputId = paste0("b_dir_", index_selection() + 1),
                   label = paste("Borders of", input[[last_selection]]),
                   choices = adjacent_countries
                 )
               )))
    }

    # update reactive value
    new_index <- index_selection() + 1
    index_selection(new_index)
  })

  # clear route
  observeEvent(input$clear, {
    # remove inserted uis
    if (index_selection() > 1) {
      lapply(2:index_selection(), function(x)
        removeUI(selector = paste0(".col-sm-3:has(#b_dir_", x, ")" )))
    }
    # update from / to inputs
    updateSelectInput(session = session, inputId = "cou_from", selected = "")
    updateSelectInput(session = session, inputId = "cou_to", selected = "")
    # reset reactive value
    index_selection(1)

  })

}

shinyApp(ui = ui, server = server)