From 116afbf527748cad8eefa2a3f7ca560f8f862990 Mon Sep 17 00:00:00 2001 From: Jakub Hampl Date: Thu, 11 Jun 2026 13:27:24 +0100 Subject: [PATCH] Fixes balancing in tidy tree --- src/Hierarchy/Tidy.elm | 16 +++++--- tests/Hierarchy/TidyTests.elm | 72 +++++++++++++++++++++++++++++++++++ 2 files changed, 83 insertions(+), 5 deletions(-) diff --git a/src/Hierarchy/Tidy.elm b/src/Hierarchy/Tidy.elm index 2efc35e..d133aa1 100644 --- a/src/Hierarchy/Tidy.elm +++ b/src/Hierarchy/Tidy.elm @@ -275,14 +275,20 @@ type alias YList = List { index : Int, id : Int, y : Float } -moveSubtree : Int -> Maybe { y : Float, id : Int, index : Int } -> Int -> Float -> TidyLayout a -> TidyLayout a -moveSubtree currentIndex fromMaybe currentId dist lay = +moveSubtree : Array Id -> Int -> Maybe { y : Float, id : Int, index : Int } -> Int -> Float -> TidyLayout a -> TidyLayout a +moveSubtree nodeChildren currentIndex fromMaybe currentId dist lay = case fromMaybe of Just from -> if from.index /= currentIndex - 1 then let normDist = dist / toFloat (currentIndex - from.index) + + -- The slack is distributed across the interior subtrees between + -- `from` and `current`, so the positive acceleration is planted on + -- the first interior sibling (children[from.index + 1]) + interiorStartId = + Array.get (from.index + 1) nodeChildren |> Maybe.withDefault from.id in lay |> updateTidyData @@ -298,7 +304,7 @@ moveSubtree currentIndex fromMaybe currentId dist lay = (\from_ -> { from_ | shiftAcceleration = from_.shiftAcceleration + normDist } ) - from.id + interiorStartId else lay @@ -430,7 +436,7 @@ separate peerMargin childIndex nodeId lay_ ylist_ = if dist > 0 then -- left and right are too close. move right part with distance of dist ( { rightContour | modifierSum = rightContour.modifierSum + dist } - , moveSubtree childIndex (yList2 |> List.head) (nodeChildren |> Maybe.andThen (Array.get childIndex) |> Maybe.withDefault -1) dist lay + , moveSubtree (nodeChildren |> Maybe.withDefault Array.empty) childIndex (yList2 |> List.head) (nodeChildren |> Maybe.andThen (Array.get childIndex) |> Maybe.withDefault -1) dist lay ) else @@ -617,7 +623,7 @@ layout getters tree = update tail else - { index = index, y = maxY, id = id } :: tail + { index = index, y = maxY, id = id } :: lst in { yList = update yList1, layN = lay3, index = index + 1 } ) diff --git a/tests/Hierarchy/TidyTests.elm b/tests/Hierarchy/TidyTests.elm index 7a9b12e..4b71670 100644 --- a/tests/Hierarchy/TidyTests.elm +++ b/tests/Hierarchy/TidyTests.elm @@ -33,11 +33,17 @@ suite = tree |> doLayout |> expectNodesToBeOrdered + , Test.fuzz fuzzHierarchy "Rule 7: Laying out a mirrored tree gives the horizontal flip of the original layout" <| + \tree -> + Expect.equalLists (nodeCenters (mirror tree)) (flippedNodeCenters tree) -- sanity checks , test1 , test2 , test3 + + -- regression for https://github.com/gampleman/elm-visualization/issues/190 + , test190 ] @@ -169,6 +175,39 @@ doLayout = Hierarchy.tidy [ Hierarchy.nodeSize (\( _, w, h ) -> ( w, h )), Hierarchy.parentChildMargin 1, Hierarchy.peerMargin 1 ] +{-| Reverse the order of every node's children, top to bottom. +-} +mirror : Tree a -> Tree a +mirror t = + Tree.tree (Tree.label t) (List.reverse (List.map mirror (Tree.children t))) + + +{-| The sorted multiset of node-center positions. The layout reports left-edge +x (center - width / 2), so we add width / 2 back to recover centers. +-} +nodeCenters : Tree ( Int, Float, Float ) -> List ( Float, Float ) +nodeCenters tree = + doLayout tree + |> Tree.toList + |> List.map (\n -> ( round3 (n.x + n.width / 2), round3 n.y )) + |> List.sort + + +{-| The original layout's node centers, flipped horizontally about x = 0. +-} +flippedNodeCenters : Tree ( Int, Float, Float ) -> List ( Float, Float ) +flippedNodeCenters tree = + doLayout tree + |> Tree.toList + |> List.map (\n -> ( round3 -(n.x + n.width / 2), round3 n.y )) + |> List.sort + + +round3 : Float -> Float +round3 v = + toFloat (round (v * 1000)) / 1000 + + formatTree : FinishedLayout -> String formatTree = let @@ -210,3 +249,36 @@ test3 = Tree.tree ( 0, 1, 1 ) [ Tree.tree ( 0, 1, 1 ) [ Tree.tree ( 0, 1, 10 ) [ Tree.singleton ( 0, 1, 1 ), Tree.singleton ( 0, 1, 1 ) ], Tree.tree ( 0, 1, 1 ) [ Tree.singleton ( 0, 1, 1 ) ], Tree.tree ( 0, 1, 10 ) [ Tree.singleton ( 0, 10, 1 ) ] ] ] |> doLayout |> expectNoOverlapNodes + + + +{- + See . +-} + + +test190 : Test +test190 = + Test.test "Issue 190: slack between a node's children is distributed evenly" <| + \() -> + let + leaf = + Tree.singleton ( 0, 1, 1 ) + + xs = + Tree.tree ( 0, 1, 1 ) + [ Tree.tree ( 0, 1, 1 ) [ leaf, leaf, leaf, leaf, leaf, leaf, Tree.tree ( 0, 1, 1 ) [ leaf ] ] + , leaf + , leaf + , Tree.tree ( 0, 1, 1 ) [ leaf ] + , leaf + , Tree.tree ( 0, 1, 1 ) [ Tree.tree ( 0, 1, 1 ) [ leaf, leaf, leaf, leaf, leaf, leaf, leaf ] ] + ] + |> doLayout + |> Tree.children + |> List.map (\c -> (Tree.label c).x) + + gaps = + List.map2 (\p q -> q - p) xs (List.drop 1 xs) + in + Expect.equalLists (List.map round3 gaps) [ 3.067, 3.067, 3.067, 2.4, 2.4 ]