Bruna Wundervald Bruna Wundervald - 3 months ago 13
R Question

plotting equations with restricted domains in shiny

there.
Im building an shiny app thats plots some functions. The user can modify the parameters. The problem appears when I have a restricted function, specially when its related to x. This is one example:

Sliders:

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)


Plot:

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"))
))


What happens here is that when 'x' is bigger than 'vthB9', the equation resumes itself to only 'vthB9', and this is only one of the cases I have. Anybody knows what to do?

*Hope I have been clear

*Im using
flexdashboard
, this is why the shiny might seen a little different

Answer

There are possibly multiple ways to plot a piecewise function in R. I am going to suggest probably the easiest way of doing it in this case:

We first define the piecewise function, say, fun

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

which we then pass to curve

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

curve is going to input a vector as a parameter to the function fun. The usual if-else statements are not going to work because they can test only one value at a time - unless we write a for-loop or vectorise it somehow with a function Vectorize. Instead of that, we pick ifelse which is already vectorized.

Since you have used a shiny tag I've prepared a shiny app instead of flexdashboard :)


Full shiny example

  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)
Comments