在Shiny中触发带有validate-need的警报?

时间:2016-10-22 22:12:46

标签: html r shiny

我在创建的Shiny应用程序中触发警报有困难。应用程序本身非常简单,并显示一个带数字和线图的滑块。但是,我想在滑块设置为大于5的值时触发警报。以下是代码:

UI

library(shiny)
library(shinythemes)
library(shinyBS)

shinyUI(fluidPage(theme = shinytheme("superhero"),
              tags$head(
                tags$style(HTML("
  .shiny-output-error-validation {
    color: green;
  }
"))
              ),

sidebarLayout(
sidebarPanel(
  sliderInput("samplestat",
              "Value:",
              min = 1,
              max = 10,
              value = 1)
),

    mainPanel(
  h3("Graph", style = "font-family: 'Jura'; color: blue; font-size: 32px;"),
  HTML("<p>Graph</p>"),
  plotOutput("LinePlot")
)
)
))

SERVER

library(shiny)
library(ggplot2)
library(scales)

samplestat <- function(input) {
if (input > 5) {
"Choose another value. samplestat must be below 5!"
} else if (input < 4) {
FALSE
} else {
NULL
}
}

shinyServer(function(input, output) {

data <- reactive({
validate(
  need(input$data != "", "Please select a value below 5")
)
get(input$data)
})

output$LinePlot <- renderPlot({

n=1:10
samplestat <- seq(min(n), max(n), length.out = input$samplestat)

plot(samplestat, type = "o", col = 'blue', border = 'white', xlab="X Axis", ylab ="Y Axis")
}

)

})

当我运行此代码时,显示行和滑块,但是当我将滑块滑动到大于5的值时,我没有得到任何警告。我不确定我是否可能使用了验证 - 需要不正确,或者我是否忽略了别的东西。

1 个答案:

答案 0 :(得分:2)

您应该validate(...)内幕renderPlot({...})。也就是说,您的server.R应该是这样的:

function(input, output) {
  output$LinePlot <- renderPlot({
    validate(
      need(input$samplestat <= 5, "Please select a value below 5")
    )
    n <- 1:10
    samplestat <- seq(min(n), max(n), length.out = input$samplestat)
    plot(samplestat, type = "o", col = 'blue', 
      fg = 'white', xlab= "X Axis", ylab = "Y Axis")
  })
}

产生这个输出: enter image description here

请注意,将验证代码包装在被动函数中应该没有问题。假设您测试条件的函数是

validate_samplestat <- function(input) {
  if (input > 5) {
    "Choose another value. samplestat must be below 5!"
  } else {
    NULL
  }
}

您可以在主服务器函数中将其包含在reactive中,并将反应函数放在输出渲染函数中。主要是在输出呈现函数中放置调用validate 的代码

function(input, output) {
  v <- reactive({
    validate(validate_samplestat(input$samplestat))
  })

  output$LinePlot <- renderPlot({
    v() # <--- validate here
    n <- 1:10
    samplestat <- seq(min(n), max(n), length.out = input$samplestat)
    plot(samplestat, type = "o", col = 'blue', 
      fg = 'white', xlab= "X Axis", ylab = "Y Axis")
  })
}