diff --git a/.paket/Paket.Restore.targets b/.paket/Paket.Restore.targets index 7136773..a86be3a 100644 --- a/.paket/Paket.Restore.targets +++ b/.paket/Paket.Restore.targets @@ -18,6 +18,11 @@ $(PaketToolsPath)paket.exe "$(PaketExePath)" $(MonoPath) --runtime=v4.0.30319 "$(PaketExePath)" + + + <_PaketExeExtension>$([System.IO.Path]::GetExtension("$(PaketExePath)")) + dotnet "$(PaketExePath)" + $(PaketRootPath)paket.bootstrapper.exe $(PaketToolsPath)paket.bootstrapper.exe "$(PaketBootStrapperExePath)" diff --git a/OrderingAlg.md b/OrderingAlg.md index a4fac43..f3e4e53 100644 --- a/OrderingAlg.md +++ b/OrderingAlg.md @@ -38,6 +38,13 @@ Actual implementation uses Map with the last part of the qualified identifier of Correct ordering of files is such that for each dependency `file1 -> file2`, `file1` is before `file2`. This directly translates to Topological order problem in oriented graphs: https://en.wikipedia.org/wiki/Topological_sort -Kahn's algorithm mentioned on wiki is implemented. +Kahn's algorithm mentioned on wiki is implemented with modifications to find ordering with minimal number of move operations: + +In each cycle, we add only one node to resulting ordered list; from set of nodes with no incoming edge, we select the one that comes first in original order. + +This alg outputs ordering that can be achieved by minimal number of *move up/down* operations (switching order of two neighbour elements). + +> *Side note (by @jindraivanek)*: If we choose different definition for edit distance as *sum of differences in node positions*, +> then above alg wouldn't work, and from my experiments with it, I think this is a hard (NP-complete) problem. Later, we need to find a way how to find ordering with minimal editing distance from original ordering. \ No newline at end of file diff --git a/src/Mechanic.Tests/Tests.fs b/src/Mechanic.Tests/Tests.fs index 481e82d..db75cc9 100644 --- a/src/Mechanic.Tests/Tests.fs +++ b/src/Mechanic.Tests/Tests.fs @@ -3,11 +3,33 @@ module Tests.Main open Expecto open Mechanic open Mechanic.GraphAlg +open Mechanic.Utils + +module Gen = + open FsCheck + + type RandomGraph = RandomGraph of (list * list) + let genEdges = + Gen.sized (fun s -> + let nodeGen = [1..s] |> List.map Gen.constant |> Gen.oneof + Gen.map2 (fun x y -> x,y) nodeGen nodeGen |> Gen.listOfLength s) + |> Gen.map set |> Gen.map (Set.toList) + let genNodes = Gen.sized (fun s -> Gen.shuffle [1..s]) |> Gen.map List.ofArray + let genGraph = + Gen.map2 (fun x y -> x,y) genNodes genEdges + |> Arb.fromGen + |> Arb.convert RandomGraph (fun (RandomGraph l) -> l) + let addToConfig config = + {config with arbitrary = typeof.DeclaringType::config.arbitrary} + +let correctOrder edges order = + let orderPos = order |> List.mapi (fun i v -> v, i) |> Map.ofList + Seq.forall (fun (v,w) -> orderPos.[v] < orderPos.[w]) edges [] let tests = testList "GraphAlg" [ - testProperty "Topological order alg" <| fun (edges: list) -> + testPropertyWithConfig (Gen.addToConfig {FsCheckConfig.defaultConfig with maxTest = 100; endSize = 100}) "Topological order alg - correctness" <| fun (Gen.RandomGraph(nodes, edges)) -> let rec haveCycleAcc edges acc = let (edgesFrom, edgesRemain) = edges |> List.partition (fun (v,_) -> Set.contains v acc) match edgesFrom with @@ -18,13 +40,32 @@ open Mechanic.GraphAlg | true -> haveCycleAcc edgesRemain (acc + nodes) | false -> true let haveCycle (nodes: list) edges = nodes |> Seq.exists (fun v -> haveCycleAcc edges (set [v])) - - let nodes = edges |> List.collect (fun (v,w) -> [v;w]) |> List.distinct + match GraphAlg.topologicalOrder nodes edges with | TopologicalOrder order -> Expect.equal (List.length order) (List.length nodes) "Number of nodes differs" let orderPos = order |> List.mapi (fun i v -> v, i) |> Map.ofList Expect.all edges (fun (v,w) -> orderPos.[v] < orderPos.[w]) "Ordering must respect oriented edge" | Cycle _ -> Expect.isTrue (haveCycle nodes edges) "Cycle reported on graph without cycle" + + // this test is really slow for bigger sizes, because it check all permutations of given size + testPropertyWithConfig (Gen.addToConfig {FsCheckConfig.defaultConfig with maxTest = 100; endSize = 7}) "Topological order alg - min edit distance" <| fun (Gen.RandomGraph(nodes, edges)) -> + let edges = edges |> List.filter (fun (v,w) -> v <> w) + let variants = nodes |> List.allPermutations |> List.filter (correctOrder edges) + let editDistance order1 order2 = + let orderPos1 = order1 |> List.mapi (fun i v -> v, i) |> Map.ofList + let rec f i = function + | [] -> 0 + | (x::xs) -> orderPos1.[x] - i + f (i+1) xs + f 0 order2 + match variants with + | [] -> () + | _ -> + let minOrder = variants |> List.minBy (editDistance nodes) + let minDistance = editDistance nodes minOrder + match GraphAlg.topologicalOrder nodes edges with + | TopologicalOrder order -> + Expect.equal (editDistance nodes order) minDistance (sprintf "Not minimal edit distance: original %A result %A min dist %A" nodes order minOrder) + | _ -> () ] diff --git a/src/Mechanic/GraphAlg.fs b/src/Mechanic/GraphAlg.fs index 70063c9..352f2c0 100644 --- a/src/Mechanic/GraphAlg.fs +++ b/src/Mechanic/GraphAlg.fs @@ -23,19 +23,13 @@ let getMinCycle (nodes: list<_>) edges = nodes |> List.map (fun v -> getCycleAcc edgesMap [v]) |> choosePick (Seq.minBy (List.length)) let topologicalOrder orderedNodes edges = - //TODO: maintain original order of nodes + let orderPos = orderedNodes |> List.mapi (fun i v -> v, i) |> Map.ofList let nodes = orderedNodes |> set let nodeInLevel = edges |> Seq.groupBy snd |> Seq.map (fun (v, xs) -> v, Seq.length xs) let initZeroInLevelNodes = nodes - (nodeInLevel |> Seq.map fst |> set) let nodeInLevel = Seq.append nodeInLevel (initZeroInLevelNodes |> Seq.map (fun x -> x, 0)) |> Map.ofSeq - let rec solve edges nodeLevels acc = + let rec solve (nodeLevels, edges, acc) = let zeroInLevelNodes = nodeLevels |> Map.toSeq |> Seq.filter (fun (_, level) -> level = 0) |> Seq.map fst |> set - let nodeLevels = nodeLevels |> Map.filter (fun _ level -> level > 0) - let (edges, nodeLevels) = - let (edgesToRemove, remainEdges) = edges |> List.partition (fun (v,_) -> Set.contains v zeroInLevelNodes) - let nodeLevels = (nodeLevels, edgesToRemove) ||> Seq.fold (fun m (_,w) -> m |>Map.add w (m.[w]-1)) - remainEdges, nodeLevels - let acc = acc @ (Set.toList zeroInLevelNodes) match edges, Set.count zeroInLevelNodes with | [], 0 -> TopologicalOrder acc | (_ :: _), 0 -> @@ -44,8 +38,20 @@ let topologicalOrder orderedNodes edges = match getMinCycle (Set.toList cycleNodes) (edges |> List.filter (fun (v,w) -> Set.contains v cycleNodes && Set.contains w cycleNodes)) with | Some c -> Cycle c | None -> failwith "" - | _ -> solve edges nodeLevels acc - match solve edges nodeInLevel [] with + | _ -> + let next = + zeroInLevelNodes |> Seq.sortBy (fun n -> orderPos.[n]) |> Seq.map (fun n -> + let (edges, nodeLevels) = + let nodeLevels = nodeLevels |> Map.filter (fun v _ -> v <> n) + let (edgesToRemove, remainEdges) = edges |> List.partition (fun (v,_) -> v = n) + let nodeLevels = (nodeLevels, edgesToRemove) ||> Seq.fold (fun m (_,w) -> m |> Map.add w (m.[w]-1)) + remainEdges, nodeLevels + let acc = acc @ [n] + nodeLevels, edges, acc + ) |> Seq.tryHead + next |> Option.map solve |> Option.defaultValue (TopologicalOrder acc) + + match solve (nodeInLevel, edges, []) with | TopologicalOrder result -> let islandNodes = nodes - (set result) TopologicalOrder (Set.toList islandNodes @ result) diff --git a/src/Mechanic/Utils.fs b/src/Mechanic/Utils.fs index 04c1564..4de3bda 100644 --- a/src/Mechanic/Utils.fs +++ b/src/Mechanic/Utils.fs @@ -2,6 +2,15 @@ module Mechanic.Utils let tee f x = f x; x +module List = + let rec internal distribute e = function + | [] -> [[e]] + | x::xs' as xs -> (e::xs)::[for xs in distribute e xs' -> x::xs] + + let rec allPermutations = function + | [] -> [[]] + | e::xs -> List.collect (distribute e) (allPermutations xs) + module Namespace = let splitByDot (s:string) = s.Split('.') |> Array.filter (System.String.IsNullOrEmpty >> not) |> Array.toList