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

1.       使函数返回值既能在Console中显示，又能被保存在变量里

用括号将表达式括起来，可以同时达到这两个目的

> (s <-seq(1,10,1))

 [1] 1  2  3 4  5  6 7  8  9  10

2.       用parse函数将字符串转化成表达式

test1<-"b0+b1*sqrt(x)"

 parse(text = test1)

#expression(b0+b1*sqrt(x))

 

parse函数也可以把文件中的字符串转化为表达式，具体可以查看它的帮助文档。

3.       substitute函数对表达式中的变量进行替换

substitute函数相当于对函数表达式中的变量进行代入求值。

 

require(graphics)

 

#令a=1,求a + b, expression(1 + b)

(s.e <-substitute(expression(a + b), list(a = 1)))

 

#1 + b

(s.s <-substitute( a + b,            list(a =1))) 

c(mode(s.e),typeof(s.e)) #  "call","language"

c(mode(s.s),typeof(s.s)) #   (the same)

# but:

(e.s.e <-eval(s.e))          #>  expression(1 + b)

c(mode(e.s.e),typeof(e.s.e)) #  "expression","expression"

 

#1 <- 1 + 1, 无效的替换，得到的表达式无意义

substitute(x <-x + 1, list(x = 1)) # nonsense

 

myplot <-function(x, y)

    plot(x, y, xlab = deparse(substitute(x)),

         ylab = deparse(substitute(y)))

 

## Simple examplesabout lazy evaluation, etc:

 

f1 <-function(x, y = x)             { x <-x + 1; y }

s1 <-function(x, y = substitute(x)) { x <- x + 1; y }

s2 <-function(x, y) { if(missing(y)) y <- substitute(x); x <- x + 1; y }

a <- 10

f1(a)  # 11

s1(a)  # 11

s2(a)  # a

typeof(s2(a))  # "symbol"

 

4.       rgl包绘制三维图一例

fn = function(x, y) {

   x^2 + y^2 - 10 * (cos(2 * pi * x) + cos(2 * pi * y)) + 20

}

a = 5

x = seq(-a, a, 0.05)

y = seq(-a, a, 0.05)

z = outer(x, y, fn)

persp(x, y, z)

library(rgl)

zorder = rank(z)

persp3d(x, y, z, col =rainbow(as.integer(max(zorder)))[zorder])

 

 

5.       图形保存为各种文件格式

x=seq(-4,4,.01)

y=dnorm(x)

#保存为png格式

png(file = “myplot.png”, bg =“transparent”);plot(x,y,type=’l’);dev.off()

#保存为jpeg格式

jpeg(file =“myplot.jpeg”);plot(x,y,type=’l’);dev.off()

#保存为pdf格式

pdf(file = “myplot.pdf”);plot(x,y,type=’l’);dev.off()

#保存为tiff格式

tiff(file =“myplot.tiff”);plot(x,y,type=’l’);dev.off()

#保存为bmp格式

bmp(file =“myplot.bmp”);plot(x,y,type=’l’);dev.off()

#保存为bmp格式

postscript(“myplot.ps”);plot(x,y,type=’l’);dev.off()

 

6.       慎用：强制替换函数的功能

utils包中有一个assignInNamespace()函数，用来修改那些没有被导出的对象。

## 把utils包中的write.table函数调包为print函数

assignInNamespace('write.table', print,'utils')

write.table(iris[1:2, ])  # 结果write.table()再也不会写文件了，而是变成了打印

# "Sepal.Length""Sepal.Width" "Petal.Length" "Petal.Width""Species"

# "1" 5.1 3.5 1.4 0.2"setosa"

# "2" 4.9 3 1.4 0.2"setosa"

## 也许你还不相信，它真的在utils内部被调包了吗？

utils::write.table

# function (x, ...)

# UseMethod("print")

# [environment: namespace:base]

identical(print, utils::write.table)

# [1] TRUE

7.       用igraph包绘制有向图

require(igraph)

d = data.frame(p1  = c('a', 'b', 'c'), p2  = c('b', 'c', 'a'), weight = c(1, 2, 4))

g = graph.data.frame(d, directed = TRUE)

plot(g, edge.width = E(g)$weight)

8.       do.call函数的解释

do.call用于对list列表中保存的参数，调用某一个函数。比如，给它传入两个参数，一个rbind函数，一个list列表，list中的每一个元素都会作为参数应用在rbind函数中，结果就是合并list中的每一个元素，得到一个大的矩阵或者数据框。

 

#对list中的保存的

do.call("complex", list(imaginary= 1:3))

[1] 0+1i 0+2i 0+3i

> tmp <- expand.grid(letters[1:2],1:3, c("+", "-"))

> do.call("paste", c(tmp, sep= ""))

 [1]"a1+" "b1+" "a2+" "b2+" "a3+""b3+" "a1-" "b1-" "a2-" "b2-""a3-" "b3-"

> tmp

  Var1 Var2 Var3

1    a    1    +

2    b    1    +

3    a    2    +

4    b    2    +

5    a    3    +

6    b    3    +

7    a    1    -

8    b    1    -

9    a    2    -

10   b    2    -

11   a    3    -

12   b    3    -

 

9.       关于“::”与“:::”

以stringr包中的函数为例，输入以下字符，然后按tab键，会出现函数列表，列表中的函数列在了后面。

> stringr::

stringr::fixed  stringr::ignore.case  stringr::invert_match  stringr::perl stringr::str_c  stringr::str_countstringr::str_length stringr::str_pad stringr::str_sub     stringr::str_detect  stringr::str_locate  stringr::str_replacestringr::str_sub<-  stringr::str_dup stringr::str_locate_all  stringr::str_replace_all  stringr::str_trim           stringr::str_extractstringr::str_match stringr::str_split stringr::str_wrap           stringr::str_extract_all  stringr::str_match_all  stringr::str_split_fixed stringr::word

> stringr:::

stringr:::.__NAMESPACE__.       stringr:::is.perl               stringr:::str_extract           stringr:::str_replace_all

stringr:::.__S3MethodsTable__.  stringr:::match_to_matrix       stringr:::str_extract_all       stringr:::str_split

stringr:::.packageName          stringr:::perl                  stringr:::str_join              stringr:::str_split_fixed

stringr:::case.ignored          stringr:::re_call               stringr:::str_length            stringr:::str_sub

stringr:::check_pattern         stringr:::re_mapply             stringr:::str_locate            stringr:::str_sub<-

stringr:::check_string          stringr:::recyclable            stringr:::str_locate_all        stringr:::str_trim

stringr:::fixed                 stringr:::str_c                 stringr:::str_match             stringr:::str_wrap

stringr:::ignore.case           stringr:::str_count             stringr:::str_match_all         stringr:::word

stringr:::invert_match          stringr:::str_detect            stringr:::str_pad

stringr:::is.fixed              stringr:::str_dup               stringr:::str_replace

可以看出，使用:::能够查看到的函数更多，因为它可以查看已经导出的函数和内部函数。比如， stringr:::check_pattern 是一个内部函数，这类函数是包的作者，为了方便自己编程而实现的，是内部函数，并不希望用户调用，对用户不可见，不需要写文档；而::显示的那些函数对用户是可见的，也就是已经导出的函数，一般需要撰写完整的文档。

10. aggregate函数对子集分别进行汇总

aggregate函数把数据框按照指定的列进行分组，对每一个组都调用指定的函数。

请教数据框运算问题，有以下数据

x  y

a1 1828

a1 1828

a1 1793

a1 1736

a2 1679

a2 1599

a2 1507

a3 1162

a3 1199

a3 921

a3 832

a3 514.6

a4 432.4

a4 290.7

a4 149.6

问题如下：

问题1：如何按照x列的变量名对y列的数据求和，即所有与a1同行的数据（1828 1828 17931736）求和，依次类推，按照a2，a3和a4分组求和

问题2：如何按照x列的变量名分组，求每组第一个数据与最后一个数据的差？以a1为例，求1736-1828的值，以此类推，把整个数据框分组求差。

原始数据5万多个记录，求简单的方法。

解法一：

