I have a form filling application. I am taking inputs from the user and then proceeding ahead as required. I am trying to repeat a condition many times. 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)
library(janitor)
df <- structure(list(Category = c("A", "A", "A", "B", "B", "C", "C","D", "D"),
Subcategory = c("A_1", "A_2", "A_3", "B_1", "B_2", "C_1", "C_2", "D_3", "D_4"),
Option = c("Q1", "Q2", "Q3", "Q4", "Q5", "Q6", "Q7", "Q8", "Q9")),
row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))
ui<- fluidPage(useShinyjs(),
titlePanel("Form"),
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 = "Student Services", status = "primary")
)
)))
server<- function(input,output, session)
{
############Clear Function##############
clearInput<- function()
{
updateTextInput(session,"message", value = "")
}
unique_Categories1<- df%>% distinct(Category)
emojis<- matrix(c("Happy", "Confused", "Worried"), byrow =F, nrow = 1)
emj <- reactiveValues(em = 1 )
types<- matrix(c("Pre Acceptance Queries", "Post Arrival Challenges"), byrow =F, nrow = 1)
type_tp <- reactiveValues(tp = 1 )
pre_cat<- matrix(c("A", "B", "C", "D"), byrow =F, nrow = 1)
pre_1 <- reactiveValues(pt = 1 )
#Function to call
call_function<- function(a, lvl)
{
lvl<-1
a<- insertUI(selector = "#message", where = "beforeBegin",
ui= div(class="chat-bubbles",
div(class="bubble admin",
wellPanel(
p(paste("No worries!", emoji("smiley") , "I can help you in-")))), tags$br(),
wellPanel(
actionBttn("TP1","Pre Acceptance Queries", style = "pill", size = "xs"),
actionBttn("TP2","Post Arrival Challenges", style = "pill",size = "xs")
)), immediate = TRUE)
runjs(' document.getElementById("bottom").scrollIntoView(); ')
shinyjs::disable("message")
shinyjs::hide("send")
shinyjs::disable("mood1")
shinyjs::disable("mood2")
shinyjs::disable("mood3")
}
############################################ Pre Landing questions ####################################################
admission_cat_quest<- reactive({
df%>%filter(Category=="A")%>% group_by(Category)%>% distinct( Subcategory, Option)
})
################################################### Main function######################################################
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",
wellPanel(
p("Hi",tags$b(msg),".",tags$br(), "My name is Zeta!","How are you feeling today?")), tags$br()),
wellPanel(
actionBttn("mood1","Happy", style = "pill", size = "xs"),
actionBttn("mood2","Confused", style = "pill",size = "xs"),
actionBttn("mood3","Worried", style = "pill",size = "xs")
)), immediate = TRUE)
clearInput()
shinyjs::disable("message")
shinyjs::hide("send")
lvl(lvl + 1)
runjs('
document.getElementById("bottom").scrollIntoView();
')
},
# Check for Level 2
if(msg=="Happy" | msg=="Confused" | msg=="Worried")
{
if(msg=="Happy")
{
insertUI(selector = "#message", where = "beforeBegin",
ui= div(class="chat-bubbles",
div(class="bubble admin",
wellPanel(
p(paste("It sounds great!", emoji("smiley") , "How can I help you now?")))), tags$br(),
wellPanel(
actionBttn("TP1","Pre Acceptance Queries", style = "pill", size = "xs"),
actionBttn("TP2","Post Arrival Challenges",style = "pill",size = "xs")
)), immediate = TRUE)
lvl(lvl + 1)
runjs(' document.getElementById("bottom").scrollIntoView();')
shinyjs::disable("message")
shinyjs::hide("send")
shinyjs::disable("mood1")
shinyjs::disable("mood2")
shinyjs::disable("mood3")
}
else if(msg=="Confused"| msg=="Worried")
{
message(lvl)
insertUI(selector = "#message", where = "beforeBegin",
ui= div(class="chat-bubbles",
div(class="bubble admin",
wellPanel(
p(paste("No worries!", emoji("smiley") , "I can help you in-")))), tags$br(),
wellPanel(
actionBttn("TP1","Pre Acceptance Queries", style = "pill", size = "xs"),
actionBttn("TP2","Post Arrival Challenges", style = "pill",size = "xs")
)), immediate = TRUE)
lvl(lvl+1)
runjs(' document.getElementById("bottom").scrollIntoView(); ')
shinyjs::disable("message")
shinyjs::hide("send")
shinyjs::disable("mood1")
shinyjs::disable("mood2")
shinyjs::disable("mood3")
}
},
if(msg=="Pre Acceptance Queries" | msg=="Post Arrival Challenges")
{
if(msg=="Pre Acceptance Queries")
{
message(lvl)
insertUI(selector = "#message", where = "beforeBegin",
ui= div(class="chat-bubbles",
div(class="bubble admin",
wellPanel(
p(paste("It sounds great!", emoji("smiley") , "How can I help you now?")))),
wellPanel(
actionBttn("PRE1",unique_Categories1[1,1], style = "pill", size = "xs"),
actionBttn("PRE2",unique_Categories1[2,1], style = "pill",size = "xs"),
actionBttn("PRE3",unique_Categories1[3,1], style = "pill",size = "xs"),
actionBttn("PRE4",unique_Categories1[4,1], style = "pill",size = "xs")
)), immediate = TRUE)
lvl(lvl + 1)
runjs(' document.getElementById("bottom").scrollIntoView(); ')
shinyjs::disable("message")
shinyjs::hide("send")
shinyjs::disable("mood1")
shinyjs::disable("mood2")
shinyjs::disable("mood3")
}
},
**if(msg=="A")**
{
call_function(a)
}
)
}
# 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:3),
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")
})
lapply(sprintf("TP%s", 1:2),
function(x)
{
observeEvent(input[[x]],{
type_tp$tp<- as.numeric(sub("TP", "", x))
insertUI(selector = "#message", where = "beforeBegin",
p(paste(
replyMessage(lvl(),types[, type_tp$tp])))
)
})
shinyjs::disable("mood1")
shinyjs::disable("mood2")
shinyjs::disable("mood3")
})
lapply(sprintf("PRE%s", 1:4),
function(x)
{
observeEvent(input[[x]],{
pre_1$pt<- as.numeric(sub("PRE", "", x))
insertUI(selector = "#message", where = "beforeBegin",
p(paste(
replyMessage(lvl(),pre_cat[, pre_1$pt])))
)
})
shinyjs::disable("mood1")
shinyjs::disable("mood2")
shinyjs::disable("mood3")
})
}
# Main Function
startConversation<- function()
{
clearInput()
insertUI(
selector = "#message",
where = "beforeBegin",
ui=div(class="chat-bubbles",
div(class="bubble admin",
wellPanel(
p("Hey! Could I get your name?")
))))
getMessage(lvl)
}
# Declaring and Initializing Global Variables
i <<- 1
lvl <<- reactiveVal()
lvl(i)
startConversation()
#Invalid Function
invalidInput<- function()
{
insertUI(
selector = "#message",
where = "beforeBegin",
ui=div(class="chat-bubbles",
div(class="bubble admin",
wellPanel(
p("Kindly provide a valid input")))
), immediate = TRUE
)
clearInput()
}
}
shinyApp(ui,server)
I have created lvl function(like counter) which increases when the condition proceeds ahead. I am trying to repeat the condition of Pre Acceptance Queries (in reprex) when condition (if msg=='A'). I have created a UI in create_function in server part and calling it. But it's showing the UI part only(of if msg=='A'), it's not proceeding after that. For usage of the application- Kindly enter a text , then select and Mood (Happy, Confused and Worried) then go to Pre Acceptance queries then select A .