stringhe allineamento di un dataframe in colonne in r

Question

ho una grande cornice di dati, e voglio stringhe da essere allineati in colonne in base suffissi (sottostringhe), il dataframe fonte assomiglia a questo:

notst significa altro preffixes variabili per essere ignorati

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

il risultato, dovrebbe essere:

#   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: considerare l'intero suffisso (dopo "-"). Non ha numeri. Ci sono casi in cui l'intera stringa ("xxxx-spst") deve essere abbinata (*) perché la parte xxxx della stringa è disponibile in diverse versioni.

Per:

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) 

un possibile risultato, potrebbe essere: (nome di colonna e l'ordine è irrilevante)

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

(*) Si noti che nella riga 2, col2, "STC-spst "sembra fuori posto, ma non è un problema perché il valore stb-spst non esiste in quella riga, quindi per quel particolare caso, solo il suffisso (" spst ") è importante. In altre parole, quando l'intera stringa (suffisso-suffisso) corrisponde ad altre (in altre righe), dovrebbero essere nella stessa colonna, in caso contrario, quando il suffisso corrisponde al suffisso (di altre righe), dovrebbero essere nello stesso colonna. Il dataframe risultante dovrebbe avere lo stesso numero di righe dell'originale e il minor numero possibile di colonne.

MODIFICA. la risposta dovrebbe essere universale e funzionare per:

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) 

per esempio, anche. risultato possibile:

#   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 

esempio 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) 

output desiderato

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 

EDIT esempio 4. Al fine di rendere il compito più facile, si può esplicitamente definire una funzione i suffissi potrebbe avere più di un prefisso possibile per riga. In questo esempio ("spst"). Quindi ogni stringa con suffisso diverso da "spst" dovrebbe avere solo un possibile prefisso per riga e può e deve essere compressa in una colonna nel df risultante, come col2 nell'output desiderato. Questo non è quello che volevo in origine perché otterrò più colonne del previsto. Idealmente stringhe contenenti spst e prefissi diversi dovrebbero apparire nel minor numero possibile di colonne. Vedi sopra).

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) 

desiderata uscita

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

Testato con quattro esempi, ma questa versione è stato fatto senza riguardo per le informazioni hai aggiunto come soluzione alternativa nell'esempio 4.

Il mai n inoltre è la logica shuffle (che può essere piuttosto lenta) per compattare il modulo dataframe risultante da destra a sinistra. È possibile che lo assigned_by_suffix e lo assigned_by_single_suffix non siano più necessari, ma non l'ho verificato.

uscite sono alla fine del codice

# 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

Possiamo farlo prima melt ing set di dati, estrarre l'indice numerico dagli elementi, creare un indice di riga/colonna a seconda che e assegnare gli elementi ad un matrix creato in base al valore massimo dell'indice.

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 indicizzazione potrebbe rendere questo una possibilità:

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" 

Dove dat è stato importato come:

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)