align struny dataframe w kolumnach w R

Question

Mam dużą ramkę danych i chcę ciągi być wyrównane w kolumnach na podstawie przyrostków (podciągi), The dataframe źródło wygląda następująco:

notst stoi na inny zmienna preffixes być ignorowane

#   col1  col2  col3 
#  notst-s1 notst-s2 notst-x3 
#  notst-s1 notst-x3 notst-a5 
#  notst-s2 notst-a5 
#  notst-x3 notst-a5 

rezultatem powinno być:

#   col1  col2  col3  col4 
#  notst-s1 notst-s2 notst-x3 
#  notst-s1    notst-x3 notst-a5 
#     notst-s2    notst-a5 
#        notst-x3 notst-a5 

Edit: Rozważmy cały sufiks (po "-"). Nie ma liczb. Istnieją przypadki, w których cały ciąg ("xxxx-spst") powinien być dopasowany (*), ponieważ część xxxx ciągu występuje w kilku wersjach.

dla:

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) 

możliwy wynik może być: (nazwa kolumny, a porządek jest bez znaczenia)

#   col1   col2  col3  col4  
#   st1-ab  stb-spst sta-spst  
#   st4-ab  stc-spst sta-spst   
#   st7-ab  stb-spst  
#     stb-spst     st9-ba  

(*) Należy zauważyć, że w rzędzie 2, col2 „STC-SPST "wydaje się nie na miejscu, ale nie stanowi problemu, ponieważ wartość stb -stst nie istnieje w tym wierszu, więc w tym konkretnym przypadku liczy się tylko przyrostek (" spst "). Innymi słowy, gdy cały ciąg (przedrostek-przyrostek) pasuje do innych (w innych wierszach), powinny one być w tej samej kolumnie, jeśli nie, gdy sufiks dopasuje sufiks (innych wierszy), powinny one być w tym samym kolumna. Wynikowa ramka danych powinna mieć taką samą liczbę wierszy, jaka jest możliwa dla oryginalnej i najniższej liczby kolumn.

EDYCJA. Odpowiedź powinna być uniwersalna i pracować dla:

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) 

na przykład również. Możliwy wynik:

#   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 

przykład 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) 

pożądane wyjście

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 

przykład EDIT 4. Aby ułatwić zadanie, można jednoznacznie określić w funkcji przyrostki może mieć więcej niż jeden możliwy prefiks w wierszu. W tym przykładzie ("spst"). Zatem dowolny ciąg z sufiksem różnym od "spst" powinien mieć tylko jeden możliwy prefiks na wiersz i może i musi być zwinięty w jedną kolumnę w wynikowym df, jako col2 w pożądanym wyjściu. To nie jest to, co chciałem pierwotnie, ponieważ dostanę więcej kolumn, niż się spodziewano. Idealnie ciągi zawierające spst i różne prefiksy powinny pojawić się w najniższej liczbie kolumn możliwych. Patrz wyżej).

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) 

sygnał wyjściowy

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 

Answer 1

przetestowany z czterech przykładów, ale ta wersja została wykonana bez względu na informacje dodany jako obejście w przykładzie 4.

Mai n dodatek to logika shuffle (która może być dość powolna), aby skompaktować wynikową ramkę danych od prawej do lewej. Możliwe, że assigned_by_suffix i assigned_by_single_suffix nie są już wymagane, ale nie zostały zweryfikowane.

Wyjścia są na końcu kodu

# 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   
> 

Answer 2

Można to zrobić poprzez pierwszy melt ing zestawu danych, wyodrębnić wskaźnik liczbowy z elementów utworzyć wskaźnik wiersz/kolumna w oparciu o to i przypisanie elementy do matrix utworzone na podstawie maksymalnej wartości indeksu.

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 

Answer 3

Matrix indeksowanie może zrobić to możliwość:

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" 

Gdzie dat został przywieziony jako:

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)