Shiny 中的条件语句和嵌套

Question

已编辑以反映正在进行的讨论。

在我的服务器部分，我想使用不同的公式，这取决于名为 input$beamSupport 的单选按钮选择，此外还根据 x 的值更改公式。但是，我被语法困住了。

我也知道我可以通过简单地说“else...”来修剪一些代码，但我希望有扩展的可能性。

现在我收到错误消息 “如果：参数长度为零时出错”

library(shiny)

ui <- fluidPage(

    # Style tags for changing the slider
    tags$style(HTML(".irs-bar {background: none}")),
    tags$style(HTML(".irs-bar {border-top: none}")),
    tags$style(HTML(".irs-bar {border-bottom: none}")),
    tags$style(HTML(".irs-bar-edge {border: none}")),
    tags$style(HTML(".irs-bar-edge {background: none}")),


mainPanel(
    titlePanel("Beam Deflection Calculator"),

    radioButtons("beamSupport",
                 label = ("Beam support type"),
                 choices = list("Simply supported" = 1,
                                "Cantilever" = 2),
                 selected = 1),

    numericInput("num_W", # Load force, W
                 label = "Enter load force in N.",
                 value = 1),

    numericInput("num_l", # Length of beam, l
                 label = "Enter beam length in m.",
                 value = 10),

    numericInput("num_I", # Intertial moment, I (caps i)
                 label = "Enter moment of inertia in m^4.",
                 value = 0.001),

    numericInput("num_E",
                 label = "Enter Young's modulus in GPa.",
                 value = 200),

    uiOutput("slider"), # Sliders for a and x

    textOutput("text_calc")
)
)


server <- function(input, output, session) {

    output$slider <- renderUI({
        tagList( # Need this for multiple reactive sliders
            sliderInput("slider_a",
                        label = "Choose position, where to apply force, starting from left, in m.",
                        min = 0,
                        max = input$num_l,
                        value = 5,
                        step = 0.1),

            sliderInput("slider_x",
                        label = "Calculate the deflection, at position starting from left, in m.",
                        min = 0,
                        max = input$num_l,
                        value = 5,
                        step = 0.1)
        )
    })

    output$text_calc <- renderText({
        W <- input$num_W
        l <- input$num_l
        I <- input$num_I
        E <- input$num_E * 10^9
        a <- input$slider_a
        x <- input$slider_x

        cond <- x < a

        if (input$beamSupport == 1){
            if (cond){
                return(paste("The deflection is =",
                      ((W*(l-a)*x)/(6*E*I*l))*(l**2-x**2-(l-a)**2)
                ))
            }
            else{
                return(paste("The deflection is =",
                      ((W*a*(l-x))/(6*E*I*l))*(l**2-(l-x)**2-a**2)
                ))
            }
        }

        if (input$beamSupport == 2){
            if (cond){
                return(paste("The deflection is =",
                      ((W*x**2)/(6*E*I))*(3*a-x)
                ))
            }
            else{
                return(paste("The deflection is =",
                      ((W*a**2)/(6*E*I))*(3*x-a)
                ))
            }
        }
    })
}

shinyApp(ui = ui, server = server)

Answer 1

试试这个，还请注意，当您使用 renderUI 时，将在加载初始参数后进行评估，因此您的 slider_a 和 slider_x 在此之前将为空。

#rm(list = ls())
library(shiny)

ui <- fluidPage(

  # Style tags for changing the slider
  tags$style(HTML(".irs-bar {background: none}")),
  tags$style(HTML(".irs-bar {border-top: none}")),
  tags$style(HTML(".irs-bar {border-bottom: none}")),
  tags$style(HTML(".irs-bar-edge {border: none}")),
  tags$style(HTML(".irs-bar-edge {background: none}")),


  mainPanel(
    titlePanel("Beam Deflection Calculator"),

    radioButtons("beamSupport",
                 label = ("Beam support type"),
                 choices = list("Simply supported" = 1,
                                "Cantilever" = 2),
                 selected = 1),

    numericInput("num_W", # Load force, W
                 label = "Enter load force in N.",
                 value = 1),

    numericInput("num_l", # Length of beam, l
                 label = "Enter beam length in m.",
                 value = 10),

    numericInput("num_I", # Intertial moment, I (caps i)
                 label = "Enter moment of inertia in m^4.",
                 value = 0.001),

    numericInput("num_E",
                 label = "Enter Young's modulus in GPa.",
                 value = 200),

    uiOutput("slider"), # Sliders for a and x

    textOutput("text_calc")
  )
)


server <- function(input, output, session) {

  output$slider <- renderUI({
    tagList( # Need this for multiple reactive sliders
      sliderInput("slider_a",
                  label = "Choose position, where to apply force, starting from left, in m.",
                  min = 0,
                  max = input$num_l,
                  value = 5,
                  step = 0.1),

      sliderInput("slider_x",
                  label = "Calculate the deflection, at position starting from left, in m.",
                  min = 0,
                  max = input$num_l,
                  value = 5,
                  step = 0.1)
    )
  })

  output$text_calc <- renderText({
    if(is.null(input$slider_a) || is.null(input$slider_x)){
      return()
    }
    W <- input$num_W
    l <- input$num_l
    I <- input$num_I
    E <- input$num_E * 10^9
    a <- input$slider_a
    x <- input$slider_x

    cond <- x < a

    if (input$beamSupport == 1){
      if (cond){
        return(paste("The deflection is =",
                     ((W*(l-a)*x)/(6*E*I*l))*(l**2-x**2-(l-a)**2)
        ))
      }
      else{
        return(paste("The deflection is =",
                     ((W*a*(l-x))/(6*E*I*l))*(l**2-(l-x)**2-a**2)
        ))
      }
    }

    if (input$beamSupport == 2){
      if (cond){
        return(paste("The deflection is =",
                     ((W*x**2)/(6*E*I))*(3*a-x)
        ))
      }
      else{
        return(paste("The deflection is =",
                     ((W*a**2)/(6*E*I))*(3*x-a)
        ))
      }
    }
  })
}

shinyApp(ui = ui, server = server)