• Posts tagged "R包"

Blog Archives

R包开发每日中国天气

R的极客理想系列文章,涵盖了R的思想,使用,工具,创新等的一系列要点,以我个人的学习和体验去诠释R的强大。

R语言作为统计学一门语言,一直在小众领域闪耀着光芒。直到大数据的爆发,R语言变成了一门炙手可热的数据分析的利器。随着越来越多的工程背景的人的加入,R语言的社区在迅速扩大成长。现在已不仅仅是统计领域,教育,银行,电商,互联网….都在使用R语言。

要成为有理想的极客,我们不能停留在语法上,要掌握牢固的数学,概率,统计知识,同时还要有创新精神,把R语言发挥到各个领域。让我们一起动起来吧,开始R的极客理想。

关于作者:

  • 张丹(Conan), 程序员Java,R,PHP,Javascript
  • weibo:@Conan_Z
  • blog: http://blog.fens.me
  • email: bsspirit@gmail.com

转载请注明出处:
http://blog.fens.me/r-package-chinaweather/

r-package-chinaweather

前言

本节将继续R语言天气可视化应用一文的内容,把我们已经完成的R语言程序,封装成R语言程序包。这个看起来简单的任务,其实要花很多的时间来处理细节。整个的R包开发过程,将按照文章在巨人的肩膀前行 催化R包开发的流程进行,为了保证check()函数的顺利执行,代码有多处改动。

目录

  1. 构建项目
  2. 静态数据
  3. 编写功能代码
  4. 项目配置文件
  5. 调试程序
  6. 程序打包

1. 构建项目

R语言天气可视化应用一文,我们写的R程序都在Window中完成,由于R的跨平台代码有兼容性的问题,我们的应用程序最终将在Linux中发布,所以为了减少发布时不必要的麻烦,我们转到Linux系统中完成R包的开发。

本节的系统环境

  • Linux: Ubuntu Server 12.04.2 LTS 64bit
  • R: 3.1.1 x86_64-pc-linux-gnu (64-bit)
  • RStudio-Server 0.97.551

在巨人的肩膀前行 催化R包开发文中,我们其实已经创建好了chinaWeather项目,那么R包的开发将继续在这个项目中进行。进入chinaWeather项目的目录,我单独开一个Git分支,进行本节的R包开发。


~ cd /home/conan/R/chinaWeather     # 进入项目目录
~ git branch app                    # 新建分支,名为app
~ git checkout app                  # 切换到分支app
~ git branch                        # 查看当查的分支
  * app
    master

查看Linux系统中,R语言环境变量的设置,字符集是特别要处理的部分。


> sessionInfo()
R version 3.1.1 (2014-07-10)
Platform: x86_64-pc-linux-gnu (64-bit)

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C
 [3] LC_TIME=zh_CN.UTF-8        LC_COLLATE=en_US.UTF-8
 [5] LC_MONETARY=zh_CN.UTF-8    LC_MESSAGES=en_US.UTF-8
 [7] LC_PAPER=zh_CN.UTF-8       LC_NAME=C
 [9] LC_ADDRESS=C               LC_TELEPHONE=C
[11] LC_MEASUREMENT=zh_CN.UTF-8 LC_IDENTIFICATION=C

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base

环境准备就绪,下面就是开始R包开的工作了。

2. 静态数据

在开始写R包代码之前,我们需要先来整理一下静态数据。 这个项目中,静态数据包括了地图数据、WOEID映射数据、天气概况的映射数据、中英文图片可视化数据、测试数据集。对于普通的R应用程序来说可以用CSV格式文件保存在本地,但对于R包项目来说,最好是封装成rda的数据文件,随R包一起打包发布。

首先,我们就要对这些静态数据文件进行整理,新建目录metadata,用于存储原始CSV文件和地图文件。


~ mkdir /home/conan/R/chinaWeather/metadata         # 新建目录,并把原数据文件复制到metadata目录
~ ls -l /home/conan/R/chinaWeather/metadata         # 查看metadata目录
-rw-rw-r-- 1 conan conan 3396 10月  4 22:14 20141001.csv         # 测试数据集
-rw-r--r-- 1 conan conan  754  2月  5  2013 ADCODE99.csv         # ADCODE99与省份中文映射数据
-rw-r--r-- 1 conan conan 1418  2月  6  2013 code.csv             # 天气概况映射数据
-rw-r--r-- 1 conan conan  214  2月  6  2013 labelcode.csv        # 天气概况映射数据
drwxr-xr-x 2 conan conan 4096  4月 23  2013 mapdata              # 地图数据目录
-rw-rw-r-- 1 conan conan 1900  2月  4  2013 WOEID.csv            # WOEID映射数据

~ ls -l /home/conan/R/chinaWeather/metadata/mapdata     # 查看地图数据文件
-rw-r--r-- 1 conan conan   86283  4月 10  1999 bou2_4p.dbf
-rw-r--r-- 1 conan conan 1508752  4月 10  1999 bou2_4p.shp
-rw-r--r-- 1 conan conan    7500  4月 10  1999 bou2_4p.shx

把静态数据转换为rda格式的文件,存储在data目录中。


~ mkdir /home/conan/R/chinaWeather/data       # 新建目录data
~ R                                           # 启动R语言程序。

2.1 WOEID数据文件 WOEID.rda

对WOEID数据进行处理,把adcode99代码合并到WOEID数据集中,合并WOEID.csv文件和ADCODE99.csv文件的数据,生成WOEID.rda的文件。


> WOEID<-read.csv(file="metadata/WOEID.csv",header=FALSE,fileEncoding="utf-8", encoding="utf-8")     # 加载WOEID数据集
> names(WOEID)<-c("en","woeid","zh",'prov','long','lat')
> adcode99<-read.csv(file="metadata/ADCODE99.csv",header=TRUE,fileEncoding="utf-8", encoding="utf-8")     # 加载ADCODE99数据集

> fc<-function(row){
+     code<-adcode99$ADCODE99[which(row[4]==as.character(adcode99$prov))]
+     if(length(code)==0)code=0
+     code
+ }
> WOEID<-cbind(WOEID,adcode99=unlist(apply(WOEID,1,fc)))                # 合并数据集
> save(WOEID,file="data/WOEID.rda")                                     # 生成WOEID.rda文件

> WOEID     # 合并后的WOEID数据集
               en    woeid       zh             prov      long      lat adcode99
  1       beijing  2151330     北京           北京市 116.46667 39.90000   110000
  2      shanghai  2151849     上海           上海市 121.48333 31.23333   310000
  3        tianji  2159908     天津           天津市 117.18333 39.15000   120000
  4     chongqing 20070171     重庆           重庆市 106.53333 29.53333   500000
  5        harbin  2141166   哈尔滨         黑龙江省 126.68333 45.75000   230000
  6     changchun  2137321     长春           吉林省 125.31667 43.86667   220000
  7      shenyang  2148332     沈阳           辽宁省 123.40000 41.83333   210000
  8        hohhot  2149760 呼和浩特     内蒙古自治区 111.80000 40.81667   150000
  9  shijiazhuang  2171287   石家庄           河北省 114.46667 38.03333   130000
  10     wulumuqi 26198317 乌鲁木齐 新疆维吾尔自治区  87.60000 43.80000   650000
  11      lanzhou  2145605     兰州           甘肃省 103.81667 36.05000   620000
  12       xining  2138941     西宁           青海省 101.75000 36.63333   630000
  13         xian  2157249     西安           陕西省 108.90000 34.26667   610000
  14     yinchuan  2150551     银川   宁夏回族自治区 106.26667 38.33333   640000
  15    zhengzhou  2172736     郑州           河南省 113.70000 34.80000   410000
  16        jinan  2168327     济南           山东省 117.00000 36.63333   370000
  17      taiyuan  2154547     太原           山西省 112.56667 37.86667   140000
  18        hefei  2127866     合肥           安徽省 117.30000 31.85000   340000
  19        wuhan  2163866     武汉           湖北省 114.35000 30.61667   420000
  20     changsha 26198213     长沙           湖南省 113.00000 28.18333   430000
  21      nanjing  2137081     南京           江苏省 118.83333 32.03333   320000
  22      chengdu  2158433     成都           四川省 104.08333 30.65000   510000
  23      guiyang  2146703     贵阳           贵州省 106.70000 26.58333   520000
  24      kunming  2160693     昆明           云南省 102.68333 25.00000   530000
  25      nanning  2166473     南宁   广西壮族自治区 108.33333 22.80000   450000
  26         lasa 26198235     拉萨       西藏自治区  91.16667 29.66667   540000
  27     hangzhou  2132574     杭州           浙江省 120.15000 30.23333   330000
  28     nanchang 26198151     南昌           江西省 115.86667 28.68333   360000
  29    guangzhou  2161838     广州           广东省 113.25000 23.13333   440000
  30       fuzhou  2139963     福州           福建省 119.30000 26.08333   350000
  31       taipei  2306179     台北           台湾省 121.51667 25.05000   710000
  32       haikou  2162779     海口           海南省 110.33333 20.03333   460000
  33     hongkong 24865698     香港   香港特别行政区 114.16667 22.30000   810000
  34        macau 20070017     澳门   澳门特别行政区 113.50000 22.20000        0

我们看到WOEID数据集包括了中文字符,而R语言的rda的规范中,要求不能包括ASCII以外的字符集了。在执行check()检查的过程中,就会遇到非法字符集的警告错误。因此,就需要对中文数据集进行特殊转码处理,把中文字符统一转码成unicode来表示,如 北京 unicode转码后表示为 \u5317\u4eac。当数据集用于中文显示的时候,需要再反转unicode到中文,这样就可以中文与R语言程序的兼容了。

对WOEID的数据集转码处理,我们需要用到stringi包。


> install.packages("stringi")     # 安装stringi包
> library("stringi")              # 加载stringi包

通过 stri_escape_unicode()函数,对WOEID数据集的zh和prov列的中文进行unicode转码。


> WOEID$prov<-stri_escape_unicode(WOEID$prov)       # 对WOEID$prov列转码
> WOEID$zh<-stri_escape_unicode(WOEID$zh)           # 对WOEID$zh列转码
> save(WOEID,file="data/WOEID.rda",compress=TRUE)    # 保存数据集

> head(WOEID)            # 查看转码后的WOEID数据集
         en    woeid                          zh                                 prov     long      lat adcode99 adcode99
1   beijing  2151330          \\u5317\\u4eac          \\u5317\\u4eac\\u5e02 116.4667 39.90000   110000   110000
2  shanghai  2151849          \\u4e0a\\u6d77          \\u4e0a\\u6d77\\u5e02 121.4833 31.23333   310000   310000
3    tianji  2159908          \\u5929\\u6d25          \\u5929\\u6d25\\u5e02 117.1833 39.15000   120000   120000
4 chongqing 20070171          \\u91cd\\u5e86          \\u91cd\\u5e86\\u5e02 106.5333 29.53333   500000   500000
5    harbin  2141166 \\u54c8\\u5c14\\u6ee8 \\u9ed1\\u9f99\\u6c5f\\u7701 126.6833 45.75000   230000   230000
6 changchun  2137321          \\u957f\\u6625          \\u5409\\u6797\\u7701 125.3167 43.86667   220000   220000

我们再试一下,把unicode的数据转码成原来的中文字符,通过stri_unescape_unicode()函数实现。


> head(stri_unescape_unicode(WOEID$prov))
[1] "北京市"   "上海市"   "天津市"   "重庆市"   "黑龙江省" "吉林省"

> head(stri_unescape_unicode(WOEID$zh))
[1] "北京"   "上海"   "天津"   "重庆"   "哈尔滨" "长春"

转码的操作正常,所以在遇到非ASCII的字符集,我们就可以用这种方式进行转换了。

2.2 地图数据文件 chinaMap.rda

对地图数据进行处理,加载原始地图数据,生成chinaMap.rda文件。在chinaMap对象中,NAME列也是中文字符,但Linux系统在加载地图数据时,字符编码已经被修改,我们不能看到编码类型,所以这里不能通过上面所说的unicode转码。NAME列数据,我们刚好用不到,一种简单的操作方法就是将他从数据集中去掉。


> library(maps)
> library(mapdata)
> library(maptools)
> chinaMap<-readShapePoly('metadata/mapdata/bou2_4p.shp')       # 加载地图数据

> head(chinaMap$NAME)                       # NAME列,非ASCII编码
[1] \xba\xda\xc1\xfa\xbd\xadʡ
[2] \xc4\xda\xc3ɹ\xc5\xd7\xd4\xd6\xce\xc7\xf8
[3] \xd0½\xaeά\xce\xe1\xb6\xfb\xd7\xd4\xd6\xce\xc7\xf8
[4] \xbc\xaa\xc1\xd6ʡ
[5] \xc1\xc9\xc4\xfeʡ
[6] \xb8\xca\xcb\xe0ʡ
33 Levels: \xb0\xb2\xbb\xd5ʡ ... \xd6\xd8\xc7\xec\xca\xd0

> chinaMap<-chinaMap[,c(1:6)]              # 去掉NAME列
> save(chinaMap,file="data/chinaMap.rda",compress='xz')          # 生成chinaMap.rda文件

2.3 中英文图片可视化数据 props.rda

对于可视化的图片输出时,用于中文名的字段显示,生成props.rda文件,中文编码通过转成unicode进行处理。


> props<-data.frame(
+     key=c('high','low'),
+     zh=c('中国各省白天气温','中国各省夜间气温'),
+     en=c('Daytime Temperature','Nighttime Temperature')
+ )
> props$zh<-stri_escape_unicode(props$zh)
> save(props,file="data/props.rda",compress=TRUE)

2.4 测试数据集weather20141001.rda

以2014年10月01日的天气数据集,做为一个demo数据集,生成weather20141001.rda文件,中文编码通过转成unicode进行处理。


> weather20141001<-read.csv(file="metadata/20141001.csv",header=TRUE,fileEncoding="utf-8", encoding="utf-8")  # 加载数据庥
> weather20141001$prov<-stri_escape_unicode(weather20141001$prov)          # 对weather20141001$prov列转码
> weather20141001$zh<-stri_escape_unicode(weather20141001$zh)              # 对weather20141001$zh列转码
> save(weather20141001,file="data/weather20141001.rda",compress=TRUE)      # 生成weather20141001.rda文件。

查看data目录下面的文件列表,生成了4个静态数据集文件。


> dir('data')
[1] "WOEID.rda"   "chinaMap.rda"   "props.rda"  "weather20141001.rda"

我们把所有的静态数据集先整理好,下面的R包代码,就可以直接使用这些静态数据集了。

3. 编写功能代码

按照函数功能的不同,我们定义4个文件来描述这些函数。

  • getData.R,用于定义爬去数据的函数。
  • render.R,用于静态图片可视化渲染的函数。
  • chinaWeather.R,用于定义各种工具函数。
  • chinaWeather-packages.R,用于定义R包内的数据集。

3.1 文件 getData.R

新建文件getData.R,用于爬取数据和XML文档解析,文件中定义了3个函数。

  • getWeatherFromYahoo(), 从Yahoo的开放数据源,获取天气数据。
  • getWeatherByCity(), 通过城市英文名,获取当前城市的天气数据。
  • getWeather(), 获取中国省会城市的天气数据,在WOEID数据集中定义的城市。

~ vi R/getData.R

#' Get weather data from Yahoo openAPI.
#'
#' @importFrom RCurl getURL
#' @importFrom XML xmlTreeParse getNodeSet xmlGetAttr
#' @param woeid input a yahoo woeid
#' @return data.frame weather data
#' @keywords weather
#' @export
#' @examples
#' \dontrun{
#'  getWeatherFromYahoo()
#'  getWeatherFromYahoo(2151330)
#' }
getWeatherFromYahoo<-function(woeid=2151330){
  url<-paste('http://weather.yahooapis.com/forecastrss?w=',woeid,'&u=c',sep="")
  doc = xmlTreeParse(getURL(url),useInternalNodes=TRUE)

  ans<-getNodeSet(doc, "//yweather:atmosphere")
  humidity<-as.numeric(sapply(ans, xmlGetAttr, "humidity"))
  visibility<-as.numeric(sapply(ans, xmlGetAttr, "visibility"))
  pressure<-as.numeric(sapply(ans, xmlGetAttr, "pressure"))
  rising<-as.numeric(sapply(ans, xmlGetAttr, "rising"))

  ans<-getNodeSet(doc, "//item/yweather:condition")
  code<-as.numeric(sapply(ans, xmlGetAttr, "code"))

  ans<-getNodeSet(doc, "//item/yweather:forecast[1]")
  low<-as.numeric(sapply(ans, xmlGetAttr, "low"))
  high<-as.numeric(sapply(ans, xmlGetAttr, "high"))

  print(paste(woeid,'==>',low,high,code,humidity,visibility,pressure,rising))
  return(as.data.frame(cbind(low,high,code,humidity,visibility,pressure,rising)))
}

#' Get one city weather Data.
#'
#' @param en input a English city name
#' @param src input data source
#' @return data.frame weather data
#' @keywords weather
#' @export
#' @examples
#' \dontrun{
#'  getWeatherByCity()
#'  getWeatherByCity(en="beijing")
#' }
getWeatherByCity<-function(en="beijing",src="yahoo"){
  woeid<-getWOEIDByCity(en)
  if(src=="yahoo"){
    return(getWeatherFromYahoo(woeid))
  }else{
    return(NULL)
  }
}

#' Get all of city weather Data.
#'
#' @param lang input a language
#' @param src input data source
#' @return data.frame weather data
#' @keywords weather
#' @export
#' @examples
#' \dontrun{
#'  getWeather()
#' }
getWeather<-function(lang="en",src="yahoo"){
  cities<-getCityInfo(lang)
  wdata<-do.call(rbind, lapply(cities$woeid,getWeatherFromYahoo))
  return(cbind(cities,wdata))
}

