添加新的菜单项后图不渲染

时间:2019-06-29 10:27:21

标签: r dataframe shiny plotly shinydashboard

我正在使用plotly软件包以闪亮的方式显示情节。但是,我所有的绘图都无法正确渲染。即使我使用过renderPlotlyplotlyOutput

我到目前为止所做的事情: 在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")
    })

这里是指向空白未呈现页面的链接。

enter image description here

0 个答案:

没有答案