Shinyの追加機能を呼び出す

Question

私は平均値がmy_meanで標準偏差が​​の分布でmy_xというスコアを入力として受け取るシンプルなアプリを開発しました。出力として、アプリは、対応するz-scoreがmy_xの標準標準分布を持つラティスプロットを返します。アプリのコードはGitHubで見つけてください。私は、例えば、入力およびシェードのpnormグラフの相対的面積を計算することになるcheckboxInputをチェックすることによって

：

さて、アプリケーションへの第2の機能を追加したいと思います。

私はグラフのコード（ここでは予期した結果の例）を書いたが、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

私は機能する解決策を見つけました。私はそれが最も効率的ではないと確信していますが、うまくいきます。これは、プロットを呼び出すサーバ関数内の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 
     } 

    }) 

} 

）

Answer 2

これは動作するはずです：

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