Interleaving zwei Strings, Erhalt der Reihenfolge: funktionalen Stil

Question

In this question, der Autor bringt eine interessante Programmierfrage: gegeben zwei String, finden Sie mögliche 'verschachtelte' Permutationen von denen, die Reihenfolge der ursprünglichen Strings bewahrt.

generali ich das Problem zu n Strings anstelle von 2 im Falle des OP, und kam mit:

-- charCandidate is a function that finds possible character from given strings. 
-- input : list of strings 
-- output : a list of tuple, whose first value holds a character 
-- and second value holds the rest of strings with that character removed 
-- i.e ["ab", "cd"] -> [('a', ["b", "cd"])] .. 

charCandidate xs = charCandidate' xs [] 
charCandidate' :: [String] -> [String] -> [(Char, [String])] 
charCandidate' [] _ = []  
charCandidate' ([]:xs) prev = 
    charCandidate' xs prev 
charCandidate' (x@(c:rest):xs) prev = 
    (c, prev ++ [rest] ++ xs) : charCandidate' xs (x:prev) 

interleavings :: [String] -> [String] 
interleavings xs = interleavings' xs []  

-- interleavings is a function that repeatedly applies 'charCandidate' function, to consume 
-- the tuple and build permutations. 
-- stops looping if there is no more tuple from charCandidate. 

interleavings' :: [String] -> String -> [String] 
interleavings' xs prev = 
    let candidates = charCandidate xs 
     in case candidates of 
      [] -> [prev] 
      _ -> concat . map (\(char, ys) -> interleavings' ys (prev ++ [char])) $ candidates 

-- test case 
input :: [String] 
input = ["ab", "cd"]  
-- interleavings input == ["abcd","acbd","acdb","cabd","cadb","cdab"] 

es funktioniert, aber ich bin ganz mit dem Code betroffen:

1. ist es hässlich. kein Punkt-frei!
2. explizite Rekursion und zusätzliches Funktionsargument prev Staaten zu bewahren
3. Tupeln als Zwischenform

Wie kann ich das obige Programm neu zu schreiben, um mehr „haskellic“, prägnant, lesbar und anschmiegsamer zu „functional mit Programmierung"?

Answer 1

Ich denke, ich würde es so schreiben. Die Hauptidee besteht darin, das Erstellen eines Interleavings als einen nichtdeterministischen Prozess zu behandeln, der eine der Eingabezeichenfolgen auswählt, um das Interleaving und Recurses zu starten.

Bevor wir beginnen, wird es helfen, eine Dienstprogrammfunktion zu haben, die ich unzählige Male benutzt habe. Es bietet eine bequeme Möglichkeit, ein Element aus einer Liste auszuwählen und zu wissen, welches Element es war. Dies ist ein bisschen wie Ihre charCandidate', außer dass es auf einer einzigen Liste zu einer Zeit (und folglich breiter anwendbar ist).

zippers :: [a] -> [([a], a, [a])] 
zippers = go [] where 
    go xs [] = [] 
    go xs (y:ys) = (xs, y, ys) : go (y:xs) ys 

Mit diesem in der Hand ist es leicht, einige nicht-deterministische Wahlen unter Verwendung der Liste monad zu machen. Unsere interleavings Funktion sollte wahrscheinlich einen Typ wie [NonEmpty a] -> [[a]] haben, der verspricht, dass jeder eingehende String mindestens ein Zeichen enthält, aber der syntaktische Overhead von NonEmpty ist zu nervig für eine einfache Übung wie diese, also geben wir nur falsche Antworten wenn diese Vorbedingung verletzt wird. Sie könnten auch in Erwägung ziehen, dies zu einer Hilfsfunktion zu machen und leere Listen aus Ihrer Top-Level-Funktion herauszufiltern, bevor Sie diese ausführen.

interleavings :: [[a]] -> [[a]] 
interleavings [] = [[]] 
interleavings xss = do 
    (xssL, h:xs, xssR) <- zippers xss 
    t <- interleavings ([xs | not (null xs)] ++ xssL ++ xssR) 
    return (h:t) 

Sie können es in GHCI gehen zu sehen:

> interleavings ["abc", "123"] 
["abc123","ab123c","ab12c3","ab1c23","a123bc","a12bc3","a12b3c","a1bc23","a1b23c","a1b2c3","123abc","12abc3","12ab3c","12a3bc","1abc23","1ab23c","1ab2c3","1a23bc","1a2bc3","1a2b3c"] 
> interleavings ["a", "b", "c"] 
["abc","acb","bac","bca","cba","cab"] 
> permutations "abc" -- just for fun, to compare 
["abc","bac","cba","bca","cab","acb"] 

Answer 2

Ein weiterer Ansatz, um die Liste Monade zu verwenden wäre:

interleavings xs ys = interl xs ys ++ interl ys xs where 
    interl [] ys = [ys] 
    interl xs [] = [xs] 
    interl xs ys = do 
    i <- [1..(length xs)] 
    let (h, t) = splitAt i xs 
    map (h ++) (interl ys t) 

So ist der rekursive Teil zwischen den beiden Listen abwechseln, nimm abwechselnd alle 1 bis N Elemente aus jeder Liste und produziere dann alle möglichen Kombinationen daraus. Spaß beim Verwenden der Liste Monade.

Edit: Fehler behoben, wodurch Duplikate

Edit: Antwort auf dfeuer. Es stellte sich heraus, dass es schwierig war, Code im Kommentarfeld zu schreiben. Ein Beispiel für Lösungen, die length nicht aussehen etwas verwenden:

interleavings xs ys = interl xs ys ++ interl ys xs where 
    interl [] ys = [ys] 
    interl xs [] = [xs] 
    interl xs ys = splits xs >>= \(h, t) -> map (h ++) (interl ys t) 

splits [] = [] 
splits (x:xs) = ([x], xs) : map ((h, t) -> (x:h, t)) (splits xs) 

Die Splits Funktion fühlt sich ein wenig umständlich.Es könnte durch die Verwendung von takeWhile oder break in Kombination mit splitAt ersetzt werden, aber diese Lösung endete auch ein bisschen peinlich. Hast du irgendwelche Vorschläge?

(habe ich von der do-Notation befreit es etwas kürzer gerade zu machen)

Answer 3

Dies ist schnellste Implementierung Ich habe kommen mit so weit. Es verschachtelt eine Liste von Listen paarweise.

Dieses schrecklich hässliche Chaos ist der beste Weg, um zwei Listen zu verschachteln. Es soll asymptotisch optimal sein (was ich glaube es ist); es ist nicht sehr hübsch. Die konstanten Faktoren könnten verbessert werden, indem eine spezielle Warteschlange (wie diejenige, die in Data.List verwendet wird, um inits zu implementieren) anstelle von Sequenzen verwendet wird, aber ich habe nicht das Gefühl, so viele Standardwerte mit aufzunehmen.

{-# LANGUAGE BangPatterns #-} 
import Data.Monoid 
import Data.Foldable (toList) 
import Data.Sequence (Seq, (|>)) 

interleave2 :: [a] -> [a] -> [[a]] 
interleave2 xs ys = interleave2' mempty xs ys [] 

interleave2' :: Seq a -> [a] -> [a] -> [[a]] -> [[a]] 
interleave2' !prefix xs ys rest = 
    (toList prefix ++ xs ++ ys) 
    : interleave2'' prefix xs ys rest 

interleave2'' :: Seq a -> [a] -> [a] -> [[a]] -> [[a]] 
interleave2'' !prefix [] _ = id 
interleave2'' !prefix _ [] = id 
interleave2'' !prefix xs@(x : xs') ys@(y : ys') = 
    interleave2' (prefix |> y) xs ys' . 
     interleave2'' (prefix |> x) xs' ys 

Answer 4

Die Kombination der besten Ideen aus den vorhandenen Antworten und das Hinzufügen von ein paar meiner eigenen:

import Control.Monad 

interleave [] ys = return ys 
interleave xs [] = return xs 
interleave (x : xs) (y : ys) = 
    fmap (x :) (interleave xs (y : ys)) `mplus` fmap (y :) (interleave (x : xs) ys) 

interleavings :: MonadPlus m => [[a]] -> m [a] 
interleavings = foldM interleave [] 

Dies ist nicht der schnellstmögliche Sie bekommen können, aber es sollte in Bezug auf die allgemeine und einfache gut .

Answer 5

Mit foldr über interleave2

interleave :: [[a]] -> [[a]] 
interleave = foldr ((concat .) . map . iL2) [[]] where 
    iL2 [] ys = [ys] 
    iL2 xs [] = [xs] 
    iL2 (x:xs) (y:ys) = map (x:) (iL2 xs (y:ys)) ++ map (y:) (iL2 (x:xs) ys)