3.2 文件 render.R

新建文件render.R,用于数据处理和静态图片可视化渲染,文件中定义了5个函数。

  • getColors(),用于根据天气情况匹配不同的颜色
  • drawBackground(),画出背景
  • drawDescription(),画出文字描述
  • drawLegend(),画出图例
  • drawTemperature(),画出气温及地图结合

~ vi R/render.R

#' match the color with ADCODE99.
#'
#' @param temp the temperature
#' @param breaks cut the numbers
#' @return new color vector
#' @keywords color
getColors<-function(temp,breaks){
  f=function(x,y) ifelse(x %in% y,which(y==x),0)
  colIndex=sapply(chinaMap$ADCODE99,f,WOEID$adcode99)

  arr <- findInterval(temp, breaks)
  arr[which(is.na(arr))]=19
  return(arr[colIndex])
}

#' Draw the background.
#'
#' @param title the image's title
#' @param date the date
#' @param lang the language zh or en
drawBackground<-function(title,date,lang='zh'){
  text(100,58,title,cex=2)
  text(105,54,format(date,"%Y-%m-%d"))
  #text(98,65,paste('chinaweatherapp','http://apps.weibo.com/chinaweatherapp'))
  #text(120,-8,paste('provided by The Weather Channel',format(date, "%Y-%m-%d %H:%M")),cex=0.8)
}

#' Draw the description.
#'
#' @importFrom stringi stri_unescape_unicode
#' @param data daily data
#' @param temp the temperature
#' @param lang the language zh or en
drawDescription<-function(data,temp,lang='zh'){
  rows<-1:nrow(data)
  x<-ceiling(rows/7)*11+68
  y<-17-ifelse(rows%%7==0,7,rows%%7)*3
  fontCols<-c("#08306B","#000000","#800026")[findInterval(temp,c(0,30))+1]
  if(lang=='zh'){
    txt<-stri_unescape_unicode(data$zh)
    text(x,y,paste(txt,temp),col=fontCols)
  }else{
    text(x,y,paste(data$en,temp),col=fontCols)
  }
  #text(x,y,bquote(paste(.(data$en),.(temp),degree,C)),col=fontCols)
}

#' Draw the legend.
#'
#' @param breaks cut the numbers
#' @param colors match the color
drawLegend<-function(breaks,colors){
  breaks2 <- breaks[-length(breaks)]
  par(mar = c(5, 0, 15, 10))
  image(x=1, y=0:length(breaks2),z=t(matrix(breaks2)),col=colors[1:length(breaks)-1],axes=FALSE,breaks=breaks,xlab="",ylab="",xaxt="n")
  axis(4, at = 0:(length(breaks2)), labels = breaks, col = "white", las = 1)
  abline(h = c(1:length(breaks2)), col = "white", lwd = 2, xpd = FALSE)
}

#' Draw temperature picture.
#'
#' @importFrom RColorBrewer brewer.pal
#' @importFrom stringi stri_unescape_unicode
#' @import maptools
#' @param data daily data
#' @param lang language
#' @param type low or high
#' @param date the date
#' @param output output a file or not
#' @param path image output position
#' @export
drawTemperature<-function(data,lang='zh',type='high',date=Sys.time(),output=FALSE,path=''){
  colors <- c(rev(brewer.pal(9,"Blues")),"#ffffef",brewer.pal(9,"YlOrRd"),"#500000")
  breaks=seq(-36,44,4)

  if(type=='high') {
    temp<-data$high
    ofile<-paste(format(date,"%Y%m%d"),"_day.png",sep="")
  }else{
    temp<-data$low
    ofile<-paste(format(date,"%Y%m%d"),"_night.png",sep="")
  }

  if(lang=='zh'){
    title<-stri_unescape_unicode(props[which(props$key=='high'),]$zh)
  }else{
    title<-props[which(props$key=='high'),]$en
  }

  if(output)png(filename=paste(path,ofile,sep=''),width=600,height=600)

  layout(matrix(data=c(1,2),nrow=1,ncol=2),widths=c(8,1),heights=c(1,2))
  par(mar=c(0,0,3,10),oma=c(0.2,0.2,0.2,0.2),mex=0.3)
  plot(chinaMap,border="white",col=colors[getColors(temp,breaks)])
  points(data$long,data$lat,pch=19,col=rgb(0,0,0,0.3),cex=0.8)

  drawBackground(title,date,lang)
  drawDescription(data,temp,lang)
  drawLegend(breaks,colors)
}

3.3 文件 chinaWeather.R

修改文件chinaWeather.R,用于定义各种工具函数,文件中定义了3个函数。

  • filename(),根据日期定义文件名称。
  • getWOEIDByCity(),通过城市名获得WOEID代码。
  • getCityInfo(),查看所有城市的信息,在WOEID数据集中定义的城市。

#' Define a filename from current date.
#'
#' @param date input a date type
#' @return character a file name
#' @keywords filename
#' @export
#' @examples
#' \dontrun{
#'  filename()
#'  filename(as.Date("20110701",format="%Y%m%d"))
#' }
filename<-function(date=Sys.time()){
  paste(format(date, "%Y%m%d"),".csv",sep="")
}

#' Get WOEID of Yahoo By City Name
#'
#' @param en input a English city name
#' @return integer WOEID
#' @keywords WOEID
#' @export
#' @examples
#' \dontrun{
#'  getWOEIDByCity()
#'  getWOEIDByCity(en="beijing")
#' }
getWOEIDByCity<-function(en="beijing"){
  return(WOEID$woeid[which(WOEID$en==en)])
}

#' Get all of city info
#'
#' @param lang input a language
#' @return data.frame city info
#' @keywords language
#' @export
#' @examples
#' \dontrun{
#'  getCityInfo()
#'  getCityInfo(lang="en")
#'  getCityInfo(lang="zh")
#' }
getCityInfo<-function(lang="en"){
  if(lang=="en")return(WOEID[-c(3,4)])
  if(lang=="zh")return(WOEID[-c(4)])
}

3.4 文件 chinaWeather-package.R

新建文件chinaWeather-package,用于定义R包的说明和内置数据集。

  • NULL,关于chinaWeather包的定义说明
  • 'WOEID',WOEID数据集的描述
  • 'chinaMap',chinaMap数据集的描述
  • 'props',props数据集的描述
  • 'weather20141001',weather20141001数据集的描述

#' China Weather package.
#'
#' a visualized package for china Weather
#'
#' @name chinaWeather-package
#' @aliases chinaWeather
#' @docType package
#' @title China Weather package.
#' @keywords package
NULL

#' The yahoo code for weather openAPI.
#'
#' @name WOEID
#' @description The yahoo code for weather openAPI.
#' @docType data
#' @format A data frame
#' @source \url{https://developer.yahoo.com/geo/geoplanet/guide/concepts.html}
'WOEID'

#' China Map.
#'
#' @name chinaMap
#' @description China Map Dataset.
#' @docType data
#' @format A S4 Object.
'chinaMap'

#' Charset for Chinease and English.
#'
#' @name props
#' @description Charset.
#' @docType data
#' @format A data frame
'props'

#' Dataset for 20141001.
#'
#' @name weather20141001
#' @description A demo dataset.
#' @docType data
#' @format A data frame
#' @source \url{http://weather.yahooapis.com/forecastrss?w=2151330}
'weather20141001'

4. 项目配置文件

我们在chinaWeather项目中,增加了好几个函数定义,同时增加了5包的依赖,那么项目配置文件也需要做相当的修改。

需要修改的文件有3个。

  • DESCRIPTION,项目描述文件,用于项目全局的配置。
  • NAMESPACE,命令空间文件,用于函数的访问权限控制。
  • .Rbuildignore,在打包时,用于排除不参与打包的文件。

4.1 修改文件 DESCRIPTION

DESCRIPTION文件,用于全局项目配置,在Imports选项中定义了5个包的依赖,并增加LazyData的选项。


Package: chinaWeather
Type: Package
Title: a visualized package for china Weather
Version: 0.1
Authors@R: "Dan Zhang  [aut, cre]"
Description: a visualized package for china Weather
Depends:
    R (>= 3.1.1)
Imports:
    RCurl,
    XML,
    maptools,
    RColorBrewer,
    stringi
LazyData: TRUE
License: GPL-2
Date: 2014-09-28

4.2 修改文件 NAMESPACE

NAMESPACE文件用于函数的访问控制,我们先手动定义需要输出的函数用,稍后在运行roxygen2包的document()函数,NAMESPACE文件会自动更新。


export(drawTemperature)
export(filename)
export(getCityInfo)
export(getWOEIDByCity)
export(getWeather)
export(getWeatherByCity)
export(getWeatherFromYahoo)

4.3 新建文件 .Rbuildignore

在打包的时候,可以排除不相关的文件,比如 metadata目录 和 .gitignore文件等。


.gitignore
dist
metadata
^.*\.Rproj$
^\.Rproj\.user$
README*
NEWS*
FAQ*

