4


我有(html-)文本,我想将这些ö内容更改为真正的字符,如 ä、ü、ö 等,因为否则 xml 包不接受它。

所以我写了一个小函数,它循环通过一个替换表(link1link2)并用 sp 用特殊字符替换特殊字符......这个函数看起来像这样(只有 looonger):

html.charconv <- function(text){
    replacer <- matrix(c(
    "Á",    "&Aacute;",
    "á",    "&aacute;",
    "Â",    "&Acirc;",
    "â",    "&acirc;",
    "´",    "&acute;"
    )
    ,ncol=2,byrow=T)

    for(i in 1:length(replacer[,1])){
        text <- str_replace_all(text,replacer[i,2],replacer[i,1])
    }
    text
}

我该如何加快速度?我考虑过矢量化,但没有提供任何帮助解决方案,因为对于每个周期,最后一个周期的结果是它的起点。

4

4 回答 4

8

你可以通过稍微不同地构建你的函数来获得显着的加速,而忘记文本工具。基本上你:

  1. 拆分字符串
  2. 匹配您想要的字符并用新字符替换它们
  3. 再次将所有内容粘贴在一起

您可以使用以下功能做到这一点:

html.fastconv <- function(x,old,new){
    xs <- strsplit(x,"&|;")
    old <- gsub("&|;","",old)
    xs <- lapply(xs,function(i){
        id <- match(i,old,0L)
        i[id!=0] <- new[id]
        return(i)
    })
    sapply(xs,paste,collapse="")
}

这工作为:

> sometext <- c("&Aacute;dd som&aacute; le&Acirc;tter&acirc; acute problems et&acute; cetera",
+  "&Aacute;dd som&aacute; le&Acirc;tter&acirc; acute p ..." ... [TRUNCATED] 

> newchar <- c("Á","á","Â","â","´")

> oldchar <- c("&Aacute;","&aacute;","&Acirc;","&acirc;","&acute;")
> html.fastconv(sometext,oldchar,newchar)
[1] "Ádd somá leÂtterâ acute problems et´ cetera" "Ádd somá leÂtterâ acute problems et´ cetera"

作为记录,一些基准测试:

require(rbenchmark)
benchmark(html.fastconv(sometext,oldchar,newchar),html.charconv(sometext),
     columns=c("test","elapsed","relative"),
     replications=1000) 
                                       test elapsed relative
2                   html.charconv(sometext)    0.79    5.643
1 html.fastconv(sometext, oldchar, newchar)    0.14    1.000
于 2012-11-27T12:26:40.783 回答
8

只是为了好玩,这里是一个基于Rcpp.

#include <Rcpp.h>
using namespace Rcpp ;

// [[Rcpp::export]]
CharacterVector rcpp_conv( 
    CharacterVector text, CharacterVector old , CharacterVector new_){

    int n  = text.size() ;
    int nr = old.size() ;

    std::string buffer, current_old, current_new ;
    size_t pos, current_size ; 
    CharacterVector res(n) ;

    for( int i=0; i<n; i++){
        buffer = text[i] ;
        for( int j=0; j<nr; j++){
             current_old = old[j] ;
             current_size = current_old.size() ;
             current_new = new_[j] ;
             pos = 0 ;   
             pos = buffer.find( current_old ) ;
             while( pos != std::string::npos ){
                 buffer.replace( 
                     pos, current_size, 
                     current_new
                 ) ;
                 pos = buffer.find( current_old ) ;
             }
        }
        res[i] = buffer ;
    }
    return res ;
}

为此,我获得了相当大的性能提升:

> microbenchmark(
+     html.fastconv( sometext,oldchar,newchar),
+     html.fastconvJC(sometext, oldchar, newchar),
+     rcpp_conv( sometext, oldchar, newchar)
+ )
Unit: microseconds
                                         expr    min      lq   median      uq
1   html.fastconv(sometext, oldchar, newchar) 97.588 99.9845 101.4195 103.072
2 html.fastconvJC(sometext, oldchar, newchar) 19.945 23.3060  25.8110  28.134
3       rcpp_conv(sometext, oldchar, newchar)  4.047  5.1555   6.2340   9.275
      max
1 256.061
2  40.647
3  25.763

这是一个基于该Rcpp::String功能的实现,可从Rcpp >= 0.10.2

class StringConv{
public:
    typedef String result_type ;
    StringConv( CharacterVector old_, CharacterVector new__): 
        nr(old_.size()), old(old_), new_(new__){}

    String operator()(String text) const {
        for( int i=0; i<nr; i++){
            text.replace_all( old[i], new_[i] ) ;
        }     
        return text ;
    }

private:
    int nr ;
    CharacterVector old ;
    CharacterVector new_ ;
} ;

// [[Rcpp::export]]
CharacterVector test_sapply_string( 
   CharacterVector text, CharacterVector old , CharacterVector new_
){
   CharacterVector res = sapply( text, StringConv( old, new_ ) ) ;
   return res ;
}  
于 2012-11-27T13:49:05.353 回答
5

我猜 36,000 个文件读写是你的瓶颈,而你在 R 中编码的方式对此无济于事。有些事情只需要一段时间。你的函数看起来可以正常工作,让它运行。您可以进行一些小的改进。

replacer <- matrix(c(
    "Á",    "&Aacute;",
    "á",    "&aacute;",
    "Â",    "&Acirc;",
    "â",    "&acirc;",
    "´",    "&acute;"
    )
    ,ncol=2, byrow=T)

html.fastconvJC <- function(x,old,new){
    n <- length(new)
    s <- x #make a copy cause I'm scared of scoping in R :)
    for (i in 1:n) s <- gsub(old[i], new[i], s, fixed = TRUE)
    s
    }

# borrowing the strings from Joris Meys
benchmark(html.fastconvJC(sometext, replacer[,2], replacer[,1]),
      html.charconv(sometext), columns = c("test", "elapsed", "relative"),
      replications=1000)

                                                     test elapsed relative
2                                 html.charconv(sometext)   0.727    17.31
1 html.fastconvJC(sometext, replacer[, 2], replacer[, 1])   0.042     1.00

他们的速度比我预期的要快。请注意,加速的很大一部分是fixed = TRUE,否则 Joris Meys 的回答速度大致相同。

如果这不能使您的整体速度提高很多,您就会知道瓶颈在其他地方,可能是文件读取和写入。除非您有固态或 RAID 驱动器,否则并行运行它不会加快速度,可能只会减慢速度。

于 2012-11-27T12:10:23.703 回答
-1

我会尝试 plyr :

input.data <- llply(input.files, html.charconv, .parallel=TRUE) 
于 2012-11-27T11:15:07.673 回答