Question

那里。我正在构建一个闪亮的应用程序，它绘制了一些功能。用户可以修改参数。当我有一个受限制的功能时出现问题，特别是当它与x相关时。这是一个例子：

滑块：

sliderInput("th19",
    HTML("$$ \\theta_1 $$"),
    min = 1,
    max = 10,
    value = 2)
sliderInput("thB9",
    HTML("$$ \\theta_b $$"),
    min = 1,
    max = 10,
    value = 2)
sliderInput("vthB9",
   HTML("$$ \\vartheta_b $$"),
   min = 1,
   max = 20,
   value = 2)

简介：

mForm9.1 <- as.formula("Y ~ vthB9 + th19*(x - thB9)")
mExpr9.1 <- mForm9.1[[3]]

output$Curve9 <- renderPlot({
    th19 <- input$th19
    vthB9 <- input$vthB9
    thB9 <- input$thB9

    eval(call("curve", mExpr9.1, col = 2, ylab = "", main =
               expression(vartheta[b] + theta[1]*(x - theta[b]))))

    },  height = 400, width = 600)

    mainPanel(
        tabsetPanel(type = "tabs", 
            tabPanel("Gráfico", plotOutput("Curve9"))
   ))

这里发生的是当'x'大于'vthB9'时，等式仅恢复为'vthB9'，这只是我所拥有的一种情况。谁知道该怎么办？

*希望我一直很清楚

*我正在使用flexdashboard，这就是为什么闪亮可能看起来有点不同

Answer 1

在R中绘制分段函数的方法可能有多种。我将建议最简单的方法在这种情况下：

我们首先定义分段函数，比如fun

fun <- function(x) { 
      ifelse(test = x <= vthB9, 
             yes = vthB9 + th19 * (x - thB9),
             no = vthB9) 
    }

然后我们传递给curve

curve(expr = fun, from = 0, to = 10, col = 2, ylab = "", 
      main = expression(vartheta[b] + theta[1] * (x - theta[b])))

curve将输入向量作为函数fun的参数。通常的if-else语句不起作用，因为它们一次只能测试一个值 - 除非我们使用函数Vectorize编写for循环或以某种方式将其向量化。而不是那样，我们选择已经向量化的ifelse。

由于您使用了shiny代码，我已准备好shiny应用而不是flexdashboard :)

完整闪亮的例子

  ui <- fluidPage(
      sidebarLayout(
        sidebarPanel( 
          sliderInput("th19",
                      HTML("&theta; <sub>1</sub>"),
                      min = 1,
                      max = 10,
                      value = 2),
          sliderInput("thB9",
                      HTML("&theta; <sub>b</sub>"),
                      min = 1,
                      max = 10,
                      value = 2),
          sliderInput("vthB9",
                      HTML("&thetasym; <sub>b</sub>"),
                      min = 1,
                      max = 20,
                      value = 2)
          ),
          mainPanel(
            tabsetPanel(type = "tabs", 
                        tabPanel("Gráfico", plotOutput("Curve9")))
          ))
    )

    server <- function(input, output) {

      output$Curve9 <- renderPlot({
        th19 <- input$th19
        vthB9 <- input$vthB9
        thB9 <- input$thB9

        # Define a piece wise function
        fun <- function(x) { 
          ifelse(test = x <= vthB9, 
                 yes = vthB9 + th19 * (x - thB9),
                 no = vthB9) 
        }
        # x-axis goes now from 0 to 10
        curve(expr = fun, from = 0, to = 10, col = 2, ylab = "", 
              main = expression(vartheta[b] + theta[1] * (x - theta[b])))

      },  height = 400, width = 600)

    }
    shinyApp(ui, server)

用闪亮的有限域绘制方程

1 个答案: