Question

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

例如，下面通过首先找到“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"

非常感谢你的时间，

Tony Breyal

P.S。以上可能是做我想做的最有效的方式，但我想我会问以防万一有更好的方法：）

===== TIMINGS =====

#                             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)

Answer 1

您仍然可以将正则表达式与占位符一起使用，如下所示：

> sub("^(.)abc", "\\1xyz", c("aabcdef", "xxxxxxx"))
[1] "axyzdef" "xxxxxxx"

Answer 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 manual描述了写屏障：

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

R扩展中的所有代码默认位于写屏障后面。

Luke Tierney's document描述了原因背后的逻辑：

分代收集器将分配的节点分为几代基于一些年龄概念。年轻一代被收集更多经常比旧的。为了正常工作，任何年轻人必须处理只能从较旧节点访问的节点正常。这是通过监视每个的写屏障来实现的赋值并在引用新节点时采取适当的操作是旧的。

Answer 3

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

x <- paste(substr(x, 1, 1), "1234", substr(x, 5, nchar(x)), sep="")

Answer 4

DWin功能的一些改进。

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

使用相等或更大长度的字符串有效地替换固定位置子串

4 个答案: