繁体   English   中英

在“闪亮”应用程序中使用时,ggplotly无法正常工作

[英]ggplotly does not render correctly working when used in Shiny app

在我的Shiny应用程序中使用时,我的ggplotly图(请参阅server.R中的选项卡3)不起作用。 但是,当我在RStudio中自行生成绘图时,它可以正常工作。

这是一段代码,无法正确显示绘图。

output$facetmap=renderPlotly({

      ggplotly(

        ggplot(ranksvf(),aes(Rank,input$parameterchoice,fill=Location))+
        ggtitle("") +
        theme(axis.title.y=element_blank())+
        geom_bar(position="dodge",stat="identity")+
        facet_wrap(~Tran.Hour.2h.Slot,nrow=2)

        )

    })

当我说它不能正确绘制图形时,我的意思是两件事:

1)当我在ggplot中使用input$parameterchoice时,图形变得很奇怪。 看起来像这样。 错误的情节

2)当我在ggplot中使用输入的实际名称而不是input$parameterchoice ,该图可以正常显示。 但是,当我将鼠标悬停在该图上时,这些值不会按其应有的方式显示(它是一个可绘制的图,因此应显示)。

我感到奇怪的是,我也在应用程序的选项卡2中也使用了ggplotly,它工作正常(鼠标悬停也有效)。

我不确定问题与我使用reactive函数的方式有关,尽管我不确定。 我尝试调试了一段时间,但到目前为止还没有运气。

这就是我的应用程序的样子。

####
#UI#
####

    ui=fluidPage(theme = shinytheme("paper"),
                 titlePanel("Visualising Site-Specific Indicators: XYZ University"),
                #img(src='xyz.jpg', align = "left"),
                   tabsetPanel(

                            #TAB 1

                            tabPanel(type="pills","Macro-View of Locations",
                                    fluidRow(
                                            column(width = 4,
                                                  wellPanel(     
                                                      selectInput("size",
                                                      label="Select Parameter for Rectangle Size",
                                                      choices=names(details)[2:5],selected = "Average Daily Transactions"))),

                                            column(width = 4,
                                                  wellPanel(
                                                      selectInput("color",
                                                      label="Select Parameter for Rectangle Color",
                                                      choices=names(details)[2:5],selected = "Unique Products Sold"))
                                                  )#Close column

                                            ), #Close fluidRow

                                    fluidRow(
                                           plotOutput("plot")),
                                    fluidRow(
                                           dataTableOutput("tab"))

                                     ),#Close tabPanel macroview

                           #TAB 2

                           tabPanel("Transaction Overiew by Location",
                                    fluidRow(
                                      column(width = 4,
                                             wellPanel(     
                                               selectInput("sitechoice",
                                                           label="Select a Site",
                                                           choices=unique(heatmap_mean$Location),selected = "Horton 1"))
                                             )#Close column

                                    ), #Close fluidRow

                                    fluidRow(
                                      plotlyOutput("heatmap")),
                                    fluidRow(
                                      dataTableOutput("tab2"))

                                     ),#Close tabPanel transactionoverview

                           #TAB 3

                           tabPanel("Parameter Ranking",
                                    fluidRow(
                                      column(width = 4,
                                             wellPanel( 
                                               selectInput("parameterchoice",
                                                           label="Rank By",
                                                           choices=unique(c(names(rankdf_avgtran),names(rankdf_ticket)))[3:4],selected = "Average Transaction Value (USD)"))
                                             ),#Close column

                                      column(width=6,
                                             wellPanel(
                                               sliderInput("rankchoice",
                                                           label="Number of Ranks Desired",
                                                           min=1,
                                                           max=10,
                                                           value=5))
                                             )#Close column

                                    ), #Close fluidRow

                                    fluidRow(
                                      plotlyOutput("facetmap")),
                                    fluidRow(
                                      dataTableOutput("tab3"))

                           )#Close tabPanel transactionoverview

    ) #Close tabsetpanel      
    ) #Close UI

    ########
    #SERVER#
    ########

    server=function(input, output,session) {


    # TAB 1

      sortTable <- reactive({
        details[do.call(order, -details[as.character(input$size)]),]
      })

      output$plot= renderPlot ({
        treemap(details,
                index=c("Site"),
                vSize=input$size,
                vColor=input$color,
                title="XYZ University: Overview of Site Data",
                fontsize.title = 20,
                #sortID = paste("-",input$sort,sep=""),
                type="value")
      })

      output$tab <- renderDataTable({
        sortTable()

      })


    #TAB 2

    test=reactive({
         heatmap_mean %>% filter(Location==input$sitechoice)
    })

    output$heatmap=renderPlotly({
      ggplotly(
        ggplot(test(), aes(Day, `Time Slot`)) +
        geom_tile(aes(fill = `Average Number of Transactions`),color = "white") +
        scale_fill_gradient(low = "lightblue", high = "darkblue") +
        ylab("") +
        xlab("") +
        theme(legend.title = element_text(size = 8),
              panel.background = element_blank(),
              legend.text = element_text(size = 8),
              plot.title = element_text(size=18),
              axis.title=element_text(size=22,face="bold"),
              axis.text.x = element_text(angle = 90, hjust = 1)) +
        labs(fill = ""))


    })

    output$tab2 <- renderDataTable({
      test()

    })

    #TAB 3

    ranks_pen <- reactive({

      if(input$parameterchoice=="Average Number of Transactions")
           { 
        showdata=rankdf_avgtran %>% 
        group_by(Tran.Hour.2h.Slot) %>%
        top_n(n = input$rankchoice, wt = `Average Number of Transactions`) %>% #For each time slot, cut off top n values.
        mutate(Rank = rank(-`Average Number of Transactions`,  ties.method = "first")) #And rank for each of the 'n' sites for each time slot
        return(showdata)   
           }

      else

         if(input$parameterchoice=="Average Transaction Value (USD)")
             {
             showdata=rankdf_ticket %>% 
             group_by(Tran.Hour.2h.Slot) %>%
             top_n(n = input$rankchoice, wt = `Average Transaction Value (USD)`) %>% #For each time slot, cut off top 'n' values.
             mutate(Rank = rank(-`Average Transaction Value (USD)`, ties.method = "first")) #And rank the 'n' sites for each time slot 
             return(showdata)
             }

    })

    ranksvf<- reactive({
              ranks_pen() %>%
              group_by(Tran.Hour.2h.Slot) %>% #Group the columns
              arrange(Rank) #Arrange rank from 1 to 'n'
    })

    output$facetmap=renderPlotly({

      ggplotly(

        ggplot(ranksvf(),aes(Rank,input$parameterchoice,fill=Location))+
        ggtitle("") +
        theme(axis.title.y=element_blank())+
        geom_bar(position="dodge",stat="identity")+
        facet_wrap(~Tran.Hour.2h.Slot,nrow=2)

        )

    })

    output$tab3 <- renderDataTable({
    ranksvf()
    })

    }#Close server

    #RUN APP
    shinyApp(ui,server)

试试吧:

    selectInput("parameterchoice",
                label="Rank By",
                choices=as.list(unique(c(names(rankdf_avgtran),names(rankdf_ticket)))[3:4]),
selected = "Average Transaction Value (USD)")

input$parameterchoice返回带引号的字符串,但是aes仅接受不带引号的字符串作为参数。 相反,使用aes_应该可以解决问题

output$facetmap=renderPlotly({
  pc <- input$parameterchoice
    ggplotly(
      ggplot(ranksvf(),aes_(quote(Rank),as.name(pc),fill=quote(Location)))+
      ggtitle("") +
      theme(axis.title.y=element_blank())+
      geom_bar(position="dodge",stat="identity")+
      facet_wrap(~Tran.Hour.2h.Slot,nrow=2)
 )
})

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM