属于你的R 2012-05-28

Linux下的R用户可以自由定制自己的环境。首先由环境变量R_PROFILE指定初始化文件位置,它的优先级最高;如果该变量没有设置,则找到R安装目录下的子目录etc里的Rprofile.site文件,优先级其次。在此之后再通过查找当前目录下添加的.Rprofile文件(如果没有则去当前用户的根目录下找)来实现,优先级最低。还有两个特殊的函数,包括对话开始时自动执行的.First()可用于初始化环境,以及对话结束时自动执行的.Last()可用于保存环境。举个例子,比如我们在~/.Rprofile文件里写入函数就有如下功能。

.First <- function() {
       options(prompt="$ ", continue="+\t")  # 用 $ 作为提示符
       options(repos = c(CRAN="http://ftp.ctex.org/mirrors/CRAN/"))
                                             # 选择速度最快的CRAN源
       options(digits=5, length=999)         # 指定数值和打印范围
       x11()                                 # 指定图形界面
       par(pch = "+")                        # 默认画图的字符
       source(file.path(Sys.getenv("HOME"), "R", "mystuff.R"))
                                             # 加载私有函数
       library(MASS)                         # 加载常用的包
     }

.Last <- function() {
       graphics.off()                        # 一个小的安全措施
       cat(paste(date(),"\nAdios\n"))        # Is it time for lunch?
	if (!any(commandArgs()=='--no-readline') && interactive()){
		require(utils)
		try(savehistory(Sys.getenv("R_HISTFILE")))
	}                                        # 记录历史命令,但是要预先在.bashrc里定义地址
                                             # export R_HISTFILE=~/.Rhistory
     }

当然.Rprofile文件里还可以写入一些其他的自定义函数,分享在我的开发机上简单但强大的两个小函数。

# 默认q可直接退出R
q <- function (save="no", ...) {
    quit(save=save, ...)
}

# 用R.log记录所有输出
sink(file = 'R.log', split=T)


但是注意到执行全部删除命令rm(list=ls())时,自定义函数也会被删除掉(比如上面的q()和sink()),但如果用new.env()先定义新的命名空间就不会被删,比如以下head,names,tail及summary的alias。

.startup <- new.env() 
assign("h", utils::head, env=.startup) 
assign("n", base::names, env=.startup) 
assign("ht", function(d) rbind(head(d,5),tail(d,5)) , env=.startup) 
assign("s", base::summary, env=.startup) 
attach(.startup)

最后提供一个sof上很强大的ls函数的改进,可以显示内存中所有对象类型、占用内存大小及维数等信息,简直相当于linux中ls命令的-a选项了。

.ls.objects <- function (pos = 1, pattern, order.by,
		decreasing=FALSE, head=FALSE, n=5) {
		napply <- function(names, fn) sapply(names, function(x)
				fn(get(x, pos = pos)))
			names <- ls(pos = pos, pattern = pattern)
			obj.class <- napply(names, function(x) as.character(class(x))[1])
			obj.mode <- napply(names, mode)
			obj.type <- ifelse(is.na(obj.class), obj.mode, obj.class)
			obj.size <- napply(names, object.size)
			obj.dim <- t(napply(names, function(x)
						as.numeric(dim(x))[1:2]))
			vec <- is.na(obj.dim)[, 1] & (obj.type != "function")
			obj.dim[vec, 1] <- napply(names, length)[vec]
			out <- data.frame(obj.type, obj.size, obj.dim)
			names(out) <- c("Type", "Size", "Rows", "Columns")
			if (!missing(order.by))
				out <- out[order(out[[order.by]], decreasing=decreasing), ]
			if (head)
				out <- head(out, n)
				out
}

ll <- function(..., n=10) {
	.ls.objects(..., order.by="Size", decreasing=TRUE, head=TRUE, n=n)
}


Powered by Jekyll on GitHub | ©2016 Meroa | Last modified: 2018-02-03