r - 具有不同组选择名称的闪亮选项卡

Question

我有一个包含多个组的数据集，每个组有不同的主题，我想构建一个闪亮的应用程序来显示各自组中每个主题的结果，每个组都表示为shiny应用程序中的一个选项卡。我觉得我大约有 95% 在那里，只是无法弄清楚为什么第二个选项卡拒绝选择数据（第一个选项卡工作得很好）。

这是我的数据的样子：

library(tidyverse)
library(reshape2)
library(shiny)

groupID <- rep(1:2, each = 5)
Subject <- LETTERS[1:10]
var1 <- rnorm(n = length(Subject), mean = 0, sd = 1)
var2 <- rnorm(n = length(Subject), mean = 0, sd = 2)
var3 <- rnorm(n = length(Subject), mean = 0, sd = 2.5)
var4 <- rnorm(n = length(Subject), mean = 0, sd = 3)

df <- data.frame(groupID, Subject, var1, var2, var3, var4)

df_long <- df %>%
  melt(., id = c("groupID", "Subject"))

shiny到目前为止，这是我的方法：

## UI
ui <- fluidPage(

  tabsetPanel(
    tabPanel("Grp1", fluid = T,
             selectizeInput(
               inputId = "Subject",
               label = "Select Subjects",
               choices = df_long %>% filter(groupID == 1) %>% distinct(., Subject) %>% pull(Subject),
               selected = "A",
               multiple = TRUE
             ),
             mainPanel(plotOutput(outputId = "grp1_plot"))),

    tabPanel("Grp2", fluid = T,
             selectizeInput(
               inputId = "Subject",
               label = "Select Subjects",
               choices = df_long %>% filter(groupID == 2) %>% distinct(., Subject) %>% pull(Subject),
               selected = "F",
               multiple = TRUE
             ),
             mainPanel(plotOutput(outputId = "grp2_plot")))
  )
)


## Server
server <- function(input, output){

  # get data
  grp1_dat <- reactive({
    dataset1 <- df_long %>%
      filter(Subject %in% input$Subject,
             groupID == 1)
    dataset1
  })

  grp2_dat <- reactive({
    dataset2 <- df_long %>%
      filter(Subject %in% input$Subject,
             groupID == 2)
    dataset2
  })

  # render the plots
  output$grp1_plot <- renderPlot({

    grp1 <- grp1_dat()

    grp1_plot <- ggplot(grp1, aes(x = variable, y = value, fill = Subject)) +
      geom_hline(aes(yintercept = 0), size = 1.1) +
      geom_rect(aes(ymin = -1, ymax = 1),
                xmin = 0, 
                xmax = Inf,
                fill = "light grey") +
      geom_col(alpha = 0.8, 
               position = position_dodge()) +
      ylim(-4, 4)

    print(grp1_plot)
  })

  output$grp2_plot <- renderPlot({

    grp2 <- grp2_dat()

    grp2_plot <- ggplot(grp2, aes(x = variable, y = value, fill = Subject)) +
      geom_hline(aes(yintercept = 0), size = 1.1) +
      geom_rect(aes(ymin = -1, ymax = 1),
                xmin = 0, 
                xmax = Inf,
                fill = "light grey") +
      geom_col(alpha = 0.8, 
               position = position_dodge()) +
      ylim(-4, 4)

    print(grp2_plot)
  })
}

shinyApp(ui, server)

您可以从我的应用程序的屏幕截图中看到，它shiny有两个选项卡，但只有 tab1 有效，而 tab2 产生错误，我不确定如何纠正它？

标签： rshiny

Answer 1

您无法将闪亮的更改 inputid 回收到 Subject2

library(tidyverse)
library(reshape2)
library(shiny)

groupID <- rep(1:2, each = 5)
Subject <- LETTERS[1:10]
var1 <- rnorm(n = length(Subject), mean = 0, sd = 1)
var2 <- rnorm(n = length(Subject), mean = 0, sd = 2)
var3 <- rnorm(n = length(Subject), mean = 0, sd = 2.5)
var4 <- rnorm(n = length(Subject), mean = 0, sd = 3)

df <- data.frame(groupID, Subject, var1, var2, var3, var4)

df_long <- df %>%
  melt(., id = c("groupID", "Subject"))


## UI
ui <- fluidPage(

  tabsetPanel(
    tabPanel("Grp1", fluid = T,
             selectizeInput(
               inputId = "Subject",
               label = "Select Subjects",
               choices = df_long %>% filter(groupID == 1) %>% distinct(., Subject) %>% pull(Subject),
               selected = "A",
               multiple = TRUE
             ),
             mainPanel(plotOutput(outputId = "grp1_plot"))),

    tabPanel("Grp2", fluid = T,
             selectizeInput(
               inputId = "Subject2",
               label = "Select Subjects",
               choices = df_long %>% filter(groupID == 2) %>% distinct(., Subject) %>% pull(Subject),
               selected = "F",
               multiple = TRUE
             ),
             mainPanel(plotOutput(outputId = "grp2_plot")))
  )
)


## Server
server <- function(input, output){

  # get data
  grp1_dat <- reactive({
    dataset1 <- df_long %>%
      filter(Subject %in% input$Subject,
             groupID == 1)
    dataset1
  })

  grp2_dat <- reactive({
    dataset2 <- df_long %>%
      filter(Subject %in% input$Subject2,
             groupID == 2)
    dataset2
  })

  # render the plots
  output$grp1_plot <- renderPlot({

    grp1 <- grp1_dat()

    grp1_plot <- ggplot(grp1, aes(x = variable, y = value, fill = Subject)) +
      geom_hline(aes(yintercept = 0), size = 1.1) +
      geom_rect(aes(ymin = -1, ymax = 1),
                xmin = 0, 
                xmax = Inf,
                fill = "light grey") +
      geom_col(alpha = 0.8, 
               position = position_dodge()) +
      ylim(-4, 4)

    print(grp1_plot)
  })

  output$grp2_plot <- renderPlot({

    grp2 <- grp2_dat()

    grp2_plot <- ggplot(grp2, aes(x = variable, y = value, fill = Subject)) +
      geom_hline(aes(yintercept = 0), size = 1.1) +
      geom_rect(aes(ymin = -1, ymax = 1),
                xmin = 0, 
                xmax = Inf,
                fill = "light grey") +
      geom_col(alpha = 0.8, 
               position = position_dodge()) +
      ylim(-4, 4)

    print(grp2_plot)
  })
}

shinyApp(ui, server)