3
在我的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)]
}