R条件替换/修剪填充(正则表达式,gsub,gregexpr,regmatches)

时间:2014-08-06 18:57:49

标签: regex r replace trim

我有一个涉及条件替换的问题。

我基本上想找到每一串数字,并且对于4之后的每个连续数字,用空格替换它。

我需要解决方案进行矢量化,速度至关重要。

这是一个有效(但效率低下的解决方案):

data <- data.frame(matrix(NA, ncol=2, nrow=6, dimnames=list(c(), c("input","output"))), 
                              stringsAsFactors=FALSE)
data[1,] <- c("STRING WITH 2 FIX(ES): 123456    098765  1111   ",NA)
data[2,] <- c(" PADDED STRING WITH 3 FIX(ES): 123456    098765  111111   ",NA)
data[3,] <- c(" STRING WITH 0 FIX(ES): 12        098     111   ",NA)
data[4,] <- c(NA,NA)
data[5,] <- c("1234567890",NA)
data[6,] <- c("   12345   67890    ",NA)

x2 <- data[,"input"]
x2

p1 <- "([0-9]+)"

m1 <- gregexpr(p1, x2,perl = TRUE)

nchar1 <- lapply(regmatches(x2, m1), function(x){
  if (length(x)==0){ x <- NA  } else ( x <- nchar(x))
  return(x) })

x3 <- mapply(function(match,length,text,cutoff) {
  temp_comb <- data.frame(match=match, length=length, stringsAsFactors=FALSE)

  for(i in which(temp_comb[,"length"] > cutoff))
  {
    before <- substr(text, 1, (temp_comb[i,"match"]-1))
    middle_4 <- substr(text, temp_comb[i,"match"], temp_comb[i,"match"]+cutoff-1)
    middle_space <-  paste(rep(" ", temp_comb[i,"length"]-cutoff),sep="",collapse="")
    after <-  substr(text, temp_comb[i,"match"]+temp_comb[i,"length"], nchar(text))
    text <- paste(before,middle_4,middle_space,after,sep="")
  }
  return(text)

},match=m1,length=nchar1,text=x2,cutoff=4)

data[,"output"] <- x3

有更好的方法吗?

我正在查看 regmatches 的帮助部分,并且有一个类似的类型问题,但它完全替换为空白而不是有条件的。

我会写一些替代方案并对它们进行基准测试但老实说,我想不出其他方法可以做到这一点。

提前感谢您的帮助!

更新

斑点,

使用你的方式,但截止输入,我收到NA情况的错误:

#replace numbers afther the 4th with spaces for those matches
zz<-lapply(regmatches(data$input, m), function(x,cutoff) {

    # x <- regmatches(data$input, m)[[4]]
    # cutoff <- 4

    mapply(function(x, n, cutoff){
      formatC(substr(x,1,cutoff), width=-n)
    }, x=x, n=nchar(x),cutoff=cutoff)

},cutoff=4)

3 个答案:

答案 0 :(得分:1)

这是一个只有一个gsub命令的快速方法:

gsub("(?<!\\d)(\\d{4})\\d*", "\\1", data$input, perl = TRUE)
# [1] "STRING WITH 2 FIX(ES): 1234    0987  1111   "        
# [2] " PADDED STRING WITH 3 FIX(ES): 1234    0987  1111   "
# [3] " STRING WITH 0 FIX(ES): 12        098     111   "    
# [4] NA                                                    
# [5] "1234"                                                
# [6] "   1234   6789    "  

字符串(?<!\\d)是一个负前瞻:一个前面没有数字的位置。字符串(\\d{4})表示 4个连续数字。最后,\\d*表示任意数量的数字。与此正则表达式匹配的字符串部分将替换为第一个组(前4个数字)。


不改变字符串长度的方法:

matches <- gregexpr("(?<=\\d{4})\\d+", data$input, perl = TRUE)
mapply(function(m, d) {
  if (!is.na(m) && m != -1L) {
    for (i in seq_along(m)) {
      substr(d, m[i], m[i] + attr(m, "match.length") - 1L) <- paste(rep(" ", attr(m, "match.length")[i]), collapse = "")
    }
  }
  return(d)
}, matches, data$input)

# [1] "STRING WITH 2 FIX(ES): 1234      0987    1111   "          
# [2] " PADDED STRING WITH 3 FIX(ES): 1234      0987    1111     "
# [3] " STRING WITH 0 FIX(ES): 12        098     111   "          
# [4] NA                                                          
# [5] "1234      "                                                
# [6] "   1234    6789     "  

答案 1 :(得分:1)

您可以在一行(以及一个数字的一​​个空格)中执行相同的操作

gsub("(?:\\G(?!\\A)|\\d{4})\\K\\d", " ", data$input, perl = TRUE)

细节:

(?:        # non-capturing group: the two possible entry points
    \G     # either the position after the last match or the start of the string
    (?!\A) # exclude the start of the string position
  |        # OR
    \d{4}  # four digits
)          # close the non-capturing group
\K         # removes all on the left from the match result
\d         # a single digit

答案 2 :(得分:0)

这是gregexprregmatches

的一种方式
#find all numbers with more than 4 digits
m <- gregexpr("\\d{5,}", data$input)

#replace numbers afther the 4th with spaces for those matches
zz<-lapply(regmatches(data$input, m), function(x) {
        mapply(function(x, n) formatC(substr(x,1,4), width=-n), x, nchar(x))
})

#combine with original values
data$output2 <- unlist(Map(function(a,b) paste0(a,c(b,""), collapse=""), 
    regmatches(data$input, m, invert=T), zz))

这里的不同之处在于它将NA值转换为""。我们可以添加其他检查来防止这种情况,或者只是将所有零长度字符串转换为最后的缺失值。我只是不想通过安全检查使代码过于复杂。