varun varun -4 years ago 245
R Question

ggplotly does not render correctly working when used in Shiny app

My ggplotly plot (see Tab 3 in server.R) does not work when used in my Shiny app. However, when I generate the plot by itself in RStudio, it works fine.

This is the bit of code that does not render a plot correctly.

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)

)

})


When I say it doesn't render a plot correctly, I mean two things:

1) When I use
input$parameterchoice
in ggplot, the graph comes out weird. It looks like this. Incorrect Plot

2) When I use the actual name of the input in ggplot instead of
input$parameterchoice
, the plot comes out fine. However when I mouseover the plot, the values do not show as they should (it is a plotly graph so it should show).

What I find strange is that I use a ggplotly in Tab 2 of my application as well, and it works fine (the mouseover works too).

I feel the problem has something to do with the way I used my
reactive
functions, though I'm not sure. I've tried to debug for a while, but no luck so far.

This is what my app looks like.

####
#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)

Answer Source

input$parameterchoice returns a quoted string, however aes only accepts unquoted strings as arguments. Using aes_ instead should resolve the issue

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)
 )
})
Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download