Question

我正在尝试使用ggplotly绘制函数。但是工具提示标签无法正确编辑。这是我尝试的代码：

library(shiny)
library(ggplot2)
library(plotly)

feeInMonth <- function(dayFare, days){
    fee = dayFare * days
    if(fee > 662.5){                                             #662.5 = 100 + 50/0.8 + 250/0.5
        fee = (fee -262.5)} else if(fee > 162.5 & fee <= 662.5){ #162.5 = 100 + 50/0.8   
            fee = fee/2+68.75 } else if(fee > 100 & fee <= 162.5){#(fee-162.5)/2+150
                fee = fee*0.8+20 } else { return(fee)}           #(fee-100)*0.8+100
    return(fee)  
} 
g <- Vectorize(feeInMonth)


ui <- fluidPage(


    titlePanel(HTML("北京地铁月度支出计算器 <br/>Beijing Subway monthly Fare Calculator")),

    fluidRow(
        column(4,radioButtons("radio", label = h4(HTML("X轴选择 <br/> Select X Variable")),
                              choiceNames = c("以天数看花费 \n days as X variable",
                                              "以单日费用看花费 \n day fare as X variable"),
                              choiceValues = c("dayFare","days"),
                              selected = "days")),
        column(5,uiOutput("Input"))),

    # Show a plot of the generated distribution
    plotlyOutput("distPlot", width=780,height = 400)
)



server <- function(input, output) {

    output$Input <- renderUI({
        if(input$radio == "days"){
            numericInput("Input", label = h4(HTML('每月使用日数<br/> monthly work days')), 
                         value = 22, min = 1, max = 31)

        }else{
            numericInput("Input", label = h4(HTML('平均每日花费<br/> average each day fare')), 
                         value = 10, min = 3, max = 50)
        }})


    output$distPlot <- renderPlotly(
        {
            if(input$radio == "dayFare"){
                p <- ggplot(data.frame(dayFare = c(3,50),days = c(0,31)), 
                            aes(x = days,text = paste('Fare: ', g(dayFare,days),'</br>days: ', days))) +
                    stat_function(fun = g,args = c(dayFare = input$Input)) + 
                    theme(axis.line = element_line(colour = "darkblue", size = 1.5, linetype = "solid"))+ 
                    labs(x = HTML("使用日数\n using days"), y = HTML("费用\ fare"))
            }
            if(input$radio == "days"){
                p <- ggplot(data.frame(dayFare = c(3,50),days = c(0,31)), 
                            aes(x = dayFare,text = paste('Fare: ', g(dayFare,days),'</br>day Fare: ', dayFare))) +
                    stat_function(fun = g,args = c(days = input$Input),size =2) + 
                    theme(axis.line = element_line(colour = "darkblue",size = 1.5, linetype = "solid"))+
                    labs(x = HTML("平均每日花费\n average each day fare"), y = HTML("费用\ fare"))
            }
            gg <- plotly_build(p)
            gg <- style(gg, line = list(color = 'lightblue'))

        })

}

shinyApp(ui = ui, server = server)

结果图如下：

y或票价数字不正确，似乎是所有y值的总和。而且x / days / dayfare值是固定的，不会改变。

我也尝试过：

gg$x$data[[2]]$text <- paste('Fare: ', g(x),'</br>number: ', x)

但我收到此错误：

找不到对象“ x”

还有其他方法可以尝试吗？

关于这个小项目，还有另一个已解决的问题： about the radioButtom setting

我看着类似的问题： the working well solution in its situation

Answer 1

显然，ggplotly不知道显式给出文本时如何呈现工具提示。如果将其删除，则悬停值将更改：

如果可行，则必须在tooltip = "text"调用中包含ggplotly。

那是适应的服务器功能：

server <- function(input, output) {

  output$Input1 <- renderUI({
    if(input$radio == "days"){
      numericInput("Input", label = h4(HTML('每月使用日数<br/> monthly work days')), 
                   value = 22, min = 1, max = 31)

    }else{
      numericInput("Input", label = h4(HTML('平均每日花费<br/> average each day fare')), 
                   value = 10, min = 3, max = 50)
    }})

  output$distPlot <- renderPlotly({
    req(input$Input)

    df <- data.frame(dayFare = seq(3,50,length.out = 32), days = 0:31)
    df$gF <- g(df$dayFare, df$days)

    if(input$radio == "dayFare"){
      p <- ggplot(data = df, 
                  aes(x = days, y = gF#, text = paste('Fare: ', df$gF,'<br>days: ', df$days)
                      )) +
        stat_function(fun = g, args = c(input$Input)) +
        theme(axis.line = element_line(colour = "darkblue", size = 1.5, linetype = "solid")) + 
        labs(x = HTML("使用日数\n using days"), y = HTML("费用\ fare"))
    }
    if(input$radio == "days"){
      p <- ggplot(data = df, 
                  aes(x = dayFare, y=gF#, text = paste('Fare: ', df$gF, '<br>day Fare: ', df$dayFare)
                      )) +
        stat_function(fun = g, args = c(input$Input), size =2) +
        theme(axis.line = element_line(colour = "darkblue",size = 1.5, linetype = "solid")) +
        labs(x = HTML("平均每日花费\n average each day fare"), y = HTML("费用\ fare"))


    }

    ggplotly(p, source = "A", dynamicTicks = F) %>%  #tooltip = "text"
      style(line = list(color = 'lightblue'))
  })
}

使用ggplot stat_function编辑plotly工具提示的标签

1 个答案: