智能整理、美化R代码（征求解决方案） « COS论坛

COS论坛 | 统计之都 » 软件应用 » S-Plus & R语言

智能整理、美化R代码（征求解决方案）

(16 篇回复) (6 个人参与)

标签：

精华帖

1楼

谢益辉

个人主页
注册于: 2006/05/19
发帖数: 7,262

由于平时自己写代码并不会刻意去注意把代码写得非常整齐，例如我很少敲空格、用引号的时候都是单引号、赋值符号都是用=而不是<-、循环和条件选择语句不注意缩进对齐，等等，相信很多人都一样，因为代码写出来只要能执行就可以了，懒得费那些事去美化。

很久以前我写过一个简单的函数tidy.source()放在animation包中，就是为了整理R源代码，把空格、引号、缩进等等东西都加到代码中，函数源代码很简单（利用R自身的parse()和deparse()去整理）：

tidy.source <- function (source = "clipboard", ...)
{
    exprs = parse(source)
    n = length(exprs)
    res = character(n)
    for (i in 1:n) {
        dep = paste(deparse(exprs[i]), collapse = "\n")
        res[i] = substring(dep, 12, nchar(dep) - 1)
    }
    cat(paste(res, collapse = "\n"), "\n", ...)
}
默认参数"clipboard"是为了在复制R代码之后，直接运行tidy.source()输出整理后的代码。

这个函数最大的问题就是不能保留注释语句（即#），因此我想稍微扩展一下它的功能，使之保留注释语句，初步想法是：先用readLines()读源代码，分析是否以#开头，记下注释的位置，然后把注释行之间的R代码进行parse()和deparse()再嵌进来，这样就可以保留注释语句了。这个工作首先要去除首尾的空格，这个好办，用正则表达式就可以了：

txt = gsub('^[[:space:]]+|[[:space:]]+$','',txt)
中间的工作可能需要用循环，结合一些判断就完成了。因为我自己没空去细想，所以把想法贴在这里，有兴趣的朋友可以补充。谢谢！

1 年前回复 # 回复
2楼

vampire530

初级会员
注册于: 2009/02/16
发帖数: 60

呵呵，writing code还是一开始就保持好习惯比较好啦，不过LZ的这个点子很interesting~~支持一下

1 年前回复 # 回复
3楼

Ihavenothing

站长
注册于: 2008/09/28
发帖数: 679

我发布一个tidy.source v1.1 alpha。

##明明感觉是很简单的程序，为什么会写出这么多？？？

tidy.source=function(source="clipboard")
{tidy.block=function(block.text)
{        exprs=parse(text=block.text);
n=length(exprs);
        res=character(n);
    for(i in 1:n)
{    dep=paste(deparse(exprs[i]),collapse="\n");
res[i]=substring(dep,12,nchar(dep)-1);}
        return(paste(res,collapse="\n"));}
    text.lines=readLines(con=file(source),warn=FALSE);
    text.lines=gsub('^[[:space:]]+|[[:space:]]+$','',text.lines);
    lines.head=substring(text.lines,1,1);
flag=FALSE;
if(lines.head[1]=="#"){
    lines.head=c("f",lines.head);
        text.lines=c("first=NULL",text.lines);flag=TRUE;
    }
sharp.index=(lines.head=="#");
    if(all(sharp.index==FALSE)==TRUE){
content=tidy.block(paste(text.lines,collapse="\n"));return(cat(content));
                              }
index.diff=diff(sharp.index);
if(min(index.diff)>-1){
    pos.n=1;              neg.n=0;block.n=2;
        posneg=1;
    }
    else
{
index.neg=which(index.diff==-1);
    neg.n=length(index.neg);
        index.pos=which(index.diff==1);
    pos.n=length(index.pos);
block.n=pos.n+neg.n+1;
posneg=rep(index.pos,rep(2,length(index.pos)));
                posneg[2*1:neg.n]=index.neg;
posneg=posneg[1:(pos.n+neg.n)];
}
    block.begin=c(1,posneg+1);block.end=c(posneg,length(sharp.index));
block.iscomment=rep(c(0,1),pos.n+1,length.out=block.n);
block=data.frame(begin=block.begin,end=block.end,iscomment=block.iscomment);
    content=NULL;
    for(i in 1:block.n)
    {
content[i]=paste(text.lines[block[i,1]:block[i,2]],collapse='\n');
                            if(block[i,3]==0)
        {content[i]=tidy.block(content[i]);
        }}
if(flag){content=content[-1];}
content=ifelse(content=="NULL","",content);
text.content=paste(content,collapse="\n");
cat(text.content);}

######################
##　　　　　　　　　　　　　　　##
## 如果你阅读起来很痛苦，就请用 ##
## 函数本身优化一下这段代码吧。 ##
##　　　　　　　　　　　　　　　##
######################

几点说明：
这段程序事实上还没有完成，因为还有以下一些问题：
1、如果某一行中有“<命令>##<注释>”这种情况，那么这样的注释没有办法保留；
2、注释与注释之间如果有空行，那么空行会被保留，但命令之间的空行，以及命令与注释之间的空行会被删除；我不确定规范上是不是应该删掉所有的空行，但实现起来是很简单的。
3、最要命的一点，如果注释出现在域结构内（大括号中），那么程序就会出错；感觉这一点我很难实现。

1 年前回复 # 回复
4楼

安华·刹那

站长
注册于: 2007/02/26
发帖数: 383

那个……我说个比较白痴的……

（基于Eclipse和StatET）
1.赋值号可以用编辑器的查找替换
2.缩进：一方面编辑器会自动缩进，已经写好的混乱代码只需全选，复制，再粘贴一下，代码格式就会自动整理好了

汗一个，我觉着这样就不错了

1 年前回复 # 回复
5楼

cloud_wei

资深会员
注册于: 2007/04/21
发帖数: 929

debug一下，代码似乎也排整齐了

1 年前回复 # 回复
6楼

刘思喆

版主
注册于: 2006/06/26
发帖数: 1,151

R-exts 里关于tidying R code 那部分，结果也没注释。
如果只是排整齐了，还是比较好办得。

1 年前回复 # 回复
7楼

谢益辉

个人主页
注册于: 2006/05/19
发帖数: 7,262

谢谢Ihavenothing，本函数稍作更改，收录到animation包中了：http://r-forge.r-project.org/plugins/scmsvn/viewcvs.php/pkg/?root=animation

1 年前回复 # 回复
8楼

Ihavenothing

站长
注册于: 2008/09/28
发帖数: 679

还是觉得我编得太罗嗦了，可能一直以来就没养成简洁的编程习惯。
另外感觉域结构内的注释是个最大的问题，因为用parse()的话，域结构是被当作一个整体进行读取的，注释很自然地就被无视掉了。
我有空的时候再多想想吧。

1 年前回复 # 回复
9楼

Ihavenothing

站长
注册于: 2008/09/28
发帖数: 679

傻了傻了，有一个超简单的算法居然没想到。之前的那一大团代码，说白了就是分以下几步：
1.读取每一行的命令，判断该行是不是注释；
2.将全文分成一个个连续的区域，每一个区域中要么全是注释，要么全是命令；
3.提取是命令的区域，进行代码美化；
4.将注释区域和美化后的代码区域进行合并。
这样做的话就会出现之前说的那些问题，而且会使得程序看起来很冗长。

今天突然想到了另一种方式，感觉是简单了很多，而且可以读取域结构中的注释。想法很简单，首先依然是读取行和判断是否为注释，接下来将注释改装成一句命令，这样在parse的时候这句话就不会被删掉。然后全文进行代码美化，再通过一些标志性的字眼将注释还原。具体是这样的：
如果有一行注释是
#### 这是注释
那么就把它改成
headOfComment="####这是注释endOfComment"
这样一来，注释就成了一句命令，是可以被读取的。经过代码美化后，将多加的这些字符删除，就可以把注释还原了。
当然这样稍微有些违背编程的原则，就是多加的这些字符可能是代码命令中的一部分，你无法区分哪些是原来代码就有的，哪些是你自己加的。不过我个人感觉出现这种情况的几率不大，除非刻意去抓这个bug。

新的代码如下：

tidy.source <- function(source = "clipboard", ...) {
    tidy.block <- function(block.text) {
        exprs = parse(text = block.text)
        n = length(exprs)
        res = character(n)
        for (i in 1:n) {
            dep = paste(deparse(exprs[i]), collapse = "\n")
            res[i] = substring(dep, 12, nchar(dep) - 1)
        }
        return(paste(res, collapse = "\n"))
    }
    text.lines = readLines(con = file(source), warn = FALSE)
    text.lines = gsub("^[[:space:]]+|[[:space:]]+$", "", text.lines)
    lines.head = substring(text.lines, 1, 1)
    text.lines[lines.head == "#"] = paste("headOfComment=\"",
        text.lines[lines.head == "#"], "endOfComment\"", sep = "")
    text.tidy = tidy.block(text.lines)
    text.tidy = gsub("headOfComment = \"|endOfComment\"", "",
        text.tidy)
    cat(text.tidy, ...)
}

下一步的任务就是解决行尾的注释了。

1 年前回复 # 回复
10楼

谢益辉

个人主页
注册于: 2006/05/19
发帖数: 7,262

妙！！！

1、关于你说的bug，可以让用户自己解决，例如让用户自定义添加在注释首尾的字符串，这两个字符串可以由你作为参数给出默认值，如c("headOfComment", "endOfComment")；

2、关于行尾的注释，你可以这样处理：在它们前面加上"\n"，使得它们变成新的一行，然后用你上面的函数处理；只是判断#是否是注释还稍微有点麻烦，因为#不一定是注释，还有可能是字符串，如"#"或"12#34"就不是注释，switch('#', `#`=1)中的`#`也不是注释，不过我能想到的情况只有这两种情况（在引号""或''和``中）。所以你可以再试试改进吧：）

1 年前回复 # 回复
11楼

谢益辉

个人主页
注册于: 2006/05/19
发帖数: 7,262

这个函数Ihavenothing还有空完善一下么？

1 年前回复 # 回复
12楼

Ihavenothing

站长
注册于: 2008/09/28
发帖数: 679

嗯，好的，昨天睡觉前就在想这个问题。

1 年前回复 # 回复
13楼

Ihavenothing

站长
注册于: 2008/09/28
发帖数: 679

拖了这么多天，今天总算是有点成果了，目前应该解决了行尾注释的问题。先说一下我的思路：
依然是读取代码的每一行，现在的关键就是想办法把行尾的注释给标记出来。我的做法是，先将读取的行“粉碎”成单个字符组成的向量，获取其中所有“#”符号的坐标并计算其个数（代码中就是nsharp），然后用parse()的方法分析这一行，看其中有多少个非注释性质的“#”符号（代码中是nsharp.tidy），比较这两个数值的差距，就可以获取这一行中起到注释作用的“#”符号的位置，然后对其加上标记（代码中是delEnter="*******endOfComment"），之后的工作就与前面的类似了。
我个人感觉最麻烦的部分是用parse()分析非注释性质的“#”的个数，因为很多行可能本身不是完整的语句，不能直接用parse()读取，比如下面些情况：
{#
所以就需要把这些字符转成可以被parse()读取的语句。最初的想法是用一个简单的语句，比如brace;来替换掉“{”和“}”，但因为一些诡异的原因（后面会再说，比如else），最终选择的语句是“if(1){}”。而又考虑到下面的情形，
a=function(x)  #123
{
}
在读取第一行时，function(x)后面没有语句，会报错，所以还得在每行的最后及“#”之前加上“{}”以“欺骗”parse()函数。举个例子来说，为了计算每一行非注释性“#”的个数，下面这一行

}a="123#" #这里是注释
会被转换成
if(1){}a=\"123\n{}#\" \n{}#这里是注释\n{}
才能被parse()识别出非注释“#”的个数是1，而这一行总共的“#”的个数是2，所以可以判断，第二个“#”是起到注释作用的符号，需要加上标记。
这样基本就可以应付大部分的语句，但遇到一些R中的关键字，比如“else”，就可能遇到麻烦，比如parse()要求else附近要有完整的if...else结构，所以我前面才会把大括号转换成“if(1){}”这样诡异的语句。
下面是整个函数的代码：

tidy.source<-function(source="clipboard",nullline=TRUE,...)
{
    tidy.block<-function(block.text)
    {
        exprs=parse(text=block.text);
        n=length(exprs);
        res=character(n);
        for(i in 1:n)
        {
            dep=paste(deparse(exprs[i]),collapse="\n");
            res[i]=substring(dep,12,nchar(dep)-1);
        }
        return(paste(res,collapse="\n"));
    }
    line.convert<-function(line)
    {
        line.ch=unlist(strsplit(line,""));
        sharp.index=which(line.ch=="#");
        nsharp=length(sharp.index);
        line2=gsub("[{}]","if(1){}",line);
        line2=gsub("#","\n{}#",line2);
        line2=paste(line2,"\n{}",collapse="");
        line.tidy.ch=unlist(strsplit(tidy.block(line2),""));
        nsharp.tidy=length(which(line.tidy.ch=="#"));
        if(nsharp==nsharp.tidy)
        {
            return(line);
        }else
        {
            line.ch[sharp.index[nsharp.tidy+1]]="\ndelEnter=\"#";
            line.ch=c(line.ch,"endOfComment\"");
        }
        return(paste(line.ch,sep="",collapse=""));
    }
    text.lines=readLines(con=file(source),warn=FALSE);
    text.lines=gsub('^[[:space:]]+|[[:space:]]+$','',text.lines);
    if(nullline)
    {
        text.lines=ifelse(text.lines=="","isNullLine",text.lines);
    }
    lines.head=substring(text.lines,1,1);
    text.lines[lines.head=="#"]=paste("headOfComment=\"",text.lines[lines.head=="#"],"endOfComment\"",sep="");
    text.lines[lines.head!="#"]=sapply(text.lines[lines.head!="#"],line.convert);
    text.tidy=tidy.block(text.lines);
    text.tidy=gsub("headOfComment = \"|endOfComment\"|isNullLine","",text.tidy);
    text.tidy=gsub("\n[ ]+delEnter = \"|delEnter = \"|\ndelEnter = \""," ",text.tidy);
    cat(text.tidy,...);
}
下面的代码供测试用：

#### Test ####
#### Yihui Xie ####

tidy.source<- function (source = "clipboard", ...)#这里有注释
#这里有注释
{#这里也有注释
    exprs = parse(source) #这里依然有注释
    n = length(exprs)
    res = character(n)
    for(i in 1:n){
        dep = paste(deparse(exprs[i]), collapse = "\n")
        res[i] = substring(dep, 12, nchar(dep) - 1)
    }#这里也加上一个注释
    cat(paste(res, collapse = "\n"), "\n", ...)
}
###################

此外还需要交代一个bug，就是下面这种结构会报错：

if(...)
{
...
}
else
{
...
}
也就是}与else之间不能有换行，要改成成
if(...)
{
...
}else
{
...
}
才行。事实上，这是R里面我感觉一个比较奇怪的规定，因为这种结构放在函数体内不会报错，但单独运行却会，不知何故……

依cloud_wei的建议，加入了参数nullline，为真时保留空行，为假时删除空行。

1 年前回复 # 回复
14楼

cloud_wei

资深会员
注册于: 2007/04/21
发帖数: 929

两个问题：
1. 测试例子中的中文注释在代码整理后有时全变为"?"？不知别人的机子上有没有这个问题。我的是R-2.8.1，WIN-XP.
2. 程序中的空行是否应该考虑恰当保留，写代码时时常刻意留空行以增强可读性的。当然，可以设置一个阈值，比如2，意思是2行以内的空行不做处理，而超过2行的空行则删至2行。这个可以作为函数参数。

1 年前回复 # 回复
15楼

Ihavenothing

站长
注册于: 2008/09/28
发帖数: 679

引用第13楼[i]cloud_wei[/i]于[i]2009-03-25 13:43[/i]发表的“”:
两个问题：
1. 测试例子中的中文注释在代码整理后有时全变为"?"？不知别人的机子上有没有这个问题。我的是R-2.8.1，WIN-XP.
2. 程序中的空行是否应该考虑恰当保留，写代码时时常刻意留空行以增强可读性的。当然，可以设置一个阈值，比如2，意思是2行以内的空行不做处理，而超过2行的空行则删至2行。这个可以作为函数参数。

第一个我猜是中文编码的问题，这个不太懂，等谢老大来看看吧。
第二个应该好办，我找时间改改。

1 年前回复 # 回复
16楼

谢益辉

个人主页
注册于: 2006/05/19
发帖数: 7,262

上面的函数对于不完整的行还是没法处理啊

想了想，与其写函数的人折腾得死去活来，不如让用户自觉遵守规范，不把注释写在行末算了

我最终决定不管那些写在行末的注释，并添加了几个参数，让用户可以控制是否保留注释（keep.comment）、是否保留空行（keep.blank.line）、注释首尾的标记，并保证这两个标记与原始代码没有冲突：

tidy.source <- function(source = "clipboard", keep.comment = TRUE,
    keep.blank.line = FALSE, begin.comment, end.comment, ...) {
    # parse and deparse the code
    tidy.block = function(block.text) {
        exprs = parse(text = block.text)
        n = length(exprs)
        res = character(n)
        for (i in 1:n) {
            dep = paste(deparse(exprs[i]), collapse = "\n")
            res[i] = substring(dep, 12, nchar(dep) - 1)
        }
        return(res)
    }
    text.lines = readLines(source, warn = FALSE)
    if (keep.comment) {
        # identifier for comments
        identifier = function() paste(sample(LETTERS), collapse = "")
        if (missing(begin.comment))
            begin.comment = identifier()
        if (missing(end.comment))
            end.comment = identifier()
        # remove leading and trailing white spaces
        text.lines = gsub("^[[:space:]]+|[[:space:]]+$", "",
            text.lines)
        # make sure the identifiers are not in the code
        # or the original code might be modified
        while (length(grep(sprintf("%s|%s", begin.comment, end.comment),
            text.lines))) {
            begin.comment = identifier()
            end.comment = identifier()
        }
        head.comment = substring(text.lines, 1, 1) == "#"
        # add identifiers to comment lines to cheat R parser
        if (any(head.comment)) {
            text.lines[head.comment] = gsub("\"", "\'", text.lines[head.comment])
            text.lines[head.comment] = sprintf("%s=\"%s%s\"",
                begin.comment, text.lines[head.comment], end.comment)
        }
        # keep blank lines?
        blank.line = text.lines == ""
        if (any(blank.line) & keep.blank.line)
            text.lines[blank.line] = sprintf("%s=\"%s\"", begin.comment,
                end.comment)
        text.tidy = tidy.block(text.lines)
        # remove the identifiers
        text.tidy = gsub(sprintf("%s = \"|%s\"", begin.comment,
            end.comment), "", text.tidy)
    }
    else {
        text.tidy = tidy.block(text.lines)
    }
    cat(paste(text.tidy, collapse = "\n"), "\n", ...)
    invisible(text.tidy)
}

测试：

> tidy.source('http://addictedtor.free.fr/graphiques/sources/source_152.R')
#' Represents Correlation circles
#'
#' @author Taiyun Wei
#' @param corr Correlation matrix to represent
#' @param col vector the fill color of circles from 1 to -1
#'        the length of it may not be 2, eg rainbow(50)
#' @param bg background color of graph
#' @param cex numeric, for the variable names
#' @param order whether reorder the variables using principal
#'         component analysis of the correlation matrix
#' @param title title of the graph
#' @param ... extra parameters, currenlty ignored
circle.corr <- function(corr, col = c("black", "white"),
    bg = "white", cex = 1, order = FALSE, title = "", ...) {
    if (is.null(corr))
        return(invisible())
    if ((!is.matrix(corr)) || (round(min(corr, na.rm = TRUE),
        6) < -1) || (round(max(corr, na.rm = TRUE), 6) > 1))
        stop("Need a correlation matrix!")
    n <- nrow(corr)
    m <- ncol(corr)
    ## reorder the variables using principal component analysis
    if (order) {
        if (!n == m) {
            stop("The matrix must be squre if order is TRUE!")
        }
        x.eigen <- eigen(corr)$vectors[, 1:2]
        e1 <- x.eigen[, 1]
        e2 <- x.eigen[, 2]
        alpha <- ifelse(e1 > 0, atan(e2/e1), atan(e2/e1) + pi)
        corr <- corr[order(alpha), order(alpha)]
    }
    ## set up variable names
    rname <- rownames(corr)
    cname <- colnames(corr)
    if (is.null(rname))
        rname <- 1:n
    if (is.null(cname))
        cname <- 1:m
    rname <- as.character(rname)
    cname <- as.character(cname)
    ## calculate label-text width approximately
    par(mar = c(0, 0, 2, 0), bg = "white")
    plot.new()
    plot.window(c(0, m), c(0, n), asp = 1)
    xlabwidth <- max(strwidth(rname, cex = cex))
    ylabwidth <- max(strwidth(cname, cex = cex))
    ## set up an empty plot with the appropriate dimensions
    plot.window(c(-xlabwidth + 0.5, m + 0.5), c(0, n + 1 + ylabwidth),
        asp = 1, xlab = "", ylab = "")
    rect(0.5, 0.5, m + 0.5, n + 0.5, col = bg)
    ## add variable names and title
    text(rep(-xlabwidth/2, n), n:1, rname, col = "red", cex = cex)
    text(1:m, rep(n + 1 + ylabwidth/2, m), cname, srt = 90, col = "red",
        cex = cex)
    title(title)
    ## add grid
    segments(rep(0.5, n + 1), 0.5 + 0:n, rep(m + 0.5, n + 1),
        0.5 + 0:n, col = "gray")
    segments(0.5 + 0:m, rep(0.5, m + 1), 0.5 + 0:m, rep(n + 0.5,
        m), col = "gray")
    ## assign circles' fill color
    nc <- length(col)
    if (nc == 1)
        bg <- rep(col, n * m)
    else {
        ff <- seq(-1, 1, length = nc + 1)
        bg2 = rep(0, n * m)
        for (i in 1:(n * m)) {
            bg2[i] <- rank(c(ff[2:nc], as.vector(corr)[i]), ties.method = "random")[nc]
        }
        bg <- (col[nc:1])[bg2]
    }
    ## plot n*m circles using vector language, suggested by Yihui Xie
    ## the area of circles denotes the absolute value of coefficient
    symbols(rep(1:m, each = n), rep(n:1, m), add = TRUE, inches = F,
        circles = as.vector(sqrt(abs(corr))/2), bg = as.vector(bg))
}
## examples
data(mtcars)
circle.corr(cor(mtcars), order = TRUE, bg = "gray50",
    col = colorRampPalette(c("blue", "white", "red"))(100))

1 年前回复 # 回复

RSS 订阅本帖

您必须登录才能回复。