Need to build dependency for 3 InsertUI fields coming from Excel sheet in RShiny

Question

I am pretty new to R and was trying to build a small utility just for my learning.

I have 3 fields in my excel workbook named:

Country State Cities

All these fields should come as a drop down in UI.

What I want to achieve is: 'when I make a selection for Country, a new drop down for State should get created with a list of States that falls under the Country selected. And based on the state selected the underlying cities should get populated in the drop down'

I found a few examples online, but they all were creating a static UI with 3 fixed drop downs in it. How can I implement it dynamically?

Below code helps me achieve it partially, for exm: if I select a country as 'India', it adds another drop down with list of all the states correctly based on the filter used. But once the states gets populated they don't change even if I change the selected value for Country.

Can someone please help me fix it?

library(shiny)
library(shinydashboardPlus)
library(shinydashboard)
library(shinyjs)
library(shinyWidgets)
library(tidyverse)
library(dplyr)
library(excelR)
library(readxl)
library(readr)

a<- read.excel("cities.xlsx")

ui<- fluidPage(
               titlePanel("Country Details"),
               fluidRow(column( width = 8,
                                div( 
                    textInput("message", label = "",placeholder = "Type your message here."),
                                          actionButton("send", "Send")
                                )
               )))

Server<- function ( input, output, session)
{

ObsereEvent(input$send, {
insertUI(selector#message", where = "beforeBegin",
                      ui=div(class="bubble",
                                 wellPanel(
                                   p( selectInput("country", "Country", choices =c("All",unique(as.character(a$Country) )), multiple = T) )))))

})
    observeEvent(input$country,{
      insertUI(selector = "#message", where = "beforeBegin",
               ui=div( div(class="bubble",
                          wellPanel(
                            p(
                              selectInput("state", "State", choices =c(unique(as.character(a$State))[a$Country==input$country])) )
                          ))))

    })

observeEvent(input$state,{
      insertUI(selector = "#message", where = "beforeBegin",
               ui=div( div(class="bubble",
                          wellPanel(
                            p(
                              selectInput("city", "City", choices =c(unique(as.character(a$city))[a$Country==input$country & a$state==input$state])) )
                          ))))

    })

} 
ShinyApp( ui, server)

score 0 · Answer 1 · answered Jun 15 '20 at 07:04

In your server function, add an observeEvent listener for your country selectInput. Inside it, use updateSelectInput to repopulate your state selectInput. Similarly, write an observeEvent listener for your state selectInput to update your city selectInput.

Unless it is important that the state selectInput doesn't appear until you've selected a country (and the city selectInput until you have selected a state, you should be able to do all of this without needing to use insertUI or renderUI. Search for help on updateSelectInput. There are plenty of examples online.

It's not possible to provide a solution for you as you haven't given us a simple, self-contained example of your problem. This would include toy input data, your code, any error messages, and expected output. This post may be helpful.

I am sorry. I have added the code to the question now. Can you please assist me now. — sudhanshucitus, Jun 16 '20 at 19:27

score 0 · Answer 2 · answered Jun 15 '20 at 16:11

My query is same-

My code is below-

I want to filter the data based on selection of first select Input ( diploma). i.e if I select any diploma course, I shall get the filtered data in available1 select Input.

My code is-

ui<- fluidPage(useShinyjs(),
               #extendShinyjs(text = "shinyjs.button = function() {window.scrollTo(0, 50);}"),
               tags$head(tags$link(rel="stylesheet", href="style.css")),
               titlePanel("Chatbot"),
               fluidRow(column( width = 8,
                                div(id='outDiv',

                                    panel(style = "overflow-y:scroll; max-height: 300px; position:relative; align: centre",
                                          textInput("message", label = "",placeholder = "Type your message here."),
                                          actionButton("send", "Send"), heading = "Smart Advisor", status = "primary")
                                )
               )))


server<- function(input, output, session)
{


  # Declaring and Initializing Global Variables
  i <- 1
  lvl <- reactiveVal()
  lvl(i)

replyMessage<- function(lvl,msg)
  {
    message('Level:', lvl)
    message('Message:', msg)

    switch(lvl,

if(msg=='Diploma')
           {
             insertUI(selector = "#message", where = "beforeBegin",
                      ui=div(class="chat-bubbles",
                             div(class="bubble",
                                 wellPanel(
                                   p("As per your selection you are eligible for:", tags$br(),
                                     selectInput("diploma_courses", "Disciplines", choices =c("All",unique(as.character(a1$`Discipline Category1`) )),
                                                 multiple = T)

                                   )))))

             observeEvent(input$diploma_courses,{
               insertUI(selector = "#message", where = "beforeBegin",
                        ui=div(class="chat-bubbles",
                               div(class="bubble",
                                   wellPanel(
                                     p(
                                       selectInput("available1", "Specialization", choices =c(as.character(a1$Subject1)[a1$`Discipline Category1`== input$diploma_courses])) )
                                   ))))

             })

 getMessage<- function(lvl)
  {
    # Observer Event for Message Box
    observeEvent(input$send,{
      if(input$message == '')
      {
        insertUI(
          selector = "#message",
          where = "beforeBegin",
          ui=div(class="chat-bubbles",
                 div(class="bubble",p("Kindly provide a valid input."))
          )
        )
        clearInput()
      }
      else
      {
        replyMessage(lvl(),input$message)
      }

    })
Solution

Need to build dependency for 3 InsertUI fields coming from Excel sheet in RShiny

2 Answers2

Linked