SelectInput not updating in r shiny

[Ankush]

I have 3 selectInput in my application. All have to be form in the insertUI. The first filter shall cmake changes in the 2nd and 2nd can make changes in 3rd. And How to avoid the duplicate insertUI being formed.

library(shiny)
library(shinyjs)
dt<- data.frame("location"=c("USA", "India", "UK", "India", "USA", "UK"), "Site"=c("google", "facebook", "microsoft", "Vodafone", "Airtel", "Aditya Birla"), 
                "Profit"=c("1000", "15000", "25000", "500", "250000", "410000"))

ui<- fluidPage(
  titlePanel("Links"),
  fluidRow(column( width = 8,
                   div(
                     uiOutput('item'),
                     actionButton("send", "Send")
                   )
  )))

server<- function(input,output,session)
{
  
  observeEvent(input$send,{
    insertUI(selector = "#send", where = "beforeBegin",
             ui=div(class="bubbles",
                    div(class="bubble",
                        wellPanel(
                          p("What is your preferred site?", tags$br(),
                            selectInput("location", "Location", choices =sort(unique(as.character(dt$location) ))
                            )
                          )))))
    
  })
  
  choice2<- reactive({
    dt%>% filter(location==input$location)%>% pull("Site")
  })
  observeEvent(input$location, {
    insertUI(selector = "#send", where = "beforeBegin",
             ui=div(class="bubbles",
                    div(class="bubble",
                        wellPanel(
                          p("What is your preferred site?", tags$br(),
                            output$site<- renderUI({
                            selectInput("selection", "site", choices =sort(unique(as.character(choice2()) ))
                            )
                            })
                          )))))
    
  })
choice3<- reactive({
  dt%>% filter(location==input$location)%>% pull("Site")%>%
    filter(Site==choice2())%>% pull(Profit)
})

observeEvent(input$selection, {
  insertUI(selector = "#send", where = "beforeBegin",
           ui=div(class="bubbles",
                  div(class="bubble",
                      wellPanel(
                        p("What is your preferred site?", tags$br(),
                          output$site<- renderUI({
                            selectInput("profit", "Profit", choices =sort(unique(as.character(choice3()) ))
                            )
                          })
                        )))))
  
})
  
}
shinyApp(ui,server)

[nirgrahamuk]

dt%>% filter(location==input$location)%>% pull("Site")%>%
  filter(Site==choice2())%>% pull(Profit)

this is confused, after the first filter you do a pull, which means you are working with a vector and no longer a dataframe, so to then apply filter as if you were in a dtaframe and pull again a field that can not exist (profit) cannot be correct.
you probably want something like

    dt%>% filter(location==input$location,Site==choice2()) %>% pull(Profit)

working with insertUI's will inevitably make it difficult to avoid duplicate UI, unless you haverules for removeUI that correspond with discarded UI's.
Therefore I would challenge that insertUI is probably the wrong approach, if at any time there should not be more than one of each UI, then you should just render the UI dynamically in a more 'pure' way i.e. with uiOutput and renderUI

[Ankush]

It's still not updating the 3rd selectInput in my original application and getting this error while implementing the solution-

Warning in `==.default`(site, choice()) :
  longer object length is not a multiple of shorter object length
Warning in is.na(e1) | is.na(e2)

[nirgrahamuk]

you must have a different implementation than the one that you shared plus my adjustment.
Because it runs without warnings in my system.

[Ankush]

let me share my original reprex.

[Ankush]

My reprex. Although, it's running but it's not changing the values.

library(shiny)
library(shinydashboardPlus)
library(shinydashboard)
library(shinyjs)
library(shinyWidgets)
library(tidyverse)
library(dplyr)
library(excelR)
library(readxl)
library(readr)
library(rsconnect)
library(gtools)
library(excelR)
library(readxl)
library(haven)
library(arules)
library(MASS)
library(rsample)
library(flextable)
library(reshape2)
library(DT)


dt<- data.frame("Discipline"=c("IT", "Computer", "Arts", "IT", "Business", "Pyschology"), 
                "Specialization"=c("IT Networking", "Computer Networks", "Arts and Culture", "Software Engineering", 
                                   "Management", "Pyschology"), 
                "Programs"=c("Bachelors in Networking", "Bachelors in Computer Scienc", "Bachelors in Arts", "Masters in Security Analysis", 
                             "Bachelors in Business Management", "Bachelors in Pyschology"))


ui<- fluidPage(
  titlePanel("Links"),
  fluidRow(column( width = 8,
                   div(
                     uiOutput('item'),
                     renderDataTable("t1"),
                     actionButton("send", "Send")
                   )
  )))



# Defining Server Controls

