如何从 R 中的两个不同来源更新 numericInput？
How to update numericInput from two different sources in R?
我正在尝试构建一个简单的 Shiny 应用程序，我可以在其中获取建筑物供暖系统的当前供暖曲线，并在绘图中将其可视化。这通过 4 个数字输入字段（x 坐标的 2 个值和 y 坐标的 2 个值）手动发生。
另外还有两个不同的问题（在这个案例中使用单选按钮处理）我应该得到一个关于新的当前加热曲线的建议，我可以在其中对我的加热系统进行一些更改。新值（根据第一个 numericInputs 和 radioButtons 计算得出）应该显示在 4 个附加的 numericInput 字段中（这已经在使用 updateNumericInput() 和 observeEvent()）。
此外，当我输入信息（radioButtons）后显示第一个建议时，我希望能够使用第二部分中的 4 个数字输入来调整新曲线。这是我目前正在努力应对的挑战。在我定义我的信息（radioButtons）后，这些字段被阻止。
下面列出了我的代码。
感谢帮助！
我也尝试过使用矩阵来提前计算每个不同的选项，并且只根据正确的矩阵行绘制线 (segment(...))。此外，我尝试在没有 observeEvent 函数的情况下工作以覆盖 numericInput 变量，但也没有工作。
library(shiny)
library(shinyjs)
jsCode <- 'shinyjs.winprint = function(){
window.print();
}'
ui <- fluidPage(
#Application title
titlePanel(title = "Heatingcurve"),
sidebarLayout(
#User Input
sidebarPanel(width = 3,
#user Data
textInput("ProjName", "project name"),
textInput("ProjNr", "Project nr."),
dateInput("date", "date", value = NULL),
textInput("heating group", "heatinggroup"),
textInput("autor", "autor"),
#horizontal line
tags$hr(style="border-color: darkgrey;"),
#Include numeric Input field (current numbers)
h3(tags$b("Heating numbers observed")),
tags$div(h4("OT [\u00B0C]", align = "center"), numericInput("x11", "x11", value = -10),
numericInput("x21", "x21", value = 25), style="display:inline-block"),
tags$div(h4("FT [\u00B0C]", align = "center"), numericInput("y11", "y11", value = 65),
numericInput("y21", "y21", value = 45), style="display:inline-block"),
#horizontal line
tags$hr(style="border-color: darkgrey;"),
#Include numeric Input field (calculated numbrs, adjustable numbers)
h3(tags$b("new adjusted heating numbers (calculated or adjusted)"),
tags$div(h4("OT [\u00B0C]", align = "center"), numericInput("x12", "x12", value = 0),
numericInput("x22", "x22", value = 0), style="display:inline-block"),
tags$div(h4("FT [\u00B0C]", align = "center"), numericInput("y12", "y12", value = 0),
numericInput("y22", "y22", value = 0), style="display:inline-block")
)),
mainPanel(
tags$br(),
radioButtons("radio1",
"What is the feeling of comfort in the reference room like in warm weather?",
choices = c("too cold"= 1, "good" = 2, "too hot" = 3),
selected = 0, inline = TRUE),
radioButtons("radio2",
"What is the feeling of comfort in the reference room like in cold weather?",
choices = c("too cold"= 1, "good" = 2, "too hot" = 3),
selected = 0, inline = TRUE),
plotOutput("plot1"),
#Notes
textAreaInput("notes", "Notes", width = "1200px", height = "300px"),
#Print Button
useShinyjs(),
extendShinyjs(text = jsCode),
actionButton("print", "Print",
style="color: #fff; background-color: #337ab7; border-color: #2e6da4")
)
)
)
server <- function(input, output, session) {
#update numericinput (Part2)
upDateFunction <- function(x0, x1, y0, y1) {
observeEvent(input$x12, {
updateNumericInput(session, "x12", value = x0)
})
observeEvent(input$x22, {
updateNumericInput(session, "x22", value = x1)
})
observeEvent(input$y12, {
updateNumericInput(session, "y12", value = y0)
})
observeEvent(input$y22, {
updateNumericInput(session, "y22", value = y1)
})
segments(x0, y0, x1, y1, col = "red", lwd = 3)
}
#create plot
output$plot1 <- renderPlot({
plot(1, type="n",xlab = "Outsidetemperature [\u00B0C]", ylab="Flowtemperature [\u00B0C]",
xlim=c(-15, 30), ylim=c(15, 80), panel.first = grid(col = "gray", lwd = 1.5))
#create black solid line (for design)
segments(x0 = 0, y0 = 17, x1 = 0, y1 = 90, col = "black", lwd = 1)
#create black solid line (for design)
segments(x0 = -40, y0 = 20, x1 = 50, y1 = 20, col = "black", lwd = 1)
#create blue heating curve
segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21, col = "blue", lwd = 3)
#conditions (radioButtons)
if (length(input$radio1) == 0 & length(input$radio2) == 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (length(input$radio1) != 0 & length(input$radio2) == 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (length(input$radio1) == 0 & length(input$radio2) != 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (input$radio1 == 0 & input$radio2 == 0) {
#segments(x0 = input$x11, y0 = input$y11 + 3, x1 = input$x21, y1 = input$y21 + 3, col = "red", lwd = 3)
upDateFunction(x0 = input$x12, y0 = input$y12, x1 = input$x22, y1 = input$y22)
}
else if (input$radio1 == 1 & input$radio2 == 1) {
#segments(x0 = input$x11, y0 = input$y11 + 3, x1 = input$x21, y1 = input$y21 + 3, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 + 3, x1 = input$x21, y1 = input$y21 + 3)
#upDateFunction(x0 = input$x12, y0 = input$y12, x1 = input$x22, y1 = input$y22)
}
else if (input$radio1 == 1 & input$radio2 == 2) {
#segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21* 5/4, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21 * 5/4)
}
else if (input$radio1 == 1 & input$radio2 == 3) {
#segments(x0 = input$x11, y0 = input$y11 * (0.9), x1 = input$x21, y1 = input$y21 / 0.9, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 * (0.9), x1 = input$x21, y1 = input$y21 / 0.9)
}
else if (input$radio1 == 2 & input$radio2 == 1) {
#segments(x0 = input$x11, y0 = input$y11 * 5/4, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 * 5/4, x1 = input$x21, y1 = input$y21)
}
else if (input$radio1 == 2 & input$radio2 == 2) {
#segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21)
}
else if (input$radio1 == 2 & input$radio2 == 3) {
#segments(x0 = input$x11, y0 = input$y11 * 4/5, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 * 4/5, x1 = input$x21, y1 = input$y21)
}
else if (input$radio1 == 3 & input$radio2 == 1) {
#segments(x0 = input$x11, y0 = input$y11 * (2/1)/1.5, x1 = input$x21, y1 = input$y21 * (1/2/1), col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 * (2/1)/1.5, x1 = input$x21, y1 = input$y21 * (1/2/1))
}
else if (input$radio1 == 3 & input$radio2 == 2) {
#segments(x0 = input$x11, y0 = input$y11 , x1 = input$x21, y1 = input$y21 * 2/3, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 , x1 = input$x21, y1 = input$y21 * 2/3)
}
else if (input$radio1 == 3 & input$radio2 == 3) {
#segments(x0 = input$x11, y0 = input$y11 - 3, x1 = input$x21, y1 = input$y21 - 3, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 - 3, x1 = input$x21, y1 = input$y21 - 3)
}
legend("topright", legend=c("Heating numbers observed", "new adjusted heating numbers (calculated or adjusted)"), col = c("blue", "red"), lty = 1:1, cex = 1)
})
}
shinyApp(ui, server)
最简单的方法是在每次更改时更新无功值并使用 updateNumericInput 然后仅基于无功值。
这是一个简单的例子，说明如何使用两个按钮更新同一个按钮numericInput
library(shiny)
ui <- fluidPage(
mainPanel(
numericInput("numericInput", "Numeric Input", min = 0, max = 200, value = 50),
actionButton("button1", "Updatebutton 1"),
actionButton("button2", "Updatebutton 2")
)
)
server <- function(input, output, session) {
reac <- reactiveValues()
observeEvent(input$button1, {
reac$numeric <- round(runif(1, 0, 100))
})
observeEvent(input$button2, {
reac$numeric <- round(runif(1, 100, 200))
})
observe({
req(reac$numeric)
updateNumericInput(session, "numericInput", value = reac$numeric)
})
}
shinyApp(ui = ui, server = server)
library(shiny)
library(shinyjs)
jsCode <- 'shinyjs.winprint = function(){
window.print();
}'
ui <- fluidPage(
#Application title
titlePanel(title = "Heatingcurve"),
sidebarLayout(
#User Input
sidebarPanel(width = 3,
#user Data
textInput("ProjName", "project name"),
textInput("ProjNr", "Project nr."),
dateInput("date", "date", value = NULL),
textInput("heating group", "heatinggroup"),
textInput("autor", "autor"),
#horizontal line
tags$hr(style="border-color: darkgrey;"),
#Include numeric Input field (current numbers)
h3(tags$b("Heating numbers observed")),
tags$div(h4("OT [\u00B0C]", align = "center"), numericInput("x11", "x11", value = -10),
numericInput("x21", "x21", value = 25), style="display:inline-block"),
tags$div(h4("FT [\u00B0C]", align = "center"), numericInput("y11", "y11", value = 65),
numericInput("y21", "y21", value = 45), style="display:inline-block"),
#horizontal line
tags$hr(style="border-color: darkgrey;"),
#Include numeric Input field (calculated numbrs, adjustable numbers)
h3(tags$b("new adjusted heating numbers (calculated or adjusted)"),
tags$div(h4("OT [\u00B0C]", align = "center"), numericInput("x12", "x12", value = 0),
numericInput("x22", "x22", value = 0), style="display:inline-block"),
tags$div(h4("FT [\u00B0C]", align = "center"), numericInput("y12", "y12", value = 0),
numericInput("y22", "y22", value = 0), style="display:inline-block")
)),
mainPanel(
tags$br(),
radioButtons("radio1",
"What is the feeling of comfort in the reference room like in warm weather?",
choices = c("adjust manually" = 0, "too cold"= 1, "good" = 2, "too hot" = 3),
selected = 0, inline = TRUE),
radioButtons("radio2",
"What is the feeling of comfort in the reference room like in cold weather?",
choices = c("adjust manually" = 0, "too cold"= 1, "good" = 2, "too hot" = 3),
selected = 0, inline = TRUE),
plotOutput("plot1"),
#Notes
textAreaInput("notes", "Notes", width = "1200px", height = "300px"),
#Print Button
useShinyjs(),
extendShinyjs(text = jsCode),
actionButton("print", "Print",
style="color: #fff; background-color: #337ab7; border-color: #2e6da4")
)
)
)
server <- function(input, output, session) {
#update numericinput (Part2)
reac1 <- reactiveValues()
reac2 <- reactiveValues()
reac3 <- reactiveValues()
reac4 <- reactiveValues()
observeEvent(input$x11,{
reac1$numeric <- input$x11
})
observe({
req(reac1$numeric)
updateNumericInput(session, "x12", value = reac1$numeric)
})
observeEvent(input$x21, {
reac2$numeric <- input$x21
})
observe({
req(reac2$numeric)
updateNumericInput(session, "x22", value = reac2$numeric)
})
observeEvent(input$y11, {
reac3$numeric <- input$y11
})
observe({
req(reac3$numeric)
updateNumericInput(session, "y12", value = reac3$numeric)
})
observeEvent(input$y21, {
reac4$numeric <- input$y21
})
observe({
req(reac4$numeric)
updateNumericInput(session, "y22", value = reac4$numeric)
})
#create plot
output$plot1 <- renderPlot({
plot(1, type="n",xlab = "Outsidetemperature [\u00B0C]", ylab="Flowtemperature [\u00B0C]",
xlim=c(-15, 30), ylim=c(15, 80), panel.first = grid(col = "gray", lwd = 1.5))
#create black solid line (for design)
segments(x0 = 0, y0 = 17, x1 = 0, y1 = 90, col = "black", lwd = 1)
#create black solid line (for design)
segments(x0 = -40, y0 = 20, x1 = 50, y1 = 20, col = "black", lwd = 1)
#create blue heating curve
segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21, col = "blue", lwd = 3)
#conditions (radioButtons)
if (length(input$radio1) == 0 & length(input$radio2) == 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (length(input$radio1) != 0 & length(input$radio2) == 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (length(input$radio1) == 0 & length(input$radio2) != 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (input$radio1 == 0 & input$radio2 == 0) {
segments(x0 = input$x12, y0 = input$y12, x1 = input$x22, y1 = input$y22, col = "red", lwd = 3)
}
else if (input$radio1 == 1 & input$radio2 == 1) {
segments(x0 = input$x11, y0 = input$y11 + 3, x1 = input$x21, y1 = input$y21 + 3, col = "red", lwd = 3)
}
else if (input$radio1 == 1 & input$radio2 == 2) {
segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21* 5/4, col = "red", lwd = 3)
}
else if (input$radio1 == 1 & input$radio2 == 3) {
segments(x0 = input$x11, y0 = input$y11 * (0.9), x1 = input$x21, y1 = input$y21 / 0.9, col = "red", lwd = 3)
}
else if (input$radio1 == 2 & input$radio2 == 1) {
segments(x0 = input$x11, y0 = input$y11 * 5/4, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
}
else if (input$radio1 == 2 & input$radio2 == 2) {
segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
}
else if (input$radio1 == 2 & input$radio2 == 3) {
segments(x0 = input$x11, y0 = input$y11 * 4/5, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
}
else if (input$radio1 == 3 & input$radio2 == 1) {
segments(x0 = input$x11, y0 = input$y11 * (2/1)/1.5, x1 = input$x21, y1 = input$y21 * (1/2/1), col = "red", lwd = 3)
}
else if (input$radio1 == 3 & input$radio2 == 2) {
segments(x0 = input$x11, y0 = input$y11 , x1 = input$x21, y1 = input$y21 * 2/3, col = "red", lwd = 3)
}
else if (input$radio1 == 3 & input$radio2 == 3) {
segments(x0 = input$x11, y0 = input$y11 - 3, x1 = input$x21, y1 = input$y21 - 3, col = "red", lwd = 3)
}
legend("topright", legend=c("Heating numbers observed", "new adjusted heating numbers (calculated or adjusted)"), col = c("blue", "red"), lty = 1:1, cex = 1)
})
}
shinyApp(ui, server)
我正在尝试构建一个简单的 Shiny 应用程序，我可以在其中获取建筑物供暖系统的当前供暖曲线，并在绘图中将其可视化。这通过 4 个数字输入字段（x 坐标的 2 个值和 y 坐标的 2 个值）手动发生。
另外还有两个不同的问题（在这个案例中使用单选按钮处理）我应该得到一个关于新的当前加热曲线的建议，我可以在其中对我的加热系统进行一些更改。新值（根据第一个 numericInputs 和 radioButtons 计算得出）应该显示在 4 个附加的 numericInput 字段中（这已经在使用 updateNumericInput() 和 observeEvent()）。
此外，当我输入信息（radioButtons）后显示第一个建议时，我希望能够使用第二部分中的 4 个数字输入来调整新曲线。这是我目前正在努力应对的挑战。在我定义我的信息（radioButtons）后，这些字段被阻止。
下面列出了我的代码。
感谢帮助！
我也尝试过使用矩阵来提前计算每个不同的选项，并且只根据正确的矩阵行绘制线 (segment(...))。此外，我尝试在没有 observeEvent 函数的情况下工作以覆盖 numericInput 变量，但也没有工作。
library(shiny)
library(shinyjs)
jsCode <- 'shinyjs.winprint = function(){
window.print();
}'
ui <- fluidPage(
#Application title
titlePanel(title = "Heatingcurve"),
sidebarLayout(
#User Input
sidebarPanel(width = 3,
#user Data
textInput("ProjName", "project name"),
textInput("ProjNr", "Project nr."),
dateInput("date", "date", value = NULL),
textInput("heating group", "heatinggroup"),
textInput("autor", "autor"),
#horizontal line
tags$hr(style="border-color: darkgrey;"),
#Include numeric Input field (current numbers)
h3(tags$b("Heating numbers observed")),
tags$div(h4("OT [\u00B0C]", align = "center"), numericInput("x11", "x11", value = -10),
numericInput("x21", "x21", value = 25), style="display:inline-block"),
tags$div(h4("FT [\u00B0C]", align = "center"), numericInput("y11", "y11", value = 65),
numericInput("y21", "y21", value = 45), style="display:inline-block"),
#horizontal line
tags$hr(style="border-color: darkgrey;"),
#Include numeric Input field (calculated numbrs, adjustable numbers)
h3(tags$b("new adjusted heating numbers (calculated or adjusted)"),
tags$div(h4("OT [\u00B0C]", align = "center"), numericInput("x12", "x12", value = 0),
numericInput("x22", "x22", value = 0), style="display:inline-block"),
tags$div(h4("FT [\u00B0C]", align = "center"), numericInput("y12", "y12", value = 0),
numericInput("y22", "y22", value = 0), style="display:inline-block")
)),
mainPanel(
tags$br(),
radioButtons("radio1",
"What is the feeling of comfort in the reference room like in warm weather?",
choices = c("too cold"= 1, "good" = 2, "too hot" = 3),
selected = 0, inline = TRUE),
radioButtons("radio2",
"What is the feeling of comfort in the reference room like in cold weather?",
choices = c("too cold"= 1, "good" = 2, "too hot" = 3),
selected = 0, inline = TRUE),
plotOutput("plot1"),
#Notes
textAreaInput("notes", "Notes", width = "1200px", height = "300px"),
#Print Button
useShinyjs(),
extendShinyjs(text = jsCode),
actionButton("print", "Print",
style="color: #fff; background-color: #337ab7; border-color: #2e6da4")
)
)
)
server <- function(input, output, session) {
#update numericinput (Part2)
upDateFunction <- function(x0, x1, y0, y1) {
observeEvent(input$x12, {
updateNumericInput(session, "x12", value = x0)
})
observeEvent(input$x22, {
updateNumericInput(session, "x22", value = x1)
})
observeEvent(input$y12, {
updateNumericInput(session, "y12", value = y0)
})
observeEvent(input$y22, {
updateNumericInput(session, "y22", value = y1)
})
segments(x0, y0, x1, y1, col = "red", lwd = 3)
}
#create plot
output$plot1 <- renderPlot({
plot(1, type="n",xlab = "Outsidetemperature [\u00B0C]", ylab="Flowtemperature [\u00B0C]",
xlim=c(-15, 30), ylim=c(15, 80), panel.first = grid(col = "gray", lwd = 1.5))
#create black solid line (for design)
segments(x0 = 0, y0 = 17, x1 = 0, y1 = 90, col = "black", lwd = 1)
#create black solid line (for design)
segments(x0 = -40, y0 = 20, x1 = 50, y1 = 20, col = "black", lwd = 1)
#create blue heating curve
segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21, col = "blue", lwd = 3)
#conditions (radioButtons)
if (length(input$radio1) == 0 & length(input$radio2) == 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (length(input$radio1) != 0 & length(input$radio2) == 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (length(input$radio1) == 0 & length(input$radio2) != 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (input$radio1 == 0 & input$radio2 == 0) {
#segments(x0 = input$x11, y0 = input$y11 + 3, x1 = input$x21, y1 = input$y21 + 3, col = "red", lwd = 3)
upDateFunction(x0 = input$x12, y0 = input$y12, x1 = input$x22, y1 = input$y22)
}
else if (input$radio1 == 1 & input$radio2 == 1) {
#segments(x0 = input$x11, y0 = input$y11 + 3, x1 = input$x21, y1 = input$y21 + 3, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 + 3, x1 = input$x21, y1 = input$y21 + 3)
#upDateFunction(x0 = input$x12, y0 = input$y12, x1 = input$x22, y1 = input$y22)
}
else if (input$radio1 == 1 & input$radio2 == 2) {
#segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21* 5/4, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21 * 5/4)
}
else if (input$radio1 == 1 & input$radio2 == 3) {
#segments(x0 = input$x11, y0 = input$y11 * (0.9), x1 = input$x21, y1 = input$y21 / 0.9, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 * (0.9), x1 = input$x21, y1 = input$y21 / 0.9)
}
else if (input$radio1 == 2 & input$radio2 == 1) {
#segments(x0 = input$x11, y0 = input$y11 * 5/4, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 * 5/4, x1 = input$x21, y1 = input$y21)
}
else if (input$radio1 == 2 & input$radio2 == 2) {
#segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21)
}
else if (input$radio1 == 2 & input$radio2 == 3) {
#segments(x0 = input$x11, y0 = input$y11 * 4/5, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 * 4/5, x1 = input$x21, y1 = input$y21)
}
else if (input$radio1 == 3 & input$radio2 == 1) {
#segments(x0 = input$x11, y0 = input$y11 * (2/1)/1.5, x1 = input$x21, y1 = input$y21 * (1/2/1), col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 * (2/1)/1.5, x1 = input$x21, y1 = input$y21 * (1/2/1))
}
else if (input$radio1 == 3 & input$radio2 == 2) {
#segments(x0 = input$x11, y0 = input$y11 , x1 = input$x21, y1 = input$y21 * 2/3, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 , x1 = input$x21, y1 = input$y21 * 2/3)
}
else if (input$radio1 == 3 & input$radio2 == 3) {
#segments(x0 = input$x11, y0 = input$y11 - 3, x1 = input$x21, y1 = input$y21 - 3, col = "red", lwd = 3)
upDateFunction(x0 = input$x11, y0 = input$y11 - 3, x1 = input$x21, y1 = input$y21 - 3)
}
legend("topright", legend=c("Heating numbers observed", "new adjusted heating numbers (calculated or adjusted)"), col = c("blue", "red"), lty = 1:1, cex = 1)
})
}
shinyApp(ui, server)
最简单的方法是在每次更改时更新无功值并使用 updateNumericInput 然后仅基于无功值。
这是一个简单的例子，说明如何使用两个按钮更新同一个按钮numericInput
library(shiny)
ui <- fluidPage(
mainPanel(
numericInput("numericInput", "Numeric Input", min = 0, max = 200, value = 50),
actionButton("button1", "Updatebutton 1"),
actionButton("button2", "Updatebutton 2")
)
)
server <- function(input, output, session) {
reac <- reactiveValues()
observeEvent(input$button1, {
reac$numeric <- round(runif(1, 0, 100))
})
observeEvent(input$button2, {
reac$numeric <- round(runif(1, 100, 200))
})
observe({
req(reac$numeric)
updateNumericInput(session, "numericInput", value = reac$numeric)
})
}
shinyApp(ui = ui, server = server)
library(shiny)
library(shinyjs)
jsCode <- 'shinyjs.winprint = function(){
window.print();
}'
ui <- fluidPage(
#Application title
titlePanel(title = "Heatingcurve"),
sidebarLayout(
#User Input
sidebarPanel(width = 3,
#user Data
textInput("ProjName", "project name"),
textInput("ProjNr", "Project nr."),
dateInput("date", "date", value = NULL),
textInput("heating group", "heatinggroup"),
textInput("autor", "autor"),
#horizontal line
tags$hr(style="border-color: darkgrey;"),
#Include numeric Input field (current numbers)
h3(tags$b("Heating numbers observed")),
tags$div(h4("OT [\u00B0C]", align = "center"), numericInput("x11", "x11", value = -10),
numericInput("x21", "x21", value = 25), style="display:inline-block"),
tags$div(h4("FT [\u00B0C]", align = "center"), numericInput("y11", "y11", value = 65),
numericInput("y21", "y21", value = 45), style="display:inline-block"),
#horizontal line
tags$hr(style="border-color: darkgrey;"),
#Include numeric Input field (calculated numbrs, adjustable numbers)
h3(tags$b("new adjusted heating numbers (calculated or adjusted)"),
tags$div(h4("OT [\u00B0C]", align = "center"), numericInput("x12", "x12", value = 0),
numericInput("x22", "x22", value = 0), style="display:inline-block"),
tags$div(h4("FT [\u00B0C]", align = "center"), numericInput("y12", "y12", value = 0),
numericInput("y22", "y22", value = 0), style="display:inline-block")
)),
mainPanel(
tags$br(),
radioButtons("radio1",
"What is the feeling of comfort in the reference room like in warm weather?",
choices = c("adjust manually" = 0, "too cold"= 1, "good" = 2, "too hot" = 3),
selected = 0, inline = TRUE),
radioButtons("radio2",
"What is the feeling of comfort in the reference room like in cold weather?",
choices = c("adjust manually" = 0, "too cold"= 1, "good" = 2, "too hot" = 3),
selected = 0, inline = TRUE),
plotOutput("plot1"),
#Notes
textAreaInput("notes", "Notes", width = "1200px", height = "300px"),
#Print Button
useShinyjs(),
extendShinyjs(text = jsCode),
actionButton("print", "Print",
style="color: #fff; background-color: #337ab7; border-color: #2e6da4")
)
)
)
server <- function(input, output, session) {
#update numericinput (Part2)
reac1 <- reactiveValues()
reac2 <- reactiveValues()
reac3 <- reactiveValues()
reac4 <- reactiveValues()
observeEvent(input$x11,{
reac1$numeric <- input$x11
})
observe({
req(reac1$numeric)
updateNumericInput(session, "x12", value = reac1$numeric)
})
observeEvent(input$x21, {
reac2$numeric <- input$x21
})
observe({
req(reac2$numeric)
updateNumericInput(session, "x22", value = reac2$numeric)
})
observeEvent(input$y11, {
reac3$numeric <- input$y11
})
observe({
req(reac3$numeric)
updateNumericInput(session, "y12", value = reac3$numeric)
})
observeEvent(input$y21, {
reac4$numeric <- input$y21
})
observe({
req(reac4$numeric)
updateNumericInput(session, "y22", value = reac4$numeric)
})
#create plot
output$plot1 <- renderPlot({
plot(1, type="n",xlab = "Outsidetemperature [\u00B0C]", ylab="Flowtemperature [\u00B0C]",
xlim=c(-15, 30), ylim=c(15, 80), panel.first = grid(col = "gray", lwd = 1.5))
#create black solid line (for design)
segments(x0 = 0, y0 = 17, x1 = 0, y1 = 90, col = "black", lwd = 1)
#create black solid line (for design)
segments(x0 = -40, y0 = 20, x1 = 50, y1 = 20, col = "black", lwd = 1)
#create blue heating curve
segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21, col = "blue", lwd = 3)
#conditions (radioButtons)
if (length(input$radio1) == 0 & length(input$radio2) == 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (length(input$radio1) != 0 & length(input$radio2) == 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (length(input$radio1) == 0 & length(input$radio2) != 0) {
segments(x0 = 0, y0 = 20, x1 = 0, y1 = 90, col = "black", lwd = 1)
}
else if (input$radio1 == 0 & input$radio2 == 0) {
segments(x0 = input$x12, y0 = input$y12, x1 = input$x22, y1 = input$y22, col = "red", lwd = 3)
}
else if (input$radio1 == 1 & input$radio2 == 1) {
segments(x0 = input$x11, y0 = input$y11 + 3, x1 = input$x21, y1 = input$y21 + 3, col = "red", lwd = 3)
}
else if (input$radio1 == 1 & input$radio2 == 2) {
segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21* 5/4, col = "red", lwd = 3)
}
else if (input$radio1 == 1 & input$radio2 == 3) {
segments(x0 = input$x11, y0 = input$y11 * (0.9), x1 = input$x21, y1 = input$y21 / 0.9, col = "red", lwd = 3)
}
else if (input$radio1 == 2 & input$radio2 == 1) {
segments(x0 = input$x11, y0 = input$y11 * 5/4, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
}
else if (input$radio1 == 2 & input$radio2 == 2) {
segments(x0 = input$x11, y0 = input$y11, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
}
else if (input$radio1 == 2 & input$radio2 == 3) {
segments(x0 = input$x11, y0 = input$y11 * 4/5, x1 = input$x21, y1 = input$y21, col = "red", lwd = 3)
}
else if (input$radio1 == 3 & input$radio2 == 1) {
segments(x0 = input$x11, y0 = input$y11 * (2/1)/1.5, x1 = input$x21, y1 = input$y21 * (1/2/1), col = "red", lwd = 3)
}
else if (input$radio1 == 3 & input$radio2 == 2) {
segments(x0 = input$x11, y0 = input$y11 , x1 = input$x21, y1 = input$y21 * 2/3, col = "red", lwd = 3)
}
else if (input$radio1 == 3 & input$radio2 == 3) {
segments(x0 = input$x11, y0 = input$y11 - 3, x1 = input$x21, y1 = input$y21 - 3, col = "red", lwd = 3)
}
legend("topright", legend=c("Heating numbers observed", "new adjusted heating numbers (calculated or adjusted)"), col = c("blue", "red"), lty = 1:1, cex = 1)
})
}
shinyApp(ui, server)