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

半世苍凉 提交于 2020-06-23 14:16:34

问题


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)

回答1:


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.




回答2:


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


来源:https://stackoverflow.com/questions/62376985/need-to-build-dependency-for-3-insertui-fields-coming-from-excel-sheet-in-rshiny

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!