server<- function(input, output, session)
{
  
  
           observeEvent(input$send,{
                  insertUI(selector = "#send", where = "beforeBegin",
                      ui=div(class="chat-bubbles",
                             div(class="bubble",
                                 wellPanel(
                                   p("What are your preferred disciplines?", tags$br(),
                                     selectInput("grad_courses", "Disciplines", choices =sort(unique(as.character(dt$Discipline) ))
                                     )
                                   )))))
           })
           
           observeEvent(input$grad_courses,{
               insertUI(selector = "#send", where = "beforeBegin",
                      ui=div(class="chat-bubbles",
                             div(class="bubble",
                                 wellPanel(
                                   output$item<- renderUI({
                                     selectInput("specialization", "Specilisation", choices =sort(unique(as.character(graduate_spec() ))
                                     ))
                                   })
                                   ))))
           })
             
                 # Check for Level 9
           
           observeEvent(input$specialization,{
           
             insertUI(selector = "#send", where = "beforeBegin",
                      ui=div(class="chat-bubbles",
                             div(class="bubble",
                                 wellPanel(
                                   p("You are eligible for the courses mentioned below:"),
                                   output$t1 <- shiny::renderDataTable({
                                     enframe(paste0(grad_prgm() ),value="link",name=NULL)
                                   }, escape=FALSE,
                                   options = list(dom = 't',
                                                  searching= FALSE))
                                   
                                   
                                 ))))
           })
             
          
  ## graduation values

  
  graduate_spec<- reactive({
    dt%>% filter(Discipline== input$grad_courses)%>%
      pull(Specialization)
  })
  
  grad_prgm<- reactive({
    z<-dt %>% filter(Discipline == input$grad_courses, Specialization == graduate_spec()) %>%
      pull(Programs)
    return(z)
  })
  
  
  
  
}
shinyApp(ui,server)

[nirgrahamuk]

library(shiny)
library(tidyverse)


dt <- data.frame(
  "Discipline" = c("IT", "Computer", "Arts", "IT", "Business", "Pyschology"),
  "Specialization" = c(
    "IT Networking", "Computer Networks", "Arts and Culture", "Software Engineering",
    "Management", "Pyschology"
  ),
  "Programs" = c(
    "Bachelors in Networking", "Bachelors in Computer Scienc", "Bachelors in Arts", "Masters in Security Analysis",
    "Bachelors in Business Management", "Bachelors in Pyschology"
  )
)

ui <- fluidPage(
  titlePanel("Links"),
  fluidRow(column(
    width = 8,
    div(
      actionButton("send", "Send"),
      uiOutput("d"),
      uiOutput("s"),
      uiOutput("p"),
      renderDataTable("t1")
    )
  ))
)

server <- function(input, output, session) {
  output$d <- renderUI({
    req(input$send)
    wellPanel(
      p(
        "What are your preferred disciplines?", tags$br(),
        selectInput("grad_courses", "Disciplines", choices = sort(unique(as.character(dt$Discipline))))
      )
    )
  })
  output$s <- renderUI({
    req(graduate_spec)
    wellPanel(
      p("pick spec"),
      selectInput("specialization", "Specilisation", choices = sort(unique(as.character(graduate_spec()))))
    )
  })

  output$p <- renderUI({
    req(grad_prgm())
    wellPanel(
      p("You are eligible for the courses mentioned below:"),
      output$t1 <- shiny::renderDataTable(
        {
          enframe(paste0(grad_prgm()), value = "link", name = NULL)
        },
        escape = FALSE,
        options = list(
          dom = "t",
          searching = FALSE
        )
      )
    )
  })

  ## graduation values
  graduate_spec <- reactive({
    dt %>%
      filter(Discipline == req(input$grad_courses)) %>%
      pull(Specialization)
  })

  grad_prgm <- reactive({
    z <- dt %>%
      filter(Discipline == req(input$grad_courses), Specialization == req(input$specialization)) %>%
      pull(Programs)

    return(z)
  })
}
shinyApp(ui, server)

[Ankush]

Your code is running. But I want to have that with insertUI as all my code is using that..
Can you provide the solution of that..

[nirgrahamuk]

for example, in the UI I change

uiOutput("d"),

to

div(id="d")

then the server code, instead of

  output$d <- renderUI({ ....

becomes

  observeEvent(input$send,{
    if(input$send>0){
      removeUI(selector="#dd")
    }
    insertUI(selector = "#d",
             where="afterBegin",
             ui=wellPanel(id="dd",
      p(
        "What are your preferred disciplines?", tags$br(),
        selectInput("grad_courses", "Disciplines", choices = sort(unique(as.character(dt$Discipline))))
      )
    ))
  })

the rest is left as an exercise....
i consider this less elegant than the original solution, and I dont see benefits.

[Ankush]

Thanks for the Solution Nir

[hinkelman]

If your question's been answered (even by you!), would you mind choosing a solution? It helps other people see which questions still need help, or find solutions if they have similar problems. Here’s how to do it:

FAQ: How do I mark a solution?

If your question has been answered, don't forget to mark the solution! How do I mark a solution? Find the reply you want to mark as the solution and look for the row of small gray icons at the bottom of that reply. Click the one that looks like a box with a checkmark in it: [image] Hovering over the mark solution button shows the label, "Select if this reply solves the problem". If you don't see the mark solution button, try clicking the three dots button ( ••• ) to expand the full set of options. When a solution is chosen, the icon turns green and the hover label changes to: "Unselect if this reply no longer solves the problem". Success! [solution_reply_author] …