Question

在我的R闪亮应用程序中有一个仪表和一个单选按钮，我想根据所选的单选按钮选择动态调整仪表标题。

我正在使用ShinyDash作为包装来制作我的仪表。

ShinyDash可以使用以下命令下载和安装软件包：

devtools::install_github("ShinyDash", "trestletech")

以下是我可重复的示例，它只是提供的shiny dash example的略微改编的版本。调整只是创建一个单选按钮选项，这是我想要连接的仪表。我在ui.R文件中添加注释，我认为它应该更改，我认为它应该大致改为。但是尝试它会导致错误。

第一部分是ui.R文件

  # ui.R


  library(shiny)
  library(ShinyDash)

  shinyUI(bootstrapPage(
    h1("ShinyDash Example"),

    gridster(tile.width = 250, tile.height = 250,
             gridsterItem(col = 1, row = 1, size.x = 1, size.y = 1,

                          sliderInput("rate", "Rate of growth:",
                                      min = -0.25, max = .25, value = .02, step = .01),

                          sliderInput("volatility", "Volatility:",
                                      min = 0, max = .5, value = .25, step = .01),

                          sliderInput("delay", "Delay (ms):",
                                      min = 250, max = 5000, value = 3000, step = 250),

                          tags$p(
                            tags$br(),
                            tags$a(href = "https://github.com/trestletech/ShinyDash-Sample", "Source code")
                          )
             ),
             gridsterItem(col = 2, row = 1, size.x = 2, size.y = 1,
                          lineGraphOutput("live_line_graph",
                                          width=532, height=250, axisType="time", legend="topleft"
                          )
             ),
             gridsterItem(col = 1, row = 2, size.x = 1, size.y = 1,
                          gaugeOutput("live_gauge", width=250, height=200, units="CPU", min=0, max=200, title="Cost per Unit") #THIS IS THE PART THAT NEEDS CHANGING...perhaps something like gaugeOutput("live_gauge", width=250, height=200, units="CPU", min=0, max=200, title=input$guage_title_options)
             ),
             gridsterItem(col = 2, row = 2, size.x = 1, size.y = 1,
                          tags$div(class = 'grid_title', 'Status'),
                          htmlWidgetOutput('status', 
                                           tags$div(id="text", class = 'grid_bigtext'),
                                           tags$p(id="subtext"),
                                           tags$p(id="value", 
                                                  `data-filter`="round 2 | prepend '$' | append ' cost per unit'",
                                                  `class`="numeric"))
             ),
             gridsterItem(col = 3, row = 2, size.x = 1, size.y = 1,
                          radioButtons('guage_title_options',label='Guage title options',choices=c("Cost per Unit","Cost per year"),selected='Cost per unit')
             )
    )
  ))

下一位是server.R文件

  # server.R


  library(shiny)
  library(ShinyDash)
  library(XML)
  library(httr)

  shinyServer(function(input, output, session) {

    all_values <- 100  # Start with an initial value 100
    max_length <- 80   # Keep a maximum of 80 values

    # Collect new values at timed intervals and adds them to all_values
    # Returns all_values (reactively)
    values <- reactive({
      # Set the delay to re-run this reactive expression
      invalidateLater(input$delay, session)

      # Generate a new number
      isolate(new_value <- last(all_values) * (1 + input$rate + runif(1, min = -input$volatility, max = input$volatility)))

      # Append to all_values
      all_values <<- c(all_values, new_value)

      # Trim all_values to max_length (dropping values from beginning)
      all_values <<- last(all_values, n = max_length)

      all_values
    })


    output$weatherWidget <- renderWeather(2487956, "f", session=session)

    # Set the value for the gauge
    # When this reactive expression is assigned to an output object, it is
    # automatically wrapped into an observer (i.e., a reactive endpoint)
    output$live_gauge <- renderGauge({
      running_mean <- mean(last(values(), n = 10))
      round(running_mean, 1)
    })

    # Output the status text ("OK" vs "Past limit")
    # When this reactive expression is assigned to an output object, it is
    # automatically wrapped into an observer (i.e., a reactive endpoint)
    output$status <- reactive({
      running_mean <- mean(last(values(), n = 10))
      if (running_mean > 200)
        list(text="Past limit", widgetState="alert", subtext="", value=running_mean)
      else if (running_mean > 150)
        list(text="Warn", subtext = "Mean of last 10 approaching threshold (200)",
             widgetState="warning", value=running_mean)
      else
        list(text="OK", subtext="Mean of last 10 below threshold (200)", value=running_mean)
    })


    # Update the latest value on the graph
    # Send custom message (as JSON) to a handler on the client
    sendGraphData("live_line_graph", {
      list(
        # Most recent value
        y0 = last(values()),
        # Smoothed value (average of last 10)
        y1 = mean(last(values(), n = 10))
      )
    })

  })


  # Return the last n elements in vector x
  last <- function(x, n = 1) {
    start <- length(x) - n + 1
    if (start < 1)
      start <- 1

    x[start:length(x)]
  }

Answer 1

您需要使用renderUI函数创建一个响应式UI输出：

你需要输入ui.R

.......  
gridsterItem(col = 1, row = 2, size.x = 1, size.y = 1,
   uiOutput("live_gauge_title")
),
.......

并在server.R

中

shinyServer(function(input, output, session) {
  output$live_gauge_title = renderUI({
      gaugeOutput("live_gauge", width=250, height=200, units="CPU", min=0, max=200, title=input$guage_title_options)
  }) 
......

闪亮的动态仪表标题

1 个答案: