如何在R中更新来自两个不同来源的数字输入?

如何在R中更新来自两个不同来源的数字输入?,r,dynamic,shiny,shiny-server,numeric-input,R,Dynamic,Shiny,Shiny Server,Numeric Input,我正在尝试构建一个简单的闪亮应用程序,在这里我可以从建筑中的加热系统获取当前的加热曲线,并将其可视化到绘图中。使用4个数字输入字段(2个x坐标值和2个y坐标值)手动执行此操作 另外还有两个不同的问题(在本例中使用单选按钮),我应该得到一个新的当前加热曲线的建议,在这里我可以对我的加热系统进行一些更改。新值(从第一个NumericiInput和单选按钮计算得出)应显示在4个附加NumericiInput字段中(这已在使用updateNumericInput()和ObserveeEvent() 此外

我正在尝试构建一个简单的闪亮应用程序,在这里我可以从建筑中的加热系统获取当前的加热曲线,并将其可视化到绘图中。使用4个数字输入字段(2个x坐标值和2个y坐标值)手动执行此操作

另外还有两个不同的问题(在本例中使用单选按钮),我应该得到一个新的当前加热曲线的建议,在这里我可以对我的加热系统进行一些更改。新值(从第一个NumericiInput和单选按钮计算得出)应显示在4个附加NumericiInput字段中(这已在使用updateNumericInput()和ObserveeEvent()

此外,当我输入信息(单选按钮)后显示第一条建议时,我希望能够在第二部分中使用4个数字输入调整新曲线。这是我目前面临的挑战。这些字段在我定义信息(单选按钮)后被阻止

下面我列出了我的代码

谢谢你的帮助

我还尝试使用矩阵提前计算每个不同的选项,并仅参考正确的矩阵行绘制直线(段(…)。另外,我尝试在没有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)


图书馆(闪亮)
图书馆(shinyjs)

jsCode最简单的方法是在每次更改时更新反应值,然后仅基于反应值使用
updateNumericInput

下面是一个简单的示例,介绍如何使用两个按钮更新相同的
numericInput

库(闪亮)
ui
库(闪亮)
图书馆(shinyjs)

jsCode代码似乎缺少一个
库(shinyjs)
,并且还有一个未定义的
jsCode
对象:目前无法运行。我想你的问题也会从一个更简单的例子中受益。@MikkoMarttila事实上,我因为复制到一个文件中而错过了一些代码,你已经提到过了。我在脚本顶部添加了以下内容:
library(shinyjs)
jsCode感谢您的输入!我可以为我的应用程序实现并修改您的示例-现在可以使用了。下面我已经发布了我的脚本。
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)