Как отсортировать список, используя частичный порядок в Haskell?

у меня есть процедурный EDSL, который использует блоки операторов.

эти операторы добавляются в блоки в определенном порядке, хотя между операторами могут быть зависимости.

во время компиляции EDSL, однако, мне нужно убедиться, что утверждения упорядочены в порядке зависимости, например

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

поскольку не все операторы имеют зависимости нет общего порядка (например. E := D выше независимо и может быть разместить в любом месте). Циклических зависимостей нет, поэтому порядок списков должен быть возможен.

я попытался взломать решение с помощью Data.List.sortBy и определения Ordering вернет EQ означает, что операторы не имеют зависимостей. Это сработало для некоторых примеров, но не в общем случае, например, заказ следующего ничего не сделал:

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

это потому, что по умолчанию сортировка вставки сортировки и только гарантирует, что вставленный элемент меньше или равен следующий.

я искал в интернетах реализацию Poset, но не нашел ничего применимого:

altfloat:данные.Poset определяет Ordering = LT | GT | EQ | NC (NC для несопоставимых), что хорошо, но при условии sort предполагает NaN - как несопоставимые предметы и просто выбрасывает их.

logfloat:данные.Число.PartialOrd аналогично выше, за исключением использования Maybe Ordering и я не видел функцию сортировки в любом месте упаковки.

математика.Комбинаторика.Poset я не понял, как его использовать или применим ли он.

ниже приведен минимальный пример, который имеет как обязательные, так и необязательные заявления. Порядок не связанных операторов имеет значение, и они должны поддерживать исходный порядок (т. е. сортировка должна быть стабильный w.r.т. утверждения, которые не имеют отношения зависимости).

я надеюсь, что есть простое решение к этому без использования полномасштабного графика зависимости...

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]
8
code-generation haskell poset sorting

2 ответов

проблема с ваш подход заключается в том, что ваш orderStmts не является ни упорядочением, ни частичным упорядочением. В частности, это не транзитивное и именно поэтому попытки использовать его для сортировки не получится.

то, что вы ищете топологическая сортировка. У вас есть граф вершин (операторов), которые имеют ребра между ними (их зависимости), и вы хотите убедиться, что порядок соответствует ребрам.

я сосредоточусь только на объявления, поскольку необязательные заявления просты (нам просто нужно разделить список на два, отсортировать объявления и снова объединить).

топологическая сортировка уже реализована в данные.График, что делает задачу очень просто:

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]

вызов flattenSCC это только для тестирования, как SCC нет Show экземпляра. Вы, вероятно, захотите проверить SCCs для циклов (цикл будет ошибкой компиляции языка), и если нет, извлеките отсортированную последовательность.

6

Я думаю, что единственный способ отсортировать ваши заявления группы идут от корней к детям

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]

выход

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

когда "сортировка" над группами (не операторы).

(стабильность предоставляется на этом коде, так как инвариантна через partition, map, ++, ...)

(добавление)

если вы действительно хотите какое-то свойство стабильности (сортировка ваших операторов), вы должны добавить какое-то другое ограничение (определение "стабильности").

пусть два" сортируют " прямые алгоритмы (просто переупорядочивают операторы спереди или сзади)

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

С тем же входом,orderToFront выход отличается от orderToBack вывод, но оба они действительны

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

(только с отношением равенства ваш алгоритм не может быть ниже O (n^2), но если вы определяете ограничение стабильности, оно может быть уменьшено)

2