将规则字符串解析为data.frame的最快方法

时间:2017-01-30 14:42:00

标签: r dataframe data.table

我有一个带字符串规则集的数据集。

R> input
   id                                   rules
1   1 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
2   2 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
3   3 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
4   4 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
5   5 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
6   6 1.11=>0;1.12=>0;1.13=>0;1.14=>1;1.15=>0
7   7 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
8   8 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
9   9 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
10 10 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
11 11 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
12 12 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
13 13 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
14 14 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
15 15 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0
16 16 1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0

将此规则拆分并加入单独列的最快方法是什么?期望的结果:

R> res
   R1.11 R1.12 R1.13 R1.14 R1.15 id
1      0     0     0     0     0  1
2      0     0     0     0     0  2
3      0     0     0     0     0  3
4      0     0     0     0     0  4
5      0     0     0     0     0  5
6      0     0     0     1     0  6
7      0     0     0     0     0  7
8      0     0     0     0     0  8
9      0     0     0     0     0  9
10     0     0     0     0     0 10
11     0     0     0     0     0 11
12     0     0     0     0     0 12
13     0     0     0     0     0 13
14     0     0     0     0     0 14
15     0     0     0     0     0 15
16     0     0     0     0     0 16

要重现数据集,请参阅下面的结构。

输入数据结构:

input <- structure(
    list(id = 1:16,
         rules = c("1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>1;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0", 
                   "1.11=>0;1.12=>0;1.13=>0;1.14=>0;1.15=>0")), 
    .Names = c("id", "rules"),
    row.names = c(NA, -16L),
    class = "data.frame")

输出数据结构:

output <- structure(
    list(R1.11 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L),
         R1.12 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), 
         R1.13 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), 
         R1.14 = c(0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), 
         R1.15 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L),
         id = 1:16), 
    .Names = c("R1.11", "R1.12", "R1.13", "R1.14", "R1.15", "id"),
    class = "data.frame",
    row.names = c(NA, -16L))

4 个答案:

答案 0 :(得分:4)

我可能会......

library(splitstackshape)
res = cSplit(input, "rules", ";", "long")
res[, c("variable", "value") := tstrsplit(rules, "=>", type.convert=TRUE)]

# head(res)
#    id   rules variable value
# 1:  1 1.11=>0     1.11     0
# 2:  1 1.12=>0     1.12     0
# 3:  1 1.13=>0     1.13     0
# 4:  1 1.14=>0     1.14     0
# 5:  1 1.15=>0     1.15     0
# 6:  2 1.11=>0     1.11     0

我会停在这里,数据格式为长格式,但您可以使用...来获得所需的宽输出。

wideres = dcast(res, id ~ paste0("R", variable), value.var="value")

# test that it's essentially correct:
fsetequal(wideres, setcolorder(data.table(output), names(wideres)))

答案 1 :(得分:3)

这是一个基础R方法:

input[3:7] <- 
 matrix(as.integer(sub(".*=>", "", unlist(strsplit(input$rules, ";", fixed=TRUE)))), 
         ncol=5, byrow = TRUE)

您仍然需要根据需要设置列名。

答案 2 :(得分:1)

为你做了一个快速的功能。

http://www.mediaelementjs.com/

第一行测试

my.Parser <- function(row){
  r <- unlist(strsplit(gsub(";","x",row[-1]),"x"))
  Values <- data.frame(t(gsub("*.*=>","",r)))
  colnames(Values) <- paste("R",gsub("=>*.*","",r,),sep="")
  Values <- cbind(id=row[1], Values)
  return(Values)
}

申请my.Parser(input[1,])

input

输出:

Results <- apply(input,1,function(x) my.Parser(x))
Results <- do.call("rbind", Results)
Results

答案 3 :(得分:1)

感谢您的回复。我的解决方案仅基于data.table包:

library(data.table)
parse_rules <- function(.data, id_col, rules_col, prefix = "R", sep1 = ";", sep2 = "=>", convert = TRUE) {
    if (is.numeric(id_col)) id_col <- names(.data)[id_col]
    if (is.numeric(rules_col)) rules_col <- names(.data)[rules_col]
    res <- .data[, tstrsplit(get(rules_col), split = sep1, fixed = TRUE)]
    res[, (id_col) := .data[[id_col]]]
    res <- melt(res, id.vars = id_col, measure.vars = setdiff(names(res), id_col))
    res[, c("variable", "value") := tstrsplit(value, split = sep2, fixed = TRUE, type.convert = convert)]
    res <- dcast(res, get(id_col) ~ paste0(prefix, variable), value.var = "value")
    setnames(res, "id_col", id_col)
    return(res)
}
setDT(input)
parse_rules(input, "id", "rules")

结果:

    id R1.11 R1.12 R1.13 R1.14 R1.15
 1:  1     0     0     0     0     0
 2:  2     0     0     0     0     0
 3:  3     0     0     0     0     0
 4:  4     0     0     0     0     0
 5:  5     0     0     0     0     0
 6:  6     0     0     0     1     0
 7:  7     0     0     0     0     0
 8:  8     0     0     0     0     0
 9:  9     0     0     0     0     0
10: 10     0     0     0     0     0
11: 11     0     0     0     0     0
12: 12     0     0     0     0     0
13: 13     0     0     0     0     0
14: 14     0     0     0     0     0
15: 15     0     0     0     0     0
16: 16     0     0     0     0     0

基于base函数的另一种解决方案:

parse_rules <- function(.data, col, prefix = "R", sep1 = ";", sep2 = "=>", convert = TRUE) {
    n <- length(gregexpr(sep1, .data[1L, col])[[1]]) + 1L
    str <- unlist(strsplit(.data[[col]], sep1, fixed = TRUE))
    res <- matrix(sub(paste0(".*", sep2), "", str), ncol = n, byrow = TRUE)
    res <- as.data.frame(res, stringsAsFactors = FALSE)
    nm <- paste0(prefix, sub(paste0(sep2, ".*"), "", str[seq_len(n)]))
    names(res) <- nm
    if (convert && any(chr <- sapply(res, is.character))) {
        for (c in names(res)[chr])
            res[[c]] <- type.convert(res[[c]], as.is = TRUE)
    }
    .data[[col]] <- NULL
    res <- cbind(.data, res, stringsAsFactors = FALSE)
    res
}