Merge mehrere Listen, wenn die Bedingung wahr ist

Question

Ich habe versucht, meinen Kopf für eine Weile jetzt um diese zu wickeln, aber es scheint, als würde mein Mangel an Haskell Erfahrung mich nur nicht durchkommen. Ich konnte eine ähnliche Frage hier auf Stackoverflow nicht finden (die meisten von ihnen beziehen sich auf das Zusammenführen aller Unterlisten, ohne irgendeine Bedingung)

So hier geht es. Sagen wir, ich eine Liste von Listen wie diese haben:

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

Gibt es eine effiziente Möglichkeit, Listen zu verschmelzen, wenn irgendeine Art von Bedingung wahr ist? Nehmen wir an, ich muss Listen zusammenführen, die mindestens ein Element teilen. Im Fall von Beispiel wäre, das Ergebnis sein:

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

Ein weiteres Beispiel (wenn alle Listen zusammengefügt werden können):

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

Und es ist Ergebnis:

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

Vielen Dank für Ihre Hilfe!

Answer 1

Ich weiß nicht, was ich über Effizienz sagen soll, aber wir können das, was vor sich geht, aufschlüsseln und zumindest einige verschiedene Funktionalitäten bekommen. Bestimmte Funktionen sind möglicherweise optimierbar, aber es ist wichtig, genau zu klären, was benötigt wird.

Lassen Sie mich die Frage umformulieren: Für einige Menge X, einige binäre Beziehung R, und einige binäre Operation +, produzieren eine Menge Q = {x + y | x in X, y in X, xRy}. Für Ihr Beispiel könnte also X eine Menge von Listen sein, wobei R "xRy ist, wenn und nur wenn es mindestens ein Element in x und y gibt" und + ++ ist.

Eine naive Implementierung könnte kopieren Sie einfach die Set-Builder-Notation selbst

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] 

dann p = v1 shareElement (++) :: Eq a => [[a]] -> [[a]] könnte das erreichen, was Sie wollen. Außer es wahrscheinlich nicht.

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

Das offensichtlichste Problem ist, dass wir vier Exemplare erhalten: mit sich selbst zwei aus der Zusammenführung der Listen, zwei die Listen miteinander „in beide Richtungen“ aus der Verschmelzung. Das Problem tritt auf, weil List nicht das selbe wie Set ist, also können wir nicht Uniques töten. Natürlich, das eine einfache Lösung ist, werden wir nur Set überall

import Data.Set as Set 

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

verwenden So können wir wieder versuchen, p = v2 (shareElement auf Set.toList) Set.union mit

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

, die zu funktionieren scheint. Beachten Sie, dass wir List "durchlaufen" müssen, da Set aufgrund seiner Ord Einschränkung keine Instanz von Monad oder Applicative gemacht werden kann.

Ich würde auch bemerken, dass es viel verlorenes Verhalten in Set gibt. Zum Beispiel kämpfen wir, indem wir entweder Auftragsinformationen in der Liste wegwerfen oder sowohl x <> y als auch y <> x handhaben müssen, wenn unsere Beziehung symmetrisch ist.

Einige bequemen Versionen können wie

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

und leistungsfähigere geschrieben werden kann gebaut werden, wenn wir davon ausgehen, dass die Beziehung ist, sagt sich, eine Gleichheitsbeziehung, da dann stattdessen einen O(n^2) Betrieb mit was wir tun können es in O(nd) wo d ist die Anzahl der Partitionen (Nebenklassen) der Beziehung.

Im Allgemeinen ist es ein wirklich interessantes Problem.

Answer 2

Ich bin nur zufällig ähnlich hier etwas schreiben: Finding blocks in arrays

Sie können es nur so ändern, (obwohl ich über die Effizienz nicht sicher bin):

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) 

OUTPUT:

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

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