R - 提取匹配模式的所有字符串并创建关系表

Question

我正在寻找一个更短，更漂亮的解决方案（可能在tidyverse）以解决以下问题。 我有一个data.frame“数据”：

  id            string
1  A 1.001 xxx 123.123
2  B 23,45 lorem ipsum
3  C      donald trump
4  D    ssss 134, 1,45

我想要做的是提取所有数字（无论分隔符是“。”还是“，” - >在这种情况下我假设字符串“134,1,45”可以提取为两个数字：134和1.45 ）并创建一个类似于这个的data.frame“输出”：

  id  string
1  A   1.001
2  A 123.123
3  B   23.45
4  C    <NA>
5  D     134
6  D    1.45

我设法做到这一点（下面的代码），但解决方案对我来说非常难看也不那么有效（两个for循环）。 有人建议更好的方法来做到这一点（最好使用dplyr）

# data
data <- data.frame(id = c("A", "B", "C", "D"), 
                  string = c("1.001 xxx 123.123", 
                             "23,45 lorem ipsum", 
                             "donald trump", 
                             "ssss 134, 1,45"),
                  stringsAsFactors = FALSE)

# creating empty data.frame                     
len <- length(unlist(sapply(data$string, function(x) gregexpr("[0-9]+[,|.]?[0-9]*", x))))
output <- data.frame(id = rep(NA, len), string = rep(NA, len))

# main solution
start = 0

for(i in 1:dim(data)[1]){
  tmp_len <- length(unlist(gregexpr("[0-9]+[,|.]?[0-9]*", data$string[i])))
  for(j in (start+1):(start+tmp_len)){
    output[j,1] <- data$id[i]
    output[j,2] <- regmatches(data$string[i], gregexpr("[0-9]+[,|.]?[0-9]*", data$string[i]))[[1]][j-start]
  }
  start = start + tmp_len
}

# further modifications
output$string <- gsub(",", ".", output$string)
output$string <- as.numeric(ifelse(substring(output$string, nchar(output$string), nchar(output$string)) == ".",
                                   substring(output$string, 1, nchar(output$string) - 1),
                                   output$string))

output

Answer 1

1）Base R这使用相对简单的正则表达式而不使用包。

在前两行代码中，替换任何逗号，后跟带空格的空格，然后用点替换所有剩余的逗号。 在这两行之后s将是： c("1.001 xxx 123.123", "23.45 lorem ipsum", "donald trump", "ssss 134 1.45")

在接下来的4行代码中，从每个字符串字段的开头和结尾修剪空格，并在空格上拆分字符串字段，生成列表。 grep out那些仅由数字和点组成的元素。 （正则表达式^[0-9.]*$匹配单词的开头，后跟零个或多个数字或点，后跟单词的结尾，因此只匹配包含这些字符的单词。）替换任何零长度组件与NA。 最后添加data$id作为名称。 在运行这4行之后，列表L将是list(A = c("1.001", "123.123"), B = "23.45", C = NA, D = c("134", "1.45")) 。

在最后一行代码中，将列表L转换为具有适当名称的数据框。

s <- gsub(", ", " ", data$string)
s <- gsub(",", ".", s)

L <- strsplit(trimws(s), "\\s+")
L <- lapply(L, grep, pattern = "^[0-9.]*$", value = TRUE)
L <- ifelse(lengths(L), L, NA)
names(L) <- data$id

with(stack(L), data.frame(id = ind, string = values))

赠送：

  id  string
1  A   1.001
2  A 123.123
3  B   23.45
4  C    <NA>
5  D     134
6  D    1.45

2）magrittr （1）的这种变化将其写为magrittr管道。

library(magrittr)

data %>%
     transform(string = gsub(", ", " ", string)) %>%
     transform(string = gsub(",", ".", string)) %>%
     transform(string = trimws(string)) %>%
     with(setNames(strsplit(string, "\\s+"), id)) %>%
     lapply(grep, pattern = "^[0-9.]*$", value = TRUE) %>%
     replace(lengths(.) == 0, NA) %>%
     stack() %>%
     with(data.frame(id = ind, string = values))

3）dplyr / tidyr这是使用dplyr和tidyr的备用管道解决方案。 unnest转换为长格式， id是因为我们以后可以使用complete来恢复后续过滤删除的id，过滤器会删除垃圾行并为每个不会出现的id complete插入NA行。

library(dplyr)
library(tidyr)

data %>%
  mutate(string = gsub(", ", " ", string)) %>%
  mutate(string = gsub(",", ".", string)) %>%
  mutate(string = trimws(string)) %>%
  mutate(string = strsplit(string, "\\s+")) %>%
  unnest() %>%
  mutate(id = factor(id))
  filter(grepl("^[0-9.]*$", string)) %>%
  complete(id)

4）data.table

library(data.table)

DT <- as.data.table(data)
DT[, string := gsub(", ", " ", string)][, 
     string := gsub(",", ".", string)][,
     string := trimws(string)][,
     string := setNames(strsplit(string, "\\s+"), id)][,
     list(string = list(grep("^[0-9.]*$", unlist(string), value = TRUE))), by = id][,
     list(string = if (length(unlist(string))) unlist(string) else NA_character_), by = id]
DT

更新删除了垃圾词没有数字或点的假设。 还增加了（2），（3）和（4）以及一些改进。

Answer 2

我们可以更换,在数字之间. （使用gsub ），使用str_extract_all （从stringr到list ）提取数字，用NA替换length等于0的list元素，使用'id'列设置list名称，使用stack将list转换为data.frame并重命名列。

library(stringr)
setNames(stack(setNames(lapply(str_extract_all(gsub("(?<=[0-9]),(?=[0-9])", ".", 
      data$string, perl = TRUE), "[0-9.]+"), function(x) 
     if(length(x)==0) NA else as.numeric(x)), data$id))[2:1], c("id", "string"))
#  id  string
#1  A   1.001
#2  A 123.123
#3  B   23.45
#4  C      NA
#5  D     134
#6  D    1.45

Answer 3

和Gabor一样的想法。 我曾希望使用R的内置字符串解析（ type.convert ，在read.table ），而不是编写自定义正则表达式替换：

sp = setNames(strsplit(data$string, " "), data$id)

spc = lapply(sp, function(x) {
  x = x[grep("[^0-9.,]$", x, invert=TRUE)]

  if (!length(x))
    NA_real_
  else 
    mapply(type.convert, x, dec=gsub("[^.,]", "", x), USE.NAMES=FALSE)
})

setNames(rev(stack(spc)), names(data))

  id  string
1  A   1.001
2  A 123.123
3  B   23.45
4  C    <NA>
5  D     134
6  D    1.45

不幸的是， type.convert不够强大，不能同时考虑两个十进制分隔符，所以我们需要这个mapply malarkey而不是type.convert(x, dec = "[.,]") 。