Question

我没什么问题。我有一个名为d3K的构建包，可以在不同的仪表板上使用。功能之一如下：

conditionalRenderValueBox <- function(value, title, red_limit, yellow_limit){
      renderValueBox(    valueBox(value, title,
      color = if(class(value)=="character" | is.na(value)){
        "blue"
      }else if(value>red_limit ){
        "red"
      }else if(value>yellow_limit){
        "yellow"
      }else{
        "green"
      }
    ))
}

现在我试图在函数中传递value参数，其中参数是无效值。

server.R

library(lubridate)
# library(googleVis)
# library(readr)
library(shinyjs)
library(ggplot2)
library(plotly)
library(d3K)
library(dplyr)
server <- function(input, output, session) {

   v1 = reactive({
      input$v1
   })

   f <-  reactive({
      if(is.na(v1())){
          "WAI"
       }else{
           runif(1, 1, 10)
       }
       })
output$t <- conditionalRenderValueBox(f(), "Possible Value", 15, 10) 
}

ui.R

library(shinydashboard)
library(shiny)
library(shinyjs)
library(plotly)

ui <- dashboardPage(

  dashboardHeader(title = "DashBoard")
  ,skin = 'yellow'
    ,dashboardSidebar(
      tags$head(
      tags$style(HTML("
                      .sidebar { height: 90vh; overflow-y: auto; }
                      " )
      )
    ),

      sidebarMenu(

          menuItem("R", tabName = "R", icon = icon("cog"))
          , selectInput("v1", label = h3("Select box"), 
choices = list( 1,  11, 15), 
selected = 1),


      )

    )


   ,dashboardBody(
       tabItems(
          tabItem(
             tabName = "R"
             , br()
             , fluidRow(
                  valueBoxOutput("t")
                )

  )
)
)
)

我无法在闪亮的信息中心看到价值框。

但是，如果在服务器的输出$ t中使用以下代码，则可以正常工作

output$t <- renderValueBox(    valueBox(f(), "title",
          color = if(class(f())=="character" | is.na(f())){
            "blue"
          }else if(f()>red_limit ){
            "red"
          }else if(f()>yellow_limit){
            "yellow"
          }else{
            "green"
          }
        ))

然后我能够按预期看到结果

Answer 1

如果您在脚本中定义conditionalRenderValueBox，我发现它会运行：

library(lubridate)
# library(googleVis)
# library(readr)
library(shinyjs)
library(ggplot2)
library(plotly)
# library(d3K) I don't have access to this package obviously
library(dplyr)
library(shinydashboard)
library(shiny)
library(shinyjs)
library(plotly)

conditionalRenderValueBox <- function(value, title, red_limit, yellow_limit){
  renderValueBox(    valueBox(value, title,
                              color = if(class(value)=="character" | is.na(value)){
                                "blue"
                              }else if(value>red_limit ){
                                "red"
                              }else if(value>yellow_limit){
                                "yellow"
                              }else{
                                "green"
                              }
}

server <- function(input, output, session) {

  v1 = reactive({
    input$v1
  })
  f <-  reactive({
    if(is.na(v1())){
      "WAI"
    }else{
      runif(1, 1, 10)
    }
  })
  output$t <- conditionalRenderValueBox(f(), "Possible Value", 15, 10) 

  ))
}

ui <- dashboardPage(
  dashboardHeader(title = "DashBoard")
  ,skin = 'yellow'
  ,dashboardSidebar(
    tags$head(
      tags$style(HTML("
                      .sidebar { height: 90vh; overflow-y: auto; }
                      " )
      )
    ),
    sidebarMenu(
      menuItem("R", tabName = "R", icon = icon("cog"))
      , selectInput("v1", label = h3("Select box"), 
                    choices = list( 1,  11, 15), 
                    selected = 1)      
    )    
  )
  ,dashboardBody(
    tabItems(
      tabItem(
        tabName = "R"
        , br()
        , fluidRow(
          valueBoxOutput("t")
        )

      )
    )
  )
)

runApp(shinyApp(server=server,ui=ui))

我猜测问题在于你的软件包如何导出函数，但是如果没有看到代码，我很难知道。

希望这有帮助。

编辑：嘿，我不确切知道你的d3K套餐是做什么的，如果你已经让它发挥作用，但据我所知，你不想写包装render * shiny函数的函数。下面这个应用程序不会起作用：

myFunc <- function(x) {
  renderTable({
    head(x)
  })
}

shinyApp(
  ui=fluidPage(
    selectInput("select","Choose dataset",c("mtcars","iris")),
    tableOutput("table")
    ),
  server=function(input,output) {

    dataset <- reactive({
      get(input$select)
    })

    output$table <- myFunc(dataset())

  })

该函数在启动时运行一次并呈现初始表，但在此之后它永远不会改变，因为myFunc不像render *函数那样理解反应性。

我认为你的函数应该包装valueBox元素，然后你将函数提供给renderValueBox，如下所示：

library(lubridate)
# library(googleVis)
# library(readr)
library(shinyjs)
library(ggplot2)
library(plotly)
# library(d3K) I don't have access to this package obviously
library(dplyr)
library(shinydashboard)
library(shiny)
library(shinyjs)
library(plotly)

conditionalRenderValueBox <- function(value, title, red_limit, yellow_limit){

  #renderValueBox( 
    valueBox(value, title,
                          color = if(class(value)=="character" | is.na(value)){
                                "blue"
                              }else if(value>red_limit ){
                                "red"
                              }else if(value>yellow_limit){
                                "yellow"
                              }else{
                                "green"
                              }
  )
  #)
}

server <- function(input, output, session) {

  v1 = reactive({
    input$v1
  })
  f <-  reactive({
    v1 <- v1()
    print("Hey")
    if(is.na(v1)){
      "WAI"
    }else{
      runif(1, 1, 10)
    }
  })
  observe({
  output$t <- renderValueBox(conditionalRenderValueBox(f(), "Possible Value", 15, 10))
  })

}

ui <- dashboardPage(
  dashboardHeader(title = "DashBoard")
  ,skin = 'yellow'
  ,dashboardSidebar(
    tags$head(
      tags$style(HTML("
                      .sidebar { height: 90vh; overflow-y: auto; }
                      " )
      )
      ),
    sidebarMenu(
      menuItem("R", tabName = "R", icon = icon("cog"))
      , selectInput("v1", label = h3("Select box"), 
                    choices = list( 1,  11, 15), 
                    selected = 1)      
    )    
      )
  ,dashboardBody(
    tabItems(
      tabItem(
        tabName = "R"
        , br()
        , fluidRow(
          valueBoxOutput("t")
        )

      )
    )
  )
)

runApp(shinyApp(server=server,ui=ui))

如何使用带有传递函数的函数在闪亮时具有反应作为输入

1 个答案: