Unisci più elenchi se la condizione è vera

Question

Ho cercato di capirci qualcosa per un po 'di tempo, ma sembra che la mia mancanza di esperienza con Haskell non riesca a farcela. Non riesco a trovare una domanda simile qui su Stackoverflow (la maggior parte di essi sono legati alla fusione di tutte le sottoliste, senza alcuna condizione)

Quindi ecco qui. Diciamo che ho una lista di liste come questa:

[[1, 2, 3], [3, 5, 6], [20, 21, 22]] 

C'è un modo efficiente per fondere le liste se un qualche tipo di condizione è vera? Diciamo che ho bisogno di unire liste che condividono almeno un elemento. In caso di esempio, risultato sarebbe:

[[1, 2, 3, 3, 5, 6], [20, 21, 22]] 

Un altro esempio (quando tutte le liste possono essere unite):

[[1, 2], [2, 3], [3, 4]] 

Ed è risultato:

[[1, 2, 2, 3, 3, 4]] 

Grazie per il vostro aiuto!

Answer 1

Non so cosa dire dell'efficienza, ma possiamo analizzare cosa sta succedendo e ottenere almeno diverse funzionalità. Funzionalità particolari potrebbero essere ottimizzabili, ma è importante chiarire esattamente ciò che è necessario.

Lasciatemi riformulare la domanda: Per alcuni set X, una relazione binaria R, e qualche operazione binaria +, producono un insieme Q = {x + y | x in X, y in X, xRy}. Quindi, per il tuo esempio, potremmo avere X come un gruppo di elenchi, R come "xRy se e solo se c'è almeno un elemento in entrambi xey", e + è ++.

Un'implementazione ingenuo potrebbe basta copiare il set-builder notazione stessa

shareElement :: Eq a => [a] -> [a] -> Bool 
shareElement xs ys = or [x == y | x <- xs, y <- ys] 

v1 :: (a -> a -> Bool) -> (a -> a -> b) -> [a] -> [b] 
v1 (?) (<>) xs = [x <> y | x <- xs, y <- xs, x ? y] 

poi p = v1 shareElement (++) :: Eq a => [[a]] -> [[a]] potrebbe ottenere quello che vuoi. Tranne che probabilmente no.

Prelude> p [[1], [1]] 
[[1,1],[1,1],[1,1],[1,1]] 

Il problema più evidente è che otteniamo quattro copie: due dalla fusione delle liste con se stessi, due dalla fusione delle liste con l'altro "in entrambe le direzioni". Il problema si verifica perché List non è lo stesso di Set, quindi non possiamo uccidere utenti unici. Naturalmente, questa è una soluzione semplice, ci limiteremo a usare Set ovunque

import Data.Set as Set 

v2 :: (a -> a -> Bool) -> (a -> a -> b) -> Set.Set a -> Set.Set b 
v2 (?) (<>) = Set.fromList . v1 (?) (<>) . Set.toList 

così possiamo provare di nuovo, p = v2 (shareElement su Set.toList) Set.union con

Prelude Set> p $ Set.fromList $ map Set.fromList [[1,2], [2,1]] 
fromList [fromList [1,2]] 

che sembra funzionare. Si noti che è necessario "passare attraverso" List perché non è possibile creare Set un'istanza di Monad o Applicative a causa del relativo vincolo Ord.

Vorrei anche notare che c'è un sacco di comportamenti persi in Set. Per esempio, combattiamo o buttando via le informazioni sull'ordine nella lista o dovendo gestire sia x <> y e y <> x quando la nostra relazione è simmetrica.

Alcune versioni più convenienti possono essere scritti come

v3 :: Monoid a => (a -> a -> Bool) -> [a] -> [a] 
v3 r = v2 r mappend 

e più efficienti quelli possono essere costruite se si assume che la relazione è, diciamo, una relazione di uguaglianza da allora invece di avere un O(n^2) un'operazione che possiamo fare in O(nd) dove d è il numero di partizioni (coseti) della relazione.

Generalmente, è un problema davvero interessante.

Answer 2

mi è capitato di scrivere qualcosa di simile qui: Finding blocks in arrays

Si può solo modificarlo in modo (anche se non sono troppo sicuro circa l'efficienza):

import Data.List (delete, intersect) 

example1 = [[1, 2, 3], [3, 5, 6], [20, 21, 22]] 
example2 = [[1, 2], [2, 3], [3, 4]] 

objects zs = map concat . solve zs $ [] where 
    areConnected x y = not . null . intersect x $ y 
    solve []  result = result 
    solve (x:xs) result = 
    let result' = solve' xs [x] 
    in solve (foldr delete xs result') (result':result) where 
    solve' xs result = 
    let ys = filter (\y -> any (areConnected y) result) xs 
    in if null ys 
      then result 
      else solve' (foldr delete xs ys) (ys ++ result) 

USCITA:

*Main> objects example1 
[[20,21,22],[3,5,6,1,2,3]] 

*Main> objects example2 
[[3,4,2,3,1,2]]