Come ordinare una lista usando un ordine parziale in Haskell?

Question

Ho una EDSL procedurale che utilizza blocchi di istruzioni.

Queste istruzioni vengono aggiunte ai blocchi in un ordine particolare sebbene possano esistere delle dipendenze tra le istruzioni.

Durante la compilazione dell'EDSL, tuttavia, è necessario verificare che le istruzioni siano ordinate nell'ordine di dipendenza, ad es.

B := A 
C := B 
E := D 

Dal momento che non tutte le dichiarazioni hanno dipendenze non esiste un ordine totale (ad esempio E := D sopra è indipendente e può essere posizionato ovunque). Non ci sono dipendenze cicliche quindi l'ordinamento delle liste dovrebbe essere possibile.

Ho provato a hackerare una soluzione utilizzando Data.List.sortBy e definendo Ordering che restituirebbe EQ a significare che le istruzioni non hanno dipendenze. Questo ha funzionato per alcuni esempi ma non nel caso generale, ad es. ordinare il seguente fatto nulla:

C := B       B := A 
D := C = should produce => C := B 
B := A       D := C 

Questo perché l'ordinamento per inserzione ordinamento predefinito e solo assicura l'elemento inserito è minore o uguale a quello successivo.

ho cercato l'internet per un'implementazione Poset ma non hanno trovato nulla applicabile:

altfloat:Data.Poset definisce Ordering = LT | GT | EQ | NC (NC per non comparabili), che è buona, ma la condizione sort assume NaN -come elementi non comparabili e li getta via.

logfloat:Data.Number.PartialOrd è simile al precedente tranne che utilizza Maybe Ordering e non ho visto una funzione di ordinamento in qualsiasi parte del pacchetto.

Math.Combinatorics.Poset Non ho capito come usarlo o se è applicabile.

Di seguito è riportato un esempio minimo che contiene sia istruzioni vincolanti che non vincolanti. L'ordine delle dichiarazioni non binarie è importante e devono mantenere l'ordine originale (vale a dire che l'ordinamento deve essere stabile con le dichiarazioni w.r.t. che non hanno una relazione di dipendenza).

spero che ci sia una semplice soluzione a questo senza utilizzare un grafico in piena regola dipendenza ...

module Stmts where 

import Data.List (sortBy) 

data Var = A | B | C | D | E | F | G | H deriving (Eq, Show) 
data Stmt = Var := Var 
      | Inc Var 
    deriving (Show) 

-- LHS variable 
binds :: Stmt -> Maybe Var 
binds (v := _) = Just v 
binds _  = Nothing 

-- RHS variables 
references :: Stmt -> [Var] 
references (_ := v) = [v] 
references (Inc v) = [v] 

order :: [Stmt] -> [Stmt] 
order = sortBy orderStmts 

orderStmts :: Stmt -> Stmt -> Ordering 
orderStmts s1 s2 = ord mbv1 mbv2 
where 
    ord Nothing Nothing = EQ -- No dep since they don't bind vars 
    ord (Just v1) Nothing = LT -- Binding statements have precedence 
    ord Nothing (Just v2) = GT -- ^^^ 
    ord (Just v1) (Just v2)  -- Both statements are binding: 
    | v1 `elem` refs2 = LT  -- * s2 depends on s1 
    | v2 `elem` refs1 = GT  -- * s1 depends on s2 
    | otherwise  = EQ  -- * neither 

    -- *Maybe* they bind variables 
    mbv1 = binds s1 
    mbv2 = binds s2 

    -- Variables they reference 
    refs1 = references s1 
    refs2 = references s2 

-- The following should return [B := A, C := B, D := C, Inc F, Inc G] 
test = order [Inc F, Inc G, C := B, D := C, B := A] 

Answer 1

Il problema con il tuo approccio è che il tuo orderStmts non è né un ordinamento né un ordine parziale. In particolare, non è transitive ed è per questo che i tentativi di utilizzarlo per l'ordinamento falliscono.

Quello che stai cercando è topological sorting. Hai un grafico di vertici (istruzioni) che hanno degli spigoli tra loro (le loro dipendenze) e vuoi assicurarti che l'ordine corrisponda ai bordi.

Mi concentrerò solo sulle dichiarazioni, poiché le dichiarazioni non vincolanti sono semplici (abbiamo solo bisogno di dividere la lista in due, ordinare le dichiarazioni e concatenare di nuovo).

ordinamento topologico è già implementata in Data.Graph, che rende il compito molto semplice:

module Stmts where 

import Data.Graph 

data Var = A | B | C | D | E | F | G | H deriving (Eq, Ord, Show) 

data Decl = Var := Var 
    deriving (Show, Eq) 

data Stmt = Decl 
      | Inc Var 
    deriving (Show, Eq) 

sortDecls :: [Decl] -> [SCC Decl] 
sortDecls = stronglyConnComp . map triple 
    where 
    triple n@(x := y) = (n, x, [y]) 

-- The following should return [B := A, C := B, D := C] 
test = map flattenSCC . sortDecls $ [C := B, D := C, B := A] 

Calling flattenSCC è solo per prova, come SCC non ha Show esempio. Probabilmente vorrai controllare i cicli SCC s (un ciclo sarebbe un errore di compilazione della lingua), e se non ce n'è nessuno, estrai la sequenza ordinata.

Answer 2

Credo che l'unico modo per ordinare le sue dichiarazioni gruppi sono a piedi dalle radici ai bambini

import Data.List 

data Var = A | B | C | D | E | F | G | H deriving (Eq, Show) 
data Stmt = Var := Var deriving (Show) 

parent :: Stmt -> Var 
parent (_ := p) = p 

child :: Stmt -> Var 
child (c := _) = c 

steps :: [Stmt] -> [[Stmt]] 
steps st = step roots st 
    where step _ [] = [] 
     step r s = let (a, b) = partition (flip elem r . parent) s 
         (v, u) = partition (flip elem (map child b) . child) a 
        in if null u then error "Cycle!" 
           else u : step (r ++ (nub $ map child u)) (v ++ b) 

     roots = let cs = map child st 
        rs = nub $ filter (not . flip elem cs) (map parent st) 
       in if null rs then error "No roots!" 
           else rs 

main = mapM_ print $ steps [F := H, G := H, C := B, D := C, B := A] 

con uscita

[F := H,G := H,B := A] 
[C := B] 
[D := C] 

quando "sort" è gruppi (non dichiarazioni).

(La stabilità è concessa su questo codice, poiché è invariante fino a partition, map, ++, ...)

(Aggiunto)

Se davvero si vuole un po 'di proprietà di stabilità (l'ordinamento le sue dichiarazioni) è necessario aggiungere qualche altra restrizione (che definisce la "stabilità").

Let due "sort" algoritmi diretti (semplicemente riordinando dichiarazioni Davanti o schiena)

orderToFront :: [Stmt] -> [Stmt] 
orderToFront [] = [] 
orderToFront (s@(_ := p):xs) = let (l, r) = splitAtFirst ((==p).child) xs 
           in if null r then s: orderToFront xs 
              else head r: s: orderToFront (l ++ tail r) 

orderToBack' :: [Stmt] -> [Stmt] 
orderToBack' [] = [] 
orderToBack' (s@(c := _):xs) = let (l, r) = splitAtFirst ((==c).parent) xs 
           in if null r then s: orderToBack' xs 
              else orderToBack' (l ++ head r: s: tail r) 
orderToBack = reverse . orderToBack' 

splitAtFirst :: (a -> Bool) -> [a] -> ([a], [a]) 
splitAtFirst f xs = let rs = dropWhile (not.f) xs 
        in (take (length xs - length rs) xs, rs) 


main = do 

    let q = [F := H, C := B, D := C, G := F, B := A] 

    putStrLn "-- orderToFront" 
    mapM_ print $ orderToFront q 

    putStrLn "-- orderToBack" 
    mapM_ print $ orderToBack q 

con lo stesso input, orderToFront uscita è diverso orderToBack uscita ma entrambi sono valide

-- orderToFront 
F := H 
B := A 
C := B 
D := C 
G := F 
-- orderToBack 
B := A 
F := H 
G := F 
C := B 
D := C 

(con la sola relazione di uguaglianza il tuo algoritmo non può essere inferiore a O (n^2) ma se si definisce la restrizione di stabilità potrebbe essere ridotto)