R语言基础编程技巧汇编 - 21

1.      tapply函数的一个例子解释

>n<-17;fac<-factor(rep(1:3,len=n),levels=1:5)

> table(fac)

fac

1 2 3 4 5

6 6 5 0 0

> tapply(1:n,fac,sum)

1 2 3 4 5

51 57 45 NA NA

求和过程

 

index:1   2    3    1    2   3    1    2   3     1     2    3     1     2    3     1     2

 value:1   2    3    4   5    6    7   8    9    10   11    12    13   14    15    16   17

1+4+7+10+13+16=51

2+5+8+11+14+17=57

 

2.      获取system()调用其他程序后的返回结果

比如，在Windows中，以下语句可以返回dir命令的结果，并保存在变量a中。

a<-system("dir", intern=TRUE)

3.      read.csv函数中as.is参数的含义

参数 as.is 控制着未通过 colClasses 指定类型的列的转换行为。它的取值是一个逻辑型向量或是一个数值型、字符型元素组成的向量，指定了那些不应该被转换为因子型的列的下标。

比如数据有三列，列名为”a”, “b”, “c”，第一列和第三列不想转换为因子型，可以写

as.is = c(TRUE, FALSE, TRUE)

as.is = c(1, 3)

as.is = c("a", "c")

 

4.       dotchart示例

require(lattice)

dotplot(VADeaths, groups = FALSE,

       layout = c(1, 4), aspect = 0.7,

       origin = 0, type = c("p", "h"),

       main = "Death Rates in Virginia - 1940",

       xlab = "Rate (per 1000)")

Sys.sleep(3)

dotplot(VADeaths, type = "o",

       auto.key = list(lines = TRUE, space = "right"),

       main = "Death Rates in Virginia - 1940",

       xlab = "Rate (per 1000)")

## End(Not run)

5.       返回多维数组的索引

x <- array(1:48, c(2,3,4,2))

which(x==13,arr.ind = TRUE)

#     dim1 dim2 dim3 dim4

#[1,]   1    1    3   1

6.      指定xlsx文件写入位置

require(xlsx)

wb = createWorkbook()

sheet = createSheet(wb, sheetName ="Foo")

x = data.frame(rnorm(7))

addDataFrame(x, sheet, row.names = FALSE,col.names = FALSE,  startRow = 3,startColumn = 2)

saveWorkbook(wb, 'foo.xlsx')

 

7.      单元测试包RUnit介绍

RUnit包用于对函数进行单元测试。

下面举个简单的例子：

> library("RUnit")

> add <- function(a, b)

+ {

+ return(a + b)

+ }

> test.add <- function() {

+ checkEquals(add(1,1),2)

+ checkEquals(add(2,2),2)

+ }

> test.add()

Error in checkEquals(add(2, 2), 2) : Meanrelative difference: 0.5

稍作解释：

add()是要测试的函数

test.add()是add()函数的测试函数，命名方法跟JUnit是一样的。

checkEquals()是RUnit提供的函数，用来测试函数返回的结果。

checkEquals(add(2,2),2)这个测试通不过，在测试运行结果中会给出误差。

这就是最简单的测试了。看了一下RUnit中的其他函数，诸如注入之类的基本元素都有，测试报告的生成也不错，应该是很有前途的包。

8.       导入Matlab文件

需要R.matlab包

path <-system.file("mat-files", package="R.matlab")

pathname <- file.path(path,"ABC.mat")

data <- readMat(pathname)

print(data)

 

9.       让ggplot2和lattice立刻进行作图

在ggplot2和lattice绘图包中，调用绘图函数往往不能立即显示绘图效果，跟graphics包中的行为不同，这让很多用户很困惑。其实，只要在绘图函数外加上print函数，就可以立即看到绘图结果。

例如

library(lattice)

setwd("C:\\")

test.pdf <- function(pdf.file){

  mt<-data.frame(num=1:10,var=rep(c("a","b"),5),time=rep(1:5,2))

 pdf(pdf.file)

  print(barchart(num~ time,groups=var,data=mt))

 dev.off()

}

test.pdf("test1.pdf")

10. system.time()函数输出的解释

想看看R程序运行的时间，以便对自己的程序进行优化，于是执行了下面的命令并得到相应的结果：

>system.time(apply(icol,1,sampnumberfunction))

用户系统流逝

0.16 0.01 0.17

请问，在这里，用户、系统、流逝分别是什么时间

 

这是计算机操作系统中说明运算时间的概念，“用户”是消耗在应用程序（非操作系统部分）执行的时间，“系统”是底层操作系统执行（例如磁盘读写等）部分的时间，“流逝”是经过的总时间（可以认为是前两者的总和）。一般优化时主要关注“用户”的时间。

11. 趣味实现：图片操作示例

library(RCurl)

library(jpeg)

library(png)

street_fighter <- function() {

       url <- list(

                bg ="http://front-back.com/wp-content/uploads/2013/01/sf2-bg.jpg",

                ken ="http://front-back.com/wp-content/uploads/2013/01/ken.png"

                )

       bg <- readJPEG(getURLContent(url$bg))

       ken <- readPNG(getURLContent(url$ken))

       block_w <- 70

        block_h <- 80

       draw_w <- 140

       draw_h <- 160

       bg_w <- ncol(bg)

       bg_h <- nrow(bg)

       bg_margin <- (bg_w - bg_h) / 2

       fighter_x <- 200

       fighter_y <- 30

       step_size <- 35

       init_bg <- function() {

                plot(c(1, bg_w), c(-bg_margin,bg_h + bg_margin), type = "n", axes = FALSE, xlab = "",ylab = "")

                rasterImage(bg, 1, 1, bg_w,bg_h)

       }

       recover_bg <- function(x, y, w, h) {

                rasterImage(bg[bg_h - (h:1 + y)+ 1, 1:w + x, ], x + 1, y + 1, x + w, y + h)

       }

       draw_block <- function(sx, sy, sw, sh, x, y, w, h) {

                rasterImage(ken[1:sh + sy, 1:sw+ sx, ], x + 1, y + 1, x + w, y + h)

       }

       init_bg()

       repeat {

                for (step in 0:15) {

                        if (step %% 4 == 0) {

                               recover_bg(fighter_x, fighter_y, draw_w, draw_h)

                               draw_block(block_w * ((floor(step / 4) + 2) %% 4), 0, block_w, block_h,fighter_x, fighter_y, draw_w, draw_h)

                        }

                        draw_block(block_w *(step %% 2), 320, block_w, block_h, fighter_x + draw_w + step * step_size,fighter_y, draw_w, draw_h)

                        Sys.sleep(0.15)

                        recover_bg(fighter_x +draw_w + step * step_size, fighter_y, draw_w, draw_h)

                }

       }

}

street_fighter()

12. 在正则表达式中匹配反斜杠”\”

注意“\”在R的字符串需要转义，写成“\\”；而“\”在正则表达式里也需要转义，也写成“\\”；因此，在grep或strsplit的参数中，如果要表示查找“\”，则需要两次转义，最终就会有四个“\”连写：

> a <- "abc\\def"

> a

[1] "abc\\def"

> nchar(a)

[1] 7

> for (i in 1:nchar(a))print(substring(a, i, i))

[1] "a"

[1] "b"

[1] "c"

[1] "\\" ######## 注意这里"\\"是一个字符，就是反斜杠

[1] "d"

[1] "e"

[1] "f"

> strsplit(a,"\\\\")  ####### 这里虽然四个反斜杠连写，但传给正则表达式解析器时，其实已经变成两个反斜杠了，也就表示查找单个斜杠

[[1]]

[1] "abc" "def"

13. 在程序退出时执行语句

require(graphics)

 

opar <- par(mai = c(1,1,1,1))

on.exit(par(opar))

14. by函数给数据框分组示例

现有如下数据x

  LT  LG  E    TSW     G    Y

a 48.05    77.5           8    28  2001

b 48.15    65.25    393 8    22  2001

a 48.2     65.4     314 8    24  2001

b 45.25    75.34    74  7.48     24  1999

d 45.25    75.34    67  8.96     14.5     1999

a 45.58    77.24    160 10.57    45  1999

c      45.58    77.24    160 7.73     36.5     1999

e 45.58    77.24    160 10.79    51  1999

a 45.58    77.24    160 9.23     73  1999

e 45.58    77.24    160 10.67    59.5     2001

d 45.59    77.28    180 9.95     58  1999

c 48.32    56.37    330 8.01     32.5     1999

b 46.3     67.03    242 8.04     40  1999

b 45.38    62.04    125 11.24    54.5     1999

如何按照第一列各水平把该数据分成5个子数据框，变成如下5个数据

xa

  LT  LG  E    TSW     G    Y

a 48.05    77.5           8    28  2001

a 48.2     65.4     314 8    24  2001

a 45.58    77.24    160 10.57    45  1999

a 45.58    77.24    160 9.23     73  1999

xb

  LT  LG  E    TSW     G    Y

b 48.15    65.25    393 8    22  2001

b 45.25    75.34    74  7.48     24  1999

b 46.3     67.03    242 8.04     40  1999

b 45.38    62.04    125 11.24    54.5     1999

xc

  LT  LG  E    TSW     G    Y

c 48.32    56.37    330 8.01     32.5     1999

c      45.58    77.24    160 7.73     36.5     1999

xd

  LT  LG  E    TSW     G    Y

d 45.25    75.34    67  8.96     14.5     1999

d 45.59    77.28    180 9.95     58  1999

xe

  LT  LG  E    TSW     G    Y

e 45.58    77.24    160 10.79    51  1999

e 45.58    77.24    160 10.67    59.5     2001

 

DF <- read.table('clipboard',sep ='\t',header = TRUE)

Result <- by(data = DF,INDICES =DF$X,FUN = as.data.frame)

> Result[[1]]

 X    LT    LG  E   TSW  G    Y

1 a 48.05 77.50  NA 8.00 28 2001

3 a 48.20 65.40 314  8.00 24 2001

6 a 45.58 77.24 160 10.57 45 1999

9 a 45.58 77.24 160  9.23 73 1999

> Result[[2]]

  X    LT    LG  E   TSW    G   Y

2  b48.15 65.25 393  8.00 22.0 2001

4  b45.25 75.34  74  7.48 24.0 1999

13 b 46.30 67.03 242  8.04 40.0 1999

14 b 45.38 62.04 125 11.24 54.5 1999

> Result[[3]]

  X    LT    LG  E  TSW    G   Y

12 c 48.32 56.37 330 8.01 32.5 1999

> Result[[4]]

  X    LT    LG   E TSW    G    Y

7 c 45.58 77.24 160 7.73 36.5 1999

> Result[[5]]

  X    LT    LG  E  TSW    G   Y

5  d45.25 75.34  67 8.96 14.5 1999

11 d 45.59 77.28 180 9.95 58.0 1999

> Result[[6]]

  X    LT    LG  E   TSW    G   Y

8  e45.58 77.24 160 10.79 51.0 1999

10 e 45.58 77.24 160 10.67 59.5 2001

 

15. 时间格式转化示例

format(strptime("2013/3/1922:57:47", "%Y/%m/%d %H:%M:%S"), "%H:%M:%S")