![](/img/trans.png)
[英]R: facet_wrap does not render correctly with ggplotly in Shiny app
[英]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.