2

我正在 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)
4

0 回答 0