在 Shiny 中调用附加函数

Question

我开发了一个简单的 shiny 应用程序，它以均值 my_mean 和标准差 my_sd 分布的分数 my_x 作为输入。作为输出，应用程序 return 具有正态标准分布的格子图，相应的 z-score 为 my_x。请在 GitHub.

上找到该应用程序的代码

现在，我想为应用程序添加第二个功能：

通过检查 checkboxInput 我会计算，例如，输入的 pnorm 和阴影图的相对区域。

我为图表编写了代码（这里是预期结果的示例），但我不知道如何让它在 Shiny 中工作。特别是，我不知道如何使通过复选框激活的功能与绘制图形的第一个功能一起正常工作。

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

这应该有效：

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

Answer 2

我找到了一个有效的解决方案。我很确定它不是最有效的，但它确实有效。它由调用绘图的服务器函数中的 if/else 语句组成。感谢@zx8754 的启发。

这是 ui.r 文件：

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

)

和 server.R 文件：

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
        }

    })

}

)

在 Shiny 中调用附加函数

Calling additional functions in Shiny

r

lattice

shiny