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