我有一个带字符串规则集的数据集。
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))
答案 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
}