5

用另一个相等或更大长度的字符串替换固定位置子字符串的有效方法是什么？

例如，下面通过首先找到“abc”的位置然后替换它来替换子字符串“abc”：

sub("abc", "123", "iabc.def", fixed = TRUE)
#[1] "i123.def"

sub("abc", "1234", "iabc.def", fixed = TRUE)
#[1] "i1234.def"

但是，我们知道子字符串“abc”总是在字符位置 2、3 和 4。在这种情况下，有没有办法指定这些位置，以便不需要执行字符串匹配并且使用字符索引反而？

我确实尝试使用 substr() 但是当替换字符串大于被替换的子字符串时，它并没有像我希望的那样工作：

x <- "iabc.def"
substr(x, 2, 4) <- "123"
#[1] "i123.def"

x <- "iabc.def"
substr(x, 2, 4) <- "1234"
#[1] "i123.def"

非常感谢您抽出宝贵的时间，

托尼·布雷亚尔

PS以上可能是做我想做的最有效的方法，但我想我会问，以防万一有更好的方法:)

===== 时间 =====

#                             test elapsed  relative
# 7 francois.fx_wb(x, replacement)    0.94  1.000000
# 1                           f(x)    1.56  1.659574
# 6    francois.fx(x, replacement)    2.23  2.372340
# 5                      Sobala(x)    3.89  4.138298
# 2                    Hong.Ooi(x)    4.41  4.691489
# 3                        DWin(x)    5.57  5.925532
# 4                      hadley(x)    9.47 10.074468

上面的时间是从下面的代码生成的：

library(rbenchmark)
library(stringr)
library(Rcpp)
library(inline)

f <- function(x, replacement = "1234")  sub("abc", replacement, x, fixed = TRUE)

Hong.Ooi <- function(x, replacement = "1234") paste(substr(x, 1, 1), replacement, substr(x, 5, nchar(x)), sep = "")

DWin <- function(x, replacement =  paste("\\1", "1234", sep = "")) sub("^(.)abc", replacement, x)

Sobala <- function(x, replacement =  paste("\\1", "1234", sep = ""))  sub("^(.).{3}", replacement, x, perl=TRUE)

hadley <- function(x, replacement = "1234") {
  str_sub(x, 2, 4) <- replacement
  return(x)
}

