r - R中的重复循环条件
问题描述
我有一个表格填写应用程序。我正在接受用户的输入，然后根据需要继续进行。我试图重复一个条件。我的代表——
library(tidyverse)
library(dplyr)
library(purrr)
library(magrittr)
library(shinyWidgets)
library(shiny)
library(shinydashboardPlus)
library(shinydashboard)
library(shinyjs)
library(reshape2)
library(pool)
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)
我创建了 lvl 函数（如计数器），当条件继续进行时它会增加。当条件（if=='A'）时，我试图重复Pre Acceptance Queries的条件（在 reprex 中）。我在服务器部分的 create_function 中创建了一个 UI 并调用它。但它仅显示 UI 部分（if=='A'），之后不再继续。对于应用程序的使用，请输入文本，然后选择和心情（快乐、困惑和担心），然后转到预接受查询，然后选择A。
解决方案
推荐阅读
- swift - 测试模块时重置单例状态
- typescript - TypeScript：在项目之间共享代码的最简单方法
- python - 如何在熊猫数据框中使用 if-else
- c++ - 派生类模板中的条件覆盖
- entity-framework-core - EF Core 2.1 - 使用流畅 API 时的重复关系
- android - android布局位图不占用全部空间
- c# - 获取数据表的特定行
- sql - SQL如何检查多个非空值，但不在查询中创建多行
- php - Laravel API 在响应前添加 npm
- xml - counter (for loop?) through XML in powershell