我们把R语言代码、函数注释和配置文件,都修改完成了,下面开始调试程序。

5. 调试程序

用devtools包的工具函数,调试程序还是比较简单的。


> library(devtools)     # 加载devtools包
> load_all("/home/conan/R/chinaWeather")        # 加载chinaWeather项目
Loading chinaWeather

> data(package="chinaWeather")                  # 查看chinaWeather的数据集
Data sets in package ‘chinaWeather’:
WOEID
chinaMap
props
weather20141001

调用weather20141001测试数据集,画出2014年10月01日的白天气温静态图。


> date<-as.Date(as.character(20141001), format = "%Y%m%d")
> drawTemperature(weather20141001,date=date)

w8

再画出2014年10月01日的英文的夜间气温图。


> drawTemperature(weather20141001,type='low',date=date,lang='en')

w9

生成的可视化图片,完成符合我们的要求。这里偷懒一下,暂时跳过单元测试了。之前我们在代码上已经加了注释,接下就通过roxygen2包生成文档。


> library(roxygen2)
> roxygenize("/home/conan/R/chinaWeather")
First time using roxygen2 4.0. Upgrading automatically...
Writing NAMESPACE
Writing chinaWeather-package.Rd
Writing WOEID.Rd
Writing chinaMap.Rd
Writing props.Rd
Writing weather20141001.Rd
Writing filename.Rd
Writing getWOEIDByCity.Rd
Writing getCityInfo.Rd
Writing getWeatherFromYahoo.Rd
Writing getWeatherByCity.Rd
Writing getWeather.Rd
Writing getColors.Rd
Writing drawBackground.Rd
Writing drawDescription.Rd
Writing drawLegend.Rd
Writing drawTemperature.Rd

文件NAMESPACE也被同时更新了,通过自动化的方式,我们又可以少维护一个文件了。运行一切正常,最后就是程序打包。

6. 程序打包

我们把用于打包的程序放到dist目录中,新建dist目录。


~ mkdir /home/conan/R/chinaWeather/dist       # 新建目录dist

6.1 程序打包

执行打包函数build(),存在于dist目录。


> build("/home/conan/R/chinaWeather",path="dist")
'/usr/lib/R/bin/R' --vanilla CMD build '/home/conan/R/chinaWeather' --no-manual --no-resave-data

* checking for file ‘/home/conan/R/chinaWeather/DESCRIPTION’ ... OK
* preparing ‘chinaWeather’:
* checking DESCRIPTION meta-information ... OK
* checking for LF line-endings in source and make files
* checking for empty or unneeded directories
* looking to see if a ‘data/datalist’ file should be added
* building ‘chinaWeather_0.1.tar.gz’

[1] "dist/chinaWeather_0.1.tar.gz"

在本地安装chinaWeather包。


~ R CMD INSTALL dist/chinaWeather_0.1.tar.gz
* installing to library ‘/home/conan/R/x86_64-pc-linux-gnu-library/3.1’
* installing *source* package ‘chinaWeather’ ...
** R
** data
*** moving datasets to lazyload DB
** inst
** preparing package for lazy loading
** help
*** installing help indices
** building package indices
** testing if installed package can be loaded
* DONE (chinaWeather)

加载chinaWeather包,下载当天的天气数据,并可视化输出,如图5-20所示。


> library(chinaWeather)
> data<-getWeather(lang='zh')
[1] "2151330 ==> 8 19 28 32 NA 1023.5 0"
[1] "2151849 ==> 17 25 34 51 9.99 1015.92 0"
[1] "2159908 ==> 9 19 30 35 9.99 1015.92 0"
[1] "20070171 ==> 16 26 28 60 NA 1021.7 0"
[1] "2141166 ==> 0 14 34 22 9.99 1015.92 0"
[1] "2137321 ==> 2 16 30 27 9.99 1015.92 2"
[1] "2148332 ==> 6 18 28 35 9.99 1015.92 0"
[1] "2149760 ==> 3 15 30 31 9.99 1015.92 0"
[1] "2171287 ==> 9 22 34 27 9.99 1015.92 2"
[1] "26198317 ==> 9 18 34 55 9.99 1015.92 2"
[1] "2145605 ==> 6 21 32 39 NA 812.73 0"
[1] "2138941 ==> 3 19 32 34 NA 745.01 0"
[1] "2157249 ==> 12 26 32 44 NA 1022 0"
[1] "2150551 ==> 8 21 32 29 16 1022.7 0"
[1] "2172736 ==> 13 24 20 64 1.5 1015.92 0"
[1] "2168327 ==> 9 21 32 44 15 1022.3 0"
[1] "2154547 ==> 6 20 34 26 9.99 1015.92 2"
[1] "2127866 ==> 15 26 34 42 9.99 1015.92 2"
[1] "2163866 ==> 17 28 28 55 4.01 1019.8 0"
[1] "26198213 ==> 17 28 34 33 9.99 1015.92 0"
[1] "2137081 ==> 14 25 30 54 9.99 1015.92 2"
[1] "2158433 ==> 18 28 30 37 9.99 1015.92 2"
[1] "2146703 ==> 11 22 28 53 9.99 1015.92 2"
[1] "2160693 ==> 8 20 30 49 9.99 1015.92 2"
[1] "2166473 ==> 19 29 30 74 9 982.05 2"
[1] "26198235 ==> -1 16 32 20 NA 643.41 0"
[1] "2132574 ==> 16 25 34 39 9.99 1015.92 0"
[1] "26198151 ==> 19 28 30 40 NA 1018.4 0"
[1] "2161838 ==> 20 31 34 31 9.99 982.05 0"
[1] "2139963 ==> 18 27 34 42 9.99 982.05 2"
[1] "2306179 ==> 23 27 28 51 9.99 982.05 0"
[1] "2162779 ==> 23 28 30 66 9.99 982.05 2"
[1] "24865698 ==> 23 29 30 38 9.99 982.05 0"
[1] "20070017 ==> 25 29 34 48 9.99 982.05 2"

> drawTemperature(data,date=Sys.Date())

w10

6.2 check检查

打包过程一切正常,接下就是check()函数检查。 从check()函数的输出来看,顺利地通过了检查,但其实程序调试的过程中遇到了N多的问题,是一点一点花时间解决的。


> check("/home/conan/R/chinaWeather")            # 执行check检查
Updating chinaWeather documentation
Loading chinaWeather
'/usr/lib/R/bin/R' --vanilla CMD build '/home/conan/R/chinaWeather' --no-manual --no-resave-data

* checking for file ‘/home/conan/R/chinaWeather/DESCRIPTION’ ... OK
* preparing ‘chinaWeather’:
* checking DESCRIPTION meta-information ... OK
* checking for LF line-endings in source and make files
* checking for empty or unneeded directories
* looking to see if a ‘data/datalist’ file should be added
* building ‘chinaWeather_0.1.tar.gz’

'/usr/lib/R/bin/R' --vanilla CMD check '/tmp/Rtmp3YI3Ar/chinaWeather_0.1.tar.gz' --timings

* using log directory ‘/tmp/Rtmp3YI3Ar/chinaWeather.Rcheck’
* using R version 3.1.1 (2014-07-10)
* using platform: x86_64-pc-linux-gnu (64-bit)
* using session charset: UTF-8
* checking for file ‘chinaWeather/DESCRIPTION’ ... OK
* checking extension type ... Package
* this is package ‘chinaWeather’ version ‘0.1’
* checking package namespace information ... OK
* checking package dependencies ... OK
* checking if this is a source package ... OK
* checking if there is a namespace ... OK
* checking for executable files ... OK
* checking for hidden files and directories ... OK
* checking for portable file names ... OK
* checking for sufficient/correct file permissions ... OK
* checking whether package ‘chinaWeather’ can be installed ... OK
* checking installed package size ... OK
* checking package directory ... OK
* checking DESCRIPTION meta-information ... OK
* checking top-level files ... OK
* checking for left-over files ... OK
* checking index information ... OK
* checking package subdirectories ... OK
* checking R files for non-ASCII characters ... OK
* checking R files for syntax errors ... OK
* checking whether the package can be loaded ... OK
* checking whether the package can be loaded with stated dependencies ... OK
* checking whether the package can be unloaded cleanly ... OK
* checking whether the namespace can be loaded with stated dependencies ... OK
* checking whether the namespace can be unloaded cleanly ... OK
* checking loading without being on the library search path ... OK
* checking dependencies in R code ... OK
* checking S3 generic/method consistency ... OK
* checking replacement functions ... OK
* checking foreign function calls ... OK
* checking R code for possible problems ... OK
* checking Rd files ... OK
* checking Rd metadata ... OK
* checking Rd line widths ... OK
* checking Rd cross-references ... OK
* checking for missing documentation entries ... OK
* checking for code/documentation mismatches ... OK
* checking Rd \usage sections ... OK
* checking Rd contents ... OK
* checking for unstated dependencies in examples ... OK
* checking contents of ‘data’ directory ... OK
* checking data for non-ASCII characters ... OK
* checking data for ASCII and uncompressed saves ... OK
* checking examples ... OK
* checking PDF version of manual ... OK

6.3 Github上传

最后,把项目代码上传到Github中,在Github中开源发布。


~ git add .
~ git commit -m 'app
~ git push origin app
To https://github.com/bsspirit/chinaWeatherDemo.git
 * [new branch]      app -> app

项目的访问地址为 https://github.com/bsspirit/chinaWeatherDemo/tree/app,感兴趣的用户可以自行查看源代码。

6.4 从Github安装chinaWeatherDemo项目

我们把代码上传到github的同时,就完成了在Github上发布项目,用户可以通过devtools包从Github安装项目。


> library(devtools)       # 加载devtools包
> install_github("bsspirit/chinaWeatherDemo",ref="app") # 安装项目,配置app分支
Downloading github repo bsspirit/chinaWeatherDemo@app
Installing chinaWeather
'/usr/lib/R/bin/R' --vanilla CMD INSTALL '/tmp/RtmpTkR2Sd/devtools8435b61dfe5/bsspirit-chinaWeatherDemo-54e36d4'  \
  --library='/home/conan/R/x86_64-pc-linux-gnu-library/3.1' --install-tests

* installing *source* package ‘chinaWeather’ ...
** R
** data
** inst
** preparing package for lazy loading
** help
*** installing help indices
** building package indices
** testing if installed package can be loaded
* DONE (chinaWeather)
Reloading installed chinaWeather

到此为止,整个项目关于R语言的程序开发部分,就全都完成了。接下来就是PHP的部分了,下一篇文章中将继续介绍。

转载请注明出处:
http://blog.fens.me/r-package-chinaweather/

打赏作者

撬动R内核的高级工具包pryr

R的极客理想系列文章,涵盖了R的思想,使用,工具,创新等的一系列要点,以我个人的学习和体验去诠释R的强大。

R语言作为统计学一门语言,一直在小众领域闪耀着光芒。直到大数据的爆发,R语言变成了一门炙手可热的数据分析的利器。随着越来越多的工程背景的人的加入,R语言的社区在迅速扩大成长。现在已不仅仅是统计领域,教育,银行,电商,互联网….都在使用R语言。

要成为有理想的极客,我们不能停留在语法上,要掌握牢固的数学,概率,统计知识,同时还要有创新精神,把R语言发挥到各个领域。让我们一起动起来吧,开始R的极客理想。

关于作者:

  • 张丹(Conan), 程序员Java,R,PHP,Javascript
  • weibo:@Conan_Z
  • blog: http://blog.fens.me
  • email: bsspirit@gmail.com

转载请注明出处:
http://blog.fens.me/r-pryr/

r-pryr

前言

随着对R语言的使用越来越深入,我们需要更多的对R语言底层的进行了解,比如数据结构S3,S4对象,函数的调用机制等。pryr包就是可以帮助我们了解R语言运行机制的工具。利用pryr包,我们可以更容易地接触R的核心。

本文为R语言的高级内容。

目录

  1. pryr介绍
  2. pryr安装
  3. pryr使用

1 pryr介绍

pryr包是一个深层的了解R语言运行机制的工具,可以帮助我们更加贴近R语言的核心。为了能开发出更高级R语言应用,需要我们更深入地懂R。

pryr的API介绍

内部实现工具:

  • promise对象:uneval(), is_promise()
  • 查询环境变量: where(), rls(), parenv()
  • 查看闭包函数变量: unenclose()
  • 函数调用关系:call_tree()
  • 查看对象底层对应的C语言类型 address(), refs(), typename()
  • 跟踪对象是否被修改track_copy()

面向对象检查:

  • 判断属于哪种类型对象: otype()
  • 判断属于哪种类型函数: ftype()

辅助编程函数:

  • 通过参数创建函数:make_function(), f()
  • 变量表达式替换:substitute_q(), subs()
  • 批量修改对象: modify_lang()
  • 快速创建list对象:dots(), named_dots()
  • 建匿名函数调用:partial()
  • 找符合条件函数:find_funs()

代码简化工具:

  • 创建延迟或直接绑定:%<d-%, %<a-%
  • 创建常量绑定:%<c-%
  • 重新绑定:rebind, <<-

2 pryr安装

系统环境

  • Linux Ubuntu 12.04.2 LTS 64bit
  • R 3.0.1 x86_64-pc-linux-gnu (64-bit)

由于项目pryr,还没有发布到CRAN,仅支持从github安装。我们要使用devtools包来通过github来安装。关于devtools包的使用,请参考文章:在巨人的肩膀前行 催化R包开发

pryr安装


~ R

# 安装devtools
# install.packages("devtools")

> library(devtools)
> install_github("pryr")

注:我尝试在Win7下安装,但出现了编译错误。

3 pryr使用

  • 3.1 创建匿名函数f()
  • 3.2 通过参数创建函数make_function()
  • 3.3 创建匿名函数调用partial()
  • 3.4 变量表达式替换substitute_q(), subs()
  • 3.5 面向对象类型判断otype(),ftype()
  • 3.6 查看对象底层的C语言类型 address(), refs(), typename()
  • 3.7 查看对象是否被修改track_copy()
  • 3.8 查看闭包函数变量 unenclose()
  • 3.9 批量修改对象 modify_lang()
  • 3.10 快速创建list对象 dots(), named_dots()
  • 3.11 查找符合条件函数 fun_calls()
  • 3.12 查询环境变量 where(), rls(), parenv()
  • 3.13 打印函数调用关系 call_tree(), ast()
  • 3.14 promise对象 uneval(), is_promise()
  • 3.15 数据绑定%<a-%, %<c-%,%<d-%, rebind,<<-

3.1 创建匿名函数f()

通过使用f()函数,可以实现创建匿名函数,在单行完成函数定义、调用、运算的操作。


# 创建一个匿名函数
> f(x + y)
function (x, y)
x + y

# 创建一个匿名函数,并赋值计算
> f(x + y)(1, 10)
[1] 11

# 创建一个匿名函数,指定参数和默认值
> f(x, y = 2, x + y)
function (x, y = 2)
x + y

# 创建一个匿名函数,并赋值计算
> f(x, y = 2, x + y)(1)
[1] 3

# 创建一个匿名函数,多行运行,并赋值计算
>  f({y <- runif(1); x + y})(3)
[1] 3.7483

3.2 通过参数创建函数make_function()

通过使用make_function()函数,可以通过make_function()函数的3个参数,来创建一个普通的函数,从而现实动态性。

make_function()函数的3个参数分别是:

  • 生成函数的参数部分, list类型
  • 生成函数的表达式部分, 语法表达式, call类型
  • 生成函数的系统环境部分, environment类型

# 创建标准的函数
> f <- function(x) x + 3
> f
function(x) x + 3

# 运行函数
> f(12)
[1] 15

# 通过参数创建函数
> g <- make_function(alist(x = ), quote(x + 3))
> g
function (x)
x + 3

# 运行函数
> g(12)
[1] 15

3.3 创建匿名函数调用partial()

使用partial()函数,可以减少参数定义的过程,方便匿名函数的调用


# 定义一个普通的函数
> compact1 <- function(x) Filter(Negate(is.null), x)
> compact1
function(x) Filter(Negate(is.null), x)

# 通过partial定义的匿名函数
> compact2 <- partial(Filter, Negate(is.null))
> compact2
function (...)
Filter(Negate(is.null), ...)

我们看到,上面的两个函数定义很像,一个是有明确的参数定义,另一个用partial()则是隐式的参数定义。

再看另一例:输出runif()均匀分布的结果


# 标准函数实现
> f1 <- function(){runif(rpois(1, 5))}
> f1()
[1] 0.09654228 0.93089395 0.85530142 0.33021067 0.16728877 0.79099825
> f1()
[1] 0.6166580 0.2100876 0.3125176

# 通过partial的匿名函数调用
> f2 <- partial(runif, n = rpois(1, 5))
> f2()
[1] 0.25955143 0.12858459 0.04994997 0.11505708 0.10509429
> f2()
[1] 0.9710866 0.1469317

3.4 变量表达式替换 substitute_q(), subs()

使用substitute_q()函数,可以对表达式调用,直接进行参数替换


# 定义一个表达式调用
>  x <- quote(a + b)
> class(x)
[1] "call"

# 对x调用参数替换,无效
>  substitute(x, list(a = 1, b = 2))
x

# 对直接变量参数替换
> substitute(a+b, list(a = 1, b = 2))
1 + 2

# 对x调用参数替换
>  substitute_q(x, list(a = 1, b = 2))
1 + 2

执行参数调用
> eval(substitute_q(x, list(a = 1, b = 2)))
[1] 3

使用subs()函数,可以直接对变量表达式替换


> a <- 1
> b <- 2

# 对变量表达式替换,无效
> substitute(a + b)
a + b

# 对变量表达式替换
> subs(a + b)
1 + 2

3.5 面向对象类型判断otype(),ftype()

判断对象类型:通过otype()函数可以很容易的分辨出基本类型,S3类型,S4类型,RC类型的对象,比起内置的类型检查要高效的多。


