library(shiny)
library(leaflet)
library(RMySQL)
library(DBI)
data <- function(con){
con <- dbConnect(MySQL(), dbname="", host="localhost",
port = , user="",
password="")
dbSendQuery(con, "SEt NAMES euckr")
d <- dbGetQuery(con, "select * from accidents")
dbDisconnect(con)
}
原始数据(d)包含信息:事故发生地点、事故发生年份、事故发生数量、经度、纬度等等...
这是UI界面。
ui <- navbarPage("Interactive Map",
tabPanel("Map",
leafletOutput("m", height=800),
tags$style("
#controls {
backgropund-color: #ddd;
opacity: 0.7;
}
#controls:hover{
opacity: 1;
}
"),
absolutePanel(id = "controls", class="panel panel-default",
fixed =TRUE, draggable = TRUE, top=60, left="auto",
right=20, bottom ="auto", width=250, height=450,
sliderInput("year",
"years:",
min=min(d$acci_year),
max=max(d$acci_year),
value=range(d$acci_year),
step=1, sep=""))))
这是服务器
server <- function(input, output, session){
filteredData <- reactive({
d[d$acci_year >= input$year[1] & d$acci_year <= input$year[2],]
})
d_colour <- colorFactor("viridis", d$acci_type)
output$m <- renderLeaflet({
leaflet(d) %>%
setView(lng = 126.97806, lat=37.56667, zoom=13) %>%
addTiles() %>%
addCircles(lng=~d$longitude, lat=~d$latitude, color=~d_colour(d$acci_type), radius=20,
popup=paste0("<br>accident place:", d$accident_address, "<br>accident year:", d$acci_year, "<br>발생건수:", d$발생건수,
"<br>사상자수:", d$사상자수, "<br>사망자수:", d$사망자수,
"<br>중상자수:", d$중상자수, "<br>경상자수:", d$경상자수,
"<br>부상자수:", d$부상자수)) %>%
addLegend(position = "bottomleft",
title = "types of accident",
pal = d_colour, values = ~d$acci_type, opacity = 1)
})
d_colour <- colorFactor("viridis", d$acci_type)
observe({
leafletProxy("m", data=filteredData()) %>%
clearShapes() %>%
addCircles(lng=~d$longitude, lat=~d$latitude, color=~d_colour(d$acci_type), radius=20,
popup=paste0("<br>accident place:", d$accident_address, "<br>accident year:", d$acci_year, "<br>발생건수:", d$발생건수,
"<br>사상자수:", d$사상자수, "<br>사망자수:", d$사망자수,
"<br>중상자수:", d$중상자수, "<br>경상자수:", d$경상자수,
"<br>부상자수:", d$부상자수))
})
}
shinyApp(ui=ui, server=server)
我替你把一些变量名从韩文改为英文!但由于这个函数的问题,我已经一个星期无法进行下一步操作了。非常感谢你的回复!!