我已经指定了我的图表，其列宽为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 )
我感谢任何帮助！
答案 0 :(得分：1)
box()的默认宽度为6（=总宽度的1/2）。
但是，您的框位于宽度为5的列中。
所以你的盒子总大小为5 * 0.5 = 2.5。
如果您希望获得整列的宽度，只需在框内设置width=12。
这是您的固定MWE（并将tidyverse替换为ggplot和purrr，因为我不想污染我的R ...）：< / p>
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 )