Tag: R

R对数组指定下标顺序输出

问题

1
2
3
4
> table(week.data['星期'])
星期二 星期六 星期日 星期三 星期四 星期五 星期一 
    34     46     37     55     40     46     65

table函数可以统计各个值的频度，但是输出的顺序却不是我们所期待的（期待的顺序是从星期一到星期日）。特别是使用barplot生成柱状图时，如果不按顺序，那肯定是不行的。

解决

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
CaiSortByFields <- function(p.arr, p.fields) {
  # 把数组按照指定顺序输出
  # 
  # Args：
  #   p.arr   数组数据
  #   p.fields  指定顺序
  # Returns：
  #   array
  
  tmp <- array()
  for (i in p.fields) {
    tmp[i] <- p.arr[i]
  }
  
  # 去掉缺失值
  tmp[!is.na(tmp)]
}

这个方式比较曲折，应该有更直接的方式的。

R语言的小技巧

ifelse和if … else …不同

认为相同，主要是受到之前经验的影响，不过这里的ifelse是向量化的运算，返回值的长度会和test的长度一致。可以看ifelse的源码：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
function (test, yes, no) 
{
    if (is.atomic(test)) 
        storage.mode(test) <- "logical"
    else test <- if (isS4(test)) 
        as(test, "logical")
    else as.logical(test)
    ans <- test
    ok <- !(nas <- is.na(test))
    if (any(test[ok])) 
        ans[test & ok] <- rep(yes, length.out = length(ans))[test & 
            ok]
    if (any(!test[ok])) 
        ans[!test & ok] <- rep(no, length.out = length(ans))[!test & 
            ok]
    ans[nas] <- NA
    ans
}
1
2
> ifelse(c(T, F, T), c(1,2), c(5,6))  # 长度不够，则会自动补充
[1] 1 6 1

install RCurld的问题

在ubuntu12.04上安装：

1
install.packages("RCurl")

提示：

1
2
3
checking for curl-config... no
Cannot find curl-config
ERROR: configuration failed for package ‘RCurl’

解决：

1
sudo apt-get install libcurl4-gnutls-dev

附: http://cos.name/cn/topic/108303

R中vector和names函数

问题

源数据保存在文件中，格式如下：

1
2
3
4
5
6
7
drt=2013-09-02+22:14:28&at=7&cid=mDamz1b7WRJZ
drt=2013-09-02+22:14:29&at=3&cid=Q4ETETM9Hjx0
drt=2013-09-02+22:14:39&at=0&cid=ytBSubxEaFN6
drt=2013-09-02+22:14:40&at=3&cid=mDamz1b7WRJZ
drt=2013-09-02+22:14:42&at=6&cid=ytBSubxEaFN6
drt=2013-09-02+22:14:42&at=3&cid=mDamz1b7WRJZ
drt=2013-09-02+22:14:45&at=0&cid=66OwWFuVBMSS

需要生成一个list，其下标是数据的字段名：drt，at，cid

解决

开始写成这样，很别扭的代码：

1
2
3
4
5
x <- scan(filename, what="", sep="&", nlines=1)
fields.name <- sapply(x, FUN=function(x){strsplit(x, split="=")[[1]][1]})
names(fields.name) <- NULL
names(fields.name) <- fields.name
fields.name <- as.list(fields.name)

借鉴tapply的源码，改成这样：

1
2
3
4
x <- scan(filename, what="", sep="&", nlines=1)
fields.name <- sapply(x, FUN=function(x){strsplit(x, split="=")[[1]][1]})
tmp.fields.name <- vector("list", length(fields.name))    # 生成一个空的list
names(tmp.fields.name) <- fields.name

使用R来获取网易公开课的下载地址

今天看到一个网易公开课的课程，想把它们下载下来，所以写了一个脚本去分析页面结构，把title和url解析出来。

脚本见https://github.com/cyy0523xc/R/blob/master/lib/cai_get_download_url.r

其他页面的数据应该也是一样的。

R资源列表

文档

R扩展：http://cran.r-project.org/doc/manuals/R-exts.html

文章

炼数成金 R中国用户组http://r.dataguru.cn/
编写R包C扩展的核心指引http://www.dataguru.cn/article-1178-1.html
关于在R programming中避免显式循环的一些方法http://www.dataguru.cn/article-3284-1.html

书籍刊物

数据科学http://kan.weibo.com/kan/3444217594966746
R语言小站http://kan.weibo.com/kan/3484733640942053

课程

北美18名校的数据挖掘，数据分析，人工智能及机器学习课程汇总http://kan.weibo.com/con/3547413957114530?_from=text

R编码规范

编码规范

google：http://google-styleguide.googlecode.com/svn/trunk/Rguide.xml

中文版：http://www.road2stat.com/rstyle/rstyle.html

https://docs.google.com/document/d/1esDVxyWvH8AsX-VJa-8oqWaHLs4stGlIbk8kLc5VlII/edit

补充规范

变量的特殊前缀

  • tmp： 临时变量
  • p: 函数参数

变量的后缀

后缀通常用来表示变量的类型，如：

  • lst，tb，vec, ft等
  • fn: 函数变量, 通常在例如tapply等函数中使用

技巧

  1. 在shell直接运行R脚本
1
2
3
#!/usr/bin/Rscript --slave
argv <- commandArgs(TRUE)
x <- as.numeric(argv[1])

然后：sudo chmod +x file.r

R function tapply

tapply

1
tapply(X, INDEX, FUN = NULL, ..., simplify = TRUE)

把变量X（通常为向量）通过函数FUN作用在INDEX这个因子变量上，返回值可以根据simplify参数设置。simplify = T（默认）返回array，simplify = F则返回list。

实例

计算各个省份的人均收入

1
2
3
4
5
6
7
8
9
10
11
12
13
14
> ins <- list(year=c(2011, 2012, 2012, 2013, 2013), province=c("GZ", "GZ", "BG", "BG", "GZ"), income=c(10, 12, 13, 12, 15))  # 定义数据
> ins
$year
[1] 2011 2012 2012 2013 2013
$province
[1] "GZ" "GZ" "BG" "BG" "GZ"
$income
[1] 10 12 13 12 15
> tapply(ins$income, ins$province, mean)
      BG       GZ 
12.50000 12.33333

计算各个省份在各个年份的平均收入

1
2
3
4
> tapply(ins$income, list(ins$province, ins$year), mean)
   2011 2012 2013
BG   NA   13   12
GZ   10   12   15

源码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
function (X, INDEX, FUN = NULL, ..., simplify = TRUE) 
{
    FUN <- if (!is.null(FUN)) 
        match.fun(FUN)
    if (!is.list(INDEX))           # 如果分组因子不是list，则自动转为list
        INDEX <- list(INDEX)
    nI <- length(INDEX)
    if (!nI) 
        stop("'INDEX' is of length zero")
    namelist <- vector("list", nI)
    names(namelist) <- names(INDEX)
    extent <- integer(nI) 
    nx <- length(X)
    one <- 1L
    group <- rep.int(one, nx)     # 构造一个重复向量
    ngroup <- one
    for (i in seq_along(INDEX)) {   # 对分组因子列表的下标进行循环处理
        index <- as.factor(INDEX[[i]])
        if (length(index) != nx) 
            stop("arguments must have same length")
        namelist[[i]] <- levels(index)
        extent[i] <- nlevels(index)
        
        # 注意这里计算分组的算法：计算组合后的分组情况
        group <- group + ngroup * (as.integer(index) - one)
        ngroup <- ngroup * nlevels(index)
    }
    if (is.null(FUN)) 
        return(group)
        
    # 分组数据，完成映射（FUN）
    ans <- lapply(X = split(X, group), FUN = FUN, ...)   # split按照分组因子切割变量X
    index <- as.integer(names(ans))
    if (simplify && all(unlist(lapply(ans, length)) == 1L)) {
        ansmat <- array(dim = extent, dimnames = namelist)
        ans <- unlist(ans, recursive = FALSE)
    }
    else {
        ansmat <- array(vector("list", prod(extent)), dim = extent, 
            dimnames = namelist)
    }
    if (length(index)) {
        names(ans) <- NULL
        ansmat[index] <- ans
    }
    ansmat
}

这个源码有可以优化的地方，例如循环体里面的：

1
2
3
namelist[[i]] <- levels(index)
extent[i] <- nlevels(index)
ngroup <- ngroup * nlevels(index)

实际上nlevels(index)只是对levels(index)取length，所以这三行代码实质上调用了levels函数三次（在一次循环体里面），调用nlevels和length两次。可以修改成这样：

1
2
3
namelist[[i]] <- levels(index)
extent[i] <- length(namelist[[i]])
ngroup <- ngroup * extent[i]

有时间的话，可以考虑把tapply改成C语言实现

R function lapply

包括函数：lapply, sapply, vapply

lapply

1
lapply(X, FUN, ...)

该函数会返回一个长度和X参数的长度相同的列表，其中每个元素都是X参数在FUN函数作用下的结果。

实现源码

1
2
3
4
5
6
7
function (X, FUN, ...) 
{
    FUN <- match.fun(FUN)
    if (!is.vector(X) || is.object(X))    # 如果不是向量（列表等也是向量），则会先转成list
        X <- as.list(X)
    .Internal(lapply(X, FUN))   # 直接调用C核心的函数
}

实例

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
> a
     [,1] [,2]
[1,]    1    3
[2,]    2    4
> lapply(a, function(x)x^2)  # length(a) == 4
[[1]]
[1] 1
[[2]]
[1] 4
[[3]]
[1] 9
[[4]]
[1] 16
> d
$a
[1] 1 2
$b
[1] 3 4 5
> lapply(d, sum)  # length(d) == 2
$a
[1] 3
$b
[1] 12

一个实际的例子：一次性加载某个目录下的R文件

1
2
3
4
5
6
CaiSource <- function(x, p.path) {
  source(paste(p.path, x, sep=""))
}
# lib.path是指定的目录
lapply(list.files(path=lib.path, pattern='\\.[rR]$'), CaiSource, lib.path)

sapply

1
sapply(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE)

sapply是对lapply的封装，实现代码：

1
2
3
4
5
6
7
8
9
10
function (X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE) 
{
    FUN <- match.fun(FUN)
    answer <- lapply(X = X, FUN = FUN, ...)     # 直接调用lapply
    if (USE.NAMES && is.character(X) && is.null(names(answer))) 
        names(answer) <- X   # USE。NAMES参数
    if (!identical(simplify, FALSE) && length(answer)) 
        simplify2array(answer, higher = (simplify == "array"))  # simplify参数，默认会转换成array
    else answer
}

vapply

1
vapply(X, FUN, FUN.VALUE, ..., USE.NAMES = TRUE)

该函数和sapply类似

1
2
3
4
5
6
7
function (X, FUN, FUN.VALUE, ..., USE.NAMES = TRUE) 
{
    FUN <- match.fun(FUN)
    if (!is.vector(X) || is.object(X))   # 对数据进行预处理
        X <- as.list(X)
    .Internal(vapply(X, FUN, FUN.VALUE, USE.NAMES))
}

FUN.VALUE的值定义是？

R function apply

apply

apply(X, MARGIN, FUN, …)

参数说明

1
2
3
4
X:         array or matrix
MARGIN:    1表示按行计算，2表示按列计算，c(1, 2)表示对行和列同时作用，就会对每个元素都产生作用
FUN:       作用函数
...:       作用函数的参数

实例

按行计算

1
2
3
4
5
6
7
> a
[,1] [,2] [,3] [,4]
[1,] 1 3 2 1
[2,] 2 1 3 2
> apply(a, 1, function(x)sum(x))     # 可以简化成：apply(a, 1, sum)
[1] 7 8

按列计算

1
2
3
> apply(a, 2, function(x)sum(x))
[1] 3 4 5 3

行列同时作用

1
2
3
4
> apply(a, c(1,2), function(x)sum(x))
[,1] [,2] [,3] [,4]
[1,] 1 3 2 1
[2,] 2 1 3 2

扩展参数

1
2
3
4
5
6
> apply(a, 1, function(x, t)x+t, 10)    # 
[,1] [,2]
[1,] 11 12
[2,] 13 11
[3,] 12 13
[4,] 11 12

一段R程序的优化

R性能优化

原程序：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
CaiAnalyseEiMac <- function(x) {
  # 分析应用中，一个mac对应多个imei地址的情况
  #
  # Args:
  #   x: list类型，待分析数据
  #     x$aid: 应用ID，格式例如：aid=23。（下面的格式也类同）
  #     x$ei:  imei列表
  #     x$mac: mac列表
  # Return:
  #   list，对应多个imei的mac的占比
  
  # 格式化应用数据
  x$aid <- substr(x$aid, 5, 100)
  n <- length(x$aid)
  aid.lst <- unique(x$aid)
  
  # 计算总体一个mac对应多个imei的情况
  
  # 初始化
  tmp.lst <- list()
  mac.unique <- unique(x$mac)
  for (mac in mac.unique) {
    tmp.lst[[mac]] <- c()
  }
  
  # 把imei都加入mac列表
  for (i in 1:n) {
    tmp.lst[[x$mac[i]]] <- c(tmp.lst[[x$mac[i]]], x$ei[i])
  }
  
  # 汇总唯一值的个数
  tmp.lst <- lapply(tmp.lst, FUN=function(x){return(length(unique(x)))})
  
}

因为数据量比较大，在工作的机器上跑的时间超过半小时。。。。主要原因有两个：

  • copy-on-change，这是R的机制，循环里有大量的修改list操作；
  • R的循环效率比较低

后来发现tapply函数可以达到目的，主要代码如下：

1
tmp.lst <- tapply(x$mac, x$ei, function(x)length(unique(x)))

非常的简洁，而且时间消耗就几秒而已。