我正在Shiny中创建一个应用程序,用户可以使用两个值的滑块输入。之后,用户可以按下动作按钮并查看仅包括对应于具有高于滑块输入值的值的数据帧的行的点的散点图。应用程序的这一部分似乎正在起作用。
但是,如果用户选择较小的滑块输入值,则数据框可能非常大。因此,如果用户选择将导致超过50行数据框的滑块输入值,则当用户单击操作按钮时,将出现警告消息(以指示数据框行的数量)可能很大(大于50)并建议用户选择较小的滑块输入值)。如果用户收到此消息,但仍然第二次单击操作按钮(不更改滑块输入),则仍然会绘制> 50个点。
我一直在研究方法,我正在尝试使用shinyBS方法popify()。但是,我的算法(下面的第40-49行)使用if和else语句来决定是否应该发出警告消息,并且该部分似乎不起作用。此外,我不确定如何防止绘制> 50点,除非用户忽略警告消息并再次点击操作按钮。
非常感谢有关如何实现这一目标的任何建议!
library(shiny)
library(plotly)
library(htmltools)
library(shinyBS)
ui <- shinyUI(pageWithSidebar(
headerPanel("Click the button"),
sidebarPanel(
uiOutput("slider"),
sliderInput("val2", "Value 2:", min = 0, max = 1, value=0.5, step=0.1),
uiOutput("uiExample")
),
mainPanel(
plotlyOutput("plot1"),
verbatimTextOutput("click")
)
))
set.seed(1)
dat <- data.frame(Case = paste0("case",1:100), val1=runif(100,0,1), val2=runif(100,0,1))
dat$Case <- as.character(dat$Case)
xMax = max(dat$val1)
xMin = min(dat$val1)
yMax = max(dat$val2)
yMin = min(dat$val2)
maxTemp = max(abs(xMax), abs(xMin))
server <- shinyServer(function(input, output) {
output$slider <- renderUI({
sliderInput("val1", "Value 1:", min=0, max=ceiling(maxTemp), value=0.5, step=0.1)
})
# datInput only validated once the go button is clicked
datInput <- eventReactive(input$goButton, {
subset(dat, val1 > input$val1 & val2 > input$val2)
})
output$uiExample <- renderUI({
#if (nrow(datInput()>50)){
# tags$span(
# popify(actionButton("goButton", "Go!"), "Warning", "We recommend to choose val1 and val2 both to be greater than 0.5. If you wish to plot the selected values anyway, press Go again", trigger = "click")
# )
# }
#else{
actionButton("goButton", "Go!")
#}
})
output$plot1 <- renderPlotly({
# will wait to render until datInput is validated
plot_dat <- datInput()
p <- qplot(plot_dat$val1, plot_dat$val2) + xlim(0, ceiling(maxTemp)) +ylim(0,1)
ggplotly(p)
})
d <- reactive(event_data("plotly_selected"))
output$click <- renderPrint({
if (is.null(d())){
"Click on a state to view event data"
}
else{
#str(d()$pointNumber)
datInput()[d()$pointNumber+1,] #Working now
}
})
})
shinyApp(ui, server)