反应图侧边栏和选项卡

Question

我正在尝试构建一个闪亮的应用程序，它有多个选项卡，这些选项卡从我使用单选按钮和侧边栏中的 selectizeInput 过滤的相同数据中提取。

您可以使用以下代码生成第一个热图的数据：

dat<-expand.grid(2:6,7:20,letters[1:8],LETTERS[1:26])
dat$Var5<-sample(0:200,nrow(dat),replace = T)
names(dat)<-c("WEEKDAY"  ,
              "HOUR"   ,
              "MEETING_LOCATION" ,
              "COURSE_SUBJECT",
              "n.SESSIONS")
dat[,"WEEKDAY"]<-factor(dat[,1],levels = c("2","3","4","5","6"),ordered = T)
dat[,c("MEETING_LOCATION","COURSE_SUBJECT")]<-lapply(dat[,c("MEETING_LOCATION","COURSE_SUBJECT")],as.character)

我可以让界面显示出来，但是我在堆栈上找到的很多示例并没有说明我需要如何包装所有函数，而且我知道我已经差不多了这是第一个。

我正在使用的闪亮应用代码看起来很像这样：

ui <- fluidPage(
  titlePanel("Oh My God Please Help"),
  fluidRow(
    column(3,
           wellPanel(
             h4("Filter"),
             radioButtons("MEETING_LOCATION",
                          "Location:",
                          c("a" = "a",
                            "b" = "b",
                            "c" = "c",
                            "d" = "d",
                            "e" = "e",
                            "f" = "f",
                            "g" = "g",
                            "h" = "h")),
             selectizeInput("COURSE_SUBJECT",
                                         label = "Course Subject: ",
                                         choices = LETTERS[1:26],
                                         selected = NULL,
                                         multiple = T)
             ))
    ))


  # Show a plot of the generated distribution
  mainPanel(
    tabsetPanel(type = "tabs",
                tabPanel("Usage",plotOutput("USAGE")))
    # other tabs I need to put in don't pay attention to this
    # other tabs I need to put in don't pay attention to this
    # other tabs I need to put in don't pay attention to this
  )


  server <- function(input, output) {


    usage.0<-reactive({
      dat%>%
        dplyr::filter(COURSE_SUBJECT %in% input$COURSE_SUBJECT)%>%
        dplyr::filter(MEETING_LOCATION==input$MEETING_LOCATION)%>%
        group_by(WEEKDAY,HOUR)%>%
        sumarise(TOTAL.SESSIONS = sum(n.SESSIONS))
    })
    output$USAGE <- renderPlot({
      usage.0()%>%
        ggplot(aes(x = WEEKDAY,y = HOUR))+
        geom_tile(aes(fill = TOTAL.SESSIONS))+
        geom_text(aes(label = TOTAL.SESSIONS),colour = "white",fontface = "bold",size = 3)+
        scale_fill_gradient(guide = guide_legend(title = "Total Number of\nMeetings"),low = "#00ABE1",high = "#FFCD00")+
        theme(axis.ticks = element_blank(),
              legend.background = element_blank(), 
              legend.key = element_blank(),
              panel.background = element_blank(),
              axis.text.x = element_text(angle = 35, hjust = 1),
              panel.border = element_blank(),
              strip.background = element_blank(), 
              plot.background = element_blank())+
        xlab("Weekday")+
        ylab("Hour")+
        ggtitle("Busiest Tutoring Days/Hours")
    })
  }

  # Run the application 
  shinyApp(ui = ui, server = server)

我认为问题与 how/where 我正在（不）渲染情节有关。也许我实际上需要另一个选项卡，以便 R 知道该怎么做，我不知道......我知道这可能是非常低效的代码，所以任何帮助都会很棒，但主要焦点只是为了得到这个当我 select 来自 sidebar/radio 按钮的数据子集时显示的热图。

提前致谢。

Answer 1

我在这里看到了几个问题。

1) 在包含主面板之前，您的 fluidPage 已关闭 )。识别这一点的一个技巧是 a) 你的东西没有出现。或者 b) 重新缩进代码菜单中的行。如果他们不排队，你就知道出了问题。

2) 我强烈建议您将数据准备和绘图编写为可以在应用上下文之外进行测试的函数。然后使用应用程序中的功能。我在下面这样做了。这使您能够独立于应用程序测试它们（没有运行应用程序、重新加载、冲洗、重复减速）。当您编辑 UI/Server 元素时，这会使您的应用程序更加简洁和易于导航。以及让增长和测试更加理智。

3) 在您的代码中，永远不要使用对列的数字引用（如 dat[,1]）。始终使用列的名称。它花费的时间稍微多一些，但是在将来数据发生变化时可以节省您的时间，并且可以在阅读您的代码时节省其他人的时间。

4) 发布代码时，请测试它是否真的适合自己。逐行！如果您查看 dat 的结果，您可能会对您的发现感到惊讶。

你现在的工作是，修复这些功能，使它们按照你的期望运行。

app.R

ui <- fluidPage(
  titlePanel("Oh My God Please Help"),
  fluidRow(
    column(
      3,
      wellPanel(
        h4("Filter"),
        radioButtons(
          inputId = "MEETING_LOCATION",
          "Location:",
          c("a" = "a",
            "b" = "b",
            "c" = "c",
            "d" = "d",
            "e" = "e",
            "f" = "f",
            "g" = "g",
            "h" = "h")),
        selectizeInput(
          inputId = "COURSE_SUBJECT",
          label = "Course Subject: ",
          choices = LETTERS[1:26],
          selected = NULL,
          multiple = T)
      ))
  ),
  # Show a plot of the generated distribution
  mainPanel(
    tabsetPanel(
      tabPanel(
        "Usage",
        plotOutput("USAGE")
    )
  ) # Don't forget the comma here! , 
  # other tabs I need to put in don't pay attention to this
  # other tabs I need to put in don't pay attention to this
  # other tabs I need to put in don't pay attention to this
  )
)



server <- function(input, output, session) {

  usage_prep <- reactive({
    cat(input$MEETING_LOCATION)
    cat(input$COURSE_SUBJECT)

    myData(dat, input$MEETING_LOCATION, input$COURSE_SUBJECT)

  })

  output$USAGE <- renderPlot({
    myPlot(usage_prep())
  })
}

# Run the application
shinyApp(ui = ui, server = server)

global.R

library(dplyr)
library(ggplot2)

dat<-expand.grid(2:6,7:20,letters[1:8],LETTERS[1:26])
dat$Var5<-sample(0:200,nrow(dat),replace = T)
names(dat)<-c("WEEKDAY"  ,
              "HOUR"   ,
              "MEETING_LOCATION" ,
              "COURSE_SUBJECT",
              "n.SESSIONS")
dat$WEEKDAY <-factor(dat$WEEKDAY,levels = c("2","3","4","5","6"),ordered = T)



myData <- function(dat, meeting_location, course_subject) {
  dat %>%
    filter(COURSE_SUBJECT %in% course_subject)%>%
    filter(MEETING_LOCATION==meeting_location)%>%
    group_by(WEEKDAY,HOUR)%>%
    summarise(TOTAL.SESSIONS = sum(n.SESSIONS))
}

myPlot <- function(pd) {
  ggplot(pd, aes(x = WEEKDAY,y = HOUR))+
    geom_tile(aes(fill = TOTAL.SESSIONS))+
    geom_text(aes(label = TOTAL.SESSIONS),colour = "white",fontface = "bold",size = 3)+
    scale_fill_gradient(guide = guide_legend(title = "Total Number of\nMeetings"),low = "#00ABE1",high = "#FFCD00")+
    theme(axis.ticks = element_blank(),
          legend.background = element_blank(),
          legend.key = element_blank(),
          panel.background = element_blank(),
          axis.text.x = element_text(angle = 35, hjust = 1),
          panel.border = element_blank(),
          strip.background = element_blank(),
          plot.background = element_blank())+
    xlab("Weekday")+
    ylab("Hour")+
    ggtitle("Busiest Tutoring Days/Hours")
}

反应图侧边栏和选项卡

reactive plots sidebars and tabs

tabs

r

sidebar

shiny

reactive