使用Shiny服务器内置的数据帧进行两次输出

问题描述 投票:1回答:1

我正在研究一个简单的Shiny应用程序来可视化ANOVA(总数,之间,之内)的变异来源。基本上,我希望用户为三组单向ANOVA场景输入“group n”,“means”和“sds” - 然后,app会生成一个数据集来创建一个绘图和一个相应的ANOVA表。

当用户更改输入参数时,我无法弄清楚如何同时使用绘图和ANOVA表。我的大多数尝试都导致了一个更新的情节,但没有表格。

我最接近实际的解决方案是下面的“hack-y / cheating”方法,其中相同的数据集生成两次。但是,这似乎显然是不必要的。我假设解决方案与在服务器功能中创建“反应性”数据集有关,可以为多个输出绘制。这看起来原则上应该是一件相当简单的事情。但是,我无法在线拼写教程/材料以弄清楚如何做到这一点。任何帮助都将不胜感激。

码:

# Visualizing partitioning variance for oneway ANOVA

library(shiny)

ui <- fluidPage(
   titlePanel("Partitioning Variance in a Oneway ANOVA"),

   sidebarLayout(
      sidebarPanel(
        sliderInput("N", "n for each group:",
                     min = 2, max = 50, value = 25),
        sliderInput("M1", "Mean for Control Group:",
                    min = 1, max = 100, value = 55),
        sliderInput("SD1", "SD for Control Group:",
                    min = 1, max = 20, value = 10),
        sliderInput("M2", "Mean for Treatment Group One:",
                    min = 1, max = 100, value = 55),
        sliderInput("SD2", "SD for Treatment Group One:",
                    min = 1, max = 20, value = 10),
        sliderInput("M3", "Mean for Treatment Group Two:",
               min = 1, max = 100, value = 55),
        sliderInput("SD3", "SD for Treatment Group Two:",
                    min = 1, max = 20, value = 10)
),
      mainPanel(
         plotOutput("varPlot"),
         verbatimTextOutput("anovaTable")
      )
   )
)

server <- function(input, output) {

   output$varPlot <- renderPlot({
     set.seed(1976)
     X1 <- rnorm(input$N, input$M1, input$SD1)
     X2 <- rnorm(input$N, input$M2, input$SD2)
     X3 <- rnorm(input$N, input$M3, input$SD3)
     datOutcome = data.frame(X1, X2, X3)
     library(tidyr)
     dat <- gather(datOutcome, group, outcome)
     dat$group <- factor(dat$group, levels = c("X1", "X2", "X3"), 
                         labels = c("Control", "Treatment One", "Treatment Two"))
     # attach the data
     attach(dat)

     library(car)
     mod <- Anova(lm(outcome ~ group, data = dat), type = "III")

     # make the stripcharts by group
     stripchart(outcome ~ group, method = "jitter", jitter = 0.05, 
                vertical = TRUE, pch = 1, col = "blue", 
                group.names = c("Control", "Treatment One", "Treatment Two"),
                xlim = c(.5,4.75),
                ylim = c((min(dat$outcome) - 5), (max(dat$outcome) + 5)),
                ylab = "Outcome Value",
                main = paste("Group n =", input$N, 
                             "\nRed = total variation, Blue = within groups variation, Green indicates between groups variation"))

     # label group means
     text(1.3, mean(X1), 
          paste("Control \nmean =", format(round(mean(X1), 2), nsmall = 2)), 
          col = "darkgreen", cex = .9)
     text(2.3, mean(X2), 
          paste("Treatment One \nmean =", format(round(mean(X2), 2), nsmall = 2)), 
          col = "darkgreen", cex = .9)
     text(3.3, mean(X3), 
          paste("Treatment Two\n mean =", format(round(mean(X3), 2), nsmall = 2)), 
          col = "darkgreen", cex = .9)

     # add diamonds to indicate the means for each group
     points(1, mean(X1), pch = 18, cex = 2, col = "darkgreen")
     points(2, mean(X2), pch = 18, cex = 2, col = "darkgreen")
     points(3, mean(X3), pch = 18, cex = 2, col = "darkgreen")

     # plot a stripchart for the grand mean
     stripchart( outcome, method="jitter" , jitter=0.05 , 
                 vertical=TRUE , pch=1 , col="red" , 
                 at = 4, add = TRUE, 
                 xlim=c(.5,3.75))

     # label grand mean and add dimaond to indicate mean
     text(4.3, mean(outcome), 
          paste("Grand \nmean =", format(round(mean(outcome), 2), nsmall = 2)), 
          col = "red", cex = .9)
     points(4, mean(outcome), pch = 18, cex = 2)

   })


   output$anovaTable <- renderPrint( {
     set.seed(1976)
     X1 <- rnorm(input$N, input$M1, input$SD1)
     X2 <- rnorm(input$N, input$M2, input$SD2)
     X3 <- rnorm(input$N, input$M3, input$SD3)
     datOutcome = data.frame(X1, X2, X3)
     library(tidyr)
     dat <- gather(datOutcome, group, outcome)
     dat$group <- factor(dat$group, levels = c("X1", "X2", "X3"), 
                         labels = c("Control", "Treatment One", "Treatment Two"))

     A <- Anova(aov(outcome ~ group, data = dat), type = "III")
     A
   }) 
}

