在 shiny 中绘制具有受限域的方程

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，这就是为什么 shiny 可能看起来有点不同

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 语句不会起作用，因为它们一次只能测试一个值 - 除非我们编写一个 for 循环或使用函数 Vectorize 以某种方式对其进行向量化。取而代之的是，我们选择已经矢量化的 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)

在 shiny 中绘制具有受限域的方程

plotting equations with restricted domains in shiny

interactive

r

shiny