如何解决在传单中使用条形图和散点图的问题
我试图在传单中同时使用散点图和条形图。日期表、传单和散点图工作正常。问题是 当在传单中我们选择地图中的一些点时,条形图不起作用,如下图所示。为什么散点图可以正常工作,而条形图却不行?
#R code
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
#devtools::install_github("jcheng5/d3scatter")
library(d3scatter)
data_2<-structure(list(ID = 1:8,Name1 = c("A","A","C","B","B"),Name2 = c("a","b","a","c"),Value1 = c(12,43,54,34,23,77,44,22),Value2 = c(0,1,2),Lat = c(51.1,51.6,57.3,52.4,56.3,54.3,60.4,49.2),Lon = c(5,-3,-2,-1,4,3,-5,0),lab_DB = c("blue","blue","green","red","red")),class = "data.frame",row.names = c(NA,-8L))
sdf <- SharedData$new(data_2,key=~ID)
lmap <- leaflet(data = sdf) %>% addTiles() %>%
addCircleMarkers(data = sdf,lng = ~Lon,lat = ~Lat,group = ~Name1,color = ~lab_DB,radius =3
)
dtable <- datatable(sdf,width = "100%",editable=TRUE)
ggplt<-ggplot(sdf,aes(x=factor(Value2)))+
geom_bar(stat="count",width=0.7,fill="steelblue")
d3<-d3scatter(sdf,x=~Value1,y=~Value2,width="100%",height=300)
bscols( widths=c(6,6,list(lmap,d3),list(dtable,ggplotly(ggplt)))
下面的代码显示了正确计算的“value2”的#0、#1和#2的计数! (显示在数据表的标题中)但是条形图有问题!!
#R code
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
#devtools::install_github("jcheng5/d3scatter")
library(d3scatter)
data_2<-structure(list(ID = 1:8,class = "data.frame",radius =3
)
ggplt<-ggplotly(sdf %>% ggplot( aes(x=factor(Value2)))+
geom_bar(stat="count",fill="steelblue"))
d3<-d3scatter(sdf,height=300)
dtable <- datatable(sdf,editable=TRUE,caption=tags$caption("Value2: #0: ",summarywidget(sdf,selection=~Value2==0)," Value2: #1: ",selection=~Value2==1),selection=~Value2==2)
))
bscols( list(lmap,dtable),list(d3,ggplt),htmltools::p(summarywidget(sdf,selection=~Value2==0,column="Value2"),selection=~Value2==1,selection=~Value2==2,style="display:none;"))
解决方法
这是一个有光泽的解决方案。我再次对您的数据表使用回调函数来对共享数据 sdf
进行子集化,以便您可以单击您感兴趣的列并显示条形图:
library(shiny)
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
library(d3scatter)
data_2 <- structure(
list(ID = 1:8,Name1 = c("A","A","C","B","B"),Name2 = c("a","b","a","c"),Value1 = c(12,43,54,34,23,77,44,22),Value2 = c(0,1,2),Lat = c(51.1,51.6,57.3,52.4,56.3,54.3,60.4,49.2),Lon = c(5,-3,-2,-1,4,3,-5,0),lab_DB = c("blue","blue","green","red","red")),class = "data.frame",row.names = c(NA,-8L))
ui <- fluidPage(
fluidRow(
column(6,leafletOutput("lmap")),column(6,d3scatterOutput("scatter"))
),fluidRow(
column(6,DTOutput("table")),style = "padding-top: 105px;",plotlyOutput("plot"))
)
)
server <- function(input,output) {
sdf <- SharedData$new(data_2,key=~ID)
output$lmap <- renderLeaflet({
leaflet(data = sdf) %>%
addTiles() %>%
addCircleMarkers(data = sdf,lng = ~Lon,lat = ~Lat,group = ~Name1,color = ~lab_DB,radius =3)
})
output$scatter <- renderD3scatter({
d3scatter(sdf,x = ~Value1,y = ~Value2,width = "100%",height=300)
})
output$table <- renderDT({
datatable(
sdf,filter = 'top',editable=TRUE,extensions = c('Select','Buttons'),selection = 'none',options = list(select = list(style = 'os',items = 'row'),dom = 'Bfrtip',autoWidth = TRUE,buttons = list('copy',list(extend = 'collection',buttons = c('csv','excel','pdf','print'),text = 'Download'))),caption = tags$caption("Value2: #0: ",summarywidget(sdf,selection = ~Value2 == 0)," Value2: #1: ",selection = ~Value2 == 1)," Value2: #2: ",selection = ~Value2 == 2)),# This part is new: callback to get col number as `input$col`
callback = JS("table.on('click.dt','td',function() {
var col=table.cell(this).index().column;
var data = [col];
Shiny.onInputChange('col',data );
});")
)
},server = FALSE)
# plotly bar chart
output$plot <- renderPlotly({
req(input$col)
dat <- sdf$data(withSelection = TRUE) %>%
filter(selected_ == TRUE) %>%
pull(input$col) %>%
table()
fig <- plot_ly(
x = names(dat),y = dat,name = "Count",type = "bar"
)
fig
})
}
shinyApp(ui,server)
如果您只对列 Value2
感兴趣,那么下面的方法也适用:
library(shiny)
library(leaflet)
library(crosstalk)
library(DT)
library(dplyr)
library(htmltools)
library(summarywidget)
library(plotly)
library(d3scatter)
data_2 <- structure(
list(ID = 1:8,selection = ~Value2 == 2))
)
},server = FALSE)
# plotly bar chart
output$plot <- renderPlotly({
dat <- sdf$data(withSelection = TRUE) %>% filter(selected_ == TRUE)
p <- ggplot(data = dat,aes(x=factor(Value2))) +
geom_bar(stat="count",width=0.7,fill="steelblue")
ggplotly(p)
})
}
shinyApp(ui,server)
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。