Shiny 调用地理编码服务示例

注:因百度地图的地图调起API及天地图的静态图API嵌入Shiny APP IFRAME碰到问题,还未找到具体原因,转换坐标系后暂时分别在高德、腾讯地图中标注显示。
show with app
library(reticulate)

location<- substr(getwd(),1,4)
# 调用Pyhton脚本连接 Neo4j, Neo4j的官方Python Driver比开源R Driver好用。
if (location != '/srv'){    # Rstudio 开发环境
  part<- '~'
}else{                       # 服务器部署环境
  part<- '..'
}
path<- paste(part,"/scripts/","test_GeoCode.py",sep="")
t1<-proc.time()
source_python(path)
t2<-proc.time()
cat(t2-t1);cat("\n")

# 1.天地图 提供的是静态地图及标注夫妇,不是其它地图的地图调起API
TDURL_mask<- function (location,address, application_key){
  url_a <- 'http://api.tianditu.gov.cn/staticimage? width=1024&height=1024&zoom=18&layers=vec_c,cva_c'
  url_b <- paste("&center=", location, "&markers=", location, "&markerStyles=-1,,", address, sep="")
  url_c <- paste('&tk=', application_key, sep="")
  URL <- URLencode(paste(url_a, url_b, url_c, sep=""))
  # cat(URL)
  # browseURL(URL)
  return (URL)
}

# 2.腾讯地图 
TxURL_mask<- function(location, address){
  url_a <- 'https://apis.map.qq.com/uri/v1/marker?marker=coord:'
  url_b <- paste(location, ";title:", address, ";addr:", address, sep="")
  url_c <- '&ref=myapp'
  URL <- URLencode(paste(url_a, url_b, url_c, sep=""))
  # cat(URL)
  # browseURL(URL)
  return (URL)
}

# 3.高德地图 
GaoDeURL_mask<- function(location, address){
  url_a <- 'https://uri.amap.com/marker'
  url_b <- paste("?markers=", location, ",", address, sep="")
  url_c <- '&src=mypage&callnative=0'
  URL <- URLencode(paste(url_a, url_b, url_c, sep=""))
  # cat(URL)
  # browseURL(URL)
  return (URL)
}

# 4.百度地图
BaiDuURL_mask<- function(location, address){
  url_a <- 'http://api.map.baidu.com/marker'
  url_b <- paste("?location=", location, "&title=", address, "&content=", address, sep="")
  url_c = '&output=html&src=webapp.baidu.openAPIdemo&zoom=20'
  URL <- URLencode(paste(url_a, url_b, url_c, sep=""))
  # cat(URL)
  # browseURL(URL)
  return (URL)
}
# embed iframe inside shiny app
# https://stackoverflow.com/questions/33020558/embed-iframe-inside-shiny-app/33021018#33021018
shinyServer(function(input, output, session) {
  
  vendor<- reactive({
    input$vendor
  })
  
  address<- reactive({
    input$address
  })
  
  observe({
     print(vendor())
     print(address())
  })
  
  output$longlat<-renderText({
    if (vendor()=='天地图')
      location<- TDGeoCode(address())
    else if (vendor()=='腾讯')
      location<- TXGeoCode(address())
    else if (vendor()=='高德')
      location<- GDGeoCode(address())
    else if (vendor()=='百度')
      location<- BDGeoCode(address())
    
    paste(vendor(),paste(location[[1]],location[[2]],sep=" , "),sep=" : ")
  })
  
  output$frame <- renderUI({
    # application_key <- "**********************"
    
    if (vendor()=='天地图'){
      location<- TDGeoCode(address())
      location2<- wgs2gcj(location[[1]], location[[2]])
      # url<- TDURL_mask(paste(location[[1]],location[[2]],sep=","), address(), application_key)
      url<- GaoDeURL_mask(paste(location2[[1]],location2[[2]],sep=","), address())
    }else if (vendor()=='腾讯'){
      location<- TXGeoCode(address())
      url<- TxURL_mask(paste(location[[2]],location[[1]],sep=","), address())
    }else if (vendor()=='高德'){
      location<- GDGeoCode(address())
      url<- GaoDeURL_mask(paste(location[[1]],location[[2]],sep=","), address())
    }else if (vendor()=='百度'){
      location<- BDGeoCode(address())
      location2<- bd2gcj(location[[1]], location[[2]])
      # url<- BaiDuURL_mask(paste(location[[2]],location[[1]],sep=","), address())
      url<- TxURL_mask(paste(location2[[2]],location2[[1]],sep=","), address())
    }
    my_test <- tags$iframe(src=url, height=600, width="100%")
    print(my_test)
    my_test
  })
  
})
fluidPage(
  tags$head(
    tags$script(HTML("
                // 触发了shiny:inputchanged事件,屏蔽输入引起的改变
                $(document).on('shiny:inputchanged', function(event) {
                    if (event.name === 'address') {
                        event.preventDefault();                    
                    }
                });    
    
                // 点击时触发识别    
                $(document).on('click', '.btn-success', function (evt) {
                      evt.preventDefault(); 
                      var address = document.getElementById('address');
                      if (address.value ==null || address.value ==''){
                         alert('没有输入地址!');
                      }else{
                          try{
                            Shiny.setInputValue('address', address.value);
                          } catch(error){
                            alert(error);
                          }
                      }
                });  
    
              "))
  ),
  
  titlePanel("Shiny 调用地理编码服务示例"), 
  HTML("
            <table width='100%'>
                <tr>
                    <td width='20%'> 
           "),
  selectInput(
    'vendor',
    '地图',
    c('百度','高德','腾讯','天地图'),
    selected = '高德'
    # c('腾讯','天地图'),
    # selected = '腾讯'
  ),
  HTML("
                    </td>
                    <td width='60%'>
           "),
  textInput("address","地址:", value ="珠海市香洲区乐园路88号碧湾花园2栋901", width="400px"),
  HTML("
                    </td>
                    <td width='20%'>
           "),
  actionButton("geocode", "解析并标示", class = "btn-success"),
  HTML("
                    </td>
                    </tr>
                    <tr>
                    <td>
           "),
  textOutput("longlat"),
  HTML("
                    </td>
                    <td  colspan=2>
注:因百度地图的地图调起API及天地图的静态图API嵌入Shiny APP IFRAME碰到问题,还未找到具体原因,转换坐标系后暂时分别在高德、腾讯地图中标注显示。                  
                    </td>
                    </tr>
                    <tr>
                    <td colspan=3>
           "),
  htmlOutput("frame"),
  HTML("
                    </td>
                    </tr>
                    </table>
           ")
)