R(七):R开发实例-map热力图

     第四章通过REmap包完成基于map分布图示例，前面提到REmap基于Echart2.0, 一方面在移动终端适应效果差，另一方面REmap提供的热力图仅支持全国及省市大版块map，基于上面的原因，参考 http://echarts.baidu.com/examples.html#chart-type-heatmap ，利用第四章清洗后的数据结合Echart3热力图控件开发完整可缩放地图的热力分布。

目录：

• 效果图
• 在线构建Echart3脚本包
• R热力图页面模板
• R脚本

效果图：

在线构建Echart3脚本包:

• 在浏览器打开 http://echarts.baidu.com/builder.html， 选择 "下载" -->"在线构建", 在打开的页面选择要打包的图表，点击 “下载”
• 简单起见，你可以选择所有控件后打包， build 完后保存为 “echarts3.min.js”

R热力图页面模板：

• 参考Echart 热力图文档，在R脚本定义模板及Class, 保存命名：DemoTemp.R
• 示例代码如下：
  

  setClass("my.map",
           representation(
             id = "character",
             option = "character",
             content = "character"
           ))
  
  my.mapH = function(data) {
    
    if (.Platform$OS.type == "windows") {
      locate = Sys.getlocale("LC_CTYPE")
      Sys.setlocale("LC_CTYPE", "eng")
    }
    
    if (!is.data.frame(data)) {
      stop("Map data should be a data frame.")
    }
    
    if (ncol(data) <3 | nrow(data) == 0) {
      stop("Data should have at least 3 columns and 1 row")
    }
    
    
    if (!is.numeric(data[1, 1]) |
        !is.numeric(data[1, 2]) |
        !is.numeric(data[1, 3])) {
      data[, 1] = as.numeric(data[, 1])
      data[, 2] = as.numeric(data[, 2])
      data[, 3] = as.numeric(data[, 3])
    }
    
    
    heatdata = apply(data, 1, function(x) {
      out = sprintf('[%s,%s,%s]', x[1], x[2], x[3])
      return(out)
    })
    
    heatdata = paste(heatdata, collapse = ",\n")
    
    ### write remap object
    output = new("my.map")
    output@id = paste('ID', format(Sys.time(), "%Y%m%d%H%M%S"),
                      round(proc.time()[3] * 100), sep = "_")
    
    output@option = html.data.H$option
    head = html.data.H$head
    foot = html.data.H$foot
    
    if (.Platform$OS.type == "windows") {
      Sys.setlocale("LC_CTYPE", "chs")
    }
    
    output@option = sub("forChange", "һ", output@option)
    
    output@option = sub("heatMapData",
                        heatdata, output@option)
    
    ## optionNameData
    output@option = sub("optionNameData",
                        paste0("option", output@id), output@option)
    outputFoot = sub("optionNameData",
                     paste0("option", output@id), foot)
    
    output@option = strsplit(output@option, "kkkmmm")[[1]][2]
    output@content = paste(head, output@option, outputFoot, sep = "\n")
    
    if (.Platform$OS.type == "windows") {
      Sys.setlocale("LC_CTYPE", locate)
    }
    return(output)
  }
  
  
  html.data.H = list(
    head = "
    
    "utf-8\">
    
    
    
    
  "main\">
  
    
    
    
    
    
    "
    )

  View Code

 R脚本：

•  R脚本代码，demo.rda 为清洗后保存的数据，示例
  

  run <- function(...) {
    map_name <- my.writeMapH()
    out(map_name)
  }
  
  my.writeMapH <- function() {
    
    path = c("/var/www/html")
    file_name = paste0("3.0/Demo")
    full_path = paste0(path, "/", file_name, ".html")
    if (file.exists(full_path)) {
      return(file_name)
    }
    
    source("/var/FastRWeb/web.R/DemoTemp.R")
    tmp <- load("/var/FastRWeb/web.R/demo.rda")
    data <- data.frame(pdata$lon,pdata$lat,c(1))
    out <- my.mapH(data)
    
    writeLines(out@content, full_path, useBytes = T)
    return(file_name);
  }

  View Code
•  通过FastRWeb框架调用R脚本成功后，返回的是在/var/www/html目录下生成的文件名
• client再次发起请求，调用html文件
• 注意： 在/var/www/html 目录下部署脚本引用的 js 文件