我有一个大数据框，我希望字符串基于后缀（子字符串）在列中对齐，源数据框如下所示：
notst代表要忽略的其他变量前缀
# col1 col2 col3
# notst-s1 notst-s2 notst-x3
# notst-s1 notst-x3 notst-a5
# notst-s2 notst-a5
# notst-x3 notst-a5
结果应该是：
# col1 col2 col3 col4
# notst-s1 notst-s2 notst-x3
# notst-s1 notst-x3 notst-a5
# notst-s2 notst-a5
# notst-x3 notst-a5
编辑： 考虑整个后缀（在“ - ”之后）。它没有数字。在某些情况下，整个字符串（“xxxx-spst”）应匹配（*），因为字符串的xxxx部分有多个版本。
有关：
df <- read.table(text="
col1 col2 col3
st1-ab stb-spst sta-spst
stc-spst sta-spst st4-ab
stb-spst st7-ab
st9-ba stb-spst",header=TRUE,fill=TRUE,stringsAsFactors=FALSE)
可能的结果可能是:(列名和顺序无关）
# col1 col2 col3 col4
# st1-ab stb-spst sta-spst
# st4-ab stc-spst sta-spst
# st7-ab stb-spst
# stb-spst st9-ba
（*）请注意，在第2行col2中，“stc-spst”似乎放错位置，但它不是问题，因为该行中不存在值stb-spst，因此对于该特定情况，只有后缀（“spst”）很重要。换句话说，当整个字符串（preffix-suffix）匹配其他行（在其他行中）时，它们应该在同一列中，否则，当后缀与后缀（其他行）匹配时，它们应该在同一列中柱。生成的数据框应具有与原始行数相同的行数和可能的最低列数。
EDIT。答案应该是普遍适用的：
df2 <- read.table(text="
col1 col2 col3 col4
st1-ab stb-spst sta-spst std-spst
stc-spst sta-spst st4-ab st2-ab
stb-spst st7-ab sa-ac
st9-ba stb-spst",header=TRUE,fill=TRUE,stringsAsFactors=FALSE)
# col1 col2 col3 col4 col5 col6 col7
# st1-ab stb-spst sta-spst std-spst
# st4-ab stc-spst sta-spst st2-ab
# st7-ab stb-spst sa-ac
# stb-spst st9-ba
示例3
df3 <- read.table(text="
col1 col2 col3 col4
st1-ab stb-spst sta-spst std-spst
stb-spst sta-ab
sta-spst st7-ab sa-ac
sta-spst stb-spst",header=TRUE,fill=TRUE,stringsAsFactors=FALSE)
期望的输出
col1 col2 col3 col4 col5
1 st1-ab sta-spst stb-spst std-spst
2 sta-ab stb-spst
3 sa-ac st7-ab sta-spst
4 sta-spst stb-spst
编辑示例4.为了使任务更容易，您可以在函数中明确定义每行可能有多个可能前缀的后缀。在这个例子中（“spst”）。因此，任何后缀与“spst”不同的字符串应该每行只有一个可能的前缀，并且必须在生成的df中折叠成一列，作为所需输出中的col2。这不是我原本想要的，因为我会获得比预期更多的列。理想情况下，包含spst和不同前缀的字符串应出现在可能的最低列数中。往上看）。
df4 <- read.table(text="
col1 col2 col3 col4
st1-ab stb-spst sta-spst std-spst
stb-spst st1-ab
sta-spst st7-ab sa-ac
sta-spst stb-spst st7-ab",header=TRUE,fill=TRUE,stringsAsFactors=FALSE)
期望的输出
row_id col1 col2 col3 col4 col5
1 st1-ab sta-spst stb-spst std-spst
2 st1-ab stb-spst
3 sa-ac st7-ab sta-spst
4 st7-ab sta-spst stb-spst
答案 0 :(得分：4)
我们可以通过首先melt数据集，从元素中提取数字索引，基于此创建行/列索引并将元素分配给基于此创建的matrix来完成此操作。索引的最大值。
library(reshape2)
d1 <- na.omit(transform(melt(as.matrix(df1)), v1 = as.numeric(sub("\\D+", "", value))))
m1 <- matrix("", nrow = max(d1$Var1), ncol = max(d1$v1))
m1[as.matrix(d1[c("Var1", "v1")])] <- as.character(d1$value)
d2 <- as.data.frame(m1[,!!colSums(m1!="")])
colnames(d2) <- paste0("col", seq_along(d2))
d2
# col1 col2 col3 col4
#1 notst-s1 notst-s2 notst-x3
#2 notst-s1 notst-x3 notst-a5
#3 notst-s2 notst-a5
#4 notst-x3 notst-a5
答案 1 :(得分：2)
矩阵索引可能会使这成为可能：
sel <- dat!=""
unq <- unique(dat[sel])
mat <- matrix(NA, nrow=nrow(dat), ncol=length(unq))
mat[cbind(row(dat)[sel], match(dat[sel], unq) )] <- dat[sel]
# [,1] [,2] [,3] [,4]
#[1,] "notst-s1" "notst-s2" "notst-x3" NA
#[2,] "notst-s1" NA "notst-x3" "notst-a5"
#[3,] NA "notst-s2" NA "notst-a5"
#[4,] NA NA "notst-x3" "notst-a5"
导入dat的位置为：
dat <- read.table(text="
col1 col2 col3
notst-s1 notst-s2 notst-x3
notst-s1 notst-x3 notst-a5
notst-s2 notst-a5
notst-x3 notst-a5",header=TRUE,fill=TRUE,stringsAsFactors=FALSE)
答案 2 :(得分：1)
使用了四个示例进行了测试，但是这个版本的完成时没有考虑您在示例4中作为变通方法添加的信息。
主要的补充是shuffle逻辑（可能非常慢），从右到左压缩结果数据帧。可能不再需要assigned_by_suffix和assigned_by_single_suffix，但我尚未验证。
输出位于代码的末尾
# examples
df1 <- read.table(text="
col1 col2 col3
st1-ab stb-spst sta-spst
stc-spst sta-spst st4-ab
stb-spst st7-ab
st9-ba stb-spst",header=TRUE,fill=TRUE,stringsAsFactors=FALSE)
df2 <- read.table(text="
col1 col2 col3 col4
st1-ab stb-spst sta-spst std-spst
stc-spst sta-spst st4-ab st2-ab
stb-spst st7-ab sa-ac
st9-ba stb-spst",header=TRUE,fill=TRUE,stringsAsFactors=FALSE)
df3 <- read.table(text="
col1 col2 col3 col4
st1-ab stb-spst sta-spst std-spst
stb-spst sta-ab
sta-spst st7-ab sa-ac
sta-spst stb-spst",header=TRUE,fill=TRUE,stringsAsFactors=FALSE)
df4 <- read.table(text="
col1 col2 col3 col4
st1-ab stb-spst sta-spst std-spst
stb-spst st1-ab
sta-spst st7-ab sa-ac
sta-spst stb-spst st7-ab",header=TRUE,fill=TRUE,stringsAsFactors=FALSE)
library(reshape2)
library(tidyr)
library(dplyr)
library(stringr)
library(assertthat)
suffix <- function(s) {str_extract(s, "[^\\-]+$")}
# make a tall dataframe with melt, and get the suffix
dfm <- df4 %>%
mutate(row_id = seq_along(col1)) %>%
melt(id.vars="row_id") %>%
select(-2) %>%
filter(value != "") %>%
mutate(suffix = suffix(value)) %>%
arrange(value)
assert_that(!any(duplicated(dfm[c("row_id", "value")])))
# initialize
combined <- data.frame()
remaining <- dfm
# get the groups with more than 1 value
matched_values <- dfm %>%
group_by(value, suffix) %>%
summarize(n=n()) %>%
filter(n>1) %>%
rename(group_id = value) %>%
ungroup()
# .. and assign the group ids that match
assigned_by_value <- remaining %>%
inner_join(matched_values %>% select(group_id), by = c("value" = "group_id")) %>%
mutate(group_id = value) %>%
select(row_id, value, suffix, group_id)
combined <- combined %>% bind_rows(assigned_by_value)
remaining <- dfm %>% anti_join(combined, by=c("row_id", "value"))
# find the remaining suffixes
matched_suffixes <- remaining %>%
group_by(suffix) %>%
summarize(n=n()) %>%
filter(n>1) %>%
select(-n) %>%
ungroup()
# ... and assign those that match
assigned_by_suffix <- remaining %>%
inner_join(matched_suffixes, by="suffix") %>%
mutate(group_id = suffix)
combined <- bind_rows(combined, assigned_by_suffix)
remaining <- remaining %>% anti_join(combined, by=c("row_id", "value"))
# All that remain are singles assign matches by suffix, choosing the match with fewest
assigned_by_single_suffix <- remaining %>%
inner_join(matched_values, by = "suffix") %>%
top_n(1, n) %>%
head(1) %>%
select(-n)
combined <- bind_rows(combined, assigned_by_single_suffix)
remaining <- remaining %>% anti_join(combined, by=c("row_id", "value"))
# get the remaining unmatched
unmatched <- remaining%>%
mutate(group_id = value)
combined <- bind_rows(combined, unmatched)
remaining <- remaining %>% anti_join(combined, by=c("row_id", "value"))
assert_that(nrow(remaining) == 0)
# any overloads (duplicates) need to bump to their own column
dups <- duplicated(combined[,c("row_id", "group_id")])
combined$group_id[dups] <- combined$value[dups]
assert_that(nrow(combined) == nrow(dfm))
# spread the result
result <- spread(combined %>% select(-suffix), group_id, value, fill ="")
# Shuffle any matching suffix from right to left, so l long as there
# is corresponding space an that the whole column can move
# i is source (startign from right) - j is target (starting from right)
#
drop_cols = c()
suffixes <- suffix(names(result))
for (i in (ncol(result)):3) {
for(j in (i-1):2) {
if (suffixes[i] == suffixes[j]) {
non_empty <- which(result[,i] != "") # list of source to move
can_fill <- which(result[,j] == "") # list of targets can be filled
can_move <- all(non_empty %in% can_fill) # is to move a subset of can_fill?
# if there's space, shuffle the column down
if (can_move ) {
# shuffle down
result[,j] <- if_else(result[,j] != "", result[,j], result[,i])
drop_cols <- c(drop_cols, i)
result[,i] <- NA
break
}
}
}
}
if (!is.null(drop_cols)) {
result <- result[,-drop_cols]
}
result
# Example 1
# row_id ab st9-ba sta-spst stb-spst
# 1 1 st1-ab sta-spst stb-spst
# 2 2 st4-ab sta-spst stc-spst
# 3 3 st7-ab stb-spst
# 4 4 st9-ba stb-spst
# Example 2
# row_id ab sa-ac spst st2-ab st9-ba sta-spst stb-spst
# 1 1 st1-ab std-spst sta-spst stb-spst
# 2 2 st4-ab stc-spst st2-ab sta-spst
# 3 3 st7-ab sa-ac stb-spst
# 4 4 st9-ba stb-spst
# Example 3
# row_id ab sa-ac sta-spst stb-spst std-spst
# 1 1 st1-ab sta-spst stb-spst std-spst
# 2 2 sta-ab stb-spst
# 3 3 st7-ab sa-ac sta-spst
# 4 4 sta-spst stb-spst
# Example 4
# row_id sa-ac st1-ab sta-spst stb-spst std-spst
# 1 1 st1-ab sta-spst stb-spst std-spst
# 2 2 st1-ab stb-spst
# 3 3 sa-ac st7-ab sta-spst
# 4 4 st7-ab sta-spst stb-spst
>