# 基本类型
> otype(1:10)
[1] "primitive"
> otype(c('a','d'))
[1] "primitive"
> otype(list(c('a'),data.frame()))
[1] "primitive"

# S3类型
> otype(data.frame())
[1] "S3"

# 自定的S3类型
> x <- 1
> attr(x,'class')<-'foo'
> is.object(x)
[1] TRUE
> otype(x)
[1] "S3"

# S4类型
> setClass("Person",slots=list(name="character",age="numeric"))
> alice<-new("Person",name="Alice",age=40) 
> isS4(alice)
[1] TRUE
> otype(alice)
[1] "S4"

# RC类型
> Account<-setRefClass("Account")
> a<-Account$new()
> class(a)
[1] "Account"
attr(,"package")
[1] ".GlobalEnv"

> is.object(a)
[1] TRUE
> isS4(a)
[1] TRUE
> otype(a)
[1] "RC"

判断函数类型:通过ftype()函数可以很容易的分辨出function,primitive,S3,S4,internal类型的函数,比起内置的类型检查要高效的多。


# 标准函数
> ftype(`%in%`)
[1] "function"

# primitive函数
> ftype(sum)
[1] "primitive" "generic"

# internal函数
> ftype(writeLines)
[1] "internal"
> ftype(unlist)
[1] "internal" "generic"

# S3函数
>  ftype(t.data.frame)
[1] "s3"     "method"
> ftype(t.test)
[1] "s3"      "generic"

# S4 函数
> setGeneric("union")
[1] "union"
> setMethod("union",c(x="data.frame",y="data.frame"),function(x, y){unique(rbind (x, y))})
[1] "union"
> ftype(union)
[1] "s4"      "generic"

# RC函数
> Account<-setRefClass("Account",fields=list(balance="numeric"),methods=list(
+   withdraw=function(x){balance<<-balance-x},
+   deposit=function(x){balance<<-balance+x}))
> a<-Account$new(balance=100)
> a$deposit(100)
> ftype(a$deposit)
[1] "rc"     "method"

3.6 查看对象底层的C语言类型 address(), refs(), typename()

我们可以通过address(), refs(), typename()来查看,R对象对应的底层C语言实现的类型。

  • typename: 返回C语言类型名
  • address: 返回内存地址
  • refs: 返回指针数字

查看变量


# 定义一个变量x
>  x <- 1:10

# 打印C语言类型名
> typename(x)
[1] "INTSXP"

# 返回指针
> refs(x)
[1] 1

# 打印内存地址
> address(x)
[1] "0x365f560"

# 定义一个list对象
>  z <- list(1:10)

# 打印C语言类型名
>  typename(z)
[1] "VECSXP"

# 延迟赋值
> delayedAssign("a", 1 + 2)

# 打印C语言类型名
> typename(a)
[1] "PROMSXP"

# 打印a变量
> a
[1] 3
> typename(a)
[1] "PROMSXP"

# 定义变量b,与a变量对比
> b<-3
> typename(b)
[1] "REALSXP"

3.7 查看对象是否被修改track_copy()

使用track_copy()函数,我们可以跟踪对象,并检查是被修改过,通过内存地址进行判断。


# 定义一个变量
> a<-1:3
> a
[1] 1 2 3

# 查看变量的内存地址
> address(a)
[1] "0x2ad77f0"

# 跟踪变量
> track_a <- track_copy(a)

# 检查变更是否被修改,没有修改
> track_a()

# 给变量赋值
> a[3] <- 3L

# 查看变量的内存地址,发现没有变化
> address(a)
[1] "0x2ad77f0"

# 检查变量是否被修改,没有修改
>  track_a()

# 再次给变量赋值
> a[3]<-3

# 查看变量的内存地址,内存地址改变
> address(a)
[1] "0x37f8580"

# 检查变量是否被修改,已被修改,变成一份copy
>  track_a()
a copied

3.8 查看闭包函数变量 unenclose()

使用unenclose()给闭包环境的变量的赋值


# 定义一个嵌套函数power
>  power <- function(exp) {
+      function(x) x ^ exp
+  }

# 调用闭包函数
>  square <- power(2)
>  cube <- power(3)

# 查看square函数,exp变量并显示没有赋值后的结果
> square
function(x) x ^ exp
<environment: 0x4055f28>

# 查看square函数,exp变量显示赋值后的结果
> unenclose(square)
function (x)
x^2

# 执行square函数
> square(3)
[1] 9

3.9 批量修改对象 modify_lang()

这是一个神奇的函数,可以方便地替换 list对象、表达式、函数 中的变量定义。

接下来,我们尝试替换list对象中定义的变量a为变量b


# 定义list对象及内部数据
> examples <- list(
+        quote(a <- 5),
+        alist(a = 1, c = a),
+        function(a = 1) a * 10,
+        expression(a <- 1, a, f(a), f(a = a))
+      )

# 查看对象数据
> examples
[[1]]
a <- 5

[[2]]
[[2]]$a
[1] 1

[[2]]$c
a

[[3]]
function (a = 1)
a * 10

[[4]]
expression(a <- 1, a, f(a), f(a = a))

# 定义转换函数a_to_b,
>  a_to_b <- function(x) {
+        if (is.name(x) && identical(x, quote(a))) return(quote(b))
+        x
+  }

# 批量修改对象,替换examples对象中,所有的变量a变成变量b
> modify_lang(examples, a_to_b)
[[1]]
b <- 5

[[2]]
[[2]]$a
[1] 1

[[2]]$c
b

[[3]]
function (a = 1)
b * 10

[[4]]
expression(b <- 1, b, f(b), f(a = b))

3.10 快速创建list对象 dots(), named_dots()

使用dots()函数,我们可以快速创建list对象,通过参数设置来list的数据的名字和值。


# 初始化一个变量
> y <- 2

# 创建list对象
> dots(x = 1, y, z = )
$x
[1] 1

[[2]]
y

$z

# 查看对象类型
> class(dots(x = 1, y, z = ))
[1] "list"

# 查看对象的内部结果
> str(dots(x = 1, y, z = ))
List of 3
 $ x: num 1
 $  : symbol y
 $ z: symbol

使用named_dots()函数,同样我们可以快速创建list对象,通过参数设置list的数据的名字和值。与dots()函数的不同点在于,参数变量就是list的数据的名字,如 变量y在没有赋值情况下,也被用作list数据的名字,并可以通过$y来得到值。


# 创建list对象
> named_dots(x = 1, y, z =)
$x
[1] 1

$y
y

$z

# 查看对象类型
> class(named_dots(x = 1, y, z =))
[1] "list"

# 查看对象的内部结果
> str(named_dots(x = 1, y, z =))
List of 3
 $ x: num 1
 $ y: symbol y
 $ z: symbol

3.11 查找符合条件函数 fun_calls()

使用fun_calls()函数,可以通过过滤条件快速找到函数。

查找base包中所有的函数,找到匹配match.fun字符串的函数名


> find_funs("package:base", fun_calls, "match.fun", fixed = TRUE)
Using environment package:base
 [1] "apply"  "eapply" "Find"   "lapply" "Map"    "mapply" "Negate" "outer"
 [9] "Reduce" "sapply" "sweep"  "tapply" "vapply"

# 查看Map函数,检查是否包括match.fun字符串
> Map
function (f, ...)
{
    f <- match.fun(f)
    mapply(FUN = f, ..., SIMPLIFY = FALSE)
}
<bytecode: 0x21688e0>
<environment: namespace:base>

查找stats包中所有的函数的参数,找到精确匹配FUN字符串的函数名


> find_funs("package:stats", fun_args, "^FUN$")
Using environment package:stats
[1] "addmargins"           "aggregate.data.frame" "aggregate.ts"
[4] "ave"                  "dendrapply"

# 查看ave函数源代码,检查参数名是否有FUN字符串
> ave
function (x, ..., FUN = mean)
{
    if (missing(...))
        x[] <- FUN(x)
    else {
        g <- interaction(...)
        split(x, g) <- lapply(split(x, g), FUN)
    }
    x
}
<bytecode: 0x2acba70>
<environment: namespace:stats>

3.12 查询环境变量 where(), rls(), parenv()

使用where()函数,可以定位对象的在R环境中的位置,有点像Linux的命令whereis。


# 定义一个变量x
> x <- 1
> where("x")
<environment: R_GlobalEnv>

# 查询t.test函数的位置
> where("t.test")
<environment: package:stats>
attr(,"name")
[1] "package:stats"
attr(,"path")
[1] "/usr/lib/R/library/stats"

> t.test
function (x, ...)
UseMethod("t.test")
<bytecode: 0x1ae9bc8>
<environment: namespace:stats>

# 查询mean函数的位置
> where("mean")
<environment: base>

# 查询where函数的位置
> where("where")
<environment: package:pryr>
attr(,"name")
[1] "package:pryr"
attr(,"path")
[1] "/home/conan/R/x86_64-pc-linux-gnu-library/3.0/pryr"

使用rls()函数,可以显示出当前环境的所有变量,包括当前变量,全局变量,空环境变量,命令空间环境变量。


# 打印当前环境的变量
> ls()
 [1] "a"                "Account"          "alice"            "a_to_b"
 [5] "b"                "compact1"         "compact2"         "examples"
 [9] "f"                "f1"               "f2"               "g"
[13] "myGeneric"        "my_long_variable" "plot2"            "union"
[17] "x"                "y"

# 打印所有环境的变量
> rls()
[[1]]
 [1] "a"                          "Account"
 [3] "alice"                      "a_to_b"
 [5] "b"                          ".__C__Account"
 [7] "compact1"                   "compact2"
 [9] ".__C__Person"               "examples"
[11] "f"                          "f1"
[13] "f2"                         "g"
[15] ".__global__"                "myGeneric"
[17] "my_long_variable"           "plot2"
[19] ".Random.seed"               ".requireCachedGenerics"
[21] ".__T__myGeneric:.GlobalEnv" ".__T__union:base"
[23] "union"                      "x"
[25] "y"

使用parenv()函数,可以找到函数调用的上一级环境,从而可以追溯到函数的根。


# 定义一个3层嵌套函数
> adder <- function(x) function(y) function(z) x + y + z

# 调用第一层函数
> add2 <- adder(2)

# 查看函数
> add2
function(y) function(z) x + y + z
<environment: 0x323c000>

# 调用第二层函数
> add3<-add2(3)
> add3
function(z) x + y + z
<environment: 0x3203558>

# 查内层函数的上一级环境
>  parenv(add3)
<environment: 0x323c000>
>  parenv(add2)
<environment: R_GlobalEnv>

3.13 找印调用关系 call_tree(), ast()

使用call_tree()函数,可以打印出表达式的调用关系


# 嵌套函数语句调用
>  call_tree(quote(f(x, 1, g(), h(i()))))
\- ()
  \- `f
  \- `x
  \-  1
  \- ()
    \- `g
  \- ()
    \- `h
    \- ()
      \- `i

# 条件语句调用
> call_tree(quote(if (TRUE) 3 else 4))
\- ()
  \- `if
  \-  TRUE
  \-  3
  \-  4

# 表达式语句调用
> call_tree(expression(1, 2, 3))
\-  1
\-  2
\-  3

使用ast()函数,可以直接打印语句的调用关系


# 嵌套表达式语句
> ast(f(x, 1, g(), h(i())))
\- ()
  \- `f
  \- `x
  \-  1
  \- ()
    \- `g
  \- ()
    \- `h
    \- ()
      \- `i

# 条件语句
> ast(if (TRUE) 3 else 4)
\- ()
  \- `if
  \-  TRUE
  \-  3
  \-  4

# 函数定义
> ast(function(a = 1, b = 2) {a + b})
\- ()
  \- `function
  \- []
    \ a = 1
    \ b = 2
  \- ()
    \- `{
    \- ()
      \- `+
      \- `a
      \- `b
  \- 

# 函数调用
> ast(f()()())
\- ()
  \- ()
    \- ()
      \- `f

3.14 promise对象 uneval(), is_promise()

promise对象:是R语言中延迟加载机制的一部分,包含三个部分:值,表达式和环境。当函数被调用时参数进行匹配,然后每个形式参数会绑定到一个promise上。表达式有形式参数和存储在promise里的函数的指针。

简单来说,延迟加载调用过程就是,先把函数指针存储在promise对象里,并不马上调用;当其实调用发生时,从promise对象里找到函数指针,进行函数的调用。


# 定义变量并赋值
> x <- 10

# 检查是否 promise模式
> is_promise(x)
[1] FALSE

# 匿名函数调用,检查是否 promise模式
> (function(x) is_promise(x))(x = 10)
[1] TRUE

使用uneval()函数,可以在延迟赋值的过程中,打印函数调用方法,而不执行赋值函数调用。


# 定义一个函数
> f <- function(x) {
+     uneval(x)
+ }

# 打印函数调用
> f(a + b)
a + b

> class(f(a+b))
[1] "call"

# 打印函数调用
> f(1 + 4)
1 + 4

# 延迟赋值
> delayedAssign("x", 1 + 4)

# 不执行函数调用,只打印函数调用
> uneval(x)
1 + 4

# 执行函数调用,并赋值
> x
[1] 5

# 延迟赋值又一例
> delayedAssign("x", {
+     for(i in 1:3)
+         cat("yippee!\n")
+     10
+ })

# 执行函数调用,并赋值
> x
yippee!
yippee!
yippee!
[1] 10

3.15 数据绑定%<a-%, %<c-%,%<d-%, rebind,<<-

使用特殊的函数,可以实现数据绑定的功能。

直接绑定


> x %<a-% runif(1)
> x
[1] 0.06793592
> x
[1] 0.8217227

常量绑定


> y %<c-% 4 + 2
[1] 6
> y
[1] 4

延迟绑定


> z %<d-% (a + b)
> a <- 10
> b <- 100
> z
[1] 110

重新绑定


# 对已知变量a重新赋值
> a <- 1
> rebind("a", 2)

# 对未知变量cc重新赋值,出错
> rebind("ccc", 2)
Error: Can't find ccc

# 用 <<- 对已知变量a重新赋值
> a<<-2
> a
[1] 2

# 用 <<- 对未知变量cc重新赋值
> rm(ccc)
> ccc
Error: object 'ccc' not found
> ccc<<-2
> ccc
[1] 2

通过对pryr全面介绍,我们了解这个包的强大,对于R的数据结构的理解非常有帮助。

转载请注明出处:
http://blog.fens.me/r-pryr/

打赏作者

在巨人的肩膀前行 催化R包开发

R的极客理想系列文章,涵盖了R的思想,使用,工具,创新等的一系列要点,以我个人的学习和体验去诠释R的强大。

R语言作为统计学一门语言,一直在小众领域闪耀着光芒。直到大数据的爆发,R语言变成了一门炙手可热的数据分析的利器。随着越来越多的工程背景的人的加入,R语言的社区在迅速扩大成长。现在已不仅仅是统计领域,教育,银行,电商,互联网….都在使用R语言。

要成为有理想的极客,我们不能停留在语法上,要掌握牢固的数学,概率,统计知识,同时还要有创新精神,把R语言发挥到各个领域。让我们一起动起来吧,开始R的极客理想。

关于作者:

  • 张丹(Conan), 程序员Java,R,PHP,Javascript
  • weibo:@Conan_Z
  • blog: http://blog.fens.me
  • email: bsspirit@gmail.com

转载请注明出处:
http://blog.fens.me/r-package-faster/

r-devtools

前言

开发自己的R包sayHello 一文中,我们看到了如何从底层,按照R语言的标准构建一个R语言的扩展包。但实施过程确实复杂,会让很多的统计学工作者望而却步。如果能有一种比较简单方式,简化开发过程,那该多好啊!

我们是幸运的,Hadley Wickham(ggplot2,plyr的作者)已经帮我们梳理出了一套开发流程。站在巨人的肩膀上,看得更高,走得更远。

目录

  1. 开发流程介绍
  2. 编写功能代码
  3. 调试程序
  4. 单元测试
  5. 撰写文档
  6. 程序打包
  7. 程序发布

1. 开发流程介绍

站在巨人的肩膀,开发R包我们有3个武器:devtools, roxygen2, testthat

  • devtools:让开发变得简单,各种开发小工具的合集,非常实用。
  • roxygen2:通过注释的方式,生成文档,远离Latex的烦恼。
  • testthat:单元测试,让R包稳定、健壮,减少升级的痛苦。

标准化的开发流程:

  1. 编写功能代码
  2. 调试程序
  3. 单元测试
  4. 撰写文档
  5. 程序打包

2. 编写功能代码

1). 安装程序包:devtools, roxygen2, testthat


#依赖库
~ sudo apt-get install libcurl4-openssl-dev
~ sudo apt-get install libxml2-dev

#请使用root权限启动R
~ sudo R

> install.packages("devtools")
> install.packages("roxygen2")
> install.packages("testthat")

> library(devtools)
> library(roxygen2)
> library(testthat)

#查看
> search()
 [1] ".GlobalEnv"        "package:testthat"  "package:roxygen2"
 [4] "package:digest"    "package:stats"     "package:graphics"
 [7] "package:grDevices" "package:utils"     "package:datasets"
[10] "package:methods"   "Autoloads"         "package:base"

构建工程chinaWeather
创建骨架,代替package.skeleton()


> setwd("/home/conan/R")

> create("/home/conan/R/chinaWeather")
Creating package chinaWeather in /home/conan/R
No DESCRIPTION found. Creating default:

Package: chinaWeather
Title:
Description:
Version: 0.1
Authors@R: # getOptions('devtools.desc.author')
Depends: R (>= 3.0.1)
License: # getOptions('devtools.desc.license')
LazyData: true

> setwd("/home/conan/R/chinaWeather")
> dir()
[1] "DESCRIPTION" "man"         "R"

编辑DESCRIPTION文件

~ vi /home/conan/R/chinaWeather/DESCRIPTION
Package: chinaWeather
Type: Package
Title: a visualized package for china Weather
Description: a visualized package for china Weather
Author: Dan Zhang
Maintainer: Dan Zhang
Version: 0.1
Depends: R (>= 3.0.1)
License: GPL-2
LazyData: true
Date: 2013-08-05

增加函数文件chinaWeather.R


~ vi /home/conan/R/chinaWeather/R/chinaWeather.R

#define a filename from current date
filename<-function(date=Sys.time()){
  paste(format(date, "%Y%m%d"),".csv",sep="")
}

3. 调试程序

加载程序包到R中


> load_all("/home/conan/R/chinaWeather")
Loading chinaWeather

> filename
function(date=Sys.time()){
  paste(format(date, "%Y%m%d"),".csv",sep="")
}


> filename()
[1] "20130805.csv"

> day<-as.Date("20110701",format="%Y%m%d")
> filename(day)
[1] "20110701.csv"

4. 单元测试

编写单元测试代码


~ mkdir /home/conan/R/chinaWeather/inst/tests
~ vi /home/conan/R/chinaWeather/inst/tests/test.chinaWeather.R

library(testthat)
context("filename: current of date")

test_that("filename is current of date", {
  daystr<-paste(format(Sys.Date(), "%Y%m%d"),".csv",sep="")
  expect_that(filename(), equals(daystr))

  day<-as.Date("20110701",format="%Y%m%d")
  expect_that(filename(day), equals("20110701.csv"))
})

运行单元测试


#单个文件的单元测试
> source("/home/conan/R/chinaWeather/inst/tests/test.chinaWeather.R")
> test_file("/home/conan/R/chinaWeather/inst/tests/test.chinaWeather.R")
filename: current of date : ..

#对目录下所有文件的单元测试
> test_dir("/home/conan/R/chinaWeather/inst/tests/",reporter = "summary")
filename: current of date : ..

#自动单元测试
> src<-"/home/conan/R/chinaWeather/R/"
> test<-"/home/conan/R/chinaWeather/inst/tests/"
> auto_test(src,test)
filename: current of date : ..

#对package执行测试
> test("/home/conan/R/chinaWeather")
Testing chinaWeather
Loading chinaWeather
filename: current of date : ..

完成单元测试!下面开始撰写文档。

5. 撰写文档

这里撰写文档,使用源代码注释的方式,然后生成latex,再生成doc。比起原始的直接写latex要容易的多。

打开源代码文件:chinaWeather.R


~ vi /home/conan/R/chinaWeather/R/chinaWeather.R

#' Define a filename from current date.
#'
#' @param date input a date type
#' @return character a file name
#' @keywords filename 
#' @export
#' @examples
#' filename()
#' filename(as.Date("20110701",format="%Y%m%d"))
filename<-function(date=Sys.time()){
  paste(format(date, "%Y%m%d"),".csv",sep="")
}

生成latex文档


> library(roxygen2)
Loading required package: digest

> roxygenize("/home/conan/R/chinaWeather")
Updating collate directive in  /home/conan/R/chinaWeather/DESCRIPTION
Updating namespace directives
Writing chinaWeather.Rd
Writing filename.Rd

查看生成的latex文件


~ cat /home/conan/R/chinaWeather/man/filename.Rd

\name{filename}
\alias{filename}
\title{Define a filename from current date.}
\usage{
  filename(date = Sys.time())
}
\arguments{
  \item{date}{input a date type}
}
\value{
  character a file name
}
\description{
  Define a filename from current date.
}
\examples{
filename()
filename(as.Date("20110701",format="\%Y\%m\%d"))
}
\keyword{filename}

6. 程序打包

详细的打包解释,请参考:开发自己的R包sayHello

对上面程序过程,更简化操作可以用如下3条命令


> load_all("/home/conan/R/chinaWeather")
> test("/home/conan/R/chinaWeather")
> document("/home/conan/R/chinaWeather")

程序检查


> check("/home/conan/R/chinaWeather")
Updating chinaWeather documentation
Loading chinaWeather
'/usr/lib/R/bin/R' --vanilla CMD build '/home/conan/R/chinaWeather'  \
  --no-manual --no-resave-data

* checking for file '/home/conan/R/chinaWeather/DESCRIPTION' ... OK
* preparing 'chinaWeather':
* checking DESCRIPTION meta-information ... OK
* checking for LF line-endings in source and make files
* checking for empty or unneeded directories
* building 'chinaWeather_0.1.tar.gz'

'/usr/lib/R/bin/R' --vanilla CMD check  \
  '/tmp/RtmpM5NdJp/chinaWeather_0.1.tar.gz' --timings

* using log directory '/tmp/RtmpM5NdJp/chinaWeather.Rcheck'
* using R version 3.0.1 (2013-05-16)
* using platform: x86_64-pc-linux-gnu (64-bit)
* using session charset: ASCII
* checking for file 'chinaWeather/DESCRIPTION' ... OK
* checking extension type ... Package
* this is package 'chinaWeather' version '0.1'
* checking package namespace information ... OK
* checking package dependencies ... OK
* checking if this is a source package ... OK
* checking if there is a namespace ... OK
* checking for executable files ... OK
* checking for hidden files and directories ... OK
* checking for portable file names ... OK
* checking for sufficient/correct file permissions ... OK
* checking whether package 'chinaWeather' can be installed ... OK
* checking installed package size ... OK
* checking package directory ... OK
* checking DESCRIPTION meta-information ... OK
* checking top-level files ... OK
* checking for left-over files ... OK
* checking index information ... OK
* checking package subdirectories ... OK
* checking R files for non-ASCII characters ... OK
* checking R files for syntax errors ... OK
* checking whether the package can be loaded ... OK
* checking whether the package can be loaded with stated dependencies ... OK
* checking whether the package can be unloaded cleanly ... OK
* checking whether the namespace can be loaded with stated dependencies ... OK
* checking whether the namespace can be unloaded cleanly ... OK
* checking loading without being on the library search path ... OK
* checking for unstated dependencies in R code ... OK
* checking S3 generic/method consistency ... OK
* checking replacement functions ... OK
* checking foreign function calls ... OK
* checking R code for possible problems ... OK
* checking Rd files ... OK
* checking Rd metadata ... OK
* checking Rd cross-references ... OK
* checking for missing documentation entries ... OK
* checking for code/documentation mismatches ... OK
* checking Rd \usage sections ... OK
* checking Rd contents ... OK
* checking for unstated dependencies in examples ... OK
* checking examples ... OK
* checking PDF version of manual ... OK

Checking chinaWeather with devtools
Checking for any extra files in built .tar.gz file... OK

查检通过.
注:请安装

sudo apt-get install texlive-full

7. 程序发布

我们把写的程序发布到github上面,然后通过devtools,我可以方便的把程序从github下载安装。

在github创建一个新的资源库:chinaWeather
https://github.com/bsspirit/chinaWeather

提交本地代码到github


~ cd /home/conan/R/chinaWeather
~ git init
~ git add .
~ git commit -m 'init commit'
~ git remote add origin https://github.com/bsspirit/chinaWeather
~ git push -u origin master

To https://github.com/bsspirit/chinaWeather
 * [new branch]      master -> master
Branch master set up to track remote branch master from origin.

通过devtools下载,并安装代码。
现在我的chinaWeather包,已经在github上面发布了,如果其他的同学想使用可以下面命令安装。


> library(devtools)
> install_github("chinaWeather","bsspirit")
Installing github repo(s) chinaWeather/master from bsspirit
Downloading chinaWeather.zip from https://github.com/bsspirit/chinaWeather/archive/master.zip
Installing package from /tmp/RtmpSaXYcA/chinaWeather.zip
Installing chinaWeather
'/usr/lib/R/bin/R' --vanilla CMD INSTALL  \
  '/tmp/RtmpSaXYcA/chinaWeather-master'  \
  --library='/home/conan/R/x86_64-pc-linux-gnu-library/3.0'  \
  --with-keep.source --install-tests

* installing *source* package 'chinaWeather' ...
** R
** inst
** preparing package for lazy loading
** help
*** installing help indices
** building package indices
** testing if installed package can be loaded
* DONE (chinaWeather)

#测试包
> library(chinaWeather)
> filename()
[1] "20130805.csv"

#查看文档
> ?filename
filename             package:chinaWeather              R Documentation
Define a filename from current date.
Description:
     Define a filename from current date.
Usage:
       filename(date = Sys.time())
Arguments:
    date: input a date type
Value:
     character a file name
Examples:
     filename()
     filename(as.Date("20110701",format="%Y%m%d"))

我们完成了,开发R包的全部流程。依赖于devtools, roxygen2, testthat三个包,真是事半功倍,比起完全手动操作提高效率了很多!!

希望更多的朋友,可以站在巨人的肩膀前行,创造让人惊叹的成果来!!

转载请注明出处:
http://blog.fens.me/r-package-faster/

打赏作者