首页 > 解决方案 > 如何在 R Shiny 中组织绘图

问题描述

所以我有一个数据子集,如下所示:

dummy_stage <- structure(list(USER_TYPE = c("external", "external", "internal", 
"external", "external", "unidentified", "internal", "unidentified", 
"internal", "external", "internal", "external", "external"), 
    SESSION_DATE = structure(c(18694, 18695, 18696, 18697, 18698, 
    18699, 18700, 18700, 18701, 18702, 18703, 18704, 18705), class = "Date"), 
    DAILY_ACTIVE_USERS = c(23, 279, 6, 1, 6, 146, 4, 6, 1, 10, 
    186, 8, 54), SESSIONS_PER_USER = c(2, 10, 0, 8, 0, 3, 6, 
    4, 4, 1, 0, 5, 2), DAILY_ACTIVE_USERS_WITH_EVENTS = c(31, 
    37, 43, 52, 22, 18, 95, 32, 81, 65, 80, 91, 78), DAILY_SESSIONS = c(1, 
    97, 77, 99, 29, 91, 62, 1, 62, 71, 78, 87, 0), SECONDS_PER_SESSION = c(8171, 
    3360, 5390, 2261, 1780, 9200, 6066, 1505, 8053, 1603, 514, 
    5150, 6506), PAGE_VISIT_COUNT = c(1221, 52, 86, 11, 43, 32, 
    66, 98, 42, 53, 100, 86, 21), EVENTS_PER_SESSION = c(3, 2, 
    7, 1, 6, 10, 8, 0, 2, 0, 7, 0, 4), PAGEVIEWS_PER_SESSION = c(8, 
    6, 5, 0, 5, 8, 3, 8, 5, 2, 9, 2, 5)), row.names = c(NA, -13L
), class = c("tbl_df", "tbl", "data.frame"))

我正在构建一个闪亮的应用程序,使用户能够与这些数据进行交互。第一次闪亮的用户,我有两个问题:

  1. 我想在 Shiny Dashboard 的第一个选项卡中显示四个图。我希望它们以二乘二布局的形式存在,但是当前两个位于正确位置时,第三和第四个地块堆叠甚至位于选项卡区域下方,这是一个问题。

  2. 我有四个 ggplots 我想在主选项卡上显示。我不〜爱〜他们有白色背景。如果它们的颜色与白色不同,我会更喜欢,最好是透明的。

这是代码:

# Test App for Stage
library(shiny)
library(shinydashboard)
library(viridis)
library(hrbrthemes)
library(scales)
library(readxl)
library(tidyverse)

# Data Flow ----

##TODO Replace and implement Snowflake data.
dummy_stage <- read_excel("~/Documents/dummy_stage.xlsx", 
                              col_types = c("text", "date", "numeric", 
                                            "numeric", "numeric", "numeric", 
                                            "numeric", "numeric", "numeric", 
                                            "numeric")) %>% 
  mutate(SESSION_DATE = as.Date(SESSION_DATE))





# Define UI ----
ui <- dashboardPage(
  dashboardHeader(title = "Title Dashboard 2.0"),
  dashboardSidebar(    
    sidebarMenu(
      menuItem("Daily Session Stats", tabName = "Daily", icon = icon("dashboard")),
      menuItem("Page & Events Stats", tabName = "wee", icon = icon("dashboard")),
      menuItem("Booking Inquiry Details", tabName = "hee", icon = icon("book"))
    )
  ),
  dashboardBody(
    tabItems(
      #Tab 1
      tabItem(
        tabName = "Daily",
        titlePanel("Daily Session Stats"),
        
        fluidRow(
          box(
            checkboxGroupInput("checkGroup", 
                               h4("User Type"), 
                               choices = list("external" = 1, 
                                              "internal" = 2, 
                                              "unidentified" = 3),
                               selected = 1),
            dateRangeInput("dates", h4("Session Date")))
        ),
        column(6, plotOutput("Plot1")),
        column(6, plotOutput("Plot2")),
        column(7, plotOutput("Plot3")),
        column(8, plotOutput("Plot4"))
#could be error here.
      ),
      
      # Second tab content
      tabItem(tabName = "wee",
              titlePanel("Tab 2")
      ),
      
      # Third tab content
      tabItem(tabName = "hee",
              titlePanel("Tab 3")
      )
    )
  )
)


server <- function(input, output) {
  
  #
  output$Plot1 <- renderPlot({
    ggplot(dummy_stage %>% 
             group_by(SESSION_DATE) %>% 
             summarize(DAILY_ACTIVE_USERS_SUM = sum(DAILY_ACTIVE_USERS))
           , aes(y=DAILY_ACTIVE_USERS_SUM, x=SESSION_DATE)) + 
      geom_col(fill = "steelblue") +
      #  scale_fill_viridis(discrete = T) +
      ggtitle("Plot 1") +
      theme(axis.text.x = element_text(face="bold", angle=45, vjust = .5),
            panel.background = element_blank())+ # TODO HERE
      scale_x_date(date_breaks  ="1 day")
    
    
    
  })
  
  output$Plot2 <- renderPlot({
    ggplot(dummy_stage %>% 
             group_by(SESSION_DATE, USER_TYPE) %>% 
             summarize(DAILY_ACTIVE_USERS_WITH_EVENTS_SUM = sum(DAILY_ACTIVE_USERS_WITH_EVENTS))
           , aes(fill=USER_TYPE, y=DAILY_ACTIVE_USERS_WITH_EVENTS_SUM, x=SESSION_DATE)) + 
      geom_bar(position="stack", stat="identity") +
      scale_fill_viridis(discrete = T) +
      ggtitle("Plot 2") +
      theme(axis.text.x = element_text(face="bold", angle=45, vjust = .5))+
      scale_x_date(date_breaks  ="1 day")
    
    
    
  })
  
  output$Plot3 <- renderPlot({
    ggplot(dummy_stage %>% 
             group_by(SESSION_DATE, USER_TYPE) %>% 
             summarize(DAILY_SESSIONS_SUM = sum(DAILY_SESSIONS))
           , aes(fill=USER_TYPE, y=DAILY_SESSIONS_SUM, x=SESSION_DATE)) + 
      geom_bar(position="stack", stat="identity") +
      scale_fill_viridis(discrete = T) +
      ggtitle("Plot 3") +
      theme(axis.text.x = element_text(face="bold", angle=45, vjust = .5))+
      scale_x_date(date_breaks  ="1 day")
    
  })
  
  output$Plot4 <- renderPlot({
    ggplot(dummy_stage %>% 
             group_by(SESSION_DATE) %>% 
             summarize(EVENTS_PER_SESSION = mean(EVENTS_PER_SESSION),
                       PAGEVIEWS_PER_SESSION = mean(PAGEVIEWS_PER_SESSION)),
           aes(x=SESSION_DATE)) + 
      geom_line(aes(y = EVENTS_PER_SESSION), color = "darkred") + 
      geom_line(aes(y = PAGEVIEWS_PER_SESSION), color="steelblue") +
      ggtitle("Plot 4") +
      theme(axis.text.x = element_text(face="bold", angle=45, vjust = .5))+
      scale_x_date(date_breaks  ="1 day")
    
    
    
  })
  
}


# Run the app ----
shinyApp(ui = ui, server = server)

我认为将它们放入 col() 会有所帮助,但无济于事,开始认为这是不对的。

最后,我希望在破折号的第一个选项卡中有四个图(2x2),最好在没有白色背景的情况下看起来不错。

标签: rshinytidyverseshinydashboard

解决方案


推荐阅读