在传单中使用条形图和散点图的问题 [英] Problem with using barplot and scatter plot in leaflet
本文介绍了在传单中使用条形图和散点图的问题的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我正在尝试在传单中同时使用散点图和条形图.日期表、传单和散点图工作正常.问题是当在传单中我们选择地图中的一些点时，条形图不起作用，如下图所示.为什么散点图可以正常工作，而条形图却不行?
I am trying to have both a scatter plot and a barplot in leaflet. The datetable, the leaflet and the scatter plot work fine. The problem is the barplot does not work when in leaflet we select some points in map as shown in the following figure. Why scatter plot works fine but bar plot does not?
如何解决这个问题?这是R代码:
How to solve this problem? Here is the R code:
#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", "A", "C", "B", "B",
"A", "B"), Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22), Value2 = c(0,
1, 1, 0, 0, 0, 0, 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", "blue", "green", "red", "red", "blue", "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,0), list(lmap, d3),list(dtable,ggplotly(ggplt)))
下面的代码显示了value2"的#0、#1 和#2 的计数.计算正确！(显示在数据表的标题中)但是条形图有问题！
The below code shows the counts of #0, #1 and #2 for "value2" calculated correctly! (showed in the caption of datatable) but something wrongs with barplot!!
#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", "A", "C", "B", "B",
"A", "B"), Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22), Value2 = c(0,
1, 1, 0, 0, 0, 0, 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", "blue", "green", "red", "red", "blue", "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
)
ggplt<-ggplotly(sdf %>% ggplot( aes(x=factor(Value2)))+
geom_bar(stat="count", width=0.7, fill="steelblue"))
d3<-d3scatter(sdf , x=~Value1 ,y=~Value2, width="100%", height=300)
dtable <- datatable(sdf , width = "100%",editable=TRUE,
caption=tags$caption("Value2: #0: ",summarywidget(sdf , selection=~Value2==0)
," Value2: #1: ",summarywidget(sdf , selection=~Value2==1)
," Value2: #1: ",summarywidget(sdf , selection=~Value2==2)
))
bscols( list(lmap, dtable),list(d3,ggplt), htmltools::p(summarywidget(sdf , selection=~Value2==0,column="Value2")
,summarywidget(sdf , selection=~Value2==1,column="Value2")
,summarywidget(sdf , selection=~Value2==2,column="Value2")
, style="display:none;"))
推荐答案
这里有一个闪亮的解决方案.我再次对您的数据表使用回调函数来对共享数据 sdf 进行子集化，以便您可以单击您感兴趣的列并显示条形图:
Here is a solution with shiny. Again I use a callback function with your datatable to subset the shared data sdf so you can click the column you are interested in and display a bar chart:
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", "A", "C", "B", "B", "A", "B"),
Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22),
Value2 = c(0, 1, 1, 0, 0, 0, 0, 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", "blue", "green", "red", "red", "blue", "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")),
column(6,
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: ", summarywidget(sdf, selection = ~Value2 == 1),
" Value2: #2: ", summarywidget(sdf, 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 感兴趣，那么下面的方法也可以:
If you are only interested in column Value2 then the approach below works as well:
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", "A", "C", "B", "B", "A", "B"),
Name2 = c("a", "b", "b", "a", "b", "a", "b", "c"),
Value1 = c(12, 43, 54, 34, 23, 77, 44, 22),
Value2 = c(0, 1, 1, 0, 0, 0, 0, 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", "blue", "green", "red", "red", "blue", "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")),
column(6,
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: ", summarywidget(sdf, selection = ~Value2 == 1),
" Value2: #2: ", summarywidget(sdf, 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)
这篇关于在传单中使用条形图和散点图的问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
