Я использую пакет plotly для отображения графика в блестящем. Тем не менее, все мои графики больше не отображаются должным образом. Хотя я использовал renderPlotly и plotlyOutput.
Что я сделал до сих пор:
В ui.R я заменил все box(plotOutput("plot1"), width=6, height=500) на box(plotlyOutput("plot1"), width=6, height=500)
На сервере я должен заменить output$plot1 <- renderPlot({
...... на output$plot1 <- renderPlotly({
....
# Define UI for application that draws a histogram
ui <- dashboardPage(
dashboardHeader(title = "Research Quality"),
dashboardSidebar(
sidebarMenu(id ="rq",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Scientific Quality", tabName = "scientificQuality", icon = icon("microscope"),
menuSubItem("Top cited Publications", tabName = "topCited",icon = icon("book-open")),
menuSubItem("SNIP", tabName = "journals",icon = icon("books"))),
menuItem("Research Funding", tabName = "researchFunding", icon = icon("hand-holding-usd"),
menuSubItem("Gross domestic expenditure on R&D", tabName = "gerd",icon = icon("coins")),
menuSubItem("Expenditure on Higher Education", tabName = "higherE",icon = icon("hand-holding-usd"))),
menuItem("Knowledge Transfer", tabName = "knowledgeTransfer", icon = icon("exchange-alt"),
menuSubItem("Patent", tabName = "patent",icon = icon("lightbulb-on")),
menuSubItem("Open Access", tabName = "open",icon = icon("lock-open-alt"))),
menuItem("Predictive", tabName = "predictive"))
),
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
fluidRow(
shinydashboard::valueBoxOutput("value1", width = 3),
shinydashboard::valueBoxOutput("value2", width = 3),
shinydashboard::valueBoxOutput("value3", width = 3),
shinydashboard::valueBoxOutput("value4", width = 3)
),# end of row
fluidRow(
box(width = 12,
title = "Gross Domestic Expenditure on R&D (GDP)",
selectInput("measure", "Select a measure", choices = c(
"GERD in '000 current PPP$"
, "GERD as a percentage of GDP"
,"GERD per capita (in current PPP$)" ),
selected = ("GERD as a percentage of GDP")),
plotlyOutput("lineGerd")
) #End of Box
) # End of Fluid Row
), # End of tabItem
# Define server logic required to draw a histogram
server <- function(input, output, session) {
output$value1 <- shinydashboard::renderValueBox({
selectedSubject <- input$subject
selectedYear <- input$yearInput
average_SNIP_DE_11 <- final_DE %>% filter(subjectArea %in% selectedSubject & year %in% selectedYear) %>% summarize(Avg = mean(SNIP, na.rm = TRUE)) %>% pull(-1)
shinydashboard::valueBox(
formatC(average_SNIP_DE_11, format="fg", big.mark=',')
,paste('Germany')
,icon = icon("stats",lib='glyphicon')
,color = "purple")
})
output$value2 <- shinydashboard::renderValueBox({
selectedSubject <- input$subject
selectedYear <- input$yearInput
average_SNIP_GB_11 <- final_GB %>% filter(subjectArea %in% selectedSubject & year %in% selectedYear) %>% summarize(Avg = mean(SNIP, na.rm = TRUE)) %>% pull(-1)
shinydashboard::valueBox(
formatC(average_SNIP_GB_11, format="fg", big.mark=',')
,paste('United Kingdom')
,icon = icon("stats",lib='glyphicon')
,color = "green")
})
output$value3 <- shinydashboard::renderValueBox({
selectedSubject <- input$subject
selectedYear <- input$yearInput
average_SNIP_US_11 <- final_US %>% filter(subjectArea %in% selectedSubject & year %in% selectedYear) %>% summarize(Avg = mean(SNIP, na.rm = TRUE)) %>% pull(-1)
shinydashboard::valueBox(
formatC(average_SNIP_US_11, format="fg", big.mark=',')
,paste('United States')
,icon = icon("stats",lib='glyphicon')
,color = "yellow")
})
output$value4 <- shinydashboard::renderValueBox({
selectedSubject <- input$subject
selectedYear <- input$yearInput
average_SNIP_IN_11 <- final_IN %>% filter(subjectArea %in% selectedSubject & year %in% selectedYear) %>% summarize(Avg = mean(SNIP, na.rm = TRUE)) %>% pull(-1)
shinydashboard::valueBox(
formatC(average_SNIP_IN_11, format="fg", big.mark=',')
,paste('India')
,icon = icon("stats",lib='glyphicon')
,color = "red")
})
#creating the plotOutput content
output$countryPlot <- renderPlotly({
displayData_prop <- Fact_Publication %>% group_by(YearID) %>% filter(quantile(cited.by,0.9) < cited.by)%>% count(YearID,CountryID)%>% mutate(prop = prop.table(n))
plot_ly(displayData_prop, x = ~YearID, y = ~prop, type = 'bar', group=~(CountryID), color=~CountryID) %>%
layout(yaxis = list(title = 'Proportions of Top Cited Publications'), barmode = 'group')
})
output$lineGerd <- renderPlotly({
selectedMeasure <- input$measure
selectedCountries <- input$country
displayData <- Fact_Indicator %>% filter( indicator %in% selectedMeasure)
plot_ly(displayData,x = ~year_id, y=~value, group=~country_id, type="scatter", color=~country_id, mode="lines+markers")
})
Вот ссылка на пустую неотрисованную страницу.
