对我闪亮的应用程序中的地址进行地理编码时出错
我希望在我的闪亮应用中上传文件，然后计算纬度和经度。下面是代码，这是所使用的数据集的LINK（{https://github.com/Pujaguptagithub/My_Data）。请帮助，因为我不熟悉闪亮
library(shiny)
library(dplyr)
library(readxl)
library(sf)
library(mapsapi)
library(gsubfn)
library(pipeR)
ui <- fluidPage(
fileInput('csvFile', 'Choose xlsx file',
accept = c(".xlsx")),
tableOutput("rawData"),
tableOutput("modifiedData")
)
server <- function(input, output, session) {
rawData <- eventReactive(input$csvFile, {
read_excel(input$csvFile$datapath)
})
output$rawData <- renderTable({
rawData() %>% head
})
output$modifiedData <- renderTable({
rawData() %>% mutate(Locations = paste(as.character(rawData()$Address),
as.character(rawData()$City),as.character(rawData()$State),
as.character(rawData()$`Zip Code`), as.character(rawData()$Country),
sep=",")) %>%
mutate(aaa = gsub("NA;", "", Locations)) %>%
mutate(bbbb = mp_geocode(addresses = aaa, region = NULL, bounds = NULL,
key = "AIzaSyBQDna1fNBT5qeET39A0lp9nNEdezRLVyI")) %>%
mutate(ccc = mp_get_points(bbbb)) %>%
mutate(pnt = sub(ccc$pnt, pattern = "c", replacement = "")) %>%
mutate(eee = sub(pnt, pattern = "[(]", replacement = "")) %>%
mutate(ffff = sub(eee, pattern = "[)]", replacement = "")) %>%
mutate(gggg = sub(ffff, pattern = ",", replacement = "")) %>%
mutate(hhh = unlist(strsplit(gggg, split = " "))) %>%
mutate(Latitude = as.numeric(hhh[seq(2, length(hhh), 2)])) %>%
mutate(Longitude = as.numeric(hhh[seq(1, length(hhh), 2)]))
})
}
shinyApp(ui, server)
下面的代码在闪亮的外观之外非常完美：
Locations <- paste(Latlong$Address, Latlong$City,Latlong$State,Latlong$`Zip
Code`, Latlong$Country, sep=",")
Locations <- gsub("NA;", "", Locations)
Locations <- mp_geocode(addresses = Locations, region = NULL, bounds =
NULL, key = "AIzaSyBQDna1fNBT5qeET39A0lp9nNEdezRLVyI")
Locations = mp_get_points(Locations)
geom <- sub(Locations$pnt, pattern = "c", replacement = "")
geom <- sub(geom, pattern = "[(]", replacement = "")
geom <- sub(geom, pattern = "[)]", replacement = "")
geom <- sub(geom, pattern = ",", replacement = "")
lonlat <- unlist(strsplit(geom, split = " "))
Latlong$Latitude <- as.numeric(lonlat[seq(2, length(lonlat), 2)])
Latlong$Longitude <- as.numeric(lonlat[seq(1, length(lonlat), 2)])
在下面检查我的整个应用，唯一的问题是由于“ df_svb <-Latlong”这一行，请帮助摆脱该错误。
library(shinyjs)
library(shinyWidgets)
library(shiny)
library(shinydashboard)
library(tidyverse)
library(devtools)
library(rsconnect)
library(readxl)
library(DT)
library(writexl)
library(stringi)
library(shinydashboardPlus)
library(ggmap)
library(zipcode)
library(leaflet)
library(htmltools)
library(data.table)
library(plotly)
library(mapsapi)
library(readxl)
Template <- read_excel("C:/Users/Template.xlsx")
header <- dashboardHeader(
# Set height of dashboardHeader
tags$li(class = "dropdown",
tags$style(".main-header .logo {height: 0px;}")),
title = div(img(src = 'svb_small.png',
style = "position:absolute; left:15px;
height: 80px;"))
)
##### Sidebar
sidebar <- dashboardSidebar(
shinyjs::useShinyjs(),
width = 400,
menuItem('Inputs',
id = 'side_panel',
#icon = icon("bar-chart-o"),
startExpanded = TRUE,
br(), br(),
fileInput('csvFile', 'Choose xlsx file',
accept = c(".xlsx")),
div(style = "font-size: 150%; font-family: sans-serif;",
selectizeGroupUI(
id = "my_filters",
params = list(
Country = list(inputId = "Country", title = "Country:"),
Company = list(inputId = "Company", title = "Company:")),
inline = FALSE)),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
downloadBttn('downloadData',
label = 'Download Template',
style = "gradient",
color = "primary"
)
)
)
body <- dashboardBody(
tags$style(type = "text/css", "#map_1 {height: calc(100vh - 80px)
!important;}"),
addSpinner(
leafletOutput("map_1"),
spin = 'folding-cube')
)
# Put them together into a dashboardPage
ui <- dashboardPage(header,sidebar,body, skin = "black")
options(shiny.maxRequestSize = 15*1024^2)
server <- function(input, output, session) {
rawData <- eventReactive(input$csvFile, {
read_excel(input$csvFile$datapath)
})
# Download template
output$downloadData <- downloadHandler(
filename = function() {"CBRE Geocoding and mapping Application.xlsx"},
content = function(file) {write_xlsx(Template, path = file)}
)
#SelectizeGroup function creates mutually dependent input filters
res_mod <- callModule(
module = selectizeGroupServer,
id = "my_filters",
data = df_svb,
vars = c('Country', 'Company')
)
modifiedData <- renderTable({
Latlong <- rawData()
Locations <- paste(Latlong$Address,
Latlong$City,Latlong$State,Latlong$`Zip Code`,
Latlong$Country, sep=",")
Locations <- gsub("NA;", "", Locations)
Locations <- mp_geocode(addresses = Locations, region = NULL, bounds=
NULL, key =
"AIzaSyBQDna1fNBT5qeET39A0lp9nNEdezRLVyI")
Locations = mp_get_points(Locations)
geom <- sub(Locations$pnt, pattern = "c", replacement = "")
geom <- sub(geom, pattern = "[(]", replacement = "")
geom <- sub(geom, pattern = "[)]", replacement = "")
geom <- sub(geom, pattern = ",", replacement = "")
lonlat <- unlist(strsplit(geom, split = " "))
Latlong$Latitude <- as.numeric(lonlat[seq(2, length(lonlat), 2)])
Latlong$Longitude <- as.numeric(lonlat[seq(1, length(lonlat), 2)])
Latlong
})
############################################################
df_svb <- Latlong
df_svb <- Latlong%>% mutate(
X = paste0('<font color="#006A4D">',
'<font-family: sans-serif>',
'<font size = "5">',
'<strong><font color="black">Country: </font color="black">
</strong>',
Country,
'<br><strong><font color="black">Company: </font color="black">
</strong>',
Company))
qpal <- colorFactor("BuPu", as.factor(df_svb$Company))
output$map_1 <- renderLeaflet(
leaflet(data = res_mod()) %>%
setView(-94.578568, 39.099728, zoom = 5) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Imagery Map") %>%
addProviderTiles(providers$Esri.WorldStreetMap, group = 'Street Map') %>%
addCircleMarkers(~Longitude, ~Latitude, group = 'svb',
fillColor = ~qpal(res_mod()$Company),
color = c("#006A4D","#FF0000"),
stroke = FALSE,
fillOpacity = 15,radius = 15,
labelOptions = labelOptions(noHide = T)
) %>%
addLayersControl(baseGroups = c('Street Map', "Imagery Map"),
options = layersControlOptions(collapsed = TRUE)) %>%
hideGroup('CBRE Locations') %>%
addLegend("topright", pal = qpal, values = ~res_mod()$Company,
title = "Company:", opacity = 1,group = 'svb' )
)
#Zooms in map when 1 office is chosen.
observe({
req(n_distinct(res_mod()$Country) == 1)
proxy <- leafletProxy('map_1')
proxy %>% setView(head(res_mod()$Longitude,1),
head(res_mod()$Latitude,1), zoom = 12)
})
}
shinyApp(ui, server)
答案 0 :(得分：0)
更新：
要将数据添加为地图，请将其添加到UI定义：
leafletOutput(outputId="myMap", height = 480)
这将指导您创建服务器功能：
output$myMap <- renderLeaflet({
# Test Data
#name <- c("London","Paris","Dublin")
#latitude <- c(51.5074,48.8566, 53.3498)
#longitude <- c(0.1278,2.3522, -6.2603)
#Latlong <- data.frame(name, latitude, longitude)
# Convert data frame to shape
coordinates(Latlong)<-~longitude+latitude
proj4string(Latlong)<- CRS("+proj=longlat +datum=WGS84")
shapeData <- spTransform(data,CRS("+proj=longlat"))
# Map the shape
map <- tm_shape(shapeData, name="Cities") +
tm_dots(size=0.2,title="Cities") +
tm_basemap("OpenStreetMap")+
tm_basemap("Esri.WorldImagery")
tmap_leaflet(map)
})
原文：
问题似乎出在您对地址解析函数mp_get_points（）的调用中。这将返回无法插入新的数据框列ccc的xml文档。
您是否有任何理由放弃原始代码？如果我将其插入您闪亮的应用程序，这似乎很好用。
output$modifiedData <- renderTable({
Latlong <- rawData()
Locations <- paste(Latlong$Address, Latlong$City,Latlong$State,Latlong$`Zip
Code`, Latlong$Country, sep=",")
Locations <- gsub("NA;", "", Locations)
Locations <- mp_geocode(addresses = Locations, region = NULL, bounds =
NULL, key = "AIzaSyBQDna1fNBT5qeET39A0lp9nNEdezRLVyI")
Locations = mp_get_points(Locations)
geom <- sub(Locations$pnt, pattern = "c", replacement = "")
geom <- sub(geom, pattern = "[(]", replacement = "")
geom <- sub(geom, pattern = "[)]", replacement = "")
geom <- sub(geom, pattern = ",", replacement = "")
lonlat <- unlist(strsplit(geom, split = " "))
Latlong$Latitude <- as.numeric(lonlat[seq(2, length(lonlat), 2)])
Latlong$Longitude <- as.numeric(lonlat[seq(1, length(lonlat), 2)])
Latlong
})