shinyApp(ui = ui, server = server)
r shiny data-visualization interactive anova
1个回答
1
投票

这可以使用“反应”范例来解决

library(shiny)
library(tidyr)

ui <- fluidPage(
  titlePanel("Partitioning Variance in a Oneway ANOVA"),

  sidebarLayout(
    sidebarPanel(
      sliderInput("N", "n for each group:",
                  min = 2, max = 50, value = 25),
      sliderInput("M1", "Mean for Control Group:",
                  min = 1, max = 100, value = 55),
      sliderInput("SD1", "SD for Control Group:",
                  min = 1, max = 20, value = 10),
      sliderInput("M2", "Mean for Treatment Group One:",
                  min = 1, max = 100, value = 55),
      sliderInput("SD2", "SD for Treatment Group One:",
                  min = 1, max = 20, value = 10),
      sliderInput("M3", "Mean for Treatment Group Two:",
                  min = 1, max = 100, value = 55),
      sliderInput("SD3", "SD for Treatment Group Two:",
                  min = 1, max = 20, value = 10)
    ),
    mainPanel(
      plotOutput("varPlot"),
      verbatimTextOutput("anovaTable")
    )
  )
)

server <- function(input, output) {

  myReactiveDat <- reactive({
    if(is.null(input$N)){
      return(NULL)
    }
    set.seed(1976)
    X1 <- rnorm(input$N, input$M1, input$SD1)
    X2 <- rnorm(input$N, input$M2, input$SD2)
    X3 <- rnorm(input$N, input$M3, input$SD3)
    datOutcome = data.frame(X1, X2, X3)
    dat <- gather(datOutcome, group, outcome)
    dat$group <- factor(dat$group, levels = c("X1", "X2", "X3"), 
                        labels = c("Control", "Treatment One", "Treatment Two"))
    res <- list(dat=dat, X1=X1, X2=X2, X3=X3)
  })

  output$varPlot <- renderPlot({
    res <- myReactiveDat()
    if(is.null(res)){
      return()
    }

    # attach the data
    dat <- res$dat
    attach(dat)

    library(car)
    mod <- Anova(lm(outcome ~ group, data = dat), type = "III")

    # make the stripcharts by group
    stripchart(outcome ~ group, method = "jitter", jitter = 0.05, 
               vertical = TRUE, pch = 1, col = "blue", 
               group.names = c("Control", "Treatment One", "Treatment Two"),
               xlim = c(.5,4.75),
               ylim = c((min(dat$outcome) - 5), (max(dat$outcome) + 5)),
               ylab = "Outcome Value",
               main = paste("Group n =", input$N, 
                            "\nRed = total variation, Blue = within groups variation, Green indicates between groups variation"))

    # label group means
    text(1.3, mean(res$X1), 
         paste("Control \nmean =", format(round(mean(res$X1), 2), nsmall = 2)), 
         col = "darkgreen", cex = .9)
    text(2.3, mean(res$X2), 
         paste("Treatment One \nmean =", format(round(mean(res$X2), 2), nsmall = 2)), 
         col = "darkgreen", cex = .9)
    text(3.3, mean(res$X3), 
         paste("Treatment Two\n mean =", format(round(mean(res$X3), 2), nsmall = 2)), 
         col = "darkgreen", cex = .9)

    # add diamonds to indicate the means for each group
    points(1, mean(res$X1), pch = 18, cex = 2, col = "darkgreen")
    points(2, mean(res$X2), pch = 18, cex = 2, col = "darkgreen")
    points(3, mean(res$X3), pch = 18, cex = 2, col = "darkgreen")

    # plot a stripchart for the grand mean
    stripchart( outcome, method="jitter" , jitter=0.05 , 
                vertical=TRUE , pch=1 , col="red" , 
                at = 4, add = TRUE, 
                xlim=c(.5,3.75))

    # label grand mean and add dimaond to indicate mean
    text(4.3, mean(outcome), 
         paste("Grand \nmean =", format(round(mean(outcome), 2), nsmall = 2)), 
         col = "red", cex = .9)
    points(4, mean(outcome), pch = 18, cex = 2)

  })


  output$anovaTable <- renderPrint( {
    res <- myReactiveDat()
    if(is.null(res)){
      return()
    }
    A <- Anova(aov(outcome ~ group, data = res$dat), type = "III")
    A
  }) 
}

shinyApp(ui = ui, server = server)
© www.soinside.com 2019 - 2024. All rights reserved.