闪亮的仪表板修复图的宽度

debugcn 发表于 Dev

CPak

我已经用列宽指定了我的图5。我的问题是，我的绘图显示的列宽更接近于2绘图之间的空白填充。

这是我的问题的 MWE

library(tidyverse)
library(shiny)
library(shinydashboard)

##----------DATA------------##
set.seed(1)
df <- map(1:4, ~data.frame(x=1:10, y=(1:10)+runif(.x), z=.x))
stat <- data.frame(A=runif(4)+2, B=runif(4)+2, depth=c(10,20,30,40))
##----------END DATA------------##

## UI
ui <- dashboardPage(
            dashboardHeader(title = "Test"),
            dashboardSidebar(
                  sidebarMenu(
                        menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
                  )
            ),
            dashboardBody(
                  tabItems(
                        # First tab content
                        tabItem(tabName = "dashboard",
                              fluidRow( 
                                    box(title = "Inputs",
                                         solidHeader = TRUE,
                                         collapsible = TRUE,
                                         width = 3,    
                                     selectInput(inputId="parameter", label="Parameter", choices=c("This", "That"), selected=c("This"))
                                    )
                              ), 
                              fluidRow(
                                    column(width=5,
                                         box(title = "Plot",
                                              solidHeader = TRUE,
                                              collapsible = TRUE,
                                              plotOutput(outputId="histogram")
                                         )
                                    ),      
                            column(width=5,
                                         box(title = "Summary",
                                     plotOutput(outputId="linegraph")
                                         )
                                    )
                              )
                )
            ) # end tabitems
        ) # end dashboardbody
    ) # end dashboardpage

## SERVER
server <-   function( input, output ) {
                  # Reactive data
                  data <- reactive({ df })
                  stats <- reactive({ stat })

                  # Histogram plot
            output$histogram <- renderPlot({ ggplot() +
                                                      geom_step(data=data()[[1]], aes(x=x, y=y, colour="1"), lwd=1) + 
                                                      geom_step(data=data()[[2]], aes(x=x, y=y, colour="2"), lwd=1) +
                                                      geom_step(data=data()[[3]], aes(x=x, y=y, colour="3"), lwd=1) +
                                                      geom_step(data=data()[[4]], aes(x=x, y=y, colour="4"), lwd=1) +
                                                      scale_color_manual(values=c("1"="cyan","2"="blue","3"="green","4"="red")) +
                                                      theme_classic() +
                                                      guides(color=guide_legend(title="")) +
                                                      theme(legend.position = "bottom", legend.direction = "horizontal") + 
                                                      theme(text = element_text(size=20)) +
                                                      xlab("") + ylab("") })

                  # Linegraph plot
            output$linegraph <- renderPlot({ ggplot() +
                                                      geom_point(data=stats(), aes(x=depth, y=A, color="A"), size=5) + 
                                                      geom_line(data=stats(), aes(x=depth, y=A, color="A"), lwd=1) +
                                                      geom_point(data=stats(), aes(x=depth, y=B, color="B"), size=5) + 
                                                      geom_line(data=stats(), aes(x=depth, y=B, color="B"), lwd=1) +
                                                      geom_hline(yintercept=0, lty=2, lwd=1, color="red") +
                                                      scale_color_manual(values=c("A"="black","B"="grey")) +
                                                      theme_classic() +
                                                      guides(color=guide_legend(title="")) +
                                                      theme(legend.position = "bottom", legend.direction = "horizontal") + 
                                                      theme(text = element_text(size=20)) +
                                                      xlab("") + ylab("") })
        }

shinyApp( ui = ui, server = server )

我感谢任何帮助！

我知道

默认宽度为box()6（= 总宽度的 1/2）。但是，您的框位于宽度为 5 的列内。因此您的框的总大小为 5*0.5=2.5。

width=12当您想要列的全宽时，只需在您的框内设置即可。

这是您的固定 MWE（并替换tidyverse为ggplotand purrr，因为我不想污染我的 R...）：

library(ggplot2)
library(purrr)
library(shiny)
library(shinydashboard)

##----------DATA------------##
set.seed(1)
df <- map(1:4, ~data.frame(x=1:10, y=(1:10)+runif(.x), z=.x))
stat <- data.frame(A=runif(4)+2, B=runif(4)+2, depth=c(10,20,30,40))
##----------END DATA------------##

## UI
ui <- dashboardPage(
  dashboardHeader(title = "Test"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      # First tab content
      tabItem(tabName = "dashboard",
              fluidRow( 
                box(title = "Inputs",
                    solidHeader = TRUE,
                    collapsible = TRUE,
                    width = 3,    
                    selectInput(inputId="parameter", label="Parameter", choices=c("This", "That"), selected=c("This"))
                )
              ), 
              fluidRow(
                column(width = 5,
                       box(title = "Plot",
                           solidHeader = TRUE,
                           collapsible = TRUE,
                           width = 12,
                           plotOutput(outputId="histogram")
                       )
                ),      
                column(width = 5,
                       box(title = "Summary",
                           width = 12,
                           plotOutput(outputId="linegraph")
                       )
                )
              )
      )
    ) # end tabitems
  ) # end dashboardbody
) # end dashboardpage

## SERVER
server <-   function( input, output ) {
  # Reactive data
  data <- reactive({ df })
  stats <- reactive({ stat })

  # Histogram plot
  output$histogram <- renderPlot({ ggplot() +
      geom_step(data=data()[[1]], aes(x=x, y=y, colour="1"), lwd=1) + 
      geom_step(data=data()[[2]], aes(x=x, y=y, colour="2"), lwd=1) +
      geom_step(data=data()[[3]], aes(x=x, y=y, colour="3"), lwd=1) +
      geom_step(data=data()[[4]], aes(x=x, y=y, colour="4"), lwd=1) +
      scale_color_manual(values=c("1"="cyan","2"="blue","3"="green","4"="red")) +
      theme_classic() +
      guides(color=guide_legend(title="")) +
      theme(legend.position = "bottom", legend.direction = "horizontal") + 
      theme(text = element_text(size=20)) +
      xlab("") + ylab("") })

  # Linegraph plot
  output$linegraph <- renderPlot({ ggplot() +
      geom_point(data=stats(), aes(x=depth, y=A, color="A"), size=5) + 
      geom_line(data=stats(), aes(x=depth, y=A, color="A"), lwd=1) +
      geom_point(data=stats(), aes(x=depth, y=B, color="B"), size=5) + 
      geom_line(data=stats(), aes(x=depth, y=B, color="B"), lwd=1) +
      geom_hline(yintercept=0, lty=2, lwd=1, color="red") +
      scale_color_manual(values=c("A"="black","B"="grey")) +
      theme_classic() +
      guides(color=guide_legend(title="")) +
      theme(legend.position = "bottom", legend.direction = "horizontal") + 
      theme(text = element_text(size=20)) +
      xlab("") + ylab("") })
}

shinyApp( ui = ui, server = server )

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。