francois.fx <- cxxfunction( signature( x_ = "character", rep_ = "character" ), '

    const char* rep =as<const char*>(rep_) ;
    CharacterVector x(x_) ;
    int nrep = strlen( rep ) ;
    int n = x.size() ; 
    CharacterVector res(n) ;

    char buffer[1024] ;

    for(int i=0; i<n; i++) {
        const char* xi = x[i] ;
        if( strncmp( xi+1, "abc", 3 ) ) {
            res[i] = x[i] ;
        } else{
            buffer[0] = xi[0] ;
            strncpy( buffer + 1, rep, nrep ) ;
            strcpy( buffer + 1 + nrep, xi + 4 ) ;
            res[i] = buffer ;
        }
    }
    return res ;
', plugin = "Rcpp" )

francois.fx_wb <- cxxfunction( signature( x_ = "character", rep_ = "character" ), '

    const char* rep =as<const char*>(rep_) ;
    int nrep = strlen( rep ) ;
    int n=Rf_length(x_) ;
    SEXP res = PROTECT( Rf_allocVector( STRSXP, n ) ) ;

    char buffer[1024] ;

    for(int i=0; i<n; i++) {
        const char* xi = char_get_string_elt(x_, i) ;
        if( strncmp( xi+1, "abc", 3 ) ) {
            set_string_elt( res, i, get_string_elt(x_,i)) ;
        } else{
            buffer[0] = xi[0] ;
            strncpy( buffer + 1, rep, nrep ) ;
            strcpy( buffer + 1 + nrep, xi + 4 ) ;
            char_set_string_elt(res, i, buffer ) ;
        }
    }
    UNPROTECT(1) ;
    return res ;
', plugin = "Rcpp" )


x <- rep("iabc.def", 1e6)
replacement <- "1234"
benchmark(f(x), Hong.Ooi(x), DWin(x), hadley(x), Sobala(x), francois.fx(x, replacement), francois.fx_wb(x, replacement),
          columns = c("test", "elapsed", "relative"),
          order = "relative",
          replications = 10)
4

4 回答 4

2

您仍然可以将正则表达式与这样的占位符一起使用：

> sub("^(.)abc", "\\1xyz", c("aabcdef", "xxxxxxx"))
[1] "axyzdef" "xxxxxxx"
于 2011-12-10T13:28:29.513 回答
2

这是一种基于 Rcpp 的解决方案。

fx <- cxxfunction( signature( x_ = "character", rep_ = "character" ), '

    const char* rep =as<const char*>(rep_) ;
    CharacterVector x(x_) ;
    int nrep = strlen( rep ) ;
    int n = x.size() ; 
    CharacterVector res(n) ;

    char buffer[1024] ;

    for(int i=0; i<n; i++) {
        const char* xi = x[i] ;
        if( strncmp( xi+1, "abc", 3 ) ) {
            res[i] = x[i] ;
        } else{
            buffer[0] = xi[0] ;
            strncpy( buffer + 1, rep, nrep ) ;
            strcpy( buffer + 1 + nrep, xi + 4 ) ;
            res[i] = buffer ;
        }
    }
    return res ;
', plugin = "Rcpp" )

它对简单的子解决方案没有太大改进，因为对 R 中的字符串的写访问受到写屏障的保护。如果我在写障碍上作弊，我会得到更好的结果，但我并不完全意识到后果，所以我可能应该建议不要这样做：/

fx_wb <- cxxfunction( signature( x_ = "character", rep_ = "character" ), '

    const char* rep =as<const char*>(rep_) ;
    int nrep = strlen( rep ) ;
    int n=Rf_length(x_) ;
    SEXP res = PROTECT( Rf_allocVector( STRSXP, n ) ) ;

    char buffer[1024] ;

    for(int i=0; i<n; i++) {
        const char* xi = char_get_string_elt(x_, i) ;
        if( strncmp( xi+1, "abc", 3 ) ) {
            set_string_elt( res, i, get_string_elt(x_,i)) ;
        } else{
            buffer[0] = xi[0] ;
            strncpy( buffer + 1, rep, nrep ) ;
            strcpy( buffer + 1 + nrep, xi + 4 ) ;
            char_set_string_elt(res, i, buffer ) ;
        }
    }
    UNPROTECT(1) ;
    return res ;
', plugin = "Rcpp" )

写屏障

R Internals 手册描述了写屏障：

分代收集器需要有效地“老化”对象，尤其是类似列表的对象（包括 STRSXP）。这是通过确保列表的元素在分配时被认为至少与列表一样旧来完成的。这由函数 SET_VECTOR_ELT 和 SET_STRING_ELT 处理，这就是为什么它们是函数而不是宏的原因。确保此类操作的完整性被称为写屏障，并且通过使 SEXP 不透明并且仅通过函数提供访问来完成（在 C 中不能用作左值）。

默认情况下，R 扩展中的所有代码都位于写屏障之后。

Luke Tierney 的文档描述了原因背后的逻辑：

分代收集器根据一些年龄概念将分配的节点分成几代。年轻一代的收集频率高于老一代。为了使其正常工作，必须正确处理只能从较旧节点访问的任何较年轻节点。这是通过一个写屏障来实现的，该屏障监视每个分配并在对新节点的引用被放置在旧节点中时采取适当的行动。

于 2011-12-14T10:41:22.567 回答
1

我能想到的最直接的方法：

x <- paste(substr(x, 1, 1), "1234", substr(x, 5, nchar(x)), sep="")
于 2011-12-10T11:26:08.783 回答
1

DWin 功能的一些改进。

function(x, replacement =  paste("\\1", "1234", sep = "")) 
                     sub("^(.).{3}", replacement, x,perl=TRUE)
于 2011-12-10T23:35:30.183 回答