2017-08-27 9 views
0

Ich habe meine plots mit einer spaltenbreite von 5 angegeben. Mein Problem ist stattdessen meine Plots werden mit einer Spaltenbreite näher an 2 mit Leerraumauffüllung zwischen Plots angezeigt.shiny armaturenbrett fix breite der plots

Hier ist ein MWE meines Problems

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) 

ich jede Hilfe dankbar!

Antwort

1

Die Standardbreite für box() ist 6 (= 1/2 der Gesamtbreite). Ihre Box befindet sich jedoch in einer Spalte der Breite 5. Ihre Box wird also eine Gesamtgröße von 5 * 0,5 = 2,5 haben.

Setzen Sie einfach width=12 in Ihre Box, wenn Sie die volle Breite der Spalte haben möchten.

Hier ist Ihre feste MWE (und ersetzt tidyverse mit ggplot und purrr, wie ich will nicht meine R verschmutzen ...):

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) 
+0

Ah, macht Sinn. Danke vielmals! – CPak

Verwandte Themen