Creating action buttons from the user's input selection.

shiny
1

Hi all,

I am creating an application in which I am trying to create action buttons from the user's input. Suppose, I have a data frame as shown.

image

What I am trying to do is-

1)Ask for the user name?
2) Ask him- "Select the countries" and 4 action buttons with country names.
3) If I select any country, it should again ask- select cities and show the number of cities as action buttons.
4) If I select any city it should ask for the Popular for-item as action buttons.
5) when I select any of the popular button it should show the ratings .

How to get this?

My reprex-

library(tidyverse)
library(dplyr)
library(purrr)
library(magrittr)
library(shinyWidgets)
library(emojifont)
library(shinyBS)
library(renv)
library(shiny)
library(shinydashboardPlus)
library(shinydashboard)
library(shinyjs)
library(reshape2)
library(pool)
library(shiny.info)
library(shinycssloaders)
library(shinybusy)
library(jsonlite)
library(readxl)
library(tidyverse)

dat<- read_xlsx(path = "Dummy.xlsx")
ui<- fluidPage(
  useShinyjs(),
  titlePanel("Info"),
  
  fluidRow(
    
    column( width = 4,
            panel(
              style = "overflow-y:scroll; max-height: 300px; position:relative; align: centre",
              textInput("message", label = "",
                        placeholder = "Type Message"),
              
     actionButton("send", "Send"), heading = "Smart-Advisor", status = "primary"
            ))))

