使用 R 将单列拆分为多个观察值
Splitting a single column into multiple observation using R
我正在处理 HCUP 数据，它在一列中有一系列值，需要拆分成多列。以下是供参考的 HCUP 数据框：
code label
61000-61003 excision of CNS
0169T-0169T ventricular shunt
所需的输出应该是：
code label
61000 excision of CNS
61001 excision of CNS
61002 excision of CNS
61003 excision of CNS
0169T ventricular shunt
我解决这个问题的方法是使用包 splitstackshape 并使用此代码
library(data.table)
library(splitstackshape)
cSplit(hcup, "code", "-")[, list(code = code_1:code_2, by = label)]
这种方法会导致内存问题。有没有更好的方法来解决这个问题？
一些评论：
- 数据中除"T"外还有很多字母。
- 字母可以在前面，也可以在最后，但不能在两个数字之间。
- 单个范围内"T"到"U"的字母没有变化
这是使用 Hmisc 中的 dplyr 和 all.is.numeric 的解决方案：
library(dplyr)
library(Hmisc)
library(tidyr)
dat %>% separate(code, into=c("code1", "code2")) %>%
rowwise %>%
mutate(lists = ifelse(all.is.numeric(c(code1, code2)),
list(as.character(seq(from = as.numeric(code1), to = as.numeric(code2)))),
list(code1))) %>%
unnest(lists) %>%
select(code = lists, label)
Source: local data frame [5 x 2]
code label
(chr) (fctr)
1 61000 excision of CNS
2 61001 excision of CNS
3 61002 excision of CNS
4 61003 excision of CNS
5 0169T ventricular shunt
修复字符值范围的编辑。稍微降低了简单性：
dff %>% mutate(row = row_number()) %>%
separate(code, into=c("code1", "code2")) %>%
group_by(row) %>%
summarise(lists = if(all.is.numeric(c(code1, code2)))
{list(str_pad(as.character(
seq(from = as.numeric(code1), to = as.numeric(code2))),
nchar(code1), pad="0"))}
else if(grepl("^[0-9]", code1))
{list(str_pad(paste0(as.character(
seq(from = extract_numeric(code1), to = extract_numeric(code2))),
strsplit(code1, "[0-9]+")[[1]][2]),
nchar(code1), pad = "0"))}
else
{list(paste0(
strsplit(code1, "[0-9]+")[[1]],
str_pad(as.character(
seq(from = extract_numeric(code1), to = extract_numeric(code2))),
nchar(gsub("[^0-9]", "", code1)), pad="0")))},
label = first(label)) %>%
unnest(lists) %>%
select(-row)
Source: local data frame [15 x 2]
label lists
(chr) (chr)
1 excision of CNS 61000
2 excision of CNS 61001
3 excision of CNS 61002
4 ventricular shunt 0169T
5 ventricular shunt 0170T
6 ventricular shunt 0171T
7 excision of CNS 01000
8 excision of CNS 01001
9 excision of CNS 01002
10 some procedure A2543
11 some procedure A2544
12 some procedure A2545
13 some procedure A0543
14 some procedure A0544
15 some procedure A0545
数据：
dff <- structure(list(code = c("61000-61002", "0169T-0171T", "01000-01002",
"A2543-A2545", "A0543-A0545"), label = c("excision of CNS", "ventricular shunt",
"excision of CNS", "some procedure", "some procedure")), .Names = c("code",
"label"), row.names = c(NA, 5L), class = "data.frame")
一种不太优雅的方式：
# the data
hcup <- data.frame(code=c("61000-61003", "0169T-0169T"),
label=c("excision of CNS", "ventricular shunt"), stringsAsFactors = F)
hcup
> code label
>1 61000-61003 excision of CNS
>2 0169T-0169T ventricular shunt
# reshaping
# split the code ranges into separate columns
seq.ends <- cbind(do.call(rbind.data.frame, strsplit(hcup$code, "-")), hcup$label)
# create a list with a data.frame for each original line
new.list <- apply(seq.ends, 1, FUN=function(x){data.frame(code=if(grepl("\d{5}", x[1])){
z<-x[1]:x[2]}else{z<-x[1]}, label=rep(x[3], length(z)),
stringsAsFactors = F)})
# collapse the list into a df
new.df <- do.call(rbind, lapply(new.list, data.frame, stringsAsFactors=F))
new.df
> code label
>1.1 61000 excision of CNS
>1.2 61001 excision of CNS
>1.3 61002 excision of CNS
>1.4 61003 excision of CNS
>2 0169T ventricular shunt
原答案：更新见下文
首先，我通过将第一行添加到底部使您的示例数据更具挑战性。
dff <- structure(list(code = c("61000-61003", "0169T-0169T", "61000-61003"
), label = c("excision of CNS", "ventricular shunt", "excision of CNS"
)), .Names = c("code", "label"), row.names = c(NA, 3L), class = "data.frame")
dff
# code label
# 1 61000-61003 excision of CNS
# 2 0169T-0169T ventricular shunt
# 3 61000-61003 excision of CNS
我们可以使用序列运算符 : 来获取 code 列的序列，用 tryCatch() 换行，这样我们就可以避免错误，并保存不能的值被排序。首先，我们用破折号 - 分割值，然后 运行 通过 lapply().
xx <- lapply(
strsplit(dff$code, "-", fixed = TRUE),
function(x) tryCatch(x[1]:x[2], warning = function(w) x)
)
data.frame(code = unlist(xx), label = rep(dff$label, lengths(xx)))
# code label
# 1 61000 excision of CNS
# 2 61001 excision of CNS
# 3 61002 excision of CNS
# 4 61003 excision of CNS
# 5 0169T ventricular shunt
# 6 0169T ventricular shunt
# 7 61000 excision of CNS
# 8 61001 excision of CNS
# 9 61002 excision of CNS
# 10 61003 excision of CNS
我们正在尝试将序列运算符 : 应用于 strsplit() 中的每个元素，如果无法采用 x[1]:x[2] 则此 returns 只是值对于这些元素，否则继续执行序列 x[1]:x[2]。然后我们根据 xx 中的结果长度复制 label 列的值，以获得新的 label 列。
更新： 以下是我对您的修改做出的回应。将上面的 xx 替换为
xx <- lapply(strsplit(dff$code, "-", TRUE), function(x) {
s <- stringi::stri_locate_first_regex(x, "[A-Z]")
nc <- nchar(x)[1L]
fmt <- function(n) paste0("%0", n, "d")
if(!all(is.na(s))) {
ss <- s[1,1]
fmt <- fmt(nc-1)
if(ss == 1L) {
xx <- substr(x, 2, nc)
paste0(substr(x, 1, 1), sprintf(fmt, xx[1]:xx[2]))
} else {
xx <- substr(x, 1, ss-1)
paste0(sprintf(fmt, xx[1]:xx[2]), substr(x, nc, nc))
}
} else {
sprintf(fmt(nc), x[1]:x[2])
}
})
是的，这很复杂。现在，如果我们将以下数据框 df2 作为测试用例
df2 <- structure(list(code = c("61000-61003", "0169T-0174T", "61000-61003",
"T0169-T0174"), label = c("excision of CNS", "ventricular shunt",
"excision of CNS", "ventricular shunt")), .Names = c("code",
"label"), row.names = c(NA, 4L), class = "data.frame")
和运行上面的xx代码就可以了，我们可以得到如下结果。
data.frame(code = unlist(xx), label = rep(df2$label, lengths(xx)))
# code label
# 1 61000 excision of CNS
# 2 61001 excision of CNS
# 3 61002 excision of CNS
# 4 61003 excision of CNS
# 5 0169T ventricular shunt
# 6 0170T ventricular shunt
# 7 0171T ventricular shunt
# 8 0172T ventricular shunt
# 9 0173T ventricular shunt
# 10 0174T ventricular shunt
# 11 61000 excision of CNS
# 12 61001 excision of CNS
# 13 61002 excision of CNS
# 14 61003 excision of CNS
# 15 T0169 ventricular shunt
# 16 T0170 ventricular shunt
# 17 T0171 ventricular shunt
# 18 T0172 ventricular shunt
# 19 T0173 ventricular shunt
# 20 T0174 ventricular shunt
为此类代码创建排序规则：
seq_code <- function(from,to){
ext = function(x, part) gsub("([^0-9]?)([0-9]*)([^0-9]?)", paste0("\",part), x)
pre = unique(sapply(list(from,to), ext, part = 1 ))
suf = unique(sapply(list(from,to), ext, part = 3 ))
if (length(pre) > 1 | length(suf) > 1){
return("NO!")
}
num = do.call(seq, lapply(list(from,to), function(x) as.integer(ext(x, part = 2))))
len = nchar(from)-nchar(pre)-nchar(suf)
paste0(pre, sprintf(paste0("%0",len,"d"), num), suf)
}
以@jeremycg 为例：
setDT(dff)[,.(
label = label[1],
code = do.call(seq_code, tstrsplit(code,'-'))
), by=.(row=seq(nrow(dff)))]
这给出了
row label code
1: 1 excision of CNS 61000
2: 1 excision of CNS 61001
3: 1 excision of CNS 61002
4: 2 ventricular shunt 0169T
5: 2 ventricular shunt 0170T
6: 2 ventricular shunt 0171T
7: 3 excision of CNS 01000
8: 3 excision of CNS 01001
9: 3 excision of CNS 01002
10: 4 some procedure A2543
11: 4 some procedure A2544
12: 4 some procedure A2545
13: 5 some procedure A0543
14: 5 some procedure A0544
15: 5 some procedure A0545
从@jeremycg 的回答中复制的数据：
dff <- structure(list(code = c("61000-61002", "0169T-0171T", "01000-01002",
"A2543-A2545", "A0543-A0545"), label = c("excision of CNS", "ventricular shunt",
"excision of CNS", "some procedure", "some procedure")), .Names = c("code",
"label"), row.names = c(NA, 5L), class = "data.frame")
如果您足够耐心，您可能会将字符串解析成单独的部分而不是 eval/parse 技巧，唉，我没有，所以：
fancy.seq = function(x) eval(parse(text=sub(', \)', ')', sub('\(, ', '(',
sub('.*?([0-9]+)(.*)-(.*?)([1-9][0-9]*).*',
'paste0("\3",
formatC(\1:\4, width=log10(\4)+1, format="d", flag="0"),
"\2")',
x)))))
# using example from jeremycg's answer
dt[, .(fancy.seq(code), label), by = 1:nrow(dt)]
# nrow V1 label
# 1: 1 61000 excision of CNS
# 2: 1 61001 excision of CNS
# 3: 1 61002 excision of CNS
# 4: 2 0169T ventricular shunt
# 5: 2 0170T ventricular shunt
# 6: 2 0171T ventricular shunt
# 7: 3 01000 excision of CNS
# 8: 3 01001 excision of CNS
# 9: 3 01002 excision of CNS
#10: 4 A2543 some procedure
#11: 4 A2544 some procedure
#12: 4 A2545 some procedure
#13: 5 A0543 some procedure
#14: 5 A0544 some procedure
#15: 5 A0545 some procedure
如果不清楚上面的内容在做什么 - 只需 运行 sub 命令在 "code" 字符串之一上一一执行。
我正在处理 HCUP 数据，它在一列中有一系列值，需要拆分成多列。以下是供参考的 HCUP 数据框：
code label
61000-61003 excision of CNS
0169T-0169T ventricular shunt
所需的输出应该是：
code label
61000 excision of CNS
61001 excision of CNS
61002 excision of CNS
61003 excision of CNS
0169T ventricular shunt
我解决这个问题的方法是使用包 splitstackshape 并使用此代码
library(data.table)
library(splitstackshape)
cSplit(hcup, "code", "-")[, list(code = code_1:code_2, by = label)]
这种方法会导致内存问题。有没有更好的方法来解决这个问题？
一些评论：
- 数据中除"T"外还有很多字母。
- 字母可以在前面，也可以在最后，但不能在两个数字之间。
- 单个范围内"T"到"U"的字母没有变化
这是使用 Hmisc 中的 dplyr 和 all.is.numeric 的解决方案：
library(dplyr)
library(Hmisc)
library(tidyr)
dat %>% separate(code, into=c("code1", "code2")) %>%
rowwise %>%
mutate(lists = ifelse(all.is.numeric(c(code1, code2)),
list(as.character(seq(from = as.numeric(code1), to = as.numeric(code2)))),
list(code1))) %>%
unnest(lists) %>%
select(code = lists, label)
Source: local data frame [5 x 2]
code label
(chr) (fctr)
1 61000 excision of CNS
2 61001 excision of CNS
3 61002 excision of CNS
4 61003 excision of CNS
5 0169T ventricular shunt
修复字符值范围的编辑。稍微降低了简单性：
dff %>% mutate(row = row_number()) %>%
separate(code, into=c("code1", "code2")) %>%
group_by(row) %>%
summarise(lists = if(all.is.numeric(c(code1, code2)))
{list(str_pad(as.character(
seq(from = as.numeric(code1), to = as.numeric(code2))),
nchar(code1), pad="0"))}
else if(grepl("^[0-9]", code1))
{list(str_pad(paste0(as.character(
seq(from = extract_numeric(code1), to = extract_numeric(code2))),
strsplit(code1, "[0-9]+")[[1]][2]),
nchar(code1), pad = "0"))}
else
{list(paste0(
strsplit(code1, "[0-9]+")[[1]],
str_pad(as.character(
seq(from = extract_numeric(code1), to = extract_numeric(code2))),
nchar(gsub("[^0-9]", "", code1)), pad="0")))},
label = first(label)) %>%
unnest(lists) %>%
select(-row)
Source: local data frame [15 x 2]
label lists
(chr) (chr)
1 excision of CNS 61000
2 excision of CNS 61001
3 excision of CNS 61002
4 ventricular shunt 0169T
5 ventricular shunt 0170T
6 ventricular shunt 0171T
7 excision of CNS 01000
8 excision of CNS 01001
9 excision of CNS 01002
10 some procedure A2543
11 some procedure A2544
12 some procedure A2545
13 some procedure A0543
14 some procedure A0544
15 some procedure A0545
数据：
dff <- structure(list(code = c("61000-61002", "0169T-0171T", "01000-01002",
"A2543-A2545", "A0543-A0545"), label = c("excision of CNS", "ventricular shunt",
"excision of CNS", "some procedure", "some procedure")), .Names = c("code",
"label"), row.names = c(NA, 5L), class = "data.frame")
一种不太优雅的方式：
# the data
hcup <- data.frame(code=c("61000-61003", "0169T-0169T"),
label=c("excision of CNS", "ventricular shunt"), stringsAsFactors = F)
hcup
> code label
>1 61000-61003 excision of CNS
>2 0169T-0169T ventricular shunt
# reshaping
# split the code ranges into separate columns
seq.ends <- cbind(do.call(rbind.data.frame, strsplit(hcup$code, "-")), hcup$label)
# create a list with a data.frame for each original line
new.list <- apply(seq.ends, 1, FUN=function(x){data.frame(code=if(grepl("\d{5}", x[1])){
z<-x[1]:x[2]}else{z<-x[1]}, label=rep(x[3], length(z)),
stringsAsFactors = F)})
# collapse the list into a df
new.df <- do.call(rbind, lapply(new.list, data.frame, stringsAsFactors=F))
new.df
> code label
>1.1 61000 excision of CNS
>1.2 61001 excision of CNS
>1.3 61002 excision of CNS
>1.4 61003 excision of CNS
>2 0169T ventricular shunt
原答案：更新见下文
首先，我通过将第一行添加到底部使您的示例数据更具挑战性。
dff <- structure(list(code = c("61000-61003", "0169T-0169T", "61000-61003"
), label = c("excision of CNS", "ventricular shunt", "excision of CNS"
)), .Names = c("code", "label"), row.names = c(NA, 3L), class = "data.frame")
dff
# code label
# 1 61000-61003 excision of CNS
# 2 0169T-0169T ventricular shunt
# 3 61000-61003 excision of CNS
我们可以使用序列运算符 : 来获取 code 列的序列，用 tryCatch() 换行，这样我们就可以避免错误，并保存不能的值被排序。首先，我们用破折号 - 分割值，然后 运行 通过 lapply().
xx <- lapply(
strsplit(dff$code, "-", fixed = TRUE),
function(x) tryCatch(x[1]:x[2], warning = function(w) x)
)
data.frame(code = unlist(xx), label = rep(dff$label, lengths(xx)))
# code label
# 1 61000 excision of CNS
# 2 61001 excision of CNS
# 3 61002 excision of CNS
# 4 61003 excision of CNS
# 5 0169T ventricular shunt
# 6 0169T ventricular shunt
# 7 61000 excision of CNS
# 8 61001 excision of CNS
# 9 61002 excision of CNS
# 10 61003 excision of CNS
我们正在尝试将序列运算符 : 应用于 strsplit() 中的每个元素，如果无法采用 x[1]:x[2] 则此 returns 只是值对于这些元素，否则继续执行序列 x[1]:x[2]。然后我们根据 xx 中的结果长度复制 label 列的值，以获得新的 label 列。
更新： 以下是我对您的修改做出的回应。将上面的 xx 替换为
xx <- lapply(strsplit(dff$code, "-", TRUE), function(x) {
s <- stringi::stri_locate_first_regex(x, "[A-Z]")
nc <- nchar(x)[1L]
fmt <- function(n) paste0("%0", n, "d")
if(!all(is.na(s))) {
ss <- s[1,1]
fmt <- fmt(nc-1)
if(ss == 1L) {
xx <- substr(x, 2, nc)
paste0(substr(x, 1, 1), sprintf(fmt, xx[1]:xx[2]))
} else {
xx <- substr(x, 1, ss-1)
paste0(sprintf(fmt, xx[1]:xx[2]), substr(x, nc, nc))
}
} else {
sprintf(fmt(nc), x[1]:x[2])
}
})
是的，这很复杂。现在，如果我们将以下数据框 df2 作为测试用例
df2 <- structure(list(code = c("61000-61003", "0169T-0174T", "61000-61003",
"T0169-T0174"), label = c("excision of CNS", "ventricular shunt",
"excision of CNS", "ventricular shunt")), .Names = c("code",
"label"), row.names = c(NA, 4L), class = "data.frame")
和运行上面的xx代码就可以了，我们可以得到如下结果。
data.frame(code = unlist(xx), label = rep(df2$label, lengths(xx)))
# code label
# 1 61000 excision of CNS
# 2 61001 excision of CNS
# 3 61002 excision of CNS
# 4 61003 excision of CNS
# 5 0169T ventricular shunt
# 6 0170T ventricular shunt
# 7 0171T ventricular shunt
# 8 0172T ventricular shunt
# 9 0173T ventricular shunt
# 10 0174T ventricular shunt
# 11 61000 excision of CNS
# 12 61001 excision of CNS
# 13 61002 excision of CNS
# 14 61003 excision of CNS
# 15 T0169 ventricular shunt
# 16 T0170 ventricular shunt
# 17 T0171 ventricular shunt
# 18 T0172 ventricular shunt
# 19 T0173 ventricular shunt
# 20 T0174 ventricular shunt
为此类代码创建排序规则：
seq_code <- function(from,to){
ext = function(x, part) gsub("([^0-9]?)([0-9]*)([^0-9]?)", paste0("\",part), x)
pre = unique(sapply(list(from,to), ext, part = 1 ))
suf = unique(sapply(list(from,to), ext, part = 3 ))
if (length(pre) > 1 | length(suf) > 1){
return("NO!")
}
num = do.call(seq, lapply(list(from,to), function(x) as.integer(ext(x, part = 2))))
len = nchar(from)-nchar(pre)-nchar(suf)
paste0(pre, sprintf(paste0("%0",len,"d"), num), suf)
}
以@jeremycg 为例：
setDT(dff)[,.(
label = label[1],
code = do.call(seq_code, tstrsplit(code,'-'))
), by=.(row=seq(nrow(dff)))]
这给出了
row label code
1: 1 excision of CNS 61000
2: 1 excision of CNS 61001
3: 1 excision of CNS 61002
4: 2 ventricular shunt 0169T
5: 2 ventricular shunt 0170T
6: 2 ventricular shunt 0171T
7: 3 excision of CNS 01000
8: 3 excision of CNS 01001
9: 3 excision of CNS 01002
10: 4 some procedure A2543
11: 4 some procedure A2544
12: 4 some procedure A2545
13: 5 some procedure A0543
14: 5 some procedure A0544
15: 5 some procedure A0545
从@jeremycg 的回答中复制的数据：
dff <- structure(list(code = c("61000-61002", "0169T-0171T", "01000-01002",
"A2543-A2545", "A0543-A0545"), label = c("excision of CNS", "ventricular shunt",
"excision of CNS", "some procedure", "some procedure")), .Names = c("code",
"label"), row.names = c(NA, 5L), class = "data.frame")
如果您足够耐心，您可能会将字符串解析成单独的部分而不是 eval/parse 技巧，唉，我没有，所以：
fancy.seq = function(x) eval(parse(text=sub(', \)', ')', sub('\(, ', '(',
sub('.*?([0-9]+)(.*)-(.*?)([1-9][0-9]*).*',
'paste0("\3",
formatC(\1:\4, width=log10(\4)+1, format="d", flag="0"),
"\2")',
x)))))
# using example from jeremycg's answer
dt[, .(fancy.seq(code), label), by = 1:nrow(dt)]
# nrow V1 label
# 1: 1 61000 excision of CNS
# 2: 1 61001 excision of CNS
# 3: 1 61002 excision of CNS
# 4: 2 0169T ventricular shunt
# 5: 2 0170T ventricular shunt
# 6: 2 0171T ventricular shunt
# 7: 3 01000 excision of CNS
# 8: 3 01001 excision of CNS
# 9: 3 01002 excision of CNS
#10: 4 A2543 some procedure
#11: 4 A2544 some procedure
#12: 4 A2545 some procedure
#13: 5 A0543 some procedure
#14: 5 A0544 some procedure
#15: 5 A0545 some procedure
如果不清楚上面的内容在做什么 - 只需 运行 sub 命令在 "code" 字符串之一上一一执行。