I'm trying to build an easy Shiny Application where I can take up the current heating curve from a heating system in a building and visualize it in a plot. This happens manually with 4 numericInput Fields (2 values for x-coordinates and 2 values for y-coordinates).
With aditionally two different questions (in this Case handled with radioButtons) I should get a suggestion for a new, current heating curve, where I can conduct some changes on my heating system. The new values (which are calculated from the first numericInputs and the radioButtons) should be displayed in 4 addition numericInput Fields (This is already working with updateNumericInput() and observeEvent()).
Furthermore, when the first suggestion is displayed after i put the information (radioButtons), I want to be able to adjust the new curve with the 4 numericinputs in the second part. This is my current challenge where I'm struggeling with. These Fields are blocked after I defined my Information (radioButtons).
Below I've listed my Code.
Thanks for help!
I've also tried to work with a matrix to calculate each different option in advance and only draw the Line (segment(...)) with reference to the correct matrix row. Also I've tried to work without the observeEvent function to overwrite the numericInput Variable but didn't work either.
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)
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)