# Defining Server Controls
server<- function(input, output, session)
{
  
  # Declaring and Initializing Global Variables
  i <- 1
  lvl <- reactiveVal()
  lvl(i)
  
  
  emojis<- matrix(c("India", "US","UK", "Canada"), byrow =F, nrow = 1)
  emj <- reactiveValues(em = 1 ) 
  
  #Clear Function 
  clearInput<- function()
  {
    updateTextInput(session,"message", value = "")
  }  
  
  #Invalid Function
  invalidInput<- function()
  {
    insertUI(
      selector = "#message",
      where = "beforeBegin",
      ui=div(class="chat-bubbles",
             div(class="bubble admin",
                 p("Kindly provide a valid input"))
      ), immediate = TRUE
    )
    clearInput()      
  }
  
  ind<- reactive({
    dat%>%filter(Country=="India")%>%distinct(Cities)
  })
  
  ind_2<- reactive({
    dat%>%filter(Country=="India" , Cities=="New Delhi")%>%distinct(`Popular for-Item`)
  }) 
  
  #Main fucntion
  replyMessage<- function(lvl,msg)
  {    
    switch(lvl,           
           # Check for Level 1
           if(grepl("^[a-zA-Z][a-zA-Z ]+[a-zA-Z]$",msg, perl=T))
           {             
             insertUI(selector = "#message", where = "beforeBegin",
                      ui= div(class="chat-bubbles",
                              div(class="bubble admin",
                                  img(),
                                  wellPanel(
                                    p("Hi",tags$b(msg),".",tags$br(), "My name is Zeta!","How are you feeling today?")), tags$br()),
                              p(actionBttn("mood1","India", icon = icon("grin"), style = "pill", color = "warning",size = "xs"),
                                actionBttn("mood2","US",icon = icon("frown-open"), style = "pill",size = "xs",color = "success" ),
                                actionBttn("mood3","UK", icon = icon("meh"),  style = "pill",size = "xs", color = "primary"),
                                actionBttn("mood4","Canada", icon = icon("meh"),  style = "pill",size = "xs", color = "primary")
                              )), immediate = TRUE)
             clearInput()
             shinyjs::disable("message")
             shinyjs::hide("send")             
             lvl(lvl + 1)             
           }, 
           
           # level 3             
             if(msg=='India')
             {
               insertUI(
                 selector = "#message",
                 where = "beforeBegin",
                 ui=div(class="chat-bubbles",
                        div(class="bubble admin",
                            img(),
                            wellPanel(
                              p("What Personal challenges are you facing?", emoji("raising_hand")))), tags$br(),
                        p(actionBttn("P1",paste(ind()[1,1]), icon=icon("user-friends"), color = "warning", style = "pill", size = "xs"),tags$br(), tags$br(),
                          actionBttn("P2",paste(ind()[2,1]),icon=icon("dollar-sign"), color = "success",style = "pill", size = "xs"),tags$br(), tags$br(),
                          actionBttn("P3",paste(ind()[3,1]),icon=icon("first-aid"), color = "primary", style = "pill", size = "xs")
                          
                        )), immediate = TRUE)
               
               shinyjs::disable("message")
               shinyjs::hide("send")
               
               lvl(lvl + 1)
               
             },
           
           if(paste(ind()[1,1])==TRUE)
           {
             insertUI(
               selector = "#message",
               where = "beforeBegin",
               ui=div(class="chat-bubbles",
                      div(class="bubble admin",
                          img(),
                          wellPanel(
                            p("What Personal challenges are you facing?", emoji("raising_hand")))), tags$br(),
                      p(actionBttn("P1",paste(ind_2()[1,1]), icon=icon("user-friends"), color = "warning", style = "pill", size = "xs"),tags$br(), tags$br(),
                        actionBttn("P2",paste(ind_2()[1,1]),icon=icon("dollar-sign"), color = "success",style = "pill", size = "xs"),tags$br(), tags$br(),
                        actionBttn("P3",paste(ind_2()[1,1]),icon=icon("first-aid"), color = "primary", style = "pill", size = "xs")
                        
                      )), immediate = TRUE)
           
           shinyjs::disable("message")
           shinyjs::hide("send")
           lvl(lvl + 1)
           }        
           ) }
  
  # Function to check blank in Message box
  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 admin",
                     img(),
                     p("Kindly provide a valid input."))
          )
        )
        clearInput()
      }
      else
      {
        replyMessage(lvl(),input$message)
      }
        })   
    
    lapply(sprintf("mood%s", 1:4),
           function(x)
           {
             observeEvent(input[[x]],{
               emj$em<- as.numeric(sub("mood", "", x))
               insertUI(selector = "#message", where = "beforeBegin",
                        p(paste(
                          replyMessage(lvl(),emojis[, emj$em])))
               )
             })
             shinyjs::disable("mood1")
             shinyjs::disable("mood2")
             shinyjs::disable("mood3")
             shinyjs::disable("mood4")
           })   
    
  }
  # Main Function
  startConversation<- function()
  {
    
    clearInput()
    insertUI(
      selector = "#message",
      where = "beforeBegin",
      ui=div(class="chat-bubbles",
             div(class="bubble admin",
                 tags$div(class = "chat_avatar",
                          tags$img(src = "chat-robot.gif",
                                   class = "img-responsive")),
                 wellPanel(
                   p("Hey! Could I get your name?")
                 ))))
    getMessage(lvl)
    
  }
  startConversation()  
}

shinyApp(ui,server)
2

Hello again Ankush,
Unfortunately what you have provided is not a reprex (you have private objects) and not minimal - you are asking how to build out a large app (5 steps, all very similar) , rather than asking how to do a particular technical thing (i.e. steps 1 or 2 on their own), and its not minimal either, as you have code relating to rendering emoji's etc, and this does not tie with your 'ask' ... I say this only so you can make changes which will increase the likelihood of forum users engagement with your request for support.

3

Hi Nir.
Glad you replied.
Kindly look into the below code-

library(tidyverse)
library(dplyr)
library(purrr)
library(magrittr)
library(shinyWidgets)
library(emojifont)
library(shinyBS)
library(renv)
library(shiny)
library(shinydashboardPlus)
library(shinydashboard)
library(shinyjs)
library(reshape2)
library(pool)
library(shiny.info)
library(shinycssloaders)
library(shinybusy)
library(jsonlite)
library(readxl)
library(tidyverse)

