0
我已经构建了一个shinydashboard应用程序。它工作正常，但唯一的问题是，它不是自动贴合的网页。此外，在移动浏览器中打开时，它会显示一个桌面版网站，而不是为手机定制的网站。 Bootstrap有问题吗？闪亮的应用程序不自动拟合网页大小
这里是我的代码：
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)
您的代码不为我运行，应用程序是灰色的并且存在在R会话错误。 – SabDeM