react 图侧边栏和选项卡

Question

我正在尝试构建一个 Shiny 的应用程序，它有多个选项卡，这些选项卡从我使用单选按钮和侧边栏中的 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)

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

我正在使用的 Shiny 应用程序代码看起来很像这样:

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) 在包含 mainPanel 之前，您的 fluidPage 已关闭)。识别这一点的一个技巧是:a) 你的东西没有出现。或者 b) 重新缩进代码菜单中的行。如果他们没有排队，你就知道出了问题。

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

3) 在代码中，切勿使用对列的数字引用(例如 dat[,1])。始终使用列的名称。它需要稍微多一点的时间，但是当将来数据发生变化时可以节省您的时间，并且可以在阅读代码时节省其他人的时间。

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

你现在的工作是修复功能，以便它们按照你的期望进行。

应用程序.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")
}