dat<- read_xlsx(path = "Dummy.xlsx")
ui<- fluidPage(
  useShinyjs(),
  titlePanel("Info"),
  
  fluidRow(
    
    column( width = 4,
            panel(
              style = "overflow-y:scroll; max-height: 300px; position:relative; align: centre",
              textInput("msg", label = "",
                        placeholder = "Type Message"),
              
              actionButton("send", "Send"), heading = "Smart-Advisor", status = "primary"
            ))))

# Defining Server Controls
server<- function(input, output, session)
{
  
 
  #Clear Function 
  clearInput<- function()
  {
    updateTextInput(session,"message", value = "")
  }  
  
  #Invalid Function
 
  
  ind<- reactive({
    dat%>%filter(Country=="India")%>%distinct(Cities)
  })
  
  ind_2<- reactive({
    dat%>%filter(Country=="India" , Cities=="New Delhi")%>%distinct(`Popular for-Item`)
  }) 
  
  observeEvent(input$send,{
    
           # Check for Level 1
           if(input$msg!="")
           {             
             insertUI(selector = "#message", where = "beforeBegin",
                      ui= div(class="chat-bubbles",
                              div(class="bubble admin",
                                  img(),
                                  wellPanel(
                                    p("Hi",tags$b(input$msg),".",tags$br(), "My name is Zeta!","How are you feeling today?")), tags$br()),
                              p(actionBttn("count1","India", style = "pill", color = "warning",size = "xs"),
                                actionBttn("count2","US", style = "pill",size = "xs",color = "success" ),
                                actionBttn("count3","UK",  style = "pill",size = "xs", color = "primary"),
                                actionBttn("count4","Canada", style = "pill",size = "xs", color = "primary")
                              )), immediate = TRUE)
             clearInput()
             shinyjs::disable("message")
             shinyjs::hide("send")             
                       
           }
           
           # level 3             
           if(input$msg=='India')
           {
             insertUI(
               selector = "#message",
               where = "beforeBegin",
               ui=div(class="chat-bubbles",
                      div(class="bubble admin",
                          img(),
                          wellPanel(
                            p("What Personal challenges are you facing?", emoji("raising_hand")))), tags$br(),
                      p(actionBttn("P1",paste(ind()[1,1]), color = "warning", style = "pill", size = "xs"),tags$br(), tags$br(),
                        actionBttn("P2",paste(ind()[2,1]), color = "success",style = "pill", size = "xs"),tags$br(), tags$br(),
                        actionBttn("P3",paste(ind()[3,1]), color = "primary", style = "pill", size = "xs")
                        
                      )), immediate = TRUE)
             
             shinyjs::disable("message")
             shinyjs::hide("send")
             
             
           }
           
           if(paste(ind()[1,1])==TRUE)
           {
             insertUI(
               selector = "#message",
               where = "beforeBegin",
               ui=div(class="chat-bubbles",
                      div(class="bubble admin",
                          img(),
                          wellPanel(
                            p("What Personal challenges are you facing?", emoji("raising_hand")))), tags$br(),
                      p(actionBttn("P1",paste(ind_2()[1,1]),  color = "warning", style = "pill", size = "xs"),tags$br(), tags$br(),
                        actionBttn("P2",paste(ind_2()[1,1]), color = "success",style = "pill", size = "xs"),tags$br(), tags$br(),
                        actionBttn("P3",paste(ind_2()[1,1]), color = "primary", style = "pill", size = "xs")
                        
                      )), immediate = TRUE)
             
             shinyjs::disable("message")
             shinyjs::hide("send")
             
           }        
   
  })


}

shinyApp(ui,server)

Hope it works!

4

As nigrahamuk said it's still not possible to test (and conseqently improve!) your code as we don't have the "Dummy.xlsx".
Try to create a dummy-data frame that contains the essential information to work with, remove everything from the code that is not directly needed and let us concentrate on these pieces that contain the problem you want to solve.

5

Hi @Matthias, reframed the code-

library(tidyverse)
library(dplyr)
library(purrr)
library(magrittr)
library(shinyWidgets)
library(emojifont)
library(shinyBS)
library(renv)
library(shiny)
library(shinydashboardPlus)
library(shinydashboard)
library(shinyjs)
library(reshape2)
library(pool)
library(shiny.info)
library(shinycssloaders)
library(shinybusy)
library(jsonlite)
library(readxl)
library(tidyverse)

dat<- CO2
ui<- fluidPage(
  useShinyjs(),
  titlePanel("Info"),
  
  fluidRow(
    
    column( width = 4,
            panel(
              style = "overflow-y:scroll; max-height: 300px; position:relative; align: centre",
              textInput("msg", label = "",
                        placeholder = "Type Message"),
              
              actionButton("send", "Send"), heading = "Smart-Advisor", status = "primary"
            ))))

# Defining Server Controls
server<- function(input, output, session)
{
  
  
  #Clear Function 
  clearInput<- function()
  {
    updateTextInput(session,"message", value = "")
  }  
  
#Filtering data
  ind<- reactive({
    dat%>%filter(Plant=="Qn1")%>%distinct(Type)
  })
  
  ind_2<- reactive({
    dat%>%filter(Country=="Qn1" , Cities=="Quebec")%>%distinct(Treatment)
  }) 
  
  observeEvent(input$send,{
    
    # Check for Level 1
    if(input$msg!="")
    {             
      insertUI(selector = "#message", where = "beforeBegin",
               ui= div(class="chat-bubbles",
                       div(class="bubble admin",
                           img(),
                           wellPanel(
                             p("Hi",tags$b(input$msg),".",tags$br(), "My name is Zeta!","How are you feeling today?")), tags$br()),
                       p(actionBttn("count1","Qn1", style = "pill", color = "warning",size = "xs"),
                         actionBttn("count2","Qn2", style = "pill",size = "xs",color = "success" ),
                         actionBttn("count3","Qn3",  style = "pill",size = "xs", color = "primary"),
                         actionBttn("count4","Qc1", style = "pill",size = "xs", color = "primary")
                       )), immediate = TRUE)
      clearInput()
      shinyjs::disable("message")
      shinyjs::hide("send")             
      
    }
    
    # level 2            
    if(input$msg=='Qn1')
    {
      insertUI(
        selector = "#message",
        where = "beforeBegin",
        ui=div(class="chat-bubbles",
               div(class="bubble admin",
                   img(),
                   wellPanel(
                     p("What Personal challenges are you facing?", emoji("raising_hand")))), tags$br(),
               p(actionBttn("P1",paste(ind()[1,1]), color = "warning", style = "pill", size = "xs"),tags$br(), tags$br(),
                 actionBttn("P2",paste(ind()[2,1]), color = "success",style = "pill", size = "xs"),tags$br(), tags$br(),
                 actionBttn("P3",paste(ind()[3,1]), color = "primary", style = "pill", size = "xs")
                 
               )), immediate = TRUE)
      
      shinyjs::disable("message")
      shinyjs::hide("send")
      
      
    }
    
    if(paste(ind()[1,1])==TRUE)
    {
      insertUI(
        selector = "#message",
        where = "beforeBegin",
        ui=div(class="chat-bubbles",
               div(class="bubble admin",
                   img(),
                   wellPanel(
                     p("What Personal challenges are you facing?", emoji("raising_hand")))), tags$br(),
               p(actionBttn("P1",paste(ind_2()[1,1]),  color = "warning", style = "pill", size = "xs"),tags$br(), tags$br(),
                 actionBttn("P2",paste(ind_2()[1,1]), color = "success",style = "pill", size = "xs"),tags$br(), tags$br(),
                 actionBttn("P3",paste(ind_2()[1,1]), color = "primary", style = "pill", size = "xs")
                 
               )), immediate = TRUE)
      
      shinyjs::disable("message")
      shinyjs::hide("send")
      
    }        
    
  })
  
  
}

shinyApp(ui,server)
6

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.