dat = read.table(textConnection('x     y

                                 a1    1828

                                 a1    1828

                                 a1    1793

                                 a1    1736

                                 a2    1679

                                 a2    1599

                                 a2    1507

                                 a3    1162

                                 a3    1199

                                 a3    921

                                 a3    832

                                 a3    514.6

                                 a4    432.4

                                 a4    290.7

                                 a4    149.6

                                '), header = TRUE)

aggregate(dat[-1], by = list(dat$x), sum)

minus = function(x) return(x[length(x)] -x[1])

aggregate(dat[-1], by = list(dat$x), minus)

解法二：

minus = function(x) tail(x,1)-head(x,1)

aggregate(y~x, dat, minus)

 x      y

1 a1 -92.0

2 a2 -172.0

3 a3 -647.4

4 a4 -282.8

11. 填充曲线之间的阴影

par(bg="white")

n <- 100

set.seed(43214)

x <- c(0,cumsum(rnorm(n)))

y <- c(0,cumsum(rnorm(n)))

xx <- c(0:n, n:0)

yy <- c(x, rev(y))

plot(xx, yy, type="n",xlab="Time", ylab="Distance")

polygon(xx, yy, col="gray")

title("Distance Between BrownianMotions")

12. 各种数学符号的绘制

require(graphics)

 

x <- seq(-4, 4, len = 101)

y <- cbind(sin(x), cos(x))

matplot(x, y, type = "l", xaxt ="n",

       main = expression(paste(plain(sin) * phi, "  and ",

                                plain(cos) * phi)),

       ylab = expression("sin" * phi, "cos" * phi), # only1st is taken

       xlab = expression(paste("Phase Angle ", phi)),

       col.main = "blue")

axis(1, at = c(-pi, -pi/2, 0, pi/2, pi),

    labels = expression(-pi, -pi/2, 0, pi/2, pi))

 

 

## How to combine "math" andnumeric variables :

plot(1:10, type="n",xlab="", ylab="", main = "plot math &numbers")

theta <- 1.23 ; mtext(bquote(hat(theta)== .(theta)), line= .25)

for(i in 2:9)

   text(i, i+1, substitute(list(xi, eta) ==group("(",list(x,y),")"),

                            list(x = i, y =i+1)))

## note that both of these use calls ratherthan expressions.

##

text(1, 10, "Derivatives:", adj = 0)

text(1, 9.6, expression(

 "             first: {f * minute}(x) " =={f * minute}(x)), adj = 0)

text(1, 9.0, expression(

 "    second: {f * second}(x) "       == {f * second}(x)), adj = 0)

 

 

plot(1:10, 1:10)

text(4, 9, expression(hat(beta) == (X^t *X)^{-1} * X^t * y))

text(4, 8.4, "expression(hat(beta) ==(X^t * X)^{-1} * X^t * y)",

    cex = .8)

text(4, 7, expression(bar(x) ==sum(frac(x[i], n), i==1, n)))

text(4, 6.4, "expression(bar(x) ==sum(frac(x[i], n), i==1, n))",

    cex = .8)

text(8, 5, expression(paste(frac(1,sigma*sqrt(2*pi)), " ",

                            plain(e)^{frac(-(x-mu)^2, 2*sigma^2)})),

    cex = 1.2)

 

## some other useful symbols

plot.new(); plot.window(c(0,4), c(15,1))

text(1, 1, "universal", adj = 0);text(2.5, 1,  "\\042")

text(3, 1,expression(symbol("\042")))

text(1, 2, "existential", adj =0); text(2.5, 2,  "\\044")

text(3, 2,expression(symbol("\044")))

text(1, 3, "suchthat", adj = 0);text(2.5, 3,  "\\047")

text(3, 3,expression(symbol("\047")))

text(1, 4, "therefore", adj = 0);text(2.5, 4,  "\\134")

text(3, 4,expression(symbol("\134")))

text(1, 5, "perpendicular", adj =0); text(2.5, 5,  "\\136")

text(3, 5,expression(symbol("\136")))

text(1, 6, "circlemultiply", adj= 0); text(2.5, 6,  "\\304")

text(3, 6,expression(symbol("\304")))

text(1, 7, "circleplus", adj =0); text(2.5, 7,  "\\305")

text(3, 7,expression(symbol("\305")))

text(1, 8, "emptyset", adj = 0);text(2.5, 8,  "\\306")

text(3, 8,expression(symbol("\306")))

text(1, 9, "angle", adj = 0);text(2.5, 9,  "\\320")

text(3, 9,expression(symbol("\320")))

text(1, 10, "leftangle", adj =0); text(2.5, 10,  "\\341")

text(3, 10,expression(symbol("\341")))

text(1, 11, "rightangle", adj =0); text(2.5, 11,  "\\361")

text(3, 11,expression(symbol("\361")))

 

13. 数据框按照各列排序

a=data.frame(a1=c(2,1,3,4,2,5,4),a2=c(7,4,5,6,5,6,4),a3=c(1,2,3,4,5,6,7))

a

  a1a2 a3

1 2  7  1

2 1  4  2

3 3  5  3

4 4  6  4

5 2  5  5

6 5  6  6

7 4  4  7

a[order(a$a1,-a$a2),]

  a1a2 a3

2 1  4  2

1 2  7  1

5 2  5  5

3 3  5  3

4  4  6  4

7 4  4  7

6 5  6  6

14. 显示当前变量占用的内存

objSize=NULL           

otherSize=0   

displaySize=NULL

displayName=NULL

obj<-ls()                                              

for (i in 1:length(obj)) {

 objSize<-c(objSize,object.size(eval(parse(text=obj[i]))))

}

objLen<-length(objSize)

maxSize<-max(objSize)

for (i in 1:length(objSize)){

 if(objSize[i]/maxSize<0.01) {

   otherSize<-otherSize+objSize[i]

  }else {

   displaySize<-c(displaySize,objSize[i])  

   displayName<-c(displayName,obj[i])

  }

}                                  

displaySize[length(displaySize)+1]<-otherSize[1]

displayName[length(displayName)+1]<-"Others" 

pie(displaySize,labels=c(displayName,displaySize),col=rainbow(length(displaySize)),main="Sizes of All Objects in Workspace (bytes)")

15. 自定义二元运算符示例

如下示例，定义了一个'%whatever%'二元运算符，可以计算两个数的平方和，定义方式跟一般的函数相同。

 

'%whatever%' <- function(x, y){return(x^2 + y^2)}

4 %whatever% 5

#[1] 41