Plotten von Gleichungen mit eingeschränkten Domänen in glänzend

Question

dort. Ich baue eine glänzende App, die einige Funktionen darstellt. Der Benutzer kann die Parameter ändern. Das Problem tritt auf, wenn ich eine eingeschränkte Funktion habe, besonders wenn es sich auf x bezieht. Dies ist ein Beispiel:

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) 

Grundstück:

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

Was hier passiert, ist, dass, wenn 'x' größer als 'vthB9', die Gleichung nimmt sich nur ' vthB9 ', und das ist nur einer der Fälle, die ich habe. Jeder weiß was zu tun ist?

* Hoffe, dass ich klar gewesen

* Im mit flexdashboard, deshalb die glänzenden könnte ein wenig anders

Answer 1

Es gesehen sind möglicherweise mehrere Möglichkeiten, um eine stückweise Funktion in R plotten. Ich werde wahrscheinlich der einfachste Weg, es in diesem Fall vorschlagen tun:

wir zuerst die weise definierte Funktion definieren, sagen wir, fun

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

, die wir passieren dann curve

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

curve wird einen Vektor als Parameter für die Funktioneingeben. Die üblichen if-else-Anweisungen funktionieren nicht, weil sie jeweils nur einen Wert testen können - es sei denn, wir schreiben eine For-Schleife oder vektorisieren sie irgendwie mit einer Funktion Vectorize. Stattdessen wählen wir ifelse, das bereits vektorisiert ist.

Da Sie ein shiny Tag verwendet habe ich eine shiny App statt flexdashboard vorbereitet haben :)

---

Voll glänzendes Beispiel

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)