Upload a file and then geocode the addresses in shiny app - r

Question

Error while geocoding addresses in my shiny app
I wish to upload a file in my shiny app and and then calculate latitude and longitude.Below is the code and here is the LINK(https://github.com/Pujaguptagithub/My_Data) to the dataset used.Please help as I am new to shiny.
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)
The below code works perfect outside the shiny :
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)])
check my entire app below, the only problem is due to line "df_svb <- Latlong", please help to get rid off the error.
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)

Answer 1

UPDATE:
To add the data as a map, add this to the UI definition:
leafletOutput(outputId="myMap", height = 480)
And this will guide you on creating the server function:
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)
})
Original:
The issue seems to be in your call to the geocode function mp_get_points(). This is returning an xml document that can't be inserted into the new dataframe column ccc.
Is there any reason why you abandoned your original code? This seems to work fine if I insert it into your shiny app.
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
})