反应性图侧边栏和标签

时间:2018-10-04 22:06:31

标签: r shiny tabs sidebar reactive

我正在尝试构建一个闪亮的应用程序,该应用程序具有多个选项卡,这些选项卡从我使用单选按钮过滤并在边栏中的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知道该怎么做,我不知道...我确实知道这可能真的是效率低下的代码,所以那里的任何帮助都将是非常有用的,但是主要的重点只是为了得到这个当我从侧边栏/单选按钮中选择数据的子集时,就会显示热图。

谢谢。

1 个答案:

答案 0 :(得分:2)

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

1)fluidPage)中被关闭,然后再包含mainPanel。识别此问题的技巧是: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")
}