Aufruf zusätzlicher Funktionen in Shiny

Question

Ich entwickelte eine einfache glänzende App, die als eine Bewertung my_x auf einer Verteilung mit Mittelwert my_mean und Standardabweichung my_sd nehmen. Als Ausgabe gibt die App ein Lattice-Diagramm mit einer Normal-Standard-Verteilung mit der entsprechenden z-score von my_x zurück. Den Code für die App finden Sie unter .

Nun würde Ich mag eine zweite Funktionalität der App hinzuzufügen:

Durch eine checkboxInput Überprüfung Ich würde zum Beispiel die pnorm der Ein- und Schatten die relative Fläche des Graphen berechnen.

Ich schrieb den Code für das Diagramm (hier ein Beispiel für das erwartete Ergebnis), aber ich kann nicht herausfinden, wie es in Shiny funktioniert. Insbesondere kann ich nicht herausfinden, wie die Funktion aktiviert wird, wenn das Kontrollkästchen mit der ersten Funktion, die den Graphen zeichnet, richtig funktioniert.

library(lattice) 
e4a <- seq(60, 170, length = 10000) 
e4b <- dnorm(e4a, 110, 15) 
#z-score is calculated with the inputs listed above: 

z_score <- (my_x - my_mean)/my_sd 

plot_e4d <- xyplot(e4b ~ e4a, 
       type = "l", 
       main = "Plot 4", 
       scales = list(x = list(at = seq(60, 170, 10)), rot = 45), 
       panel = function(x,y, ...){ 
        panel.xyplot(x,y, ...) 
        panel.abline(v = c(z_score, 110), lty = 2) 

        xx <- c(60, x[x>=60 & x<=z_score], z_score) 
        yy <- c(0, y[x>=60 & x<=z_score], 0) 
        panel.polygon(xx,yy, ..., col='red') 
       }) 
print(plot_e4d) 

Answer 1

Ich fand eine funktionierende Lösung. Ich bin mir ziemlich sicher, dass es nicht das effizienteste ist, aber es funktioniert. Es besteht aus einer if/else Anweisung innerhalb der Serverfunktion, die den Plot aufruft. Ich möchte @ zx8754 für die Inspiration danken. Hier

ist die ui.r Datei:

library(shiny) 

shinyUI(pageWithSidebar(
headerPanel("Standard Normal"), 
sidebarPanel(
    numericInput('mean', 'Your mean', 0), 
    numericInput('sd', 'Your standard deviation', 0), 
    numericInput('x', 'Your score', 0), 
    checkboxInput('p1', label = 'Probability of getting a score smaller than x or z', value = FALSE) 
), 
mainPanel(
    h3('Standard Normal'), 
    plotOutput('sdNorm'), 
    h4('Your z-score is:'), 
    verbatimTextOutput('z'), 
    h4('Your lower tail probability is:'), 
    verbatimTextOutput('p1')  
    )) 

)

Und die server.R Datei:

library(lattice) 

shinyServer(
function(input, output){ 
    output$sdNorm <- renderPlot({ 
     dt1 <- seq(-3, 3, length = 1000) 
     dt2 <- dnorm(dt1, 0, 1) 
     my_mean <- input$mean 
     my_sd <- input$sd 
     my_x <- input$x 
     z <- (my_x - my_mean)/my_sd 
     if(input$p1){ 

      xyplot(dt2 ~ dt1, 
        type = "l", 
        main = "Lower tail probability", 
        panel = function(x,y, ...){ 
         panel.xyplot(x,y, ...) 
         panel.abline(v = c(z, 0), lty = 2) 
         xx <- c(-3, x[x>=-3 & x<=z], z) 
         yy <- c(0, y[x>=-3 & x<=z], 0) 
         panel.polygon(xx,yy, ..., col='red') 
        }) 

     }else{ 
      xyplot(dt2 ~ dt1, 
        type = "l", 
        main = "Standard Normal Distribution", 
        panel = function(x, ...){ 
         panel.xyplot(x, ...) 
         panel.abline(v = c(z, 0), lty = 2) 
        }) 
     } 

     }) 
    output$z = renderPrint({ 
     my_mean <- input$mean 
     my_sd <- input$sd 
     my_x <- input$x 
     z <- (my_x - my_mean)/my_sd 
     z 
    }) 
    output$p1 <- renderPrint({ 
     if(input$p1){ 
      my_mean <- input$mean 
      my_sd <- input$sd 
      my_x <- input$x 
      p1 <- 1- pnorm(my_x, my_mean, my_sd) 
      p1 
     } else { 
      p1 <- NULL 
     } 

    }) 

} 

)

Answer 2

sollte diese Arbeit:

library(shiny) 
library(lattice) 

shinyApp(
    ui = { 
    pageWithSidebar(
     headerPanel("Standard Normal"), 
     sidebarPanel(
     numericInput('mean', 'Your mean', 80), 
     numericInput('sd', 'Your standard deviation', 2), 
     numericInput('x', 'Your score', 250), 
     checkboxInput("zScoreArea", label = "Area under z-score", value = TRUE) 
    ), 
     mainPanel(
     h3('Standard Normal'), 
     plotOutput('sdNorm'), 
     h4('Your z-score is:'), 
     verbatimTextOutput('z_score') 
    )) 
    }, 
    server = { 
    function(input, output){ 

     #data 
     dt1 <- seq(60, 170, length = 10000) 
     dt2 <- dnorm(dt1, 110, 15) 

     #xyplot panel= function() 
     myfunc <- reactive({ 
     if(input$zScoreArea){ 
      function(x,y, ...){ 
      panel.xyplot(x,y, ...) 
      panel.abline(v = c(z_score(), 110), lty = 2) 

      xx <- c(60, x[x >= 60 & x <= z_score()], z_score()) 
      yy <- c(0, y[x >= 60 & x <= z_score()], 0) 
      panel.polygon(xx,yy, ..., col='red') 
      } 
     }else{ 
      function(x, ...){ 
      panel.xyplot(x, ...) 
      panel.abline(v = c(z_score(), 110), lty = 2)} 

     } 
     }) 

     #reactive z_score for plotting 
     z_score <- reactive({ 
     my_mean <- input$mean 
     my_sd <- input$sd 
     my_x <- input$x 

     #return z score 
     (my_x - my_mean)/my_sd 
     }) 

     output$sdNorm <- renderPlot({ 
     xyplot(dt2 ~ dt1, 
       type = "l", 
       main = "Plot 4", 
       scales = list(x = list(at = seq(60, 170, 10)), rot = 45), 
       panel = myfunc() 
     ) 
     }) 

     output$z_score = renderPrint({ z_score() }) 
    } 
    } 
)