闪亮的应用程序不自动适合网页大小

时间:2015-06-20 20:32:42

标签: r shiny

我已经建立了一个shinydashboard应用程序。它的工作正常,但唯一的问题是它不能自动适应网页。此外,在移动浏览器中打开时,它会显示一个桌面站点,而不是为移动设备定制的站点。引导程序有问题吗?

这是我的代码:

             library(shiny)
          library(shinyapps)
          library(shinydashboard)
          library(dygraphs)
          library(htmltools)
          library(htmlwidgets)
          library(metricsgraphics)
          library(RColorBrewer)
          library(maps)
          library(mapproj)
          library(ggplot2)
          library(dplyr)
          library(plyr)
          library(ggvis)
          library(scales)
          library(leaflet)
          #library(RJSONIO)
          #library(shinybootstrap2)
          #shinybootstrap2::withBootstrap2()
          #source("helpers.R")

          test_bar <- read.csv("test_bar.csv")
          channel_bar <- read.csv("channel_bar.csv")
          time <- read.csv("time_enroll.csv")
          #counties <- readRDS("counties.rds")



          ui <- dashboardPage(skin="blue",

                              dashboardHeader(title="KPI Dashboard"),
                              dashboardSidebar(


                                fluidRow(),
                                fluidRow(),
                                box(width = 12.5,solidHeader=TRUE,title="Refresh Interval", 
                                    status = "warning",
                                    selectInput("interval", "Data Time Period",
                                                choices = c(
                                                  "Current Month" = 30,
                                                  "3MM" = 60,
                                                  "YTD" = 120,
                                                  "R12" = 300                      
                                                ),
                                                selected = "30"
                                    )


                                ),
                                menuItem("", tabName = "widgets"),
                                menuItem("", tabName = "widgets"),

                                box(width = 12.5,solidHeader=TRUE,title="Refresh Interval", 
                                    status = "warning",
                                    selectInput("interval", "Refresh interval",
                                                choices = c(
                                                  "30 seconds" = 30,
                                                  "1 minute" = 60,
                                                  "2 minutes" = 120,
                                                  "5 minutes" = 300,
                                                  "10 minutes" = 600
                                                ),
                                                selected = "60"
                                    ),
                                    uiOutput("timeSinceLastUpdate"),
                                    actionButton("refresh", "Refresh now")
                                    #         p(class = "text-muted",
                                    #           br(),
                                    #           "Source data updates every day."
                                    #         )
                                )
                              ),

                              dashboardBody(


                                fluidRow(
                                  infoBox("New Co-Pay Card Users", 100*10, icon = icon("credit-card"), fill = TRUE,color="olive"),
                                  infoBox("Total Co-Pay Card Users", 500*10, icon = icon("credit-card"), fill = TRUE,color="olive"),
                                  infoBox("Total Redemptions", 10000, icon = icon("thumbs-up"), fill = TRUE,color="lime")
                                ),
                                fluidRow(
                                  box(
                                    title = "Enrollments by Specialty", status = "primary", solidHeader = TRUE,
                                    collapsible = TRUE, width=6,height=315,
                                    plotOutput("plots",click="plot_click1",height=240)
                                  ),
                                  box(
                                    title = "Trend", solidHeader = TRUE,status="primary",
                                    collapsible = TRUE,width=6, dygraphOutput("plot2",height=250)
                                  )
                                ),
                                fluidRow(
                                  box(title = "Enrollments by Channel", status = "primary", solidHeader = TRUE,
                                      collapsible = TRUE, width=6,height=315,
                                      plotOutput("plot_c")),
                                  box(title="Map",
                                      tags$head(tags$style("
                                                           .leaflet-container { background-color: white !important; }
                                                           ")),

                                      leafletMap(
                                        "map", "100%", 500,
                                        # By default OpenStreetMap tiles are used; we want nothing in this case
                                        initialTileLayer = NULL,
                                        initialTileLayerAttribution = NULL,
                                        options=list(
                                          center = c(40, -98.85),
                                          zoom = 4,
                                          maxBounds = list(list(17, -180), list(59, 180))
                                        )
                                      ))

                                      ))

                                )


          server <- function(input,output,session) {


            output$plots <- renderPlot({ 
              ggplot(test_bar,aes(x=factor(Specialty),y=Actual)) +geom_bar(stat="identity")+
                theme(panel.background = element_rect(fill="white",
                                                      color="white"),panel.grid.major = element_line(color="white"),
                      axis.title.x=element_blank(),axis.title.y=element_blank())

            })



            output$plot2 <- renderDygraph({ 

              if (is.null(input$plot_click1$x)) return()

              keeprows <- round(input$plot_click1$x) == as.numeric(time$Spec)
              time2 <- time[keeprows,]
              time3 <- time2[2]

              time_ts <- ts(time3$enroll,start=c(2014,1),end=c(2014,12),frequency=12) 
              dygraph(time_ts) %>% dyRangeSelector(height=20,strokeColor="") %>% dyOptions(fillGraph=TRUE)
            })



            output$test_table <- renderTable({

              if (is.null(input$plot_click1$x)) return()

              keeprows <- round(input$plot_click1$x) == as.numeric(time$Spec)
              time[keeprows,]

            })


            output$plot_c <- renderPlot({ 
              print(ggplot(channel_bar,aes(x=factor(Channel),y=Actual)) +geom_bar(stat="identity")+
                      theme(panel.background = element_rect(fill="white",
                                                            color="white"),panel.grid.major = element_line(color="white"),
                            axis.title.x=element_blank(),axis.title.y=element_blank()))

            })



            output$map <- reactive(TRUE)

            map <- createLeafletMap(session, "map")

            # session$onFlushed is necessary to delay the drawing of the polygons until
            # after the map is created
            session$onFlushed(once=TRUE, function() {
              # Get shapes from the maps package
              states <- map("state", plot=FALSE, fill=TRUE)

              map$addPolygon(states$y, states$x, states$names,
                             lapply(brewer.pal(9, "Blues"), function(x) {
                               list(fillColor = x)
                             }),
                             list(fill=TRUE, fillOpacity=1, 
                                  stroke=TRUE, opacity=1, color="white", weight=1
                             )
              )
            })


          }




          shinyApp(ui, server)

1 个答案:

答案 0 :(得分:0)

您可以尝试使用以下代码来控制图表大小,将其放在plotOutput或showOutput函数之后。

HTML('<style>.rChart {width: 100%; height: 500px}</style>')

示例:

    fluidRow(
              box(
                  title = "Enrollments by Specialty", status = "primary",                         
solidHeader = TRUE,
collapsible = TRUE, 
width=6,height=315,
plotOutput("plots",click="plot_click1",height=240),
HTML('<style>.rChart {width: 100%; height: 500px}</style>')