0

I'm trying to plot a function with ggplotly. But the tooltip-labels cannot be edited correctly. This is the code I tried:

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)

The resulting plot looks like this: enter image description here

The y or fare number is not correct and it seems like it's the sum of all the y value. And the x/days/dayfare value is fixed, it is not changing.

I also tried this:

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

but I get this error:

object 'x' not found

Is there any other way I can try?

About this small project, there is another solved question: about the radioButtom setting

I looked at the similar questions like these: the working well solution in its situation

SeGa
  • 9,454
  • 3
  • 31
  • 70
pauke Huang
  • 71
  • 1
  • 8
  • The result of your `g` function also only gives back 2 elements: 0 and 1287 and your data.frame also only has 2 rows and the tooltip for the first row will never be shown, since the line does not go until there. Another problem is that you have 2 inputs with the `id=Input`. – SeGa Nov 29 '18 at 13:50

1 Answers1

0

Apparently ggplotly doesnt know how to render the tooltips when text is explicitly given. If you remove it, then the hover-values change:

If it would work, you would have to include tooltip = "text" in the ggplotly call.

Thats the adapted server function:

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'))
  })
}
SeGa
  • 9,454
  • 3
  • 31
  • 70
  • Thank you very much. By the way, what do you mean two Input? Actually, it doesn't work on when I use your code, which modify renderUI part "Input" to "Input1". But it works well when I change back to "Input". – pauke Huang Nov 30 '18 at 01:28
  • And I still can not edit the label of the tooltip right now. – pauke Huang Nov 30 '18 at 01:33
  • Sry I should have included my ui code too.. In your example the renderUi and the numericInput have both the ID Input, so I changed it for the renderUi to Input1. If you include tooltip = "text" in the ggplotly call, you will see that the labels appear as you defined them but then they stay static. This might also be a bug on plotly side. – SeGa Nov 30 '18 at 10:12