反应式绘图侧边栏和选项卡

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)

我认为问题与我（不）渲染情节的方式/地点有关。也许我实际上需要另一个选项卡，所以 R 知道该做什么，我不知道......我知道这可能是非常低效的代码，所以任何帮助都会很好，但主要关注点只是为了得到这个当我从侧边栏/单选按钮中选择数据的子集时显示的热图。

提前谢谢你。

Answer 1

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

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

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

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)

全球.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")
}