From 355597638ca89668eac228bec467183504b52b2e Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Sat, 1 Nov 2025 18:27:22 +0100 Subject: [PATCH 01/15] feat(transformation): group vertex connections by vertex type - Updated vertexConns to take a Map VertexTreeType [Vertex] argument. - Modified logic to compute connection counts per vertex type instead of a flat map. - Introduced helper typeForNames to map vertex names to their corresponding types. - Changed VertexConnMap type to Map VertexTreeType (Map Text Int) for type-aware connection tracking. --- src-extra/transformation/SupportVertex.hs | 38 ++++- src-extra/transformation/Transformation.hs | 161 +++++++++------------ src-extra/transformation/Types.hs | 2 +- 3 files changed, 100 insertions(+), 101 deletions(-) diff --git a/src-extra/transformation/SupportVertex.hs b/src-extra/transformation/SupportVertex.hs index 512422ce..d22d04fe 100644 --- a/src-extra/transformation/SupportVertex.hs +++ b/src-extra/transformation/SupportVertex.hs @@ -24,15 +24,39 @@ possiblyBeam node _ -> Nothing _ -> Nothing -vertexConns :: Node -> Either Text ([Node], VertexConnMap) -vertexConns topNode = case NP.queryNodes beamQuery topNode of +typeForNames :: Map VertexTreeType [AnnotatedVertex] -> Map Text VertexTreeType +typeForNames groupedVs = M.fromList [(vName $ aVertex v, t) | (t, vs) <- M.toList groupedVs, v <- vs] + +vertexConns + :: Node + -> Map VertexTreeType [AnnotatedVertex] + -> Either Text ([Node], VertexConnMap) +vertexConns topNode vsPerType = case NP.queryNodes beamQuery topNode of Just (Array beams) -> Right $ go beams _ -> Left $ "could not find " <> show beamQuery where + typeMap :: Map Text VertexTreeType + typeMap = typeForNames vsPerType + + updateConn :: VertexTreeType -> Text -> VertexConnMap -> VertexConnMap + updateConn vtype key = + M.insertWith + (M.unionWith (+)) + vtype + (M.singleton key 1) + go :: Vector Node -> ([Node], VertexConnMap) go beams = - let (badNodes, beamNames) = mapResult possiblyBeam beams - fun (beam1, beam2) = increaseBeamCount beam1 . increaseBeamCount beam2 - increaseBeamCount beamName = M.insertWith (+) beamName 1 - connCountMap = foldr fun M.empty beamNames - in (badNodes, connCountMap) + let (badNodes, beamPairs) = mapResult possiblyBeam beams + connMap = foldr updateForPair M.empty beamPairs + in (badNodes, connMap) + + updateForPair :: (Text, Text) -> VertexConnMap -> VertexConnMap + updateForPair (beam1, beam2) acc = + let acc' = case M.lookup beam2 typeMap of + Just t -> updateConn t beam1 acc + Nothing -> acc + acc'' = case M.lookup beam1 typeMap of + Just t' -> updateConn t' beam2 acc' + Nothing -> acc' + in acc'' diff --git a/src-extra/transformation/Transformation.hs b/src-extra/transformation/Transformation.hs index 12e5f90d..5b860d55 100644 --- a/src-extra/transformation/Transformation.hs +++ b/src-extra/transformation/Transformation.hs @@ -37,29 +37,23 @@ sideComment :: VertexTreeType -> InternalComment sideComment t = InternalComment (sideCommentText t) False NextNode buildTreeForType - :: VertexConnMap - -> Double - -> VertexForest + :: VertexForest -> VertexTreeType -> [AnnotatedVertex] - -> ([AnnotatedVertex], Maybe VertexTree) -buildTreeForType conns supThr originalForest treeType groupsOrig = - let annVertexCount = round $ supThr * fromIntegral (length groupsOrig) / 100 - isSupportVertex' v = any (>= annVertexCount) $ M.lookup (vName . aVertex $ v) conns - (supportVertices, nonSupportVertices) = partition isSupportVertex' groupsOrig - in case nonEmpty nonSupportVertices of - Just ne -> - let origTree = M.lookup treeType originalForest - topComments = maybe [] tComments origTree - topComments' = - if null topComments - then sideComment treeType : topComments - else topComments - in ( supportVertices - , Just $ - VertexTree topComments' (one ne) - ) - Nothing -> (supportVertices, Nothing) + -> Maybe VertexTree +buildTreeForType originalForest treeType groupsOrig = + nonEmpty groupsOrig >>= go + where + go ne = + let origTree = M.lookup treeType originalForest + topComments = maybe [] tComments origTree + topComments' = + if null topComments + then sideComment treeType : topComments + else topComments + in ( Just $ + VertexTree topComments' (one ne) + ) addPrefixComments :: NonEmpty (NonEmpty AnnotatedVertex) @@ -72,23 +66,6 @@ addPrefixComments (av :| avs) = av :| map addToAnnotatedVertex avs newComment = InternalComment ("prefix group " <> commentName) False NextNode in AnnotatedVertex (newComment : comments) vertex meta :| avs' -addSupportVertex - :: AnnotatedVertex - -> VertexForest - -> VertexForest -addSupportVertex supportVertex = - let supportSideComment = [sideComment SupportTree] - in M.insertWith - combineTrees - SupportTree - (VertexTree supportSideComment (one (one supportVertex))) - -addSupportVertices - :: VertexForest - -> [AnnotatedVertex] - -> VertexForest -addSupportVertices = foldr addSupportVertex - groupByPrefix :: NonEmpty AnnotatedVertex -> NonEmpty (NonEmpty AnnotatedVertex) @@ -97,37 +74,35 @@ groupByPrefix = NE.groupWith1 (dropIndex . vName . aVertex) addVertexTreeToForest :: UpdateNamesMap -> TransformationConfig - -> Map Text Int -> Map VertexTreeType [AnnotatedVertex] -> VertexForest -> VertexForest -> VertexTreeType -> Either Text VertexForest -addVertexTreeToForest newNames tf conns grouped forest forestAcc t = - let supThr = supportThreshold tf - in case M.lookup t grouped of - Just groupsForT -> - let (supportVertices, tree) = buildTreeForType conns supThr forest t groupsForT - in case tree of - Just vt -> - let groupsToSort = tAnnotatedVertices vt - groupsSorted = - if t /= SupportTree - then - concatMap - (NE.toList . sortVertices newNames tf t) - (NE.toList groupsToSort) - else - concatMap NE.toList groupsToSort - in case nonEmpty groupsSorted of - Just groupsSorted' -> - let prefixCommentedGroups = - addPrefixComments . groupByPrefix $ groupsSorted' - vt' = vt {tAnnotatedVertices = prefixCommentedGroups} - in Right $ addSupportVertices (M.insert t vt' forestAcc) supportVertices - Nothing -> Right $ addSupportVertices forestAcc supportVertices - Nothing -> Right $ addSupportVertices forestAcc supportVertices - Nothing -> Right forestAcc +addVertexTreeToForest newNames tf grouped forest forestAcc t = + case M.lookup t grouped of + Just groupsForT -> + let tree = buildTreeForType forest t groupsForT + in case tree of + Just vt -> + let groupsToSort = tAnnotatedVertices vt + groupsSorted = + if t /= SupportTree + then + concatMap + (NE.toList . sortVertices newNames tf t) + (NE.toList groupsToSort) + else + concatMap NE.toList groupsToSort + in case nonEmpty groupsSorted of + Just groupsSorted' -> + let prefixCommentedGroups = + addPrefixComments . groupByPrefix $ groupsSorted' + vt' = vt {tAnnotatedVertices = prefixCommentedGroups} + in Right (M.insert t vt' forestAcc) + Nothing -> Right forestAcc + Nothing -> Right forestAcc + Nothing -> Right forestAcc groupAnnotatedVertices :: XGroupBreakpoints @@ -137,46 +112,48 @@ groupAnnotatedVertices brks g = do treeType <- determineGroup' brks (aVertex g) pure (treeType, [g]) -sortSupportVertices - :: UpdateNamesMap - -> TransformationConfig - -> VertexForest - -> VertexForest -sortSupportVertices newNames tfCfg = - M.update - maybeNewTree - SupportTree - where - maybeNewTree (VertexTree topComments supportVertices) = - let vertices = - one - . sortVertices newNames tfCfg SupportTree - . sconcat - $ supportVertices - in Just - ( VertexTree - topComments - vertices - ) +sortedPairs :: Map Text Int -> [(Text, Int)] +sortedPairs = sortBy (comparing (Down . snd)) . M.toList + +topXPerTypeUniqueVertexName + :: Int -> VertexConnMap -> [(VertexTreeType, Text, Int)] +topXPerTypeUniqueVertexName x m = + let sortedPerType = [(vtt, sortedPairs inner) | (vtt, inner) <- M.toList m] + allTriples = [(vtt, txt, c) | (vtt, inner) <- M.toList m, (txt, c) <- M.toList inner] + bestPerText = + M.fromListWith + (\t1@(_, _, c1) t2@(_, _, c2) -> if c1 >= c2 then t1 else t2) + [(txt, (vtt, txt, c)) | (vtt, txt, c) <- allTriples] + takePerType (vtt, pairs) = + take + x + [ (vtt, txt, c) + | (txt, c) <- pairs + , case M.lookup txt bestPerText of + Just (vtt', _, _) -> vtt' == vtt + Nothing -> False + ] + in concatMap takePerType sortedPerType moveVerticesInVertexForest - :: UpdateNamesMap + :: Node + -> UpdateNamesMap -> TransformationConfig -> VertexForest - -> ([Node], VertexConnMap) -> Either Text ([Node], VertexForest) -moveVerticesInVertexForest newNames tfCfg vertexTrees (badBeamNodes, conns) = +moveVerticesInVertexForest topNode newNames tfCfg vertexTrees = do let allVertices = concatMap (NE.toList . sconcat . tAnnotatedVertices) vertexTrees brks = xGroupBreakpoints tfCfg in case mapM (groupAnnotatedVertices brks) allVertices of Just movableVertices' -> do let groupedVertices = M.fromListWith (++) movableVertices' + (badBeamNodes, conns) <- vertexConns topNode groupedVertices newForest <- foldM - (addVertexTreeToForest newNames tfCfg conns groupedVertices vertexTrees) + (addVertexTreeToForest newNames tfCfg groupedVertices vertexTrees) M.empty treesOrder - Right (badBeamNodes, sortSupportVertices newNames tfCfg newForest) + Right (badBeamNodes, newForest) Nothing -> Left "invalid breakpoint" getVertexNamesInForest @@ -398,11 +375,9 @@ transform newNames tfCfg topNode = getVertexForest (xGroupBreakpoints tfCfg) verticesQuery topNode >>= getNamesAndUpdateTree where - getVertexConns = vertexConns topNode getNamesAndUpdateTree (badVertexNodes, globals, vertexForest) = let vertexNames = getVertexNamesInForest vertexForest - in getVertexConns - >>= moveVerticesInVertexForest newNames tfCfg vertexForest + in moveVerticesInVertexForest topNode newNames tfCfg vertexForest >>= getUpdatedNamesAndUpdateGlobally badVertexNodes globals vertexNames getUpdatedNamesAndUpdateGlobally badVertexNodes globals oldVertexNames (badBeamNodes, updatedVertexForest) = let updatedVertexNames = getVertexNamesInForest updatedVertexForest diff --git a/src-extra/transformation/Types.hs b/src-extra/transformation/Types.hs index 961d8744..b4a1fd86 100644 --- a/src-extra/transformation/Types.hs +++ b/src-extra/transformation/Types.hs @@ -58,6 +58,6 @@ data AnnotatedVertex = AnnotatedVertex type MetaMap = Map Text Node -type VertexConnMap = Map Text Int +type VertexConnMap = Map VertexTreeType (Map Text Int) type UpdateNamesMap = Map Text Text From 56ac60508386b8579dc0d0d2f0d895b2f767da70 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Tue, 11 Nov 2025 19:33:07 +0100 Subject: [PATCH 02/15] actually moving vertices --- examples/jbeam-edit.yaml | 2 +- exe/jbeam-edit/Main.hs | 7 +- src-extra/transformation/Config.hs | 18 ++-- src-extra/transformation/SupportVertex.hs | 2 +- src-extra/transformation/Transformation.hs | 106 ++++++++++++++++----- src-extra/transformation/Types.hs | 3 + 6 files changed, 105 insertions(+), 33 deletions(-) diff --git a/examples/jbeam-edit.yaml b/examples/jbeam-edit.yaml index 2f82e540..227df4cd 100644 --- a/examples/jbeam-edit.yaml +++ b/examples/jbeam-edit.yaml @@ -4,4 +4,4 @@ support-threshold: 80 x-breakpoints: LeftTree: '>= 0.09' Middle: '> -0.09' - RightTree: <= -0.09 + RightTree: '<= -0.09' diff --git a/exe/jbeam-edit/Main.hs b/exe/jbeam-edit/Main.hs index fd71e337..e8f807de 100644 --- a/exe/jbeam-edit/Main.hs +++ b/exe/jbeam-edit/Main.hs @@ -21,7 +21,9 @@ import Data.Text qualified as T #ifdef ENABLE_TRANSFORMATION import Transformation (transform) -import Config (loadTransformationConfig) +import System.FilePath (()) +import Config +import System.Directory (getCurrentDirectory) #endif main :: IO () @@ -73,7 +75,8 @@ replaceNewlines = id applyTransform :: Options -> Node -> IO (Either Text Node) #ifdef ENABLE_TRANSFORMATION applyTransform opts topNode = do - tfConfig <- loadTransformationConfig ".jbeam-edit.yaml" + cwd <- getCurrentDirectory + tfConfig <- loadTransformationConfig $ cwd ".jbeam-edit.yaml" case transform (optUpdateNames opts) tfConfig topNode of Right (badVertexNodes, badBeamNodes, topNode') -> do reportInvalidNodes "Invalid vertex nodes encountered:" badVertexNodes diff --git a/src-extra/transformation/Config.hs b/src-extra/transformation/Config.hs index c8d383dd..7ad1827c 100644 --- a/src-extra/transformation/Config.hs +++ b/src-extra/transformation/Config.hs @@ -24,6 +24,7 @@ import Data.Yaml.Aeson ( (.:), (.:?), ) +import IOUtils import Types (VertexTreeType (..)) defaultSortingThreshold :: Scientific @@ -101,10 +102,13 @@ instance FromJSON TransformationConfig where loadTransformationConfig :: FilePath -> IO TransformationConfig loadTransformationConfig filename = do res <- decodeFileEither filename - pure $ case res of - Right tc -> tc - Left _ -> - TransformationConfig - defaultSortingThreshold - defaultBreakpoints - defaultSupportThreshold + case res of + Right tc -> pure tc + Left err -> do + putErrorLine $ show err + pure + ( TransformationConfig + defaultSortingThreshold + defaultBreakpoints + defaultSupportThreshold + ) diff --git a/src-extra/transformation/SupportVertex.hs b/src-extra/transformation/SupportVertex.hs index d22d04fe..f64d78c0 100644 --- a/src-extra/transformation/SupportVertex.hs +++ b/src-extra/transformation/SupportVertex.hs @@ -43,7 +43,7 @@ vertexConns topNode vsPerType = case NP.queryNodes beamQuery topNode of M.insertWith (M.unionWith (+)) vtype - (M.singleton key 1) + (one (key, 1)) go :: Vector Node -> ([Node], VertexConnMap) go beams = diff --git a/src-extra/transformation/Transformation.hs b/src-extra/transformation/Transformation.hs index 5b860d55..f6324ed7 100644 --- a/src-extra/transformation/Transformation.hs +++ b/src-extra/transformation/Transformation.hs @@ -56,10 +56,12 @@ buildTreeForType originalForest treeType groupsOrig = ) addPrefixComments - :: NonEmpty (NonEmpty AnnotatedVertex) + :: VertexTreeType -> NonEmpty (NonEmpty AnnotatedVertex) -addPrefixComments (av :| []) = one av -addPrefixComments (av :| avs) = av :| map addToAnnotatedVertex avs + -> NonEmpty (NonEmpty AnnotatedVertex) +addPrefixComments SupportTree avs = avs +addPrefixComments _ (av :| []) = one av +addPrefixComments _ (av :| avs) = av :| map addToAnnotatedVertex avs where addToAnnotatedVertex ((AnnotatedVertex comments vertex meta) :| avs') = let commentName = dropIndex $ vName vertex @@ -97,7 +99,7 @@ addVertexTreeToForest newNames tf grouped forest forestAcc t = in case nonEmpty groupsSorted of Just groupsSorted' -> let prefixCommentedGroups = - addPrefixComments . groupByPrefix $ groupsSorted' + addPrefixComments t . groupByPrefix $ groupsSorted' vt' = vt {tAnnotatedVertices = prefixCommentedGroups} in Right (M.insert t vt' forestAcc) Nothing -> Right forestAcc @@ -113,27 +115,86 @@ groupAnnotatedVertices brks g = do pure (treeType, [g]) sortedPairs :: Map Text Int -> [(Text, Int)] -sortedPairs = sortBy (comparing (Down . snd)) . M.toList +sortedPairs = sortWith (Down . snd) . M.toList topXPerTypeUniqueVertexName - :: Int -> VertexConnMap -> [(VertexTreeType, Text, Int)] + :: Int -> VertexConnMap -> Map Text [(VertexTreeType, Int)] topXPerTypeUniqueVertexName x m = - let sortedPerType = [(vtt, sortedPairs inner) | (vtt, inner) <- M.toList m] - allTriples = [(vtt, txt, c) | (vtt, inner) <- M.toList m, (txt, c) <- M.toList inner] + let sortedPerType = + [(vtt, sortedPairs inner) | (vtt, inner) <- M.toList m] + + allTriples = + [(vtt, txt, c) | (vtt, inner) <- M.toList m, (txt, c) <- M.toList inner] + bestPerText = M.fromListWith (\t1@(_, _, c1) t2@(_, _, c2) -> if c1 >= c2 then t1 else t2) [(txt, (vtt, txt, c)) | (vtt, txt, c) <- allTriples] + takePerType (vtt, pairs) = - take - x - [ (vtt, txt, c) - | (txt, c) <- pairs - , case M.lookup txt bestPerText of - Just (vtt', _, _) -> vtt' == vtt - Nothing -> False - ] - in concatMap takePerType sortedPerType + [ (txt, [(vtt, c)]) + | (txt, c) <- take x pairs + , case M.lookup txt bestPerText of + Just (vtt', _, _) -> vtt' == vtt + Nothing -> False + ] + in M.fromListWith (++) (concatMap takePerType sortedPerType) + +moveSupportVertices + :: Int + -> Double + -> VertexConnMap + -> Map VertexTreeType [AnnotatedVertex] + -> (VertexForest, Map VertexTreeType [AnnotatedVertex]) +moveSupportVertices maxX supThr connMap vsPerType = + let nameMapPerText :: Map Text [(VertexTreeType, Int)] + nameMapPerText = topXPerTypeUniqueVertexName maxX connMap + + supportVerticesPerType :: Map VertexTreeType [AnnotatedVertex] + supportVerticesPerType = + M.mapWithKey + ( \vtt vs -> + [ av + | av <- vs + , let name = vName (aVertex av) + , name `M.member` nameMapPerText + , case M.lookup vtt connMap >>= M.lookup name of + Just connCount -> + let vertexCount = length vs + in fromIntegral connCount >= (supThr * fromIntegral vertexCount) / 100 + Nothing -> False + ] + ) + vsPerType + + supportVerticesList :: [AnnotatedVertex] + supportVerticesList = concat (M.elems supportVerticesPerType) + + supportTree :: Maybe (VertexTreeType, VertexTree) + supportTree = + case supportVerticesList of + [] -> Nothing + svs -> + Just + ( SupportTree + , VertexTree + { tComments = [] + , tAnnotatedVertices = NE.fromList [NE.fromList svs] + } + ) + + vertexForest :: VertexForest + vertexForest = + case supportTree of + Nothing -> M.empty + Just (k, vt) -> one (k, vt) + + remainingVerticesPerType :: Map VertexTreeType [AnnotatedVertex] + remainingVerticesPerType = + M.mapWithKey + (\_vtt vs -> filter (`notElem` supportVerticesList) vs) + vsPerType + in (vertexForest, remainingVerticesPerType) moveVerticesInVertexForest :: Node @@ -148,10 +209,11 @@ moveVerticesInVertexForest topNode newNames tfCfg vertexTrees = do Just movableVertices' -> do let groupedVertices = M.fromListWith (++) movableVertices' (badBeamNodes, conns) <- vertexConns topNode groupedVertices + let (supportForest, nonSupportVertices) = moveSupportVertices 1 (supportThreshold tfCfg) conns groupedVertices newForest <- foldM - (addVertexTreeToForest newNames tfCfg groupedVertices vertexTrees) - M.empty + (addVertexTreeToForest newNames tfCfg nonSupportVertices vertexTrees) + supportForest treesOrder Right (badBeamNodes, newForest) Nothing -> Left "invalid breakpoint" @@ -172,9 +234,9 @@ vertexTreeToNodesWithPrev :: MetaMap -> VertexTreeType -> VertexTree - -> (MetaMap, NE.NonEmpty Node) + -> (MetaMap, NonEmpty Node) vertexTreeToNodesWithPrev prevMeta _ (VertexTree topComments groups) = - let topNodes = NE.fromList $ map Comment topComments + let topNodes = map Comment topComments stepVertex pm av = let (nodes, newMeta) = annotatedVertexToNodesWithPrev pm av @@ -186,7 +248,7 @@ vertexTreeToNodesWithPrev prevMeta _ (VertexTree topComments groups) = (finalMeta, groupNodesLists) = mapAccumL stepGroup prevMeta groups - allNodes = topNodes <> sconcat groupNodesLists + allNodes = topNodes `NE.prependList` sconcat groupNodesLists in (finalMeta, allNodes) removeIdenticalMeta :: MetaMap -> MetaMap -> MetaMap diff --git a/src-extra/transformation/Types.hs b/src-extra/transformation/Types.hs index b4a1fd86..10f14162 100644 --- a/src-extra/transformation/Types.hs +++ b/src-extra/transformation/Types.hs @@ -56,6 +56,9 @@ data AnnotatedVertex = AnnotatedVertex } deriving (Show) +instance Eq AnnotatedVertex where + v1 == v2 = on (==) (vName . aVertex) v1 v2 + type MetaMap = Map Text Node type VertexConnMap = Map VertexTreeType (Map Text Int) From 2e93c6061c65767b6c44058adaa062ff501630e4 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 03:40:37 +0100 Subject: [PATCH 03/15] Finalize refactoring support vertex handling - Add `max-support-coordinates` option to YAML config and Config.hs - Replace `x-breakpoints` map with structured `x-group-breakpoints` list (breakpoint + vertex-type) - Introduce `defaultMaxSupportCoordinates` and integrate it into TransformationConfig - Simplify `vertexConns` logic: limit top vertices per type and flatten VertexConnMap - Change VertexConnMap type to Map Text (VertexTreeType, Int) - Rewrite `moveSupportVertices` to use new config-driven threshold logic - Split and clarify `sortVertices` / `sortSupportVertices` functions - Improve readability, consistency, and configurability of transformation pipeline --- examples/jbeam-edit.yaml | 12 +- src-extra/transformation/Config.hs | 10 +- src-extra/transformation/SupportVertex.hs | 63 +++++----- src-extra/transformation/Transformation.hs | 129 ++++++++------------- src-extra/transformation/Types.hs | 2 +- 5 files changed, 100 insertions(+), 116 deletions(-) diff --git a/examples/jbeam-edit.yaml b/examples/jbeam-edit.yaml index 227df4cd..4ca6846a 100644 --- a/examples/jbeam-edit.yaml +++ b/examples/jbeam-edit.yaml @@ -1,7 +1,11 @@ z-sorting-threshold: 0.05 support-threshold: 80 +max-support-coordinates: 3 -x-breakpoints: - LeftTree: '>= 0.09' - Middle: '> -0.09' - RightTree: '<= -0.09' +x-group-breakpoints: + - breakpoint: ">= 0.09" + vertex-type: LeftTree + - breakpoint: "> -0.09" + vertex-type: MiddleTree + - breakpoint: "<= -0.09" + vertex-type: RightTree diff --git a/src-extra/transformation/Config.hs b/src-extra/transformation/Config.hs index 7ad1827c..5e6c9a9a 100644 --- a/src-extra/transformation/Config.hs +++ b/src-extra/transformation/Config.hs @@ -9,6 +9,7 @@ module Config ( defaultSortingThreshold, defaultSupportThreshold, defaultBreakpoints, + defaultMaxSupportCoordinates, ) where import Data.Char @@ -33,6 +34,9 @@ defaultSortingThreshold = 0.05 defaultSupportThreshold :: Double defaultSupportThreshold = 96 +defaultMaxSupportCoordinates :: Int +defaultMaxSupportCoordinates = 3 + defaultBreakpoints :: XGroupBreakpoints defaultBreakpoints = XGroupBreakpoints @@ -45,6 +49,7 @@ data TransformationConfig = TransformationConfig { zSortingThreshold :: Scientific , xGroupBreakpoints :: XGroupBreakpoints , supportThreshold :: Double + , maxSupportCoordinates :: Int } deriving (Generic) @@ -54,6 +59,7 @@ newTransformationConfig = defaultSortingThreshold defaultBreakpoints defaultSupportThreshold + defaultMaxSupportCoordinates newtype XGroupBreakpoint = XGroupBreakpoint {passingBreakpoint :: Scientific -> Bool} @@ -86,7 +92,7 @@ instance FromJSON XGroupBreakpoints where "XGroupBreakpointEntry" ( \o -> do bp <- o .: "breakpoint" - vt <- o .: "vertex" + vt <- o .: "vertex-type" pure (bp, vt) ) obj @@ -98,6 +104,7 @@ instance FromJSON TransformationConfig where <$> o .:? "z-sorting-threshold" .!= defaultSortingThreshold <*> o .:? "x-group-breakpoints" .!= defaultBreakpoints <*> o .:? "support-threshold" .!= defaultSupportThreshold + <*> o .:? "max-support-coordinates" .!= defaultMaxSupportCoordinates loadTransformationConfig :: FilePath -> IO TransformationConfig loadTransformationConfig filename = do @@ -111,4 +118,5 @@ loadTransformationConfig filename = do defaultSortingThreshold defaultBreakpoints defaultSupportThreshold + defaultMaxSupportCoordinates ) diff --git a/src-extra/transformation/SupportVertex.hs b/src-extra/transformation/SupportVertex.hs index f64d78c0..a917c565 100644 --- a/src-extra/transformation/SupportVertex.hs +++ b/src-extra/transformation/SupportVertex.hs @@ -4,7 +4,6 @@ import Core.Node import Core.NodePath qualified as NP import Core.Result import Data.Map qualified as M -import Data.Vector (Vector) import Data.Vector qualified as V import Types @@ -24,39 +23,47 @@ possiblyBeam node _ -> Nothing _ -> Nothing -typeForNames :: Map VertexTreeType [AnnotatedVertex] -> Map Text VertexTreeType -typeForNames groupedVs = M.fromList [(vName $ aVertex v, t) | (t, vs) <- M.toList groupedVs, v <- vs] - vertexConns - :: Node + :: Int + -> Node -> Map VertexTreeType [AnnotatedVertex] -> Either Text ([Node], VertexConnMap) -vertexConns topNode vsPerType = case NP.queryNodes beamQuery topNode of +vertexConns maxX topNode vsPerType = case NP.queryNodes beamQuery topNode of Just (Array beams) -> Right $ go beams _ -> Left $ "could not find " <> show beamQuery where - typeMap :: Map Text VertexTreeType - typeMap = typeForNames vsPerType - - updateConn :: VertexTreeType -> Text -> VertexConnMap -> VertexConnMap - updateConn vtype key = - M.insertWith - (M.unionWith (+)) - vtype - (one (key, 1)) - - go :: Vector Node -> ([Node], VertexConnMap) go beams = let (badNodes, beamPairs) = mapResult possiblyBeam beams - connMap = foldr updateForPair M.empty beamPairs - in (badNodes, connMap) - updateForPair :: (Text, Text) -> VertexConnMap -> VertexConnMap - updateForPair (beam1, beam2) acc = - let acc' = case M.lookup beam2 typeMap of - Just t -> updateConn t beam1 acc - Nothing -> acc - acc'' = case M.lookup beam1 typeMap of - Just t' -> updateConn t' beam2 acc' - Nothing -> acc' - in acc'' + counts :: Map Text Int + counts = + foldr + ( \(a, b) acc -> + acc + & M.insertWith (+) a 1 + & M.insertWith (+) b 1 + ) + M.empty + beamPairs + + topVerticesPerType :: Map VertexTreeType [(AnnotatedVertex, Int)] + topVerticesPerType = + M.map + ( \vs -> + take + maxX + ( sortOn + (Down . snd) + ([(v, M.findWithDefault 0 (vName $ aVertex v) counts) | v <- vs]) + ) + ) + vsPerType + + vertexConnMap :: VertexConnMap + vertexConnMap = + M.fromList + [ (vName $ aVertex v, (t, c)) + | (t, vs) <- M.toList topVerticesPerType + , (v, c) <- vs + ] + in (badNodes, vertexConnMap) diff --git a/src-extra/transformation/Transformation.hs b/src-extra/transformation/Transformation.hs index f6324ed7..0258d624 100644 --- a/src-extra/transformation/Transformation.hs +++ b/src-extra/transformation/Transformation.hs @@ -92,7 +92,7 @@ addVertexTreeToForest newNames tf grouped forest forestAcc t = if t /= SupportTree then concatMap - (NE.toList . sortVertices newNames tf t) + (NE.toList . sortVertices t newNames tf) (NE.toList groupsToSort) else concatMap NE.toList groupsToSort @@ -114,87 +114,40 @@ groupAnnotatedVertices brks g = do treeType <- determineGroup' brks (aVertex g) pure (treeType, [g]) -sortedPairs :: Map Text Int -> [(Text, Int)] -sortedPairs = sortWith (Down . snd) . M.toList - -topXPerTypeUniqueVertexName - :: Int -> VertexConnMap -> Map Text [(VertexTreeType, Int)] -topXPerTypeUniqueVertexName x m = - let sortedPerType = - [(vtt, sortedPairs inner) | (vtt, inner) <- M.toList m] - - allTriples = - [(vtt, txt, c) | (vtt, inner) <- M.toList m, (txt, c) <- M.toList inner] - - bestPerText = - M.fromListWith - (\t1@(_, _, c1) t2@(_, _, c2) -> if c1 >= c2 then t1 else t2) - [(txt, (vtt, txt, c)) | (vtt, txt, c) <- allTriples] - - takePerType (vtt, pairs) = - [ (txt, [(vtt, c)]) - | (txt, c) <- take x pairs - , case M.lookup txt bestPerText of - Just (vtt', _, _) -> vtt' == vtt - Nothing -> False - ] - in M.fromListWith (++) (concatMap takePerType sortedPerType) - moveSupportVertices - :: Int - -> Double + :: UpdateNamesMap + -> TransformationConfig -> VertexConnMap - -> Map VertexTreeType [AnnotatedVertex] - -> (VertexForest, Map VertexTreeType [AnnotatedVertex]) -moveSupportVertices maxX supThr connMap vsPerType = - let nameMapPerText :: Map Text [(VertexTreeType, Int)] - nameMapPerText = topXPerTypeUniqueVertexName maxX connMap - - supportVerticesPerType :: Map VertexTreeType [AnnotatedVertex] - supportVerticesPerType = - M.mapWithKey - ( \vtt vs -> - [ av - | av <- vs - , let name = vName (aVertex av) - , name `M.member` nameMapPerText - , case M.lookup vtt connMap >>= M.lookup name of - Just connCount -> - let vertexCount = length vs - in fromIntegral connCount >= (supThr * fromIntegral vertexCount) / 100 - Nothing -> False - ] - ) - vsPerType - - supportVerticesList :: [AnnotatedVertex] - supportVerticesList = concat (M.elems supportVerticesPerType) - - supportTree :: Maybe (VertexTreeType, VertexTree) - supportTree = - case supportVerticesList of - [] -> Nothing - svs -> - Just - ( SupportTree - , VertexTree - { tComments = [] - , tAnnotatedVertices = NE.fromList [NE.fromList svs] - } - ) + -> M.Map VertexTreeType [AnnotatedVertex] + -> (VertexForest, M.Map VertexTreeType [AnnotatedVertex]) +moveSupportVertices newNames tfCfg connMap vsPerType = + let supportVertices :: [AnnotatedVertex] + supportVertices = + [ av + | (_vType, vs) <- M.toList vsPerType + , av <- vs + , let name = vName (aVertex av) + , let vertexCount = length vs + thrCount = + max 1 (round $ (supportThreshold tfCfg / 100) * fromIntegral vertexCount) + , Just (_bestType, count) <- [M.lookup name connMap] + , count >= thrCount + ] vertexForest :: VertexForest vertexForest = - case supportTree of + case nonEmpty supportVertices of Nothing -> M.empty - Just (k, vt) -> one (k, vt) + Just vs -> + M.singleton SupportTree $ + VertexTree + [sideComment SupportTree] + (one $ sortSupportVertices newNames tfCfg vs) - remainingVerticesPerType :: Map VertexTreeType [AnnotatedVertex] - remainingVerticesPerType = - M.mapWithKey - (\_vtt vs -> filter (`notElem` supportVerticesList) vs) - vsPerType - in (vertexForest, remainingVerticesPerType) + remainingVertices :: M.Map VertexTreeType [AnnotatedVertex] + remainingVertices = + M.map (filter (`notElem` supportVertices)) vsPerType + in (vertexForest, remainingVertices) moveVerticesInVertexForest :: Node @@ -208,8 +161,14 @@ moveVerticesInVertexForest topNode newNames tfCfg vertexTrees = do in case mapM (groupAnnotatedVertices brks) allVertices of Just movableVertices' -> do let groupedVertices = M.fromListWith (++) movableVertices' - (badBeamNodes, conns) <- vertexConns topNode groupedVertices - let (supportForest, nonSupportVertices) = moveSupportVertices 1 (supportThreshold tfCfg) conns groupedVertices + (badBeamNodes, conns) <- + vertexConns (maxSupportCoordinates tfCfg) topNode groupedVertices + let (supportForest, nonSupportVertices) = + moveSupportVertices + newNames + tfCfg + conns + groupedVertices newForest <- foldM (addVertexTreeToForest newNames tfCfg nonSupportVertices vertexTrees) @@ -362,13 +321,20 @@ assignNames newNames brks treeType prefixMap av = prefixMap' = M.insert cleanPrefix (lastIdx + 1) prefixMap in (prefixMap', av {aVertex = newVertex}) -sortVertices +sortSupportVertices :: UpdateNamesMap -> TransformationConfig - -> VertexTreeType -> NonEmpty AnnotatedVertex -> NonEmpty AnnotatedVertex -sortVertices newNames tfCfg treeType groups = +sortSupportVertices = sortVertices SupportTree + +sortVertices + :: VertexTreeType + -> UpdateNamesMap + -> TransformationConfig + -> NonEmpty AnnotatedVertex + -> NonEmpty AnnotatedVertex +sortVertices treeType newNames tfCfg groups = let thr = zSortingThreshold tfCfg brks = xGroupBreakpoints tfCfg groups' = @@ -378,8 +344,7 @@ sortVertices newNames tfCfg treeType groups = else groups sortedGroups = NE.sortBy (compareAV thr treeType) groups' - renamedGroups = - snd $ mapAccumL (assignNames newNames brks treeType) M.empty sortedGroups + renamedGroups = snd $ mapAccumL (assignNames newNames brks treeType) M.empty sortedGroups in renamedGroups updateVerticesInNode diff --git a/src-extra/transformation/Types.hs b/src-extra/transformation/Types.hs index 10f14162..bfde2c54 100644 --- a/src-extra/transformation/Types.hs +++ b/src-extra/transformation/Types.hs @@ -61,6 +61,6 @@ instance Eq AnnotatedVertex where type MetaMap = Map Text Node -type VertexConnMap = Map VertexTreeType (Map Text Int) +type VertexConnMap = Map Text (VertexTreeType, Int) type UpdateNamesMap = Map Text Text From 9b153988cf459e022de65e7d3bb92a30d13ee09c Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 03:41:37 +0100 Subject: [PATCH 04/15] Regenerated AST dumps and examples --- examples/ast/jbeam/frame.hs | 114 +++++---- .../formatted_jbeam/frame-complex-jbfl.jbeam | 100 ++++---- .../formatted_jbeam/frame-minimal-jbfl.jbeam | 100 ++++---- examples/jbeam/frame.jbeam | 100 ++++---- .../fender-cfg-default.jbeam | 4 +- .../fender-cfg-example.jbeam | 2 +- .../transformed_jbeam/frame-cfg-default.jbeam | 100 ++++---- .../transformed_jbeam/frame-cfg-example.jbeam | 226 +++++++++--------- 8 files changed, 383 insertions(+), 363 deletions(-) diff --git a/examples/ast/jbeam/frame.hs b/examples/ast/jbeam/frame.hs index 233c6862..05ddaed3 100644 --- a/examples/ast/jbeam/frame.hs +++ b/examples/ast/jbeam/frame.hs @@ -146,7 +146,7 @@ Object , Number 0.364 ] , Array - [ String "rl_f_supp" + [ String "rl_f14" , Number 5.3e-2 , Number ( -1.314 ) @@ -183,12 +183,19 @@ Object , Number 0.233 ] , Array - [ String "rl_supp" + [ String "rl19" , Number 5.3e-2 , Number ( -2.4e-2 ) , Number 0.578 ] + , Comment + ( InternalComment + { cText = "support" + , cMultiline = False + , cAssociationDirection = PreviousNode + } + ) , Array [ String "rl20" , Number 0.837 @@ -370,11 +377,18 @@ Object , Number 0.448 ] , Array - [ String "rl_r_supp" + [ String "rl_r48" , Number 5.3e-2 , Number 1.71 , Number 0.565 ] + , Comment + ( InternalComment + { cText = "suport for rear" + , cMultiline = False + , cAssociationDirection = PreviousNode + } + ) , Array [ String "rl_r49" , Number 0.558 @@ -1189,58 +1203,58 @@ Object ] , Array [ String "rl_f8" - , String "rl_f_supp" + , String "rl_f14" ] , Array [ String "rl_f9" - , String "rl_f_supp" + , String "rl_f14" ] , Array - [ String "rl_f_supp" + [ String "rl_f" , String "rl_f3" ] , Array [ String "rl_f10" - , String "rl_f_supp" + , String "rl_f14" ] , Array - [ String "rl_f_supp" + [ String "rl_f14" , String "rl_f13" ] , Array [ String "rl_f1" - , String "rl_f_supp" + , String "rl_f14" ] , Array [ String "rl_f0" - , String "rl_f_supp" + , String "rl_f14" ] , Array [ String "rl_f12" - , String "rl_f_supp" + , String "rl_f14" ] , Array [ String "rl_f5" - , String "rl_f_supp" + , String "rl_f14" ] , Array - [ String "rl_f_supp" + [ String "rl_f14" , String "rl_f4" ] , Array - [ String "rl_f_supp" + [ String "rl_f14" , String "rl_f6" ] , Array - [ String "rl_f_supp" + [ String "rl_f14" , String "rl_f7" ] , Array - [ String "rl_f_supp" + [ String "rl_f14" , String "rl_f2" ] , Array - [ String "rl_f_supp" + [ String "rl_f14" , String "rl_f11" ] , Comment @@ -1258,74 +1272,74 @@ Object ] , Array [ String "rl27" - , String "rl_supp" + , String "rl19" ] , Array [ String "rl26" - , String "rl_supp" + , String "rl19" ] , Array [ String "rl24" - , String "rl_supp" + , String "rl19" ] , Array [ String "rl23" - , String "rl_supp" + , String "rl19" ] , Array [ String "rl20" - , String "rl_supp" + , String "rl19" ] , Array - [ String "rl_supp" + [ String "rl19" , String "rl16" ] , Array - [ String "rl_supp" + [ String "rl19" , String "rl15" ] , Array [ String "rl31" - , String "rl_supp" + , String "rl19" ] , Array [ String "rl33" - , String "rl_supp" + , String "rl19" ] , Array [ String "rl28" - , String "rl_supp" + , String "rl19" ] , Array - [ String "rl_supp" + [ String "rl19" , String "rl25" ] , Array [ String "rl21" - , String "rl_supp" + , String "rl19" ] , Array [ String "rl22" - , String "rl_supp" + , String "rl19" ] , Array - [ String "rl_supp" + [ String "rl19" , String "rl32" ] , Array [ String "rl29" - , String "rl_supp" + , String "rl19" ] , Array - [ String "rl_supp" + [ String "rl19" , String "rl18" ] , Array - [ String "rl_supp" + [ String "rl19" , String "rl17" ] , Array - [ String "rl_supp" + [ String "rl19" , String "rl30" ] , Comment @@ -1342,64 +1356,64 @@ Object ) ] , Array - [ String "rl_r_supp" + [ String "rl_r48" , String "rl_r51" ] , Array - [ String "rl_r_supp" + [ String "rl_r48" , String "rl_r54" ] , Array [ String "rl_r45" - , String "rl_r_supp" + , String "rl_r48" ] , Array - [ String "rl_r_supp" + [ String "rl_r48" , String "rl_r50" ] , Array - [ String "rl_r_supp" + [ String "rl_r48" , String "rl_r42" ] , Array - [ String "rl_r_supp" + [ String "rl_r48" , String "rl_r47" ] , Array [ String "rl_r49" - , String "rl_r_supp" + , String "rl_r48" ] , Array [ String "rl_r35" - , String "rl_r_supp" + , String "rl_r48" ] , Array - [ String "rl_r_supp" + [ String "rl_r48" , String "rl_r43" ] , Array [ String "rl_r44" - , String "rl_r_supp" + , String "rl_r48" ] , Array [ String "rl_r53" - , String "rl_r_supp" + , String "rl_r48" ] , Array [ String "rl_r52" - , String "rl_r_supp" + , String "rl_r48" ] , Array [ String "rl_r40" - , String "rl_r_supp" + , String "rl_r48" ] , Array - [ String "rl_r_supp" + [ String "rl_r48" , String "rl_r38" ] , Array [ String "rl_r41" - , String "rl_r_supp" + , String "rl_r48" ] , Array [ String "rl_r4" diff --git a/examples/formatted_jbeam/frame-complex-jbfl.jbeam b/examples/formatted_jbeam/frame-complex-jbfl.jbeam index 5ddbfd63..8e10830b 100644 --- a/examples/formatted_jbeam/frame-complex-jbfl.jbeam +++ b/examples/formatted_jbeam/frame-complex-jbfl.jbeam @@ -21,12 +21,12 @@ ["rl_f11", 0.547, -1.350, 0.364], ["rl_f12", -0.440, -1.350, 0.310], ["rl_f13", -0.440, -1.350, 0.364], - ["rl_f_supp", 0.053, -1.314, 0.382], + ["rl_f14", 0.053, -1.314, 0.382], [ "rl15", 0.790, -0.919, 0.182], [ "rl16", 0.790, -0.919, 0.233], [ "rl17", -0.683, -0.919, 0.182], [ "rl18", -0.683, -0.919, 0.233], - ["rl_supp", 0.053, -0.024, 0.578], + [ "rl19", 0.053, -0.024, 0.578], // support [ "rl20", 0.837, 0.002, 0.182], [ "rl21", 0.837, 0.002, 0.233], [ "rl22", 0.415, 0.002, 0.182], @@ -55,7 +55,7 @@ ["rl_r45", -0.446, 1.654, 0.359], ["rl_r46", 0.553, 1.679, 0.448], ["rl_r47", -0.446, 1.679, 0.448], - ["rl_r_supp", 0.053, 1.710, 0.565], + ["rl_r48", 0.053, 1.710, 0.565], // suport for rear ["rl_r49", 0.558, 2.284, 0.364], ["rl_r50", 0.558, 2.284, 0.447], ["rl_r51", 0.053, 2.284, 0.370], @@ -251,59 +251,59 @@ // Front end {"beamDeform" : 19000.0}, - ["rl_f8", "rl_f_supp"], - ["rl_f9", "rl_f_supp"], - ["rl_f_supp", "rl_f3"], - ["rl_f10", "rl_f_supp"], - ["rl_f_supp", "rl_f13"], - ["rl_f1", "rl_f_supp"], - ["rl_f0", "rl_f_supp"], - ["rl_f12", "rl_f_supp"], - ["rl_f5", "rl_f_supp"], - ["rl_f_supp", "rl_f4"], - ["rl_f_supp", "rl_f6"], - ["rl_f_supp", "rl_f7"], - ["rl_f_supp", "rl_f2"], - ["rl_f_supp", "rl_f11"], + ["rl_f8", "rl_f14"], + ["rl_f9", "rl_f14"], + ["rl_f", "rl_f3"], + ["rl_f10", "rl_f14"], + ["rl_f14", "rl_f13"], + ["rl_f1", "rl_f14"], + ["rl_f0", "rl_f14"], + ["rl_f12", "rl_f14"], + ["rl_f5", "rl_f14"], + ["rl_f14", "rl_f4"], + ["rl_f14", "rl_f6"], + ["rl_f14", "rl_f7"], + ["rl_f14", "rl_f2"], + ["rl_f14", "rl_f11"], // Middle {"beamDeform" : 11000.0}, - ["rl27", "rl_supp"], - ["rl26", "rl_supp"], - ["rl24", "rl_supp"], - ["rl23", "rl_supp"], - ["rl20", "rl_supp"], - ["rl_supp", "rl16"], - ["rl_supp", "rl15"], - ["rl31", "rl_supp"], - ["rl33", "rl_supp"], - ["rl28", "rl_supp"], - ["rl_supp", "rl25"], - ["rl21", "rl_supp"], - ["rl22", "rl_supp"], - ["rl_supp", "rl32"], - ["rl29", "rl_supp"], - ["rl_supp", "rl18"], - ["rl_supp", "rl17"], - ["rl_supp", "rl30"], + ["rl27", "rl19"], + ["rl26", "rl19"], + ["rl24", "rl19"], + ["rl23", "rl19"], + ["rl20", "rl19"], + ["rl19", "rl16"], + ["rl19", "rl15"], + ["rl31", "rl19"], + ["rl33", "rl19"], + ["rl28", "rl19"], + ["rl19", "rl25"], + ["rl21", "rl19"], + ["rl22", "rl19"], + ["rl19", "rl32"], + ["rl29", "rl19"], + ["rl19", "rl18"], + ["rl19", "rl17"], + ["rl19", "rl30"], // Rear end {"beamDeform" : 19000.0}, - ["rl_r_supp", "rl_r51"], - ["rl_r_supp", "rl_r54"], - ["rl_r45", "rl_r_supp"], - ["rl_r_supp", "rl_r50"], - ["rl_r_supp", "rl_r42"], - ["rl_r_supp", "rl_r47"], - ["rl_r49", "rl_r_supp"], - ["rl_r35", "rl_r_supp"], - ["rl_r_supp", "rl_r43"], - ["rl_r44", "rl_r_supp"], - ["rl_r53", "rl_r_supp"], - ["rl_r52", "rl_r_supp"], - ["rl_r40", "rl_r_supp"], - ["rl_r_supp", "rl_r38"], - ["rl_r41", "rl_r_supp"], + ["rl_r48", "rl_r51"], + ["rl_r48", "rl_r54"], + ["rl_r45", "rl_r48"], + ["rl_r48", "rl_r50"], + ["rl_r48", "rl_r42"], + ["rl_r48", "rl_r47"], + ["rl_r49", "rl_r48"], + ["rl_r35", "rl_r48"], + ["rl_r48", "rl_r43"], + ["rl_r44", "rl_r48"], + ["rl_r53", "rl_r48"], + ["rl_r52", "rl_r48"], + ["rl_r40", "rl_r48"], + ["rl_r48", "rl_r38"], + ["rl_r41", "rl_r48"], ["rl_r4", "rl_r46"], // Front crush diff --git a/examples/formatted_jbeam/frame-minimal-jbfl.jbeam b/examples/formatted_jbeam/frame-minimal-jbfl.jbeam index 8c42dbf6..95a6a9ab 100644 --- a/examples/formatted_jbeam/frame-minimal-jbfl.jbeam +++ b/examples/formatted_jbeam/frame-minimal-jbfl.jbeam @@ -21,12 +21,12 @@ ["rl_f11", 0.547, -1.350, 0.364], ["rl_f12", -0.440, -1.350, 0.310], ["rl_f13", -0.440, -1.350, 0.364], - ["rl_f_supp", 0.053, -1.314, 0.382], + ["rl_f14", 0.053, -1.314, 0.382], [ "rl15", 0.790, -0.919, 0.182], [ "rl16", 0.790, -0.919, 0.233], [ "rl17", -0.683, -0.919, 0.182], [ "rl18", -0.683, -0.919, 0.233], - ["rl_supp", 0.053, -0.024, 0.578], + [ "rl19", 0.053, -0.024, 0.578], // support [ "rl20", 0.837, 0.002, 0.182], [ "rl21", 0.837, 0.002, 0.233], [ "rl22", 0.415, 0.002, 0.182], @@ -55,7 +55,7 @@ ["rl_r45", -0.446, 1.654, 0.359], ["rl_r46", 0.553, 1.679, 0.448], ["rl_r47", -0.446, 1.679, 0.448], - ["rl_r_supp", 0.053, 1.710, 0.565], + ["rl_r48", 0.053, 1.710, 0.565], // suport for rear ["rl_r49", 0.558, 2.284, 0.364], ["rl_r50", 0.558, 2.284, 0.447], ["rl_r51", 0.053, 2.284, 0.370], @@ -251,59 +251,59 @@ // Front end {"beamDeform" : 19000.0}, - ["rl_f8", "rl_f_supp"], - ["rl_f9", "rl_f_supp"], - ["rl_f_supp", "rl_f3"], - ["rl_f10", "rl_f_supp"], - ["rl_f_supp", "rl_f13"], - ["rl_f1", "rl_f_supp"], - ["rl_f0", "rl_f_supp"], - ["rl_f12", "rl_f_supp"], - ["rl_f5", "rl_f_supp"], - ["rl_f_supp", "rl_f4"], - ["rl_f_supp", "rl_f6"], - ["rl_f_supp", "rl_f7"], - ["rl_f_supp", "rl_f2"], - ["rl_f_supp", "rl_f11"], + ["rl_f8", "rl_f14"], + ["rl_f9", "rl_f14"], + ["rl_f", "rl_f3"], + ["rl_f10", "rl_f14"], + ["rl_f14", "rl_f13"], + ["rl_f1", "rl_f14"], + ["rl_f0", "rl_f14"], + ["rl_f12", "rl_f14"], + ["rl_f5", "rl_f14"], + ["rl_f14", "rl_f4"], + ["rl_f14", "rl_f6"], + ["rl_f14", "rl_f7"], + ["rl_f14", "rl_f2"], + ["rl_f14", "rl_f11"], // Middle {"beamDeform" : 11000.0}, - ["rl27", "rl_supp"], - ["rl26", "rl_supp"], - ["rl24", "rl_supp"], - ["rl23", "rl_supp"], - ["rl20", "rl_supp"], - ["rl_supp", "rl16"], - ["rl_supp", "rl15"], - ["rl31", "rl_supp"], - ["rl33", "rl_supp"], - ["rl28", "rl_supp"], - ["rl_supp", "rl25"], - ["rl21", "rl_supp"], - ["rl22", "rl_supp"], - ["rl_supp", "rl32"], - ["rl29", "rl_supp"], - ["rl_supp", "rl18"], - ["rl_supp", "rl17"], - ["rl_supp", "rl30"], + ["rl27", "rl19"], + ["rl26", "rl19"], + ["rl24", "rl19"], + ["rl23", "rl19"], + ["rl20", "rl19"], + ["rl19", "rl16"], + ["rl19", "rl15"], + ["rl31", "rl19"], + ["rl33", "rl19"], + ["rl28", "rl19"], + ["rl19", "rl25"], + ["rl21", "rl19"], + ["rl22", "rl19"], + ["rl19", "rl32"], + ["rl29", "rl19"], + ["rl19", "rl18"], + ["rl19", "rl17"], + ["rl19", "rl30"], // Rear end {"beamDeform" : 19000.0}, - ["rl_r_supp", "rl_r51"], - ["rl_r_supp", "rl_r54"], - ["rl_r45", "rl_r_supp"], - ["rl_r_supp", "rl_r50"], - ["rl_r_supp", "rl_r42"], - ["rl_r_supp", "rl_r47"], - ["rl_r49", "rl_r_supp"], - ["rl_r35", "rl_r_supp"], - ["rl_r_supp", "rl_r43"], - ["rl_r44", "rl_r_supp"], - ["rl_r53", "rl_r_supp"], - ["rl_r52", "rl_r_supp"], - ["rl_r40", "rl_r_supp"], - ["rl_r_supp", "rl_r38"], - ["rl_r41", "rl_r_supp"], + ["rl_r48", "rl_r51"], + ["rl_r48", "rl_r54"], + ["rl_r45", "rl_r48"], + ["rl_r48", "rl_r50"], + ["rl_r48", "rl_r42"], + ["rl_r48", "rl_r47"], + ["rl_r49", "rl_r48"], + ["rl_r35", "rl_r48"], + ["rl_r48", "rl_r43"], + ["rl_r44", "rl_r48"], + ["rl_r53", "rl_r48"], + ["rl_r52", "rl_r48"], + ["rl_r40", "rl_r48"], + ["rl_r48", "rl_r38"], + ["rl_r41", "rl_r48"], ["rl_r4", "rl_r46"], // Front crush diff --git a/examples/jbeam/frame.jbeam b/examples/jbeam/frame.jbeam index 902e9e26..c9993d90 100644 --- a/examples/jbeam/frame.jbeam +++ b/examples/jbeam/frame.jbeam @@ -23,12 +23,12 @@ ["rl_f11",0.547,-1.35,0.364], ["rl_f12",-0.44,-1.35,0.31], ["rl_f13",-0.44,-1.35,0.364], - ["rl_f_supp",0.053,-1.314,0.382], + ["rl_f14",0.053,-1.314,0.382], ["rl15",0.79,-0.919,0.182], ["rl16",0.79,-0.919,0.233], ["rl17",-0.683,-0.919,0.182], ["rl18",-0.683,-0.919,0.233], - ["rl_supp",0.053,-0.024,0.578], + ["rl19",0.053,-0.024,0.578], // support ["rl20",0.837,0.002,0.182], ["rl21",0.837,0.002,0.233], ["rl22",0.415,0.002,0.182], @@ -57,7 +57,7 @@ ["rl_r45",-0.446,1.654,0.359], ["rl_r46",0.553,1.679,0.448], ["rl_r47",-0.446,1.679,0.448], - ["rl_r_supp",0.053,1.71,0.565], + ["rl_r48",0.053,1.71,0.565], // suport for rear ["rl_r49",0.558,2.284,0.364], ["rl_r50",0.558,2.284,0.447], ["rl_r51",0.053,2.284,0.37], @@ -252,59 +252,59 @@ //Front end {"beamDeform":19000}, - ["rl_f8","rl_f_supp"], - ["rl_f9","rl_f_supp"], - ["rl_f_supp","rl_f3"], - ["rl_f10","rl_f_supp"], - ["rl_f_supp","rl_f13"], - ["rl_f1","rl_f_supp"], - ["rl_f0","rl_f_supp"], - ["rl_f12","rl_f_supp"], - ["rl_f5","rl_f_supp"], - ["rl_f_supp","rl_f4"], - ["rl_f_supp","rl_f6"], - ["rl_f_supp","rl_f7"], - ["rl_f_supp","rl_f2"], - ["rl_f_supp","rl_f11"], + ["rl_f8","rl_f14"], + ["rl_f9","rl_f14"], + ["rl_f","rl_f3"], + ["rl_f10","rl_f14"], + ["rl_f14","rl_f13"], + ["rl_f1","rl_f14"], + ["rl_f0","rl_f14"], + ["rl_f12","rl_f14"], + ["rl_f5","rl_f14"], + ["rl_f14","rl_f4"], + ["rl_f14","rl_f6"], + ["rl_f14","rl_f7"], + ["rl_f14","rl_f2"], + ["rl_f14","rl_f11"], //Middle {"beamDeform":11000}, - ["rl27","rl_supp"], - ["rl26","rl_supp"], - ["rl24","rl_supp"], - ["rl23","rl_supp"], - ["rl20","rl_supp"], - ["rl_supp","rl16"], - ["rl_supp","rl15"], - ["rl31","rl_supp"], - ["rl33","rl_supp"], - ["rl28","rl_supp"], - ["rl_supp","rl25"], - ["rl21","rl_supp"], - ["rl22","rl_supp"], - ["rl_supp","rl32"], - ["rl29","rl_supp"], - ["rl_supp","rl18"], - ["rl_supp","rl17"], - ["rl_supp","rl30"], + ["rl27","rl19"], + ["rl26","rl19"], + ["rl24","rl19"], + ["rl23","rl19"], + ["rl20","rl19"], + ["rl19","rl16"], + ["rl19","rl15"], + ["rl31","rl19"], + ["rl33","rl19"], + ["rl28","rl19"], + ["rl19","rl25"], + ["rl21","rl19"], + ["rl22","rl19"], + ["rl19","rl32"], + ["rl29","rl19"], + ["rl19","rl18"], + ["rl19","rl17"], + ["rl19","rl30"], //Rear end {"beamDeform":19000}, - ["rl_r_supp","rl_r51"], - ["rl_r_supp","rl_r54"], - ["rl_r45","rl_r_supp"], - ["rl_r_supp","rl_r50"], - ["rl_r_supp","rl_r42"], - ["rl_r_supp","rl_r47"], - ["rl_r49","rl_r_supp"], - ["rl_r35","rl_r_supp"], - ["rl_r_supp","rl_r43"], - ["rl_r44","rl_r_supp"], - ["rl_r53","rl_r_supp"], - ["rl_r52","rl_r_supp"], - ["rl_r40","rl_r_supp"], - ["rl_r_supp","rl_r38"], - ["rl_r41","rl_r_supp"], + ["rl_r48","rl_r51"], + ["rl_r48","rl_r54"], + ["rl_r45","rl_r48"], + ["rl_r48","rl_r50"], + ["rl_r48","rl_r42"], + ["rl_r48","rl_r47"], + ["rl_r49","rl_r48"], + ["rl_r35","rl_r48"], + ["rl_r48","rl_r43"], + ["rl_r44","rl_r48"], + ["rl_r53","rl_r48"], + ["rl_r52","rl_r48"], + ["rl_r40","rl_r48"], + ["rl_r48","rl_r38"], + ["rl_r41","rl_r48"], ["rl_r4","rl_r46"], //Front crush diff --git a/examples/transformed_jbeam/fender-cfg-default.jbeam b/examples/transformed_jbeam/fender-cfg-default.jbeam index 1a7e2e10..83e57fa2 100644 --- a/examples/transformed_jbeam/fender-cfg-default.jbeam +++ b/examples/transformed_jbeam/fender-cfg-default.jbeam @@ -43,8 +43,8 @@ {"group" : ""}, {"nodeWeight" : 1.2}, {"selfCollision" : false}, - [ "bfsl", 0.684, -1.079, 0.507], - [ "bfsr", -0.623, -1.064, 0.507] + [ "bfsr", -0.623, -1.064, 0.507], + [ "bfsl", 0.684, -1.079, 0.507] ], "beams" : [ ["id1:", "id2:"], diff --git a/examples/transformed_jbeam/fender-cfg-example.jbeam b/examples/transformed_jbeam/fender-cfg-example.jbeam index 9baeb265..2c001309 100644 --- a/examples/transformed_jbeam/fender-cfg-example.jbeam +++ b/examples/transformed_jbeam/fender-cfg-example.jbeam @@ -37,8 +37,8 @@ {"group" : ""}, {"nodeWeight" : 1.2}, {"selfCollision" : false}, - [ "bfsl", 0.684, -1.079, 0.507], [ "bfsr", -0.623, -1.064, 0.507], + [ "bfsl", 0.684, -1.079, 0.507], {"collision" : true}, {"group" : "cot_fender_l"}, {"nodeWeight" : 0.65}, diff --git a/examples/transformed_jbeam/frame-cfg-default.jbeam b/examples/transformed_jbeam/frame-cfg-default.jbeam index 2cb4f09b..6dd71a3e 100644 --- a/examples/transformed_jbeam/frame-cfg-default.jbeam +++ b/examples/transformed_jbeam/frame-cfg-default.jbeam @@ -79,9 +79,9 @@ [ "rl_r7", -0.451, 2.284, 0.447], // Support nodes - ["rl_f_supsm", 0.053, -1.314, 0.382], - ["rl_supsm", 0.053, -0.024, 0.578], - ["rl_r_supsm", 0.053, 1.710, 0.565] + [ "rlsm", 0.053, -0.024, 0.578], // support + [ "rl_sm", 0.053, 1.710, 0.565], // suport for rear + ["rl_sm1", 0.053, -1.314, 0.382] ], // --Beams-- @@ -270,59 +270,59 @@ // Front end {"beamDeform" : 19000.0}, - ["rl_fl2", "rl_f_supsm"], - ["rl_fr2", "rl_f_supsm"], - ["rl_f_supsm", "rl_fl0"], - ["rl_fl4", "rl_f_supsm"], - ["rl_f_supsm", "rl_fr5"], - ["rl_fr1", "rl_f_supsm"], - ["rl_fl1", "rl_f_supsm"], - ["rl_fr4", "rl_f_supsm"], - ["rl_fm0", "rl_f_supsm"], - ["rl_f_supsm", "rl_fr0"], - ["rl_f_supsm", "rl_fl3"], - ["rl_f_supsm", "rl_fr3"], - ["rl_f_supsm", "rl_fm1"], - ["rl_f_supsm", "rl_fl5"], + ["rl_fl2", "rl_sm1"], + ["rl_fr2", "rl_sm1"], + ["rl_f", "rl_fl0"], + ["rl_fl4", "rl_sm1"], + ["rl_sm1", "rl_fr5"], + ["rl_fr1", "rl_sm1"], + ["rl_fl1", "rl_sm1"], + ["rl_fr4", "rl_sm1"], + ["rl_fm0", "rl_sm1"], + ["rl_sm1", "rl_fr0"], + ["rl_sm1", "rl_fl3"], + ["rl_sm1", "rl_fr3"], + ["rl_sm1", "rl_fm1"], + ["rl_sm1", "rl_fl5"], // Middle {"beamDeform" : 11000.0}, - ["rlr5", "rl_supsm"], - ["rlr3", "rl_supsm"], - ["rlm0", "rl_supsm"], - ["rll4", "rl_supsm"], - ["rll3", "rl_supsm"], - ["rl_supsm", "rll1"], - ["rl_supsm", "rll0"], - ["rll7", "rl_supsm"], - ["rlr7", "rl_supsm"], - ["rlr2", "rl_supsm"], - ["rl_supsm", "rlm1"], - ["rll5", "rl_supsm"], - ["rll2", "rl_supsm"], - ["rl_supsm", "rlr6"], - ["rlr4", "rl_supsm"], - ["rl_supsm", "rlr1"], - ["rl_supsm", "rlr0"], - ["rl_supsm", "rll6"], + ["rlr5", "rlsm"], + ["rlr3", "rlsm"], + ["rlm0", "rlsm"], + ["rll4", "rlsm"], + ["rll3", "rlsm"], + ["rlsm", "rll1"], + ["rlsm", "rll0"], + ["rll7", "rlsm"], + ["rlr7", "rlsm"], + ["rlr2", "rlsm"], + ["rlsm", "rlm1"], + ["rll5", "rlsm"], + ["rll2", "rlsm"], + ["rlsm", "rlr6"], + ["rlr4", "rlsm"], + ["rlsm", "rlr1"], + ["rlsm", "rlr0"], + ["rlsm", "rll6"], // Rear end {"beamDeform" : 19000.0}, - ["rl_r_supsm", "rl_m2"], - ["rl_r_supsm", "rl_r7"], - ["rl_r4", "rl_r_supsm"], - ["rl_r_supsm", "rl_l7"], - ["rl_r_supsm", "rl_l3"], - ["rl_r_supsm", "rl_r5"], - ["rl_l6", "rl_r_supsm"], - ["rl_m1", "rl_r_supsm"], - ["rl_r_supsm", "rl_r3"], - ["rl_l4", "rl_r_supsm"], - ["rl_r6", "rl_r_supsm"], - ["rl_m3", "rl_r_supsm"], - ["rl_l2", "rl_r_supsm"], - ["rl_r_supsm", "rl_m0"], - ["rl_r2", "rl_r_supsm"], + ["rl_sm", "rl_m2"], + ["rl_sm", "rl_r7"], + ["rl_r4", "rl_sm"], + ["rl_sm", "rl_l7"], + ["rl_sm", "rl_l3"], + ["rl_sm", "rl_r5"], + ["rl_l6", "rl_sm"], + ["rl_m1", "rl_sm"], + ["rl_sm", "rl_r3"], + ["rl_l4", "rl_sm"], + ["rl_r6", "rl_sm"], + ["rl_m3", "rl_sm"], + ["rl_l2", "rl_sm"], + ["rl_sm", "rl_m0"], + ["rl_r2", "rl_sm"], ["rl_r4", "rl_l5"], // Front crush diff --git a/examples/transformed_jbeam/frame-cfg-example.jbeam b/examples/transformed_jbeam/frame-cfg-example.jbeam index 8101169a..6dd71a3e 100644 --- a/examples/transformed_jbeam/frame-cfg-example.jbeam +++ b/examples/transformed_jbeam/frame-cfg-example.jbeam @@ -36,6 +36,20 @@ [ "rl_l6", 0.558, 2.284, 0.364], [ "rl_l7", 0.558, 2.284, 0.447], + // Middle side + [ "rlm0", 0.053, 0.002, 0.182], + [ "rlm1", 0.053, 0.002, 0.233], + + // prefix group rl_fm + ["rl_fm0", 0.053, -2.090, 0.269], + ["rl_fm1", 0.053, -2.095, 0.319], + + // prefix group rl_m + [ "rl_m0", 0.053, 1.152, 0.565], + [ "rl_m1", 0.053, 1.121, 0.628], + [ "rl_m2", 0.053, 2.284, 0.370], + [ "rl_m3", 0.053, 2.284, 0.441], + // Right side [ "rlr0", -0.683, -0.919, 0.182], [ "rlr1", -0.683, -0.919, 0.233], @@ -65,17 +79,9 @@ [ "rl_r7", -0.451, 2.284, 0.447], // Support nodes - ["rl_f_supsm", 0.053, -1.314, 0.382], - [ "rlsm", 0.053, 0.002, 0.182], - [ "rlsm1", 0.053, 0.002, 0.233], - ["rl_supsm", 0.053, -0.024, 0.578], - [ "rl_sm", 0.053, 1.152, 0.565], - ["rl_sm1", 0.053, 1.121, 0.628], - ["rl_r_supsm", 0.053, 1.710, 0.565], - ["rl_sm2", 0.053, 2.284, 0.370], - ["rl_sm3", 0.053, 2.284, 0.441], - ["rl_sm4", 0.053, -2.090, 0.269], - ["rl_sm5", 0.053, -2.095, 0.319] + [ "rlsm", 0.053, -0.024, 0.578], // support + [ "rl_sm", 0.053, 1.710, 0.565], // suport for rear + ["rl_sm1", 0.053, -1.314, 0.382] ], // --Beams-- @@ -88,7 +94,7 @@ // Front end {"beamDeform" : 20600.0, "deformLimit" : 1.1}, - ["rl_fl0", "rl_sm4"], + ["rl_fl0", "rl_fm0"], ["rl_fl1", "rl_fl0"], ["rl_fl2", "rl_fl0"], ["rll0", "rl_fl4"], @@ -102,14 +108,14 @@ ["rl_fr5", "rlr1"], ["rl_fr5", "rl_fr4"], ["rl_fr1", "rl_fr0"], - ["rl_sm5", "rl_fr1"], - ["rl_sm5", "rl_sm4"], + ["rl_fm1", "rl_fr1"], + ["rl_fm1", "rl_fm0"], ["rl_fr4", "rl_fr2"], ["rl_fr3", "rl_fr5"], ["rl_fl1", "rl_fl3"], ["rl_fr2", "rl_fr0"], - ["rl_sm5", "rl_fl1"], - ["rl_fr0", "rl_sm4"], + ["rl_fm1", "rl_fl1"], + ["rl_fr0", "rl_fm0"], ["rl_fr1", "rl_fr3"], // Middle @@ -121,23 +127,23 @@ ["rlr0", "rlr2"], ["rlr3", "rlr0"], ["rlr1", "rlr5"], - ["rlr3", "rlsm"], - ["rlsm1", "rlsm"], - ["rlsm1", "rlr5"], + ["rlr3", "rlm0"], + ["rlm1", "rlm0"], + ["rlm1", "rlr5"], ["rll5", "rll1"], ["rll2", "rll0"], ["rll0", "rll3"], ["rlr4", "rlr5"], ["rlr2", "rlr6"], ["rlr4", "rlr1"], - ["rll2", "rlsm"], + ["rll2", "rlm0"], ["rll7", "rll5"], ["rlr2", "rlr4"], ["rlr6", "rlr7"], ["rll6", "rll7"], ["rlr7", "rlr4"], ["rll6", "rll2"], - ["rlsm1", "rll4"], + ["rlm1", "rll4"], ["rlr6", "rlr3"], ["rll3", "rll5"], ["rll7", "rll4"], @@ -157,8 +163,8 @@ ["rl_l5", "rl_l3"], ["rll7", "rl_l1"], ["rl_l0", "rll6"], - ["rl_l6", "rl_sm2"], - ["rl_sm3", "rl_l7"], + ["rl_l6", "rl_m2"], + ["rl_m3", "rl_l7"], ["rl_l7", "rl_l5"], ["rl_l6", "rl_l7"], ["rl_l3", "rl_l1"], @@ -166,20 +172,20 @@ ["rl_l2", "rl_l3"], ["rl_r2", "rl_r4"], ["rl_r0", "rl_r1"], - ["rl_r1", "rl_sm1"], - ["rl_sm", "rl_sm1"], + ["rl_r1", "rl_m1"], + ["rl_m0", "rl_m1"], ["rl_r6", "rl_r7"], - ["rl_sm3", "rl_r7"], - ["rl_sm2", "rl_sm3"], + ["rl_m3", "rl_r7"], + ["rl_m2", "rl_m3"], ["rl_r4", "rl_r6"], ["rl_r7", "rl_r5"], ["rl_r3", "rl_r1"], - ["rl_r6", "rl_sm2"], - ["rl_l1", "rl_sm1"], - ["rl_sm", "rl_l0"], + ["rl_r6", "rl_m2"], + ["rl_l1", "rl_m1"], + ["rl_m0", "rl_l0"], ["rl_r4", "rl_r5"], ["rl_r2", "rl_r3"], - ["rl_sm", "rl_r0"], + ["rl_m0", "rl_r0"], ["rl_r0", "rlr6"], ["rl_r5", "rl_r3"], ["rl_l4", "rl_l6"], @@ -189,19 +195,19 @@ // Front end {"beamDeform" : 16000.0}, - ["rl_fr0", "rl_sm5"], + ["rl_fr0", "rl_fm1"], ["rl_fl1", "rl_fl2"], ["rll1", "rl_fl4"], ["rll0", "rl_fl5"], ["rl_fl4", "rl_fl3"], ["rl_fl5", "rl_fl2"], - ["rl_fr1", "rl_sm4"], + ["rl_fr1", "rl_fm0"], ["rl_fr0", "rl_fr3"], ["rl_fr1", "rl_fr2"], ["rl_fr4", "rl_fr3"], ["rl_fl0", "rl_fl3"], - ["rl_fl1", "rl_sm4"], - ["rl_fl0", "rl_sm5"], + ["rl_fl1", "rl_fm0"], + ["rl_fl0", "rl_fm1"], ["rl_fr5", "rl_fr2"], ["rlr0", "rl_fr5"], ["rlr1", "rl_fr4"], @@ -213,21 +219,21 @@ ["rlr1", "rlr2"], ["rlr1", "rlr3"], ["rlr0", "rlr5"], - ["rlr5", "rlsm"], - ["rlr3", "rlsm1"], + ["rlr5", "rlm0"], + ["rlr3", "rlm1"], ["rll7", "rll3"], ["rll0", "rll5"], ["rll1", "rll2"], ["rlr6", "rlr4"], ["rll6", "rll5"], - ["rll4", "rlsm"], + ["rll4", "rlm0"], ["rlr6", "rlr5"], ["rlr0", "rlr4"], ["rlr7", "rlr2"], ["rlr4", "rlr3"], ["rll6", "rll4"], ["rlr7", "rlr3"], - ["rll2", "rlsm1"], + ["rll2", "rlm1"], ["rll3", "rll4"], ["rlr2", "rlr5"], ["rll7", "rll2"], @@ -238,7 +244,7 @@ ["rl_r7", "rl_r4"], ["rlr6", "rl_r1"], ["rl_r1", "rl_r2"], - ["rl_l7", "rl_sm2"], + ["rl_l7", "rl_m2"], ["rll7", "rl_l0"], ["rll6", "rl_l1"], ["rl_l5", "rl_l2"], @@ -247,76 +253,76 @@ ["rl_l6", "rl_l5"], ["rl_l0", "rl_l3"], ["rl_l1", "rl_l2"], - ["rl_l1", "rl_sm"], + ["rl_l1", "rl_m0"], ["rlr7", "rl_r0"], - ["rl_r0", "rl_sm1"], - ["rl_r1", "rl_sm"], - ["rl_r6", "rl_sm3"], - ["rl_r7", "rl_sm2"], + ["rl_r0", "rl_m1"], + ["rl_r1", "rl_m0"], + ["rl_r6", "rl_m3"], + ["rl_r7", "rl_m2"], ["rl_r4", "rl_r3"], ["rl_r5", "rl_r2"], ["rl_r0", "rl_r3"], - ["rl_l0", "rl_sm1"], - ["rl_l6", "rl_sm3"], + ["rl_l0", "rl_m1"], + ["rl_l6", "rl_m3"], ["rl_l4", "rl_l3"], // Support beams // Front end {"beamDeform" : 19000.0}, - ["rl_fl2", "rl_f_supsm"], - ["rl_fr2", "rl_f_supsm"], - ["rl_f_supsm", "rl_fl0"], - ["rl_fl4", "rl_f_supsm"], - ["rl_f_supsm", "rl_fr5"], - ["rl_fr1", "rl_f_supsm"], - ["rl_fl1", "rl_f_supsm"], - ["rl_fr4", "rl_f_supsm"], - ["rl_sm4", "rl_f_supsm"], - ["rl_f_supsm", "rl_fr0"], - ["rl_f_supsm", "rl_fl3"], - ["rl_f_supsm", "rl_fr3"], - ["rl_f_supsm", "rl_sm5"], - ["rl_f_supsm", "rl_fl5"], + ["rl_fl2", "rl_sm1"], + ["rl_fr2", "rl_sm1"], + ["rl_f", "rl_fl0"], + ["rl_fl4", "rl_sm1"], + ["rl_sm1", "rl_fr5"], + ["rl_fr1", "rl_sm1"], + ["rl_fl1", "rl_sm1"], + ["rl_fr4", "rl_sm1"], + ["rl_fm0", "rl_sm1"], + ["rl_sm1", "rl_fr0"], + ["rl_sm1", "rl_fl3"], + ["rl_sm1", "rl_fr3"], + ["rl_sm1", "rl_fm1"], + ["rl_sm1", "rl_fl5"], // Middle {"beamDeform" : 11000.0}, - ["rlr5", "rl_supsm"], - ["rlr3", "rl_supsm"], - ["rlsm", "rl_supsm"], - ["rll4", "rl_supsm"], - ["rll3", "rl_supsm"], - ["rl_supsm", "rll1"], - ["rl_supsm", "rll0"], - ["rll7", "rl_supsm"], - ["rlr7", "rl_supsm"], - ["rlr2", "rl_supsm"], - ["rl_supsm", "rlsm1"], - ["rll5", "rl_supsm"], - ["rll2", "rl_supsm"], - ["rl_supsm", "rlr6"], - ["rlr4", "rl_supsm"], - ["rl_supsm", "rlr1"], - ["rl_supsm", "rlr0"], - ["rl_supsm", "rll6"], + ["rlr5", "rlsm"], + ["rlr3", "rlsm"], + ["rlm0", "rlsm"], + ["rll4", "rlsm"], + ["rll3", "rlsm"], + ["rlsm", "rll1"], + ["rlsm", "rll0"], + ["rll7", "rlsm"], + ["rlr7", "rlsm"], + ["rlr2", "rlsm"], + ["rlsm", "rlm1"], + ["rll5", "rlsm"], + ["rll2", "rlsm"], + ["rlsm", "rlr6"], + ["rlr4", "rlsm"], + ["rlsm", "rlr1"], + ["rlsm", "rlr0"], + ["rlsm", "rll6"], // Rear end {"beamDeform" : 19000.0}, - ["rl_r_supsm", "rl_sm2"], - ["rl_r_supsm", "rl_r7"], - ["rl_r4", "rl_r_supsm"], - ["rl_r_supsm", "rl_l7"], - ["rl_r_supsm", "rl_l3"], - ["rl_r_supsm", "rl_r5"], - ["rl_l6", "rl_r_supsm"], - ["rl_sm1", "rl_r_supsm"], - ["rl_r_supsm", "rl_r3"], - ["rl_l4", "rl_r_supsm"], - ["rl_r6", "rl_r_supsm"], - ["rl_sm3", "rl_r_supsm"], - ["rl_l2", "rl_r_supsm"], - ["rl_r_supsm", "rl_sm"], - ["rl_r2", "rl_r_supsm"], + ["rl_sm", "rl_m2"], + ["rl_sm", "rl_r7"], + ["rl_r4", "rl_sm"], + ["rl_sm", "rl_l7"], + ["rl_sm", "rl_l3"], + ["rl_sm", "rl_r5"], + ["rl_l6", "rl_sm"], + ["rl_m1", "rl_sm"], + ["rl_sm", "rl_r3"], + ["rl_l4", "rl_sm"], + ["rl_r6", "rl_sm"], + ["rl_m3", "rl_sm"], + ["rl_l2", "rl_sm"], + ["rl_sm", "rl_m0"], + ["rl_r2", "rl_sm"], ["rl_r4", "rl_l5"], // Front crush @@ -328,10 +334,10 @@ // --Collision Triangles-- "triangles" : [ ["id1:", "id2:", "id3:"], - ["rl_sm4", "rl_fl0", "rl_sm5"], - ["rl_fl1", "rl_sm5", "rl_fl0"], - ["rl_sm4", "rl_sm5", "rl_fr0"], - ["rl_fr1", "rl_fr0", "rl_sm5"], + ["rl_fm0", "rl_fl0", "rl_fm1"], + ["rl_fl1", "rl_fm1", "rl_fl0"], + ["rl_fm0", "rl_fm1", "rl_fr0"], + ["rl_fr1", "rl_fr0", "rl_fm1"], ["rl_fr0", "rl_fr1", "rl_fr3"], ["rl_fr0", "rl_fr3", "rl_fr2"], ["rl_fr3", "rl_fr5", "rl_fr2"], @@ -360,20 +366,20 @@ ["rl_r5", "rl_r4", "rl_r3"], ["rl_r6", "rl_r4", "rl_r5"], ["rl_r7", "rl_r6", "rl_r5"], - ["rl_r7", "rl_sm2", "rl_r6"], - ["rl_sm2", "rl_r7", "rl_sm3"], - ["rl_sm3", "rl_l7", "rl_sm2"], - ["rl_l7", "rl_l6", "rl_sm2"], + ["rl_r7", "rl_m2", "rl_r6"], + ["rl_m2", "rl_r7", "rl_m3"], + ["rl_m3", "rl_l7", "rl_m2"], + ["rl_l7", "rl_l6", "rl_m2"], ["rl_l5", "rl_l4", "rl_l6"], ["rl_l7", "rl_l5", "rl_l6"], ["rl_l5", "rl_l3", "rl_l4"], ["rl_l4", "rl_l3", "rl_l2"], ["rl_l1", "rl_l0", "rl_l2"], ["rl_l3", "rl_l1", "rl_l2"], - ["rl_l1", "rl_sm1", "rl_l0"], - ["rl_sm1", "rl_sm", "rl_l0"], - ["rl_sm1", "rl_r0", "rl_sm"], - ["rl_r0", "rl_sm1", "rl_r1"], + ["rl_l1", "rl_m1", "rl_l0"], + ["rl_m1", "rl_m0", "rl_l0"], + ["rl_m1", "rl_r0", "rl_m0"], + ["rl_r0", "rl_m1", "rl_r1"], ["rll6", "rl_l0", "rll7"], ["rl_l0", "rl_l1", "rll7"], ["rll1", "rll0", "rll2"], @@ -384,10 +390,10 @@ ["rlr4", "rlr2", "rlr3"], ["rlr1", "rlr3", "rlr0"], ["rlr5", "rlr3", "rlr1"], - ["rlsm", "rll2", "rll4"], - ["rlr5", "rlr3", "rlsm"], - ["rlsm", "rlsm1", "rlr5"], - ["rlsm", "rll4", "rlsm1"], + ["rlm0", "rll2", "rll4"], + ["rlr5", "rlr3", "rlm0"], + ["rlm0", "rlm1", "rlr5"], + ["rlm0", "rll4", "rlm1"], ["rll6", "rll4", "rll2"], ["rll6", "rll7", "rll4"], ["rlr3", "rlr5", "rlr6"], From 6240fea00acf0d43fde74141d5b68465f7ad06b1 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 04:59:45 +0100 Subject: [PATCH 05/15] Refactor XGroupBreakpoint to use explicit Operator and threshold - Replace `passingBreakpoint :: Scientific -> Bool` with `XGroupBreakpoint Operator Scientific` - Introduce `Operator` type (OpLT, OpGT, OpLE, OpGE) and `applyOperator` function - Update FromJSON instance to parse operator and number from YAML - Adjust default breakpoints to match explicit operator logic - Update `determineGroup` in VertexExtraction to use `applyOperator` - Make dump_ast/Main.hs load config using current working directory --- src-extra/transformation/Config.hs | 34 ++++++++++++-------- src-extra/transformation/VertexExtraction.hs | 2 +- tools/dump_ast/Main.hs | 5 +-- 3 files changed, 25 insertions(+), 16 deletions(-) diff --git a/src-extra/transformation/Config.hs b/src-extra/transformation/Config.hs index 5e6c9a9a..6f37c05c 100644 --- a/src-extra/transformation/Config.hs +++ b/src-extra/transformation/Config.hs @@ -2,6 +2,7 @@ module Config ( loadTransformationConfig, + applyOperator, newTransformationConfig, TransformationConfig (..), XGroupBreakpoint (..), @@ -12,7 +13,6 @@ module Config ( defaultMaxSupportCoordinates, ) where -import Data.Char import Data.Scientific (Scientific) import Data.Text qualified as T import Data.Yaml (decodeFileEither) @@ -40,9 +40,9 @@ defaultMaxSupportCoordinates = 3 defaultBreakpoints :: XGroupBreakpoints defaultBreakpoints = XGroupBreakpoints - [ (XGroupBreakpoint (>= 0.09), LeftTree) -- x >= 0.09 → LeftTree - , (XGroupBreakpoint (> -0.09), MiddleTree) -- -0.09 < x < 0.09 → MiddleTree - , (XGroupBreakpoint (<= -0.09), RightTree) -- x <= -0.09 → RightTree + [ (XGroupBreakpoint OpGE 0.09, LeftTree) -- x >= 0.09 → LeftTree + , (XGroupBreakpoint OpLE (-0.09), RightTree) -- x <= -0.09 → RightTree + , (XGroupBreakpoint OpLT 0.09, MiddleTree) -- -0.09 < x < 0.09 → MiddleTree ] data TransformationConfig = TransformationConfig @@ -61,14 +61,21 @@ newTransformationConfig = defaultSupportThreshold defaultMaxSupportCoordinates -newtype XGroupBreakpoint = XGroupBreakpoint - {passingBreakpoint :: Scientific -> Bool} +data XGroupBreakpoint = XGroupBreakpoint Operator Scientific deriving (Show) -parseOperator :: Text -> Maybe (Scientific -> Scientific -> Bool) -parseOperator ">" = Just (>) -parseOperator "<" = Just (<) -parseOperator "<=" = Just (<=) -parseOperator ">=" = Just (>=) +data Operator = OpLT | OpGT | OpLE | OpGE deriving (Show) + +applyOperator :: Operator -> Scientific -> Scientific -> Bool +applyOperator OpLT x y = x < y +applyOperator OpGT x y = x > y +applyOperator OpLE x y = x <= y +applyOperator OpGE x y = x >= y + +parseOperator :: Text -> Maybe Operator +parseOperator ">" = Just OpGT +parseOperator "<" = Just OpLT +parseOperator "<=" = Just OpLE +parseOperator ">=" = Just OpGE parseOperator _ = Nothing instance FromJSON XGroupBreakpoint where @@ -77,13 +84,14 @@ instance FromJSON XGroupBreakpoint where in case parseOperator opTxt of Nothing -> fail "Invalid operator" Just opFunc -> - case readMaybe (toString $ T.dropWhile isSpace rest) of + case readMaybe (toString $ T.strip rest) of Nothing -> fail "Invalid number" - Just brk -> pure $ XGroupBreakpoint (`opFunc` brk) + Just brk -> pure $ XGroupBreakpoint opFunc brk newtype XGroupBreakpoints = XGroupBreakpoints [(XGroupBreakpoint, VertexTreeType)] + deriving (Show) instance FromJSON XGroupBreakpoints where parseJSON = withArray "XGroupBreakpoints" $ \arr -> do diff --git a/src-extra/transformation/VertexExtraction.hs b/src-extra/transformation/VertexExtraction.hs index 51a8dea0..d24cdaa5 100644 --- a/src-extra/transformation/VertexExtraction.hs +++ b/src-extra/transformation/VertexExtraction.hs @@ -175,7 +175,7 @@ newVertexTree brks vertexNames badAcc vertexForest nodes = determineGroup :: XGroupBreakpoints -> Vertex -> Maybe VertexTreeType determineGroup (XGroupBreakpoints brks) v = - case [vtype | (XGroupBreakpoint f, vtype) <- brks, f (vX v)] of + case [vtype | (XGroupBreakpoint f brk, vtype) <- brks, applyOperator f (vX v) brk] of (vtype : _) -> Just vtype [] -> Nothing diff --git a/tools/dump_ast/Main.hs b/tools/dump_ast/Main.hs index 1036f9b6..bd2e73f8 100644 --- a/tools/dump_ast/Main.hs +++ b/tools/dump_ast/Main.hs @@ -11,7 +11,7 @@ import Data.Text.Lazy qualified as LT import Formatting import Parsing.DSL (parseDSL) import Parsing.Jbeam (parseNodes) -import System.Directory (getDirectoryContents) +import System.Directory (getCurrentDirectory, getDirectoryContents) import System.Exit (exitFailure) import System.FilePath (dropExtension, takeBaseName, ()) import System.IO qualified as IO (readFile) @@ -20,7 +20,8 @@ import Transformation main :: IO () main = do - exampleCfg <- loadTransformationConfig "examples/jbeam-edit.yaml" + cwd <- getCurrentDirectory + exampleCfg <- loadTransformationConfig $ cwd "examples" "jbeam-edit.yaml" let examplesDir = "examples" jbflInputDir = examplesDir "jbfl" jbeamInputDir = examplesDir "jbeam" From abd2475b6d3623b290afbe999fde86ef3639a341 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 05:32:07 +0100 Subject: [PATCH 06/15] Added .jbeam-edit.yaml to .gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index fb077715..169079eb 100644 --- a/.gitignore +++ b/.gitignore @@ -9,6 +9,7 @@ TAGS .hpc/ .stack-work/ .ghc.environment.* +.jbeam-edit.yaml **/*~ **/#*# **/.#* From 8b0f507ef411d8e4411cab7d2dbb58b5ce30e539 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 05:38:43 +0100 Subject: [PATCH 07/15] Higher example support threshold --- examples/jbeam-edit.yaml | 2 +- .../fender-cfg-example.jbeam | 235 +++++++++--------- 2 files changed, 116 insertions(+), 121 deletions(-) diff --git a/examples/jbeam-edit.yaml b/examples/jbeam-edit.yaml index 4ca6846a..e8c5a01d 100644 --- a/examples/jbeam-edit.yaml +++ b/examples/jbeam-edit.yaml @@ -1,5 +1,5 @@ z-sorting-threshold: 0.05 -support-threshold: 80 +support-threshold: 96 max-support-coordinates: 3 x-group-breakpoints: diff --git a/examples/transformed_jbeam/fender-cfg-example.jbeam b/examples/transformed_jbeam/fender-cfg-example.jbeam index 2c001309..83e57fa2 100644 --- a/examples/transformed_jbeam/fender-cfg-example.jbeam +++ b/examples/transformed_jbeam/fender-cfg-example.jbeam @@ -16,10 +16,13 @@ [ "bfl1", 0.959, -1.762, 0.576], [ "bfl2", 0.855, -1.788, 0.707], [ "bfl3", 0.948, -1.435, 0.730], - [ "bfl4", 0.963, -1.024, 0.112], - [ "bfl5", 0.778, -1.008, 0.873], - [ "bfl6", 0.987, -0.743, 0.109], - [ "bfl7", 0.812, -0.759, 0.896], + [ "bfl4", 0.756, -1.413, 0.843], + [ "bfl5", 0.963, -1.024, 0.112], + [ "bfl6", 0.964, -1.072, 0.507], + [ "bfl7", 0.778, -1.008, 0.873], + [ "bfl8", 0.987, -0.743, 0.109], + [ "bfl9", 0.987, -0.744, 0.494], + [ "bfl10", 0.812, -0.759, 0.896], // Right side {"group" : "cot_fender_r"}, @@ -27,10 +30,13 @@ [ "bfr1", -0.906, -1.737, 0.578], [ "bfr2", -0.807, -1.769, 0.707], [ "bfr3", -0.890, -1.409, 0.729], - [ "bfr4", -0.899, -1.005, 0.112], - [ "bfr5", -0.715, -0.991, 0.873], - [ "bfr6", -0.916, -0.742, 0.112], - [ "bfr7", -0.734, -0.746, 0.888], + [ "bfr4", -0.700, -1.397, 0.843], + [ "bfr5", -0.899, -1.005, 0.112], + [ "bfr6", -0.900, -1.053, 0.508], + [ "bfr7", -0.715, -0.991, 0.873], + [ "bfr8", -0.916, -0.742, 0.112], + [ "bfr9", -0.917, -0.746, 0.494], + [ "bfr10", -0.734, -0.746, 0.888], // Support nodes {"collision" : false}, @@ -38,18 +44,7 @@ {"nodeWeight" : 1.2}, {"selfCollision" : false}, [ "bfsr", -0.623, -1.064, 0.507], - [ "bfsl", 0.684, -1.079, 0.507], - {"collision" : true}, - {"group" : "cot_fender_l"}, - {"nodeWeight" : 0.65}, - {"selfCollision" : true}, - [ "bfsl1", 0.756, -1.413, 0.843], - [ "bfsl2", 0.964, -1.072, 0.507], - [ "bfsl3", 0.987, -0.744, 0.494], - {"group" : "cot_fender_r"}, - [ "bfsr1", -0.700, -1.397, 0.843], - [ "bfsr2", -0.900, -1.053, 0.508], - [ "bfsr3", -0.917, -0.746, 0.494] + [ "bfsl", 0.684, -1.079, 0.507] ], "beams" : [ ["id1:", "id2:"], @@ -62,100 +57,100 @@ {"beamDeform" : 6000.0}, // Front - ["bfr0", "bfsr1"], + ["bfr0", "bfr4"], ["bfr0", "bfr2"], - ["bfr2", "bfsr1"], - ["bfsl1", "bfl0"], + ["bfr2", "bfr4"], + ["bfl4", "bfl0"], ["bfl0", "bfl2"], ["bfl1", "bfl2"], - ["bfsl1", "bfl3"], + ["bfl4", "bfl3"], ["bfl1", "bfl3"], ["bfr2", "bfr1"], - ["bfsr1", "bfr3"], + ["bfr4", "bfr3"], ["bfr1", "bfr3"], - ["bfsl1", "bfl2"], + ["bfl4", "bfl2"], // Middle {"beamDeform" : 12000.0}, - ["bfsl2", "bfl3"], - ["bfsr2", "bfr3"], - ["bfsl1", "bfl5"], - ["bfsr1", "bfr5"], + ["bfl6", "bfl3"], + ["bfr6", "bfr3"], + ["bfl4", "bfl7"], + ["bfr4", "bfr7"], // Rear - ["bfl5", "bfl7"], - ["bfl4", "bfsl2"], - ["bfl5", "bfsl2"], - ["bfl4", "bfl6"], - ["bfsl2", "bfsl3"], - ["bfl6", "bfsl3"], - ["bfl7", "bfsl3"], - ["bfr5", "bfr7"], - ["bfsr2", "bfr4"], - ["bfsr2", "bfr5"], - ["bfr4", "bfr6"], - ["bfsr2", "bfsr3"], - ["bfr6", "bfsr3"], - ["bfr7", "bfsr3"], + ["bfl7", "bfl10"], + ["bfl5", "bfl6"], + ["bfl7", "bfl6"], + ["bfl5", "bfl8"], + ["bfl6", "bfl9"], + ["bfl8", "bfl9"], + ["bfl10", "bfl9"], + ["bfr7", "bfr10"], + ["bfr6", "bfr5"], + ["bfr6", "bfr7"], + ["bfr5", "bfr8"], + ["bfr6", "bfr9"], + ["bfr8", "bfr9"], + ["bfr10", "bfr9"], // Crossing beams {"deformLimitExpansion" : ""}, // Front - ["bfl1", "bfsl1"], - ["bfsl1", "bfsl2"], - ["bfl5", "bfl3"], - ["bfsr1", "bfsr2"], - ["bfr5", "bfr3"], + ["bfl1", "bfl4"], + ["bfl4", "bfl6"], + ["bfl7", "bfl3"], + ["bfr4", "bfr6"], + ["bfr7", "bfr3"], ["bfl2", "bfl3"], ["bfr3", "bfr2"], - ["bfsr1", "bfr1"], + ["bfr4", "bfr1"], // Rear - ["bfsl2", "bfl7"], - ["bfl5", "bfsl3"], - ["bfl4", "bfsl3"], - ["bfsl2", "bfl6"], - ["bfsr2", "bfr7"], - ["bfr5", "bfsr3"], - ["bfr4", "bfsr3"], - ["bfsr2", "bfr6"], + ["bfl6", "bfl10"], + ["bfl7", "bfl9"], + ["bfl5", "bfl9"], + ["bfl6", "bfl8"], + ["bfr6", "bfr10"], + ["bfr7", "bfr9"], + ["bfr5", "bfr9"], + ["bfr6", "bfr8"], // Support beams ["bfl0", "bfsl"], - ["bfsl2", "bfsl"], - ["bfl4", "bfsl"], + ["bfl6", "bfsl"], + ["bfl5", "bfsl"], ["bfl3", "bfsl"], ["bfl1", "bfsl"], ["bfl2", "bfsl"], - ["bfsl1", "bfsl"], - ["bfl5", "bfsl"], - ["bfl6", "bfsl"], - ["bfsl3", "bfsl"], + ["bfl4", "bfsl"], ["bfl7", "bfsl"], + ["bfl8", "bfsl"], + ["bfl9", "bfsl"], + ["bfl10", "bfsl"], ["bfr0", "bfsr"], - ["bfsr2", "bfsr"], - ["bfr4", "bfsr"], + ["bfr6", "bfsr"], + ["bfr5", "bfsr"], ["bfr3", "bfsr"], ["bfr1", "bfsr"], ["bfr2", "bfsr"], - ["bfsr1", "bfsr"], - ["bfr5", "bfsr"], - ["bfr6", "bfsr"], - ["bfsr3", "bfsr"], + ["bfr4", "bfsr"], ["bfr7", "bfsr"], + ["bfr8", "bfsr"], + ["bfr9", "bfsr"], + ["bfr10", "bfsr"], // Front rigid {"beamSpring" : 350000.0, "beamDamp" : 115.0}, {"beamDeform" : 900.0}, // Left side - ["bfl3", "bfsl3"], - ["bfsl1", "bfl7"], + ["bfl3", "bfl9"], + ["bfl4", "bfl10"], // Right side - ["bfr3", "bfsr3"], - ["bfsr1", "bfr7"], + ["bfr3", "bfr9"], + ["bfr4", "bfr10"], // Attachment beams {"beamType" : "|NORMAL"}, @@ -181,24 +176,24 @@ {"beamStrength" : 4000.0}, {"breakGroupType" : 1.0}, ["bfl3", "fr17"], - ["bfsl1", "fr17"], - ["bfsl1", "fr9"], + ["bfl4", "fr17"], + ["bfl4", "fr9"], {"breakGroupType" : 0.0}, // Rear {"beamStrength" : 16000.0, "beamDeform" : 12000.0}, - ["bfl4", "fr18"], - ["bfl4", "fr27"], - ["bfsl2", "fr17"], - ["bfsl2", "fr21"], - ["bfl5", "fr17"], - ["bfl5", "fr29"], - ["bfl6", "fr18"], - ["bfl6", "fr27"], - ["bfsl3", "fr28"], - ["bfsl3", "fr21"], + ["bfl5", "fr18"], + ["bfl5", "fr27"], + ["bfl6", "fr17"], + ["bfl6", "fr21"], ["bfl7", "fr17"], ["bfl7", "fr29"], + ["bfl8", "fr18"], + ["bfl8", "fr27"], + ["bfl9", "fr28"], + ["bfl9", "fr21"], + ["bfl10", "fr17"], + ["bfl10", "fr29"], // Right side @@ -218,61 +213,61 @@ {"beamStrength" : 4000.0}, {"breakGroupType" : 1.0}, ["bfr3", "fr16"], - ["bfsr1", "fr16"], - ["bfsr1", "fr7"], + ["bfr4", "fr16"], + ["bfr4", "fr7"], {"breakGroupType" : 0.0}, // Rear {"beamStrength" : 16000.0, "beamDeform" : 12000.0}, - ["bfr4", "fr19"], - ["bfr4", "fr32"], - ["bfsr2", "fr16"], - ["bfsr2", "fr20"], - ["bfr5", "fr16"], - ["bfr5", "fr34"], - ["bfr6", "fr19"], - ["bfr6", "fr32"], - ["bfsr3", "fr33"], - ["bfsr3", "fr20"], + ["bfr5", "fr19"], + ["bfr5", "fr32"], + ["bfr6", "fr16"], + ["bfr6", "fr20"], ["bfr7", "fr16"], ["bfr7", "fr34"], + ["bfr8", "fr19"], + ["bfr8", "fr32"], + ["bfr9", "fr33"], + ["bfr9", "fr20"], + ["bfr10", "fr16"], + ["bfr10", "fr34"], {"beamStrength" : 16000.0, "beamDeform" : "FLT_MAX"}, // Body // Left side {"breakGroup" : "fender_l"}, - ["bfl6", "mbl0"], - ["bfsl3", "mbl1"], - ["bfl7", "mbl2"], + ["bfl8", "mbl0"], + ["bfl9", "mbl1"], + ["bfl10", "mbl2"], // Right side {"breakGroup" : "fender_r"}, - ["bfr6", "mbr0"], - ["bfsr3", "mbr1"], - ["bfr7", "mbr2"], + ["bfr8", "mbr0"], + ["bfr9", "mbr1"], + ["bfr10", "mbr2"], {"breakGroup" : "", "breakGroupType" : "", "beamType" : "|NORMAL"} ], "triangles" : [ ["id1:", "id2:", "id3:"], - ["bfl3", "bfsl1", "bfl2"], + ["bfl3", "bfl4", "bfl2"], ["bfl1", "bfl3", "bfl2"], - ["bfsl1", "bfl0", "bfl2"], - ["bfsl1", "bfl3", "bfl5"], - ["bfsl2", "bfl5", "bfl3"], - ["bfl7", "bfl5", "bfsl2"], - ["bfsl3", "bfl7", "bfsl2"], - ["bfl4", "bfl6", "bfsl2"], - ["bfsl3", "bfsl2", "bfl6"], - ["bfsr1", "bfr2", "bfr0"], - ["bfr3", "bfr2", "bfsr1"], + ["bfl4", "bfl0", "bfl2"], + ["bfl4", "bfl3", "bfl7"], + ["bfl6", "bfl7", "bfl3"], + ["bfl10", "bfl7", "bfl6"], + ["bfl9", "bfl10", "bfl6"], + ["bfl5", "bfl8", "bfl6"], + ["bfl9", "bfl6", "bfl8"], + ["bfr4", "bfr2", "bfr0"], + ["bfr3", "bfr2", "bfr4"], ["bfr1", "bfr2", "bfr3"], - ["bfsr2", "bfr3", "bfr5"], - ["bfsr1", "bfr5", "bfr3"], - ["bfr7", "bfsr2", "bfr5"], - ["bfsr3", "bfsr2", "bfr7"], - ["bfsr3", "bfr6", "bfsr2"], - ["bfr4", "bfsr2", "bfr6"] + ["bfr6", "bfr3", "bfr7"], + ["bfr4", "bfr7", "bfr3"], + ["bfr10", "bfr6", "bfr7"], + ["bfr9", "bfr6", "bfr10"], + ["bfr9", "bfr8", "bfr6"], + ["bfr5", "bfr6", "bfr8"] ], "flexbodies" : [ ["mesh", "[group]:", "nonFlexMaterials"], From 1a6f68b5a069fe8d2edfdcb36b9993f89e906775 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 05:52:37 +0100 Subject: [PATCH 08/15] Refactor Eq instances for Vertex and AnnotatedVertex --- src-extra/transformation/Types.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src-extra/transformation/Types.hs b/src-extra/transformation/Types.hs index bfde2c54..05ea60f4 100644 --- a/src-extra/transformation/Types.hs +++ b/src-extra/transformation/Types.hs @@ -47,7 +47,10 @@ data Vertex = Vertex , vZ :: Scientific , vMeta :: Maybe Object } - deriving (Eq, Show) + deriving (Show) + +instance Eq Vertex where + (==) = (==) `on` vName data AnnotatedVertex = AnnotatedVertex { aComments :: [InternalComment] @@ -57,7 +60,7 @@ data AnnotatedVertex = AnnotatedVertex deriving (Show) instance Eq AnnotatedVertex where - v1 == v2 = on (==) (vName . aVertex) v1 v2 + (==) = (==) `on` aVertex type MetaMap = Map Text Node From 8793c25536149e6562382c2d404f82f75a861c1a Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 06:12:56 +0100 Subject: [PATCH 09/15] Change backup filename --- exe/jbeam-edit/Main.hs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/exe/jbeam-edit/Main.hs b/exe/jbeam-edit/Main.hs index e8f807de..c88ab2b1 100644 --- a/exe/jbeam-edit/Main.hs +++ b/exe/jbeam-edit/Main.hs @@ -3,7 +3,7 @@ module Main ( ) where import CommandLineOptions -import Control.Monad (unless) +import Control.Monad (when) import Core.Node (Node) import Data.ByteString.Lazy qualified as LBS (fromStrict, toStrict, writeFile) import Data.Text (Text) @@ -21,7 +21,7 @@ import Data.Text qualified as T #ifdef ENABLE_TRANSFORMATION import Transformation (transform) -import System.FilePath (()) +import System.FilePath (dropExtension, ()) import Config import System.Directory (getCurrentDirectory) #endif @@ -35,9 +35,12 @@ main = do _ -> editFile opts getWritabaleFilename :: FilePath -> Options -> IO FilePath -getWritabaleFilename filename opts = - unless (optInPlace opts) (copyFile filename (filename <> ".bak")) - >> pure filename +getWritabaleFilename filename opts = do + let backupFilename = dropExtension filename <> ".bak.jbeam" + when + (not $ optInPlace opts) + (copyFile filename backupFilename) + pure filename editFile :: Options -> IO () editFile opts = do From 3881fdf0260d7f0b703dd83d6a68d5346f20a5b7 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 06:18:47 +0100 Subject: [PATCH 10/15] fixes --- exe/jbeam-edit/Main.hs | 10 ++++++---- src-extra/transformation/Config.hs | 9 +++++---- src-extra/transformation/SupportVertex.hs | 2 +- src-extra/transformation/Transformation.hs | 14 ++++++++------ tools/dump_ast/Main.hs | 3 ++- 5 files changed, 22 insertions(+), 16 deletions(-) diff --git a/exe/jbeam-edit/Main.hs b/exe/jbeam-edit/Main.hs index c88ab2b1..0138d473 100644 --- a/exe/jbeam-edit/Main.hs +++ b/exe/jbeam-edit/Main.hs @@ -3,7 +3,7 @@ module Main ( ) where import CommandLineOptions -import Control.Monad (when) +import Control.Monad (unless) import Core.Node (Node) import Data.ByteString.Lazy qualified as LBS (fromStrict, toStrict, writeFile) import Data.Text (Text) @@ -19,9 +19,11 @@ import System.Environment (getArgs) import Data.Text qualified as T #endif +import System.FilePath (dropExtension) + #ifdef ENABLE_TRANSFORMATION import Transformation (transform) -import System.FilePath (dropExtension, ()) +import System.FilePath (()) import Config import System.Directory (getCurrentDirectory) #endif @@ -37,8 +39,8 @@ main = do getWritabaleFilename :: FilePath -> Options -> IO FilePath getWritabaleFilename filename opts = do let backupFilename = dropExtension filename <> ".bak.jbeam" - when - (not $ optInPlace opts) + unless + (optInPlace opts) (copyFile filename backupFilename) pure filename diff --git a/src-extra/transformation/Config.hs b/src-extra/transformation/Config.hs index 6f37c05c..1e0906a1 100644 --- a/src-extra/transformation/Config.hs +++ b/src-extra/transformation/Config.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} module Config ( loadTransformationConfig, @@ -40,9 +41,9 @@ defaultMaxSupportCoordinates = 3 defaultBreakpoints :: XGroupBreakpoints defaultBreakpoints = XGroupBreakpoints - [ (XGroupBreakpoint OpGE 0.09, LeftTree) -- x >= 0.09 → LeftTree - , (XGroupBreakpoint OpLE (-0.09), RightTree) -- x <= -0.09 → RightTree - , (XGroupBreakpoint OpLT 0.09, MiddleTree) -- -0.09 < x < 0.09 → MiddleTree + [ (XGroupBreakpoint OpGE 0.09, LeftTree) -- x >= 0.09 → LeftTree + , (XGroupBreakpoint OpLE (-0.09), RightTree) -- x <= -0.09 → RightTree + , (XGroupBreakpoint OpLT 0.09, MiddleTree) -- -0.09 < x < 0.09 → MiddleTree ] data TransformationConfig = TransformationConfig @@ -91,7 +92,7 @@ instance FromJSON XGroupBreakpoint where newtype XGroupBreakpoints = XGroupBreakpoints [(XGroupBreakpoint, VertexTreeType)] - deriving (Show) + deriving stock (Show) instance FromJSON XGroupBreakpoints where parseJSON = withArray "XGroupBreakpoints" $ \arr -> do diff --git a/src-extra/transformation/SupportVertex.hs b/src-extra/transformation/SupportVertex.hs index a917c565..f826f131 100644 --- a/src-extra/transformation/SupportVertex.hs +++ b/src-extra/transformation/SupportVertex.hs @@ -52,7 +52,7 @@ vertexConns maxX topNode vsPerType = case NP.queryNodes beamQuery topNode of ( \vs -> take maxX - ( sortOn + ( sortWith (Down . snd) ([(v, M.findWithDefault 0 (vName $ aVertex v) counts) | v <- vs]) ) diff --git a/src-extra/transformation/Transformation.hs b/src-extra/transformation/Transformation.hs index 0258d624..93df06d2 100644 --- a/src-extra/transformation/Transformation.hs +++ b/src-extra/transformation/Transformation.hs @@ -129,7 +129,7 @@ moveSupportVertices newNames tfCfg connMap vsPerType = , let name = vName (aVertex av) , let vertexCount = length vs thrCount = - max 1 (round $ (supportThreshold tfCfg / 100) * fromIntegral vertexCount) + max 1 (round $ supportThreshold tfCfg / 100 * fromIntegral vertexCount) , Just (_bestType, count) <- [M.lookup name connMap] , count >= thrCount ] @@ -139,10 +139,12 @@ moveSupportVertices newNames tfCfg connMap vsPerType = case nonEmpty supportVertices of Nothing -> M.empty Just vs -> - M.singleton SupportTree $ - VertexTree - [sideComment SupportTree] - (one $ sortSupportVertices newNames tfCfg vs) + one + ( SupportTree + , VertexTree + [sideComment SupportTree] + (one $ sortSupportVertices newNames tfCfg vs) + ) remainingVertices :: M.Map VertexTreeType [AnnotatedVertex] remainingVertices = @@ -155,7 +157,7 @@ moveVerticesInVertexForest -> TransformationConfig -> VertexForest -> Either Text ([Node], VertexForest) -moveVerticesInVertexForest topNode newNames tfCfg vertexTrees = do +moveVerticesInVertexForest topNode newNames tfCfg vertexTrees = let allVertices = concatMap (NE.toList . sconcat . tAnnotatedVertices) vertexTrees brks = xGroupBreakpoints tfCfg in case mapM (groupAnnotatedVertices brks) allVertices of diff --git a/tools/dump_ast/Main.hs b/tools/dump_ast/Main.hs index bd2e73f8..8a2a23e5 100644 --- a/tools/dump_ast/Main.hs +++ b/tools/dump_ast/Main.hs @@ -21,7 +21,8 @@ import Transformation main :: IO () main = do cwd <- getCurrentDirectory - exampleCfg <- loadTransformationConfig $ cwd "examples" "jbeam-edit.yaml" + exampleCfg <- + loadTransformationConfig $ cwd "examples" "jbeam-edit.yaml" let examplesDir = "examples" jbflInputDir = examplesDir "jbfl" jbeamInputDir = examplesDir "jbeam" From a1e1918a8083b8d3bccca6cb299764825875ec86 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 07:16:29 +0100 Subject: [PATCH 11/15] Replace Eq instance with notElemByVertexName helper --- src-extra/transformation/Transformation.hs | 7 ++++++- src-extra/transformation/Types.hs | 10 ++-------- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/src-extra/transformation/Transformation.hs b/src-extra/transformation/Transformation.hs index 93df06d2..bc95119e 100644 --- a/src-extra/transformation/Transformation.hs +++ b/src-extra/transformation/Transformation.hs @@ -148,9 +148,14 @@ moveSupportVertices newNames tfCfg connMap vsPerType = remainingVertices :: M.Map VertexTreeType [AnnotatedVertex] remainingVertices = - M.map (filter (`notElem` supportVertices)) vsPerType + M.map (filter (`notElemByVertexName` supportVertices)) vsPerType in (vertexForest, remainingVertices) +notElemByVertexName + :: Foldable t + => AnnotatedVertex -> t AnnotatedVertex -> Bool +notElemByVertexName vertex = not . any (on (==) (vName . aVertex) vertex) + moveVerticesInVertexForest :: Node -> UpdateNamesMap diff --git a/src-extra/transformation/Types.hs b/src-extra/transformation/Types.hs index 05ea60f4..72f84b9b 100644 --- a/src-extra/transformation/Types.hs +++ b/src-extra/transformation/Types.hs @@ -47,20 +47,14 @@ data Vertex = Vertex , vZ :: Scientific , vMeta :: Maybe Object } - deriving (Show) - -instance Eq Vertex where - (==) = (==) `on` vName + deriving (Eq, Show) data AnnotatedVertex = AnnotatedVertex { aComments :: [InternalComment] , aVertex :: Vertex , aMeta :: MetaMap } - deriving (Show) - -instance Eq AnnotatedVertex where - (==) = (==) `on` aVertex + deriving (Eq, Show) type MetaMap = Map Text Node From 1ec6336a6699dafbfbd5b03ce0ef336f83ac5df1 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 08:32:11 +0100 Subject: [PATCH 12/15] Normalize support vertex names --- src-extra/transformation/Transformation.hs | 29 ++++++++++++++++++---- 1 file changed, 24 insertions(+), 5 deletions(-) diff --git a/src-extra/transformation/Transformation.hs b/src-extra/transformation/Transformation.hs index bc95119e..7eace0ca 100644 --- a/src-extra/transformation/Transformation.hs +++ b/src-extra/transformation/Transformation.hs @@ -114,6 +114,24 @@ groupAnnotatedVertices brks g = do treeType <- determineGroup' brks (aVertex g) pure (treeType, [g]) +isLmr :: Char -> Bool +isLmr lastChar = lastChar `elem` ['l', 'm', 'r'] + +updateSupportVertexName + :: VertexTreeType + -> AnnotatedVertex + -> AnnotatedVertex +updateSupportVertexName vType (AnnotatedVertex c v m) = AnnotatedVertex c (v {vName = newName}) m + where + name = vName v + newName = + case T.unsnoc name of + Nothing -> name + Just (prefix, lastChar) -> + if isLmr lastChar + then prefix <> prefixForType vType + else name + moveSupportVertices :: UpdateNamesMap -> TransformationConfig @@ -123,8 +141,8 @@ moveSupportVertices moveSupportVertices newNames tfCfg connMap vsPerType = let supportVertices :: [AnnotatedVertex] supportVertices = - [ av - | (_vType, vs) <- M.toList vsPerType + [ updateSupportVertexName vType av + | (vType, vs) <- M.toList vsPerType , av <- vs , let name = vName (aVertex av) , let vertexCount = length vs @@ -304,6 +322,7 @@ assignNames newNames brks treeType prefixMap av = prefix = dropIndex (vName v) typeSpecific = maybe "" prefixForType (determineGroup brks v) (prefix', lastChar) = fromMaybe (error "unreachable") (T.unsnoc prefix) + supportPrefixChar = one 's' <> bool typeSpecific (one lastChar) (isLmr lastChar) cleanPrefix | treeType /= SupportTree && T.length prefix >= 3 @@ -311,7 +330,7 @@ assignNames newNames brks treeType prefixMap av = updatedPrefix (T.init prefix') <> typeSpecific | treeType /= SupportTree && T.length prefix >= 3 - && lastChar `elem` ['l', 'm', 'r'] = + && isLmr lastChar = updatedPrefix prefix' <> typeSpecific | treeType /= SupportTree = updatedPrefix prefix <> typeSpecific @@ -319,9 +338,9 @@ assignNames newNames brks treeType prefixMap av = && T.last prefix' == 's' = updatedPrefix (T.init prefix') <> one 's' <> typeSpecific | T.length prefix' < 2 = - updatedPrefix prefix <> one 's' <> typeSpecific + updatedPrefix prefix <> supportPrefixChar | otherwise = - updatedPrefix prefix' <> one 's' <> typeSpecific + updatedPrefix prefix' <> supportPrefixChar lastIdx = M.findWithDefault 0 cleanPrefix prefixMap newName = renameVertexId treeType lastIdx cleanPrefix newVertex = v {vName = newName} From 58ec9d931dfcde99ef85acd5b6e2badb72797e5e Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 08:32:22 +0100 Subject: [PATCH 13/15] Regenerated examples --- .../transformed_jbeam/frame-cfg-default.jbeam | 98 ++++++++--------- .../transformed_jbeam/frame-cfg-example.jbeam | 98 ++++++++--------- .../suspension-cfg-default.jbeam | 102 +++++++++--------- .../suspension-cfg-example.jbeam | 102 +++++++++--------- 4 files changed, 200 insertions(+), 200 deletions(-) diff --git a/examples/transformed_jbeam/frame-cfg-default.jbeam b/examples/transformed_jbeam/frame-cfg-default.jbeam index 6dd71a3e..207db62a 100644 --- a/examples/transformed_jbeam/frame-cfg-default.jbeam +++ b/examples/transformed_jbeam/frame-cfg-default.jbeam @@ -79,9 +79,9 @@ [ "rl_r7", -0.451, 2.284, 0.447], // Support nodes - [ "rlsm", 0.053, -0.024, 0.578], // support - [ "rl_sm", 0.053, 1.710, 0.565], // suport for rear - ["rl_sm1", 0.053, -1.314, 0.382] + [ "rlsl", 0.053, -0.024, 0.578], // support + [ "rl_sr", 0.053, 1.710, 0.565], // suport for rear + [ "rl_sf", 0.053, -1.314, 0.382] ], // --Beams-- @@ -270,59 +270,59 @@ // Front end {"beamDeform" : 19000.0}, - ["rl_fl2", "rl_sm1"], - ["rl_fr2", "rl_sm1"], + ["rl_fl2", "rl_sf"], + ["rl_fr2", "rl_sf"], ["rl_f", "rl_fl0"], - ["rl_fl4", "rl_sm1"], - ["rl_sm1", "rl_fr5"], - ["rl_fr1", "rl_sm1"], - ["rl_fl1", "rl_sm1"], - ["rl_fr4", "rl_sm1"], - ["rl_fm0", "rl_sm1"], - ["rl_sm1", "rl_fr0"], - ["rl_sm1", "rl_fl3"], - ["rl_sm1", "rl_fr3"], - ["rl_sm1", "rl_fm1"], - ["rl_sm1", "rl_fl5"], + ["rl_fl4", "rl_sf"], + ["rl_sf", "rl_fr5"], + ["rl_fr1", "rl_sf"], + ["rl_fl1", "rl_sf"], + ["rl_fr4", "rl_sf"], + ["rl_fm0", "rl_sf"], + ["rl_sf", "rl_fr0"], + ["rl_sf", "rl_fl3"], + ["rl_sf", "rl_fr3"], + ["rl_sf", "rl_fm1"], + ["rl_sf", "rl_fl5"], // Middle {"beamDeform" : 11000.0}, - ["rlr5", "rlsm"], - ["rlr3", "rlsm"], - ["rlm0", "rlsm"], - ["rll4", "rlsm"], - ["rll3", "rlsm"], - ["rlsm", "rll1"], - ["rlsm", "rll0"], - ["rll7", "rlsm"], - ["rlr7", "rlsm"], - ["rlr2", "rlsm"], - ["rlsm", "rlm1"], - ["rll5", "rlsm"], - ["rll2", "rlsm"], - ["rlsm", "rlr6"], - ["rlr4", "rlsm"], - ["rlsm", "rlr1"], - ["rlsm", "rlr0"], - ["rlsm", "rll6"], + ["rlr5", "rlsl"], + ["rlr3", "rlsl"], + ["rlm0", "rlsl"], + ["rll4", "rlsl"], + ["rll3", "rlsl"], + ["rlsl", "rll1"], + ["rlsl", "rll0"], + ["rll7", "rlsl"], + ["rlr7", "rlsl"], + ["rlr2", "rlsl"], + ["rlsl", "rlm1"], + ["rll5", "rlsl"], + ["rll2", "rlsl"], + ["rlsl", "rlr6"], + ["rlr4", "rlsl"], + ["rlsl", "rlr1"], + ["rlsl", "rlr0"], + ["rlsl", "rll6"], // Rear end {"beamDeform" : 19000.0}, - ["rl_sm", "rl_m2"], - ["rl_sm", "rl_r7"], - ["rl_r4", "rl_sm"], - ["rl_sm", "rl_l7"], - ["rl_sm", "rl_l3"], - ["rl_sm", "rl_r5"], - ["rl_l6", "rl_sm"], - ["rl_m1", "rl_sm"], - ["rl_sm", "rl_r3"], - ["rl_l4", "rl_sm"], - ["rl_r6", "rl_sm"], - ["rl_m3", "rl_sm"], - ["rl_l2", "rl_sm"], - ["rl_sm", "rl_m0"], - ["rl_r2", "rl_sm"], + ["rl_sr", "rl_m2"], + ["rl_sr", "rl_r7"], + ["rl_r4", "rl_sr"], + ["rl_sr", "rl_l7"], + ["rl_sr", "rl_l3"], + ["rl_sr", "rl_r5"], + ["rl_l6", "rl_sr"], + ["rl_m1", "rl_sr"], + ["rl_sr", "rl_r3"], + ["rl_l4", "rl_sr"], + ["rl_r6", "rl_sr"], + ["rl_m3", "rl_sr"], + ["rl_l2", "rl_sr"], + ["rl_sr", "rl_m0"], + ["rl_r2", "rl_sr"], ["rl_r4", "rl_l5"], // Front crush diff --git a/examples/transformed_jbeam/frame-cfg-example.jbeam b/examples/transformed_jbeam/frame-cfg-example.jbeam index 6dd71a3e..207db62a 100644 --- a/examples/transformed_jbeam/frame-cfg-example.jbeam +++ b/examples/transformed_jbeam/frame-cfg-example.jbeam @@ -79,9 +79,9 @@ [ "rl_r7", -0.451, 2.284, 0.447], // Support nodes - [ "rlsm", 0.053, -0.024, 0.578], // support - [ "rl_sm", 0.053, 1.710, 0.565], // suport for rear - ["rl_sm1", 0.053, -1.314, 0.382] + [ "rlsl", 0.053, -0.024, 0.578], // support + [ "rl_sr", 0.053, 1.710, 0.565], // suport for rear + [ "rl_sf", 0.053, -1.314, 0.382] ], // --Beams-- @@ -270,59 +270,59 @@ // Front end {"beamDeform" : 19000.0}, - ["rl_fl2", "rl_sm1"], - ["rl_fr2", "rl_sm1"], + ["rl_fl2", "rl_sf"], + ["rl_fr2", "rl_sf"], ["rl_f", "rl_fl0"], - ["rl_fl4", "rl_sm1"], - ["rl_sm1", "rl_fr5"], - ["rl_fr1", "rl_sm1"], - ["rl_fl1", "rl_sm1"], - ["rl_fr4", "rl_sm1"], - ["rl_fm0", "rl_sm1"], - ["rl_sm1", "rl_fr0"], - ["rl_sm1", "rl_fl3"], - ["rl_sm1", "rl_fr3"], - ["rl_sm1", "rl_fm1"], - ["rl_sm1", "rl_fl5"], + ["rl_fl4", "rl_sf"], + ["rl_sf", "rl_fr5"], + ["rl_fr1", "rl_sf"], + ["rl_fl1", "rl_sf"], + ["rl_fr4", "rl_sf"], + ["rl_fm0", "rl_sf"], + ["rl_sf", "rl_fr0"], + ["rl_sf", "rl_fl3"], + ["rl_sf", "rl_fr3"], + ["rl_sf", "rl_fm1"], + ["rl_sf", "rl_fl5"], // Middle {"beamDeform" : 11000.0}, - ["rlr5", "rlsm"], - ["rlr3", "rlsm"], - ["rlm0", "rlsm"], - ["rll4", "rlsm"], - ["rll3", "rlsm"], - ["rlsm", "rll1"], - ["rlsm", "rll0"], - ["rll7", "rlsm"], - ["rlr7", "rlsm"], - ["rlr2", "rlsm"], - ["rlsm", "rlm1"], - ["rll5", "rlsm"], - ["rll2", "rlsm"], - ["rlsm", "rlr6"], - ["rlr4", "rlsm"], - ["rlsm", "rlr1"], - ["rlsm", "rlr0"], - ["rlsm", "rll6"], + ["rlr5", "rlsl"], + ["rlr3", "rlsl"], + ["rlm0", "rlsl"], + ["rll4", "rlsl"], + ["rll3", "rlsl"], + ["rlsl", "rll1"], + ["rlsl", "rll0"], + ["rll7", "rlsl"], + ["rlr7", "rlsl"], + ["rlr2", "rlsl"], + ["rlsl", "rlm1"], + ["rll5", "rlsl"], + ["rll2", "rlsl"], + ["rlsl", "rlr6"], + ["rlr4", "rlsl"], + ["rlsl", "rlr1"], + ["rlsl", "rlr0"], + ["rlsl", "rll6"], // Rear end {"beamDeform" : 19000.0}, - ["rl_sm", "rl_m2"], - ["rl_sm", "rl_r7"], - ["rl_r4", "rl_sm"], - ["rl_sm", "rl_l7"], - ["rl_sm", "rl_l3"], - ["rl_sm", "rl_r5"], - ["rl_l6", "rl_sm"], - ["rl_m1", "rl_sm"], - ["rl_sm", "rl_r3"], - ["rl_l4", "rl_sm"], - ["rl_r6", "rl_sm"], - ["rl_m3", "rl_sm"], - ["rl_l2", "rl_sm"], - ["rl_sm", "rl_m0"], - ["rl_r2", "rl_sm"], + ["rl_sr", "rl_m2"], + ["rl_sr", "rl_r7"], + ["rl_r4", "rl_sr"], + ["rl_sr", "rl_l7"], + ["rl_sr", "rl_l3"], + ["rl_sr", "rl_r5"], + ["rl_l6", "rl_sr"], + ["rl_m1", "rl_sr"], + ["rl_sr", "rl_r3"], + ["rl_l4", "rl_sr"], + ["rl_r6", "rl_sr"], + ["rl_m3", "rl_sr"], + ["rl_l2", "rl_sr"], + ["rl_sr", "rl_m0"], + ["rl_r2", "rl_sr"], ["rl_r4", "rl_l5"], // Front crush diff --git a/examples/transformed_jbeam/suspension-cfg-default.jbeam b/examples/transformed_jbeam/suspension-cfg-default.jbeam index a7a30321..83f7649a 100644 --- a/examples/transformed_jbeam/suspension-cfg-default.jbeam +++ b/examples/transformed_jbeam/suspension-cfg-default.jbeam @@ -81,12 +81,12 @@ // Support nodes {"nodeWeight" : 3.5}, - [ "rlsm", 0.053, 1.710, 0.565], + [ "rlsl", 0.053, 1.710, 0.565], {"selfCollision" : true}, - [ "rlsm1", 0.053, -0.024, 0.578], + [ "rlsl1", 0.053, -0.024, 0.578], {"nodeWeight" : 3.8}, {"selfCollision" : false}, - [ "rlsm2", 0.053, -1.314, 0.382] + [ "rlsl2", 0.053, -1.314, 0.382] ], // --Beams-- @@ -275,60 +275,60 @@ // Front end {"beamDeform" : 19000.0}, - ["rll18", "rlsm2"], - ["rlr18", "rlsm2"], - ["rlsm2", "rll16"], - ["rll20", "rlsm2"], - ["rlsm2", "rlr21"], - ["rlr17", "rlsm2"], - ["rll17", "rlsm2"], - ["rlr20", "rlsm2"], - ["rlm6", "rlsm2"], - ["rlsm2", "rlr16"], - ["rlsm2", "rll19"], - ["rlsm2", "rlr19"], - ["rlsm2", "rlm7"], - ["rlsm2", "rll21"], + ["rll18", "rlsl2"], + ["rlr18", "rlsl2"], + ["rlsl2", "rll16"], + ["rll20", "rlsl2"], + ["rlsl2", "rlr21"], + ["rlr17", "rlsl2"], + ["rll17", "rlsl2"], + ["rlr20", "rlsl2"], + ["rlm6", "rlsl2"], + ["rlsl2", "rlr16"], + ["rlsl2", "rll19"], + ["rlsl2", "rlr19"], + ["rlsl2", "rlm7"], + ["rlsl2", "rll21"], // Middle {"beamDeform" : 11000.0}, - ["rlr13", "rlsm1"], - ["rlr11", "rlsm1"], - ["rlm4", "rlsm1"], - ["rll12", "rlsm1"], - ["rll11", "rlsm1"], - ["rlsm1", "rll9"], - ["rlsm1", "rll8"], - ["rll15", "rlsm1"], - ["rlr15", "rlsm1"], - ["rlr10", "rlsm1"], - ["rlsm1", "rlm5"], - ["rll13", "rlsm1"], - ["rll10", "rlsm1"], - ["rlsm1", "rlr14"], - ["rlr12", "rlsm1"], - ["rlsm1", "rlr9"], - ["rlsm1", "rlr8"], - ["rlsm1", "rll14"], + ["rlr13", "rlsl1"], + ["rlr11", "rlsl1"], + ["rlm4", "rlsl1"], + ["rll12", "rlsl1"], + ["rll11", "rlsl1"], + ["rlsl1", "rll9"], + ["rlsl1", "rll8"], + ["rll15", "rlsl1"], + ["rlr15", "rlsl1"], + ["rlr10", "rlsl1"], + ["rlsl1", "rlm5"], + ["rll13", "rlsl1"], + ["rll10", "rlsl1"], + ["rlsl1", "rlr14"], + ["rlr12", "rlsl1"], + ["rlsl1", "rlr9"], + ["rlsl1", "rlr8"], + ["rlsl1", "rll14"], // Rear end {"beamDeform" : 19000.0}, - ["rlsm", "rlm2"], - ["rlsm", "rlr7"], - ["rlr4", "rlsm"], - ["rlsm", "rll7"], - ["rlsm", "rll3"], - ["rlsm", "rlr5"], - ["rll6", "rlsm"], - ["rlm1", "rlsm"], - ["rlsm", "rlr3"], - ["rll4", "rlsm"], - ["rlr6", "rlsm"], - ["rlm3", "rlsm"], - ["rll2", "rlsm"], - ["rlsm", "rlm0"], - ["rlr2", "rlsm"], - ["rlsm", "rll5"], + ["rlsl", "rlm2"], + ["rlsl", "rlr7"], + ["rlr4", "rlsl"], + ["rlsl", "rll7"], + ["rlsl", "rll3"], + ["rlsl", "rlr5"], + ["rll6", "rlsl"], + ["rlm1", "rlsl"], + ["rlsl", "rlr3"], + ["rll4", "rlsl"], + ["rlr6", "rlsl"], + ["rlm3", "rlsl"], + ["rll2", "rlsl"], + ["rlsl", "rlm0"], + ["rlr2", "rlsl"], + ["rlsl", "rll5"], // Front crush {"beamDeform" : 8500.0}, diff --git a/examples/transformed_jbeam/suspension-cfg-example.jbeam b/examples/transformed_jbeam/suspension-cfg-example.jbeam index a7a30321..83f7649a 100644 --- a/examples/transformed_jbeam/suspension-cfg-example.jbeam +++ b/examples/transformed_jbeam/suspension-cfg-example.jbeam @@ -81,12 +81,12 @@ // Support nodes {"nodeWeight" : 3.5}, - [ "rlsm", 0.053, 1.710, 0.565], + [ "rlsl", 0.053, 1.710, 0.565], {"selfCollision" : true}, - [ "rlsm1", 0.053, -0.024, 0.578], + [ "rlsl1", 0.053, -0.024, 0.578], {"nodeWeight" : 3.8}, {"selfCollision" : false}, - [ "rlsm2", 0.053, -1.314, 0.382] + [ "rlsl2", 0.053, -1.314, 0.382] ], // --Beams-- @@ -275,60 +275,60 @@ // Front end {"beamDeform" : 19000.0}, - ["rll18", "rlsm2"], - ["rlr18", "rlsm2"], - ["rlsm2", "rll16"], - ["rll20", "rlsm2"], - ["rlsm2", "rlr21"], - ["rlr17", "rlsm2"], - ["rll17", "rlsm2"], - ["rlr20", "rlsm2"], - ["rlm6", "rlsm2"], - ["rlsm2", "rlr16"], - ["rlsm2", "rll19"], - ["rlsm2", "rlr19"], - ["rlsm2", "rlm7"], - ["rlsm2", "rll21"], + ["rll18", "rlsl2"], + ["rlr18", "rlsl2"], + ["rlsl2", "rll16"], + ["rll20", "rlsl2"], + ["rlsl2", "rlr21"], + ["rlr17", "rlsl2"], + ["rll17", "rlsl2"], + ["rlr20", "rlsl2"], + ["rlm6", "rlsl2"], + ["rlsl2", "rlr16"], + ["rlsl2", "rll19"], + ["rlsl2", "rlr19"], + ["rlsl2", "rlm7"], + ["rlsl2", "rll21"], // Middle {"beamDeform" : 11000.0}, - ["rlr13", "rlsm1"], - ["rlr11", "rlsm1"], - ["rlm4", "rlsm1"], - ["rll12", "rlsm1"], - ["rll11", "rlsm1"], - ["rlsm1", "rll9"], - ["rlsm1", "rll8"], - ["rll15", "rlsm1"], - ["rlr15", "rlsm1"], - ["rlr10", "rlsm1"], - ["rlsm1", "rlm5"], - ["rll13", "rlsm1"], - ["rll10", "rlsm1"], - ["rlsm1", "rlr14"], - ["rlr12", "rlsm1"], - ["rlsm1", "rlr9"], - ["rlsm1", "rlr8"], - ["rlsm1", "rll14"], + ["rlr13", "rlsl1"], + ["rlr11", "rlsl1"], + ["rlm4", "rlsl1"], + ["rll12", "rlsl1"], + ["rll11", "rlsl1"], + ["rlsl1", "rll9"], + ["rlsl1", "rll8"], + ["rll15", "rlsl1"], + ["rlr15", "rlsl1"], + ["rlr10", "rlsl1"], + ["rlsl1", "rlm5"], + ["rll13", "rlsl1"], + ["rll10", "rlsl1"], + ["rlsl1", "rlr14"], + ["rlr12", "rlsl1"], + ["rlsl1", "rlr9"], + ["rlsl1", "rlr8"], + ["rlsl1", "rll14"], // Rear end {"beamDeform" : 19000.0}, - ["rlsm", "rlm2"], - ["rlsm", "rlr7"], - ["rlr4", "rlsm"], - ["rlsm", "rll7"], - ["rlsm", "rll3"], - ["rlsm", "rlr5"], - ["rll6", "rlsm"], - ["rlm1", "rlsm"], - ["rlsm", "rlr3"], - ["rll4", "rlsm"], - ["rlr6", "rlsm"], - ["rlm3", "rlsm"], - ["rll2", "rlsm"], - ["rlsm", "rlm0"], - ["rlr2", "rlsm"], - ["rlsm", "rll5"], + ["rlsl", "rlm2"], + ["rlsl", "rlr7"], + ["rlr4", "rlsl"], + ["rlsl", "rll7"], + ["rlsl", "rll3"], + ["rlsl", "rlr5"], + ["rll6", "rlsl"], + ["rlm1", "rlsl"], + ["rlsl", "rlr3"], + ["rll4", "rlsl"], + ["rlr6", "rlsl"], + ["rlm3", "rlsl"], + ["rll2", "rlsl"], + ["rlsl", "rlm0"], + ["rlr2", "rlsl"], + ["rlsl", "rll5"], // Front crush {"beamDeform" : 8500.0}, From b4a57c1ac31bdb6e863d6eee4aa185d57b0c15ea Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 09:08:22 +0100 Subject: [PATCH 14/15] Fix for support vertex name generation --- src-extra/transformation/Transformation.hs | 23 ++++++++++------------ 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/src-extra/transformation/Transformation.hs b/src-extra/transformation/Transformation.hs index 7eace0ca..4148b8b8 100644 --- a/src-extra/transformation/Transformation.hs +++ b/src-extra/transformation/Transformation.hs @@ -114,9 +114,6 @@ groupAnnotatedVertices brks g = do treeType <- determineGroup' brks (aVertex g) pure (treeType, [g]) -isLmr :: Char -> Bool -isLmr lastChar = lastChar `elem` ['l', 'm', 'r'] - updateSupportVertexName :: VertexTreeType -> AnnotatedVertex @@ -127,10 +124,7 @@ updateSupportVertexName vType (AnnotatedVertex c v m) = AnnotatedVertex c (v {vN newName = case T.unsnoc name of Nothing -> name - Just (prefix, lastChar) -> - if isLmr lastChar - then prefix <> prefixForType vType - else name + Just (prefix, _) -> prefix <> prefixForType vType moveSupportVertices :: UpdateNamesMap @@ -139,9 +133,9 @@ moveSupportVertices -> M.Map VertexTreeType [AnnotatedVertex] -> (VertexForest, M.Map VertexTreeType [AnnotatedVertex]) moveSupportVertices newNames tfCfg connMap vsPerType = - let supportVertices :: [AnnotatedVertex] + let supportVertices :: [(VertexTreeType, AnnotatedVertex)] supportVertices = - [ updateSupportVertexName vType av + [ (vType, av) | (vType, vs) <- M.toList vsPerType , av <- vs , let name = vName (aVertex av) @@ -161,12 +155,14 @@ moveSupportVertices newNames tfCfg connMap vsPerType = ( SupportTree , VertexTree [sideComment SupportTree] - (one $ sortSupportVertices newNames tfCfg vs) + ( one $ + sortSupportVertices newNames tfCfg (NE.map (uncurry updateSupportVertexName) vs) + ) ) remainingVertices :: M.Map VertexTreeType [AnnotatedVertex] remainingVertices = - M.map (filter (`notElemByVertexName` supportVertices)) vsPerType + M.map (filter (`notElemByVertexName` map snd supportVertices)) vsPerType in (vertexForest, remainingVertices) notElemByVertexName @@ -322,7 +318,8 @@ assignNames newNames brks treeType prefixMap av = prefix = dropIndex (vName v) typeSpecific = maybe "" prefixForType (determineGroup brks v) (prefix', lastChar) = fromMaybe (error "unreachable") (T.unsnoc prefix) - supportPrefixChar = one 's' <> bool typeSpecific (one lastChar) (isLmr lastChar) + isLmr = lastChar `elem` ['l', 'm', 'r'] + supportPrefixChar = one 's' <> bool typeSpecific (one lastChar) isLmr cleanPrefix | treeType /= SupportTree && T.length prefix >= 3 @@ -330,7 +327,7 @@ assignNames newNames brks treeType prefixMap av = updatedPrefix (T.init prefix') <> typeSpecific | treeType /= SupportTree && T.length prefix >= 3 - && isLmr lastChar = + && isLmr = updatedPrefix prefix' <> typeSpecific | treeType /= SupportTree = updatedPrefix prefix <> typeSpecific From e55c38602516bab3fc03ff856ffeb7dc31b8d5d2 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Wed, 12 Nov 2025 09:09:04 +0100 Subject: [PATCH 15/15] Regenerated examples --- examples/ast/jbeam/frame.hs | 2 +- .../formatted_jbeam/frame-complex-jbfl.jbeam | 2 +- .../formatted_jbeam/frame-minimal-jbfl.jbeam | 2 +- examples/jbeam/frame.jbeam | 2 +- .../transformed_jbeam/frame-cfg-default.jbeam | 98 ++++++++--------- .../transformed_jbeam/frame-cfg-example.jbeam | 98 ++++++++--------- .../suspension-cfg-default.jbeam | 102 +++++++++--------- .../suspension-cfg-example.jbeam | 102 +++++++++--------- 8 files changed, 204 insertions(+), 204 deletions(-) diff --git a/examples/ast/jbeam/frame.hs b/examples/ast/jbeam/frame.hs index 05ddaed3..34281488 100644 --- a/examples/ast/jbeam/frame.hs +++ b/examples/ast/jbeam/frame.hs @@ -384,7 +384,7 @@ Object ] , Comment ( InternalComment - { cText = "suport for rear" + { cText = "support for rear" , cMultiline = False , cAssociationDirection = PreviousNode } diff --git a/examples/formatted_jbeam/frame-complex-jbfl.jbeam b/examples/formatted_jbeam/frame-complex-jbfl.jbeam index 8e10830b..425d1927 100644 --- a/examples/formatted_jbeam/frame-complex-jbfl.jbeam +++ b/examples/formatted_jbeam/frame-complex-jbfl.jbeam @@ -55,7 +55,7 @@ ["rl_r45", -0.446, 1.654, 0.359], ["rl_r46", 0.553, 1.679, 0.448], ["rl_r47", -0.446, 1.679, 0.448], - ["rl_r48", 0.053, 1.710, 0.565], // suport for rear + ["rl_r48", 0.053, 1.710, 0.565], // support for rear ["rl_r49", 0.558, 2.284, 0.364], ["rl_r50", 0.558, 2.284, 0.447], ["rl_r51", 0.053, 2.284, 0.370], diff --git a/examples/formatted_jbeam/frame-minimal-jbfl.jbeam b/examples/formatted_jbeam/frame-minimal-jbfl.jbeam index 95a6a9ab..e4adc1b6 100644 --- a/examples/formatted_jbeam/frame-minimal-jbfl.jbeam +++ b/examples/formatted_jbeam/frame-minimal-jbfl.jbeam @@ -55,7 +55,7 @@ ["rl_r45", -0.446, 1.654, 0.359], ["rl_r46", 0.553, 1.679, 0.448], ["rl_r47", -0.446, 1.679, 0.448], - ["rl_r48", 0.053, 1.710, 0.565], // suport for rear + ["rl_r48", 0.053, 1.710, 0.565], // support for rear ["rl_r49", 0.558, 2.284, 0.364], ["rl_r50", 0.558, 2.284, 0.447], ["rl_r51", 0.053, 2.284, 0.370], diff --git a/examples/jbeam/frame.jbeam b/examples/jbeam/frame.jbeam index c9993d90..62e0cf1c 100644 --- a/examples/jbeam/frame.jbeam +++ b/examples/jbeam/frame.jbeam @@ -57,7 +57,7 @@ ["rl_r45",-0.446,1.654,0.359], ["rl_r46",0.553,1.679,0.448], ["rl_r47",-0.446,1.679,0.448], - ["rl_r48",0.053,1.71,0.565], // suport for rear + ["rl_r48",0.053,1.71,0.565], // support for rear ["rl_r49",0.558,2.284,0.364], ["rl_r50",0.558,2.284,0.447], ["rl_r51",0.053,2.284,0.37], diff --git a/examples/transformed_jbeam/frame-cfg-default.jbeam b/examples/transformed_jbeam/frame-cfg-default.jbeam index 207db62a..fc76956f 100644 --- a/examples/transformed_jbeam/frame-cfg-default.jbeam +++ b/examples/transformed_jbeam/frame-cfg-default.jbeam @@ -79,9 +79,9 @@ [ "rl_r7", -0.451, 2.284, 0.447], // Support nodes - [ "rlsl", 0.053, -0.024, 0.578], // support - [ "rl_sr", 0.053, 1.710, 0.565], // suport for rear - [ "rl_sf", 0.053, -1.314, 0.382] + [ "rl1sm", 0.053, -0.024, 0.578], // support + ["rl_r4sm", 0.053, 1.710, 0.565], // support for rear + ["rl_f1sm", 0.053, -1.314, 0.382] ], // --Beams-- @@ -270,59 +270,59 @@ // Front end {"beamDeform" : 19000.0}, - ["rl_fl2", "rl_sf"], - ["rl_fr2", "rl_sf"], + ["rl_fl2", "rl_f1sm"], + ["rl_fr2", "rl_f1sm"], ["rl_f", "rl_fl0"], - ["rl_fl4", "rl_sf"], - ["rl_sf", "rl_fr5"], - ["rl_fr1", "rl_sf"], - ["rl_fl1", "rl_sf"], - ["rl_fr4", "rl_sf"], - ["rl_fm0", "rl_sf"], - ["rl_sf", "rl_fr0"], - ["rl_sf", "rl_fl3"], - ["rl_sf", "rl_fr3"], - ["rl_sf", "rl_fm1"], - ["rl_sf", "rl_fl5"], + ["rl_fl4", "rl_f1sm"], + ["rl_f1sm", "rl_fr5"], + ["rl_fr1", "rl_f1sm"], + ["rl_fl1", "rl_f1sm"], + ["rl_fr4", "rl_f1sm"], + ["rl_fm0", "rl_f1sm"], + ["rl_f1sm", "rl_fr0"], + ["rl_f1sm", "rl_fl3"], + ["rl_f1sm", "rl_fr3"], + ["rl_f1sm", "rl_fm1"], + ["rl_f1sm", "rl_fl5"], // Middle {"beamDeform" : 11000.0}, - ["rlr5", "rlsl"], - ["rlr3", "rlsl"], - ["rlm0", "rlsl"], - ["rll4", "rlsl"], - ["rll3", "rlsl"], - ["rlsl", "rll1"], - ["rlsl", "rll0"], - ["rll7", "rlsl"], - ["rlr7", "rlsl"], - ["rlr2", "rlsl"], - ["rlsl", "rlm1"], - ["rll5", "rlsl"], - ["rll2", "rlsl"], - ["rlsl", "rlr6"], - ["rlr4", "rlsl"], - ["rlsl", "rlr1"], - ["rlsl", "rlr0"], - ["rlsl", "rll6"], + ["rlr5", "rl1sm"], + ["rlr3", "rl1sm"], + ["rlm0", "rl1sm"], + ["rll4", "rl1sm"], + ["rll3", "rl1sm"], + ["rl1sm", "rll1"], + ["rl1sm", "rll0"], + ["rll7", "rl1sm"], + ["rlr7", "rl1sm"], + ["rlr2", "rl1sm"], + ["rl1sm", "rlm1"], + ["rll5", "rl1sm"], + ["rll2", "rl1sm"], + ["rl1sm", "rlr6"], + ["rlr4", "rl1sm"], + ["rl1sm", "rlr1"], + ["rl1sm", "rlr0"], + ["rl1sm", "rll6"], // Rear end {"beamDeform" : 19000.0}, - ["rl_sr", "rl_m2"], - ["rl_sr", "rl_r7"], - ["rl_r4", "rl_sr"], - ["rl_sr", "rl_l7"], - ["rl_sr", "rl_l3"], - ["rl_sr", "rl_r5"], - ["rl_l6", "rl_sr"], - ["rl_m1", "rl_sr"], - ["rl_sr", "rl_r3"], - ["rl_l4", "rl_sr"], - ["rl_r6", "rl_sr"], - ["rl_m3", "rl_sr"], - ["rl_l2", "rl_sr"], - ["rl_sr", "rl_m0"], - ["rl_r2", "rl_sr"], + ["rl_r4sm", "rl_m2"], + ["rl_r4sm", "rl_r7"], + ["rl_r4", "rl_r4sm"], + ["rl_r4sm", "rl_l7"], + ["rl_r4sm", "rl_l3"], + ["rl_r4sm", "rl_r5"], + ["rl_l6", "rl_r4sm"], + ["rl_m1", "rl_r4sm"], + ["rl_r4sm", "rl_r3"], + ["rl_l4", "rl_r4sm"], + ["rl_r6", "rl_r4sm"], + ["rl_m3", "rl_r4sm"], + ["rl_l2", "rl_r4sm"], + ["rl_r4sm", "rl_m0"], + ["rl_r2", "rl_r4sm"], ["rl_r4", "rl_l5"], // Front crush diff --git a/examples/transformed_jbeam/frame-cfg-example.jbeam b/examples/transformed_jbeam/frame-cfg-example.jbeam index 207db62a..fc76956f 100644 --- a/examples/transformed_jbeam/frame-cfg-example.jbeam +++ b/examples/transformed_jbeam/frame-cfg-example.jbeam @@ -79,9 +79,9 @@ [ "rl_r7", -0.451, 2.284, 0.447], // Support nodes - [ "rlsl", 0.053, -0.024, 0.578], // support - [ "rl_sr", 0.053, 1.710, 0.565], // suport for rear - [ "rl_sf", 0.053, -1.314, 0.382] + [ "rl1sm", 0.053, -0.024, 0.578], // support + ["rl_r4sm", 0.053, 1.710, 0.565], // support for rear + ["rl_f1sm", 0.053, -1.314, 0.382] ], // --Beams-- @@ -270,59 +270,59 @@ // Front end {"beamDeform" : 19000.0}, - ["rl_fl2", "rl_sf"], - ["rl_fr2", "rl_sf"], + ["rl_fl2", "rl_f1sm"], + ["rl_fr2", "rl_f1sm"], ["rl_f", "rl_fl0"], - ["rl_fl4", "rl_sf"], - ["rl_sf", "rl_fr5"], - ["rl_fr1", "rl_sf"], - ["rl_fl1", "rl_sf"], - ["rl_fr4", "rl_sf"], - ["rl_fm0", "rl_sf"], - ["rl_sf", "rl_fr0"], - ["rl_sf", "rl_fl3"], - ["rl_sf", "rl_fr3"], - ["rl_sf", "rl_fm1"], - ["rl_sf", "rl_fl5"], + ["rl_fl4", "rl_f1sm"], + ["rl_f1sm", "rl_fr5"], + ["rl_fr1", "rl_f1sm"], + ["rl_fl1", "rl_f1sm"], + ["rl_fr4", "rl_f1sm"], + ["rl_fm0", "rl_f1sm"], + ["rl_f1sm", "rl_fr0"], + ["rl_f1sm", "rl_fl3"], + ["rl_f1sm", "rl_fr3"], + ["rl_f1sm", "rl_fm1"], + ["rl_f1sm", "rl_fl5"], // Middle {"beamDeform" : 11000.0}, - ["rlr5", "rlsl"], - ["rlr3", "rlsl"], - ["rlm0", "rlsl"], - ["rll4", "rlsl"], - ["rll3", "rlsl"], - ["rlsl", "rll1"], - ["rlsl", "rll0"], - ["rll7", "rlsl"], - ["rlr7", "rlsl"], - ["rlr2", "rlsl"], - ["rlsl", "rlm1"], - ["rll5", "rlsl"], - ["rll2", "rlsl"], - ["rlsl", "rlr6"], - ["rlr4", "rlsl"], - ["rlsl", "rlr1"], - ["rlsl", "rlr0"], - ["rlsl", "rll6"], + ["rlr5", "rl1sm"], + ["rlr3", "rl1sm"], + ["rlm0", "rl1sm"], + ["rll4", "rl1sm"], + ["rll3", "rl1sm"], + ["rl1sm", "rll1"], + ["rl1sm", "rll0"], + ["rll7", "rl1sm"], + ["rlr7", "rl1sm"], + ["rlr2", "rl1sm"], + ["rl1sm", "rlm1"], + ["rll5", "rl1sm"], + ["rll2", "rl1sm"], + ["rl1sm", "rlr6"], + ["rlr4", "rl1sm"], + ["rl1sm", "rlr1"], + ["rl1sm", "rlr0"], + ["rl1sm", "rll6"], // Rear end {"beamDeform" : 19000.0}, - ["rl_sr", "rl_m2"], - ["rl_sr", "rl_r7"], - ["rl_r4", "rl_sr"], - ["rl_sr", "rl_l7"], - ["rl_sr", "rl_l3"], - ["rl_sr", "rl_r5"], - ["rl_l6", "rl_sr"], - ["rl_m1", "rl_sr"], - ["rl_sr", "rl_r3"], - ["rl_l4", "rl_sr"], - ["rl_r6", "rl_sr"], - ["rl_m3", "rl_sr"], - ["rl_l2", "rl_sr"], - ["rl_sr", "rl_m0"], - ["rl_r2", "rl_sr"], + ["rl_r4sm", "rl_m2"], + ["rl_r4sm", "rl_r7"], + ["rl_r4", "rl_r4sm"], + ["rl_r4sm", "rl_l7"], + ["rl_r4sm", "rl_l3"], + ["rl_r4sm", "rl_r5"], + ["rl_l6", "rl_r4sm"], + ["rl_m1", "rl_r4sm"], + ["rl_r4sm", "rl_r3"], + ["rl_l4", "rl_r4sm"], + ["rl_r6", "rl_r4sm"], + ["rl_m3", "rl_r4sm"], + ["rl_l2", "rl_r4sm"], + ["rl_r4sm", "rl_m0"], + ["rl_r2", "rl_r4sm"], ["rl_r4", "rl_l5"], // Front crush diff --git a/examples/transformed_jbeam/suspension-cfg-default.jbeam b/examples/transformed_jbeam/suspension-cfg-default.jbeam index 83f7649a..7b3c1126 100644 --- a/examples/transformed_jbeam/suspension-cfg-default.jbeam +++ b/examples/transformed_jbeam/suspension-cfg-default.jbeam @@ -81,12 +81,12 @@ // Support nodes {"nodeWeight" : 3.5}, - [ "rlsl", 0.053, 1.710, 0.565], + [ "rl4sm", 0.053, 1.710, 0.565], {"selfCollision" : true}, - [ "rlsl1", 0.053, -0.024, 0.578], + [ "rl1sm", 0.053, -0.024, 0.578], {"nodeWeight" : 3.8}, {"selfCollision" : false}, - [ "rlsl2", 0.053, -1.314, 0.382] + ["rl1sm1", 0.053, -1.314, 0.382] ], // --Beams-- @@ -275,60 +275,60 @@ // Front end {"beamDeform" : 19000.0}, - ["rll18", "rlsl2"], - ["rlr18", "rlsl2"], - ["rlsl2", "rll16"], - ["rll20", "rlsl2"], - ["rlsl2", "rlr21"], - ["rlr17", "rlsl2"], - ["rll17", "rlsl2"], - ["rlr20", "rlsl2"], - ["rlm6", "rlsl2"], - ["rlsl2", "rlr16"], - ["rlsl2", "rll19"], - ["rlsl2", "rlr19"], - ["rlsl2", "rlm7"], - ["rlsl2", "rll21"], + ["rll18", "rl1sm1"], + ["rlr18", "rl1sm1"], + ["rl1sm1", "rll16"], + ["rll20", "rl1sm1"], + ["rl1sm1", "rlr21"], + ["rlr17", "rl1sm1"], + ["rll17", "rl1sm1"], + ["rlr20", "rl1sm1"], + ["rlm6", "rl1sm1"], + ["rl1sm1", "rlr16"], + ["rl1sm1", "rll19"], + ["rl1sm1", "rlr19"], + ["rl1sm1", "rlm7"], + ["rl1sm1", "rll21"], // Middle {"beamDeform" : 11000.0}, - ["rlr13", "rlsl1"], - ["rlr11", "rlsl1"], - ["rlm4", "rlsl1"], - ["rll12", "rlsl1"], - ["rll11", "rlsl1"], - ["rlsl1", "rll9"], - ["rlsl1", "rll8"], - ["rll15", "rlsl1"], - ["rlr15", "rlsl1"], - ["rlr10", "rlsl1"], - ["rlsl1", "rlm5"], - ["rll13", "rlsl1"], - ["rll10", "rlsl1"], - ["rlsl1", "rlr14"], - ["rlr12", "rlsl1"], - ["rlsl1", "rlr9"], - ["rlsl1", "rlr8"], - ["rlsl1", "rll14"], + ["rlr13", "rl1sm"], + ["rlr11", "rl1sm"], + ["rlm4", "rl1sm"], + ["rll12", "rl1sm"], + ["rll11", "rl1sm"], + ["rl1sm", "rll9"], + ["rl1sm", "rll8"], + ["rll15", "rl1sm"], + ["rlr15", "rl1sm"], + ["rlr10", "rl1sm"], + ["rl1sm", "rlm5"], + ["rll13", "rl1sm"], + ["rll10", "rl1sm"], + ["rl1sm", "rlr14"], + ["rlr12", "rl1sm"], + ["rl1sm", "rlr9"], + ["rl1sm", "rlr8"], + ["rl1sm", "rll14"], // Rear end {"beamDeform" : 19000.0}, - ["rlsl", "rlm2"], - ["rlsl", "rlr7"], - ["rlr4", "rlsl"], - ["rlsl", "rll7"], - ["rlsl", "rll3"], - ["rlsl", "rlr5"], - ["rll6", "rlsl"], - ["rlm1", "rlsl"], - ["rlsl", "rlr3"], - ["rll4", "rlsl"], - ["rlr6", "rlsl"], - ["rlm3", "rlsl"], - ["rll2", "rlsl"], - ["rlsl", "rlm0"], - ["rlr2", "rlsl"], - ["rlsl", "rll5"], + ["rl4sm", "rlm2"], + ["rl4sm", "rlr7"], + ["rlr4", "rl4sm"], + ["rl4sm", "rll7"], + ["rl4sm", "rll3"], + ["rl4sm", "rlr5"], + ["rll6", "rl4sm"], + ["rlm1", "rl4sm"], + ["rl4sm", "rlr3"], + ["rll4", "rl4sm"], + ["rlr6", "rl4sm"], + ["rlm3", "rl4sm"], + ["rll2", "rl4sm"], + ["rl4sm", "rlm0"], + ["rlr2", "rl4sm"], + ["rl4sm", "rll5"], // Front crush {"beamDeform" : 8500.0}, diff --git a/examples/transformed_jbeam/suspension-cfg-example.jbeam b/examples/transformed_jbeam/suspension-cfg-example.jbeam index 83f7649a..7b3c1126 100644 --- a/examples/transformed_jbeam/suspension-cfg-example.jbeam +++ b/examples/transformed_jbeam/suspension-cfg-example.jbeam @@ -81,12 +81,12 @@ // Support nodes {"nodeWeight" : 3.5}, - [ "rlsl", 0.053, 1.710, 0.565], + [ "rl4sm", 0.053, 1.710, 0.565], {"selfCollision" : true}, - [ "rlsl1", 0.053, -0.024, 0.578], + [ "rl1sm", 0.053, -0.024, 0.578], {"nodeWeight" : 3.8}, {"selfCollision" : false}, - [ "rlsl2", 0.053, -1.314, 0.382] + ["rl1sm1", 0.053, -1.314, 0.382] ], // --Beams-- @@ -275,60 +275,60 @@ // Front end {"beamDeform" : 19000.0}, - ["rll18", "rlsl2"], - ["rlr18", "rlsl2"], - ["rlsl2", "rll16"], - ["rll20", "rlsl2"], - ["rlsl2", "rlr21"], - ["rlr17", "rlsl2"], - ["rll17", "rlsl2"], - ["rlr20", "rlsl2"], - ["rlm6", "rlsl2"], - ["rlsl2", "rlr16"], - ["rlsl2", "rll19"], - ["rlsl2", "rlr19"], - ["rlsl2", "rlm7"], - ["rlsl2", "rll21"], + ["rll18", "rl1sm1"], + ["rlr18", "rl1sm1"], + ["rl1sm1", "rll16"], + ["rll20", "rl1sm1"], + ["rl1sm1", "rlr21"], + ["rlr17", "rl1sm1"], + ["rll17", "rl1sm1"], + ["rlr20", "rl1sm1"], + ["rlm6", "rl1sm1"], + ["rl1sm1", "rlr16"], + ["rl1sm1", "rll19"], + ["rl1sm1", "rlr19"], + ["rl1sm1", "rlm7"], + ["rl1sm1", "rll21"], // Middle {"beamDeform" : 11000.0}, - ["rlr13", "rlsl1"], - ["rlr11", "rlsl1"], - ["rlm4", "rlsl1"], - ["rll12", "rlsl1"], - ["rll11", "rlsl1"], - ["rlsl1", "rll9"], - ["rlsl1", "rll8"], - ["rll15", "rlsl1"], - ["rlr15", "rlsl1"], - ["rlr10", "rlsl1"], - ["rlsl1", "rlm5"], - ["rll13", "rlsl1"], - ["rll10", "rlsl1"], - ["rlsl1", "rlr14"], - ["rlr12", "rlsl1"], - ["rlsl1", "rlr9"], - ["rlsl1", "rlr8"], - ["rlsl1", "rll14"], + ["rlr13", "rl1sm"], + ["rlr11", "rl1sm"], + ["rlm4", "rl1sm"], + ["rll12", "rl1sm"], + ["rll11", "rl1sm"], + ["rl1sm", "rll9"], + ["rl1sm", "rll8"], + ["rll15", "rl1sm"], + ["rlr15", "rl1sm"], + ["rlr10", "rl1sm"], + ["rl1sm", "rlm5"], + ["rll13", "rl1sm"], + ["rll10", "rl1sm"], + ["rl1sm", "rlr14"], + ["rlr12", "rl1sm"], + ["rl1sm", "rlr9"], + ["rl1sm", "rlr8"], + ["rl1sm", "rll14"], // Rear end {"beamDeform" : 19000.0}, - ["rlsl", "rlm2"], - ["rlsl", "rlr7"], - ["rlr4", "rlsl"], - ["rlsl", "rll7"], - ["rlsl", "rll3"], - ["rlsl", "rlr5"], - ["rll6", "rlsl"], - ["rlm1", "rlsl"], - ["rlsl", "rlr3"], - ["rll4", "rlsl"], - ["rlr6", "rlsl"], - ["rlm3", "rlsl"], - ["rll2", "rlsl"], - ["rlsl", "rlm0"], - ["rlr2", "rlsl"], - ["rlsl", "rll5"], + ["rl4sm", "rlm2"], + ["rl4sm", "rlr7"], + ["rlr4", "rl4sm"], + ["rl4sm", "rll7"], + ["rl4sm", "rll3"], + ["rl4sm", "rlr5"], + ["rll6", "rl4sm"], + ["rlm1", "rl4sm"], + ["rl4sm", "rlr3"], + ["rll4", "rl4sm"], + ["rlr6", "rl4sm"], + ["rlm3", "rl4sm"], + ["rll2", "rl4sm"], + ["rl4sm", "rlm0"], + ["rlr2", "rl4sm"], + ["rl4sm", "rll5"], // Front crush {"beamDeform" : 8500.0},