Search code examples
rshinylattice

Calling additional functions in Shiny


I developed a simple shiny app that take as inputs a score my_x on a distribution with mean my_mean and standard deviation my_sd. As output, the app return a Lattice plot with a Normal Standard distribution with the corresponding z-score of my_x. Please find the code for the app on GitHub.

Now, I would like to add a second functionality to the app:

By checking a checkboxInput I would calculate, for example, the pnorm of the inputs and shade the relative area of the graph.

I wrote the code for the graph (here an example of the expected result), but I cannot figure out how to make it work in Shiny. In particular, I cannot figure how to make the function activated with the checkbox working properly with the first function drawing the graph.

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)

enter image description here


Solution

  • I found a functioning solution. I am pretty sure that it is not the most efficient, but it works. It consists of an if/else statement within the server function calling the plot. I would like to thank @zx8754 for the inspiration.

    Here is the ui.r file:

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

    )

    And the server.R file:

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

    )

    enter image description here

    enter image description here