-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathapp.R
77 lines (57 loc) · 2.76 KB
/
app.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
library(shiny)
library(bslib)
library(tidyr)
library(tidyverse)
library(dplyr)
library(sass)
library(leaflet)
library(sp)
library(igraph)
library(rmarkdown)
dataset <- readRDS("dataset.RDS")
vertbus <- readRDS("vertbus.RDS")
edges <- readRDS("edges.RDS")
dias=union(as.character(dataset$Dia.Semana),as.character(dataset$Dia.Semana))
rotas=intersect(dataset$Rota,dataset$Rota)
df
bs_global_theme()
bs_global_add_variables( "body-bg" = "")
##define ui
ui <- fluidPage(
titlePanel("Rede de transporte coletivo de Belo Horizonte"),
##agora, mostrando o mapa gerado
leafletOutput("map", width = "1000", height = "1000"),
absolutePanel(top = 10, right= 10,
selectInput("Pesos", label = "Pesos",
choices = c("Embarque", "Desembarque", "Saldo")
))
)
##server
server <- function(input, output){
##criando o mapa
output$map <- renderLeaflet({
leaflet() %>% addTiles()%>%
addPolylines(data = edges, weight = 1.5, opacity = 0.15, color = "black", fillOpacity = 0.9)
})
observe({
peso <- input$Pesos
if (is.null(peso))
return()
mybins <- quantile(vertbus$avg)
pal <- colorBin(palette = "Purples", domain = vertbus$avg, na.color="transparent", alpha = 0.9, bins = mybins)
mybins1 <- quantile(vertbus$avg1)
pal1 <- colorBin(palette = "YlGnBu", domain = vertbus$avg1, na.color="transparent", alpha = 0.9, bins = mybins1)
mybins2 <- quantile(vertbus$avg2)
pal2 <- colorBin(palette = "YlOrBr", domain = vertbus$avg2, na.color="transparent", alpha = 0.9, bins = mybins2)
leafletProxy("map", data = vertbus) %>%
addCircleMarkers(fillColor = ~pal(avg), fillOpacity = 0.7, color="white", radius=3, stroke=FALSE, group="Saldo") %>%
addCircleMarkers(fillColor = ~pal1(avg1), fillOpacity = 0.7, color="white", radius=3, stroke=FALSE, group="Desembarque")%>%
addCircleMarkers(fillColor = ~pal2(avg2), fillOpacity = 0.7, color="white", radius=3, stroke=FALSE, group="Embarque") %>%
#legenda
addLegend( pal=pal, values=~avg, opacity=0.9, title = "Saldo", position = "bottomright", group="Saldo") %>%
addLegend( pal=pal1, values=~avg1, opacity=0.9, title = "Desembarque", position = "bottomright", group="Desembarque" ) %>%
addLegend( pal=pal2, values=~avg2, opacity=0.9, title = "Embarque", position = "bottomright", group="Embarque" ) %>%
addLayersControl(overlayGroups = peso, options = layersControlOptions(collapsed = FALSE))
})
}
shinyApp(ui = ui, server = server)