Exclude triangle-referenced vertices from support-vertex eligibility

.hlint.yaml

@@ -26,6 +26,7 @@
   - name: [Prelude.head]
     within: [JbeamEdit.Transformation.OMap1]
 - warn: {name: Use explicit module export list}
+- warn: {name: Use DerivingStrategies}
 - group: {name: dollar, enabled: true}
 - group: {name: extra, enabled: true}
 - group: {name: teaching, enabled: true}

examples/jbeam-edit.yaml

@@ -1,5 +1,5 @@
 y-sorting-threshold: 0.05
-support-threshold: 96
+support-threshold: 20
 max-support-coordinates: 3
 
 x-group-breakpoints:

examples/regression_jbeam/triangles-with-metadata-repro.jbeam

@@ -0,0 +1,23 @@
+{
+"testpart":{
+    "nodes":[
+        ["id", "posX", "posY", "posZ"],
+        // Synthetic regression-test fixture, not vetted by the jbeam
+        // maintainer and not intended as a demo/example.
+        ["n0", 1.0, -1.0, 0.0],
+        ["n1", 1.0, 0.0, 0.0],
+        ["n2", 1.0, 1.0, 0.0],
+    ],
+    "beams":[
+        ["id1:", "id2:"],
+        ["n0", "n1"],
+        ["n1", "n2"],
+    ],
+    "triangles":[
+        ["id1:", "id2:", "id3:"],
+        {"groundModel": "metal"},
+        {"dragCoef": 30},
+        ["n0", "n1", "n2"],
+    ],
+},
+}

src-extra/transformation/JbeamEdit/Transformation.hs

@@ -5,12 +5,12 @@
 import Data.Bool (bool)
 import Data.Foldable.Extra (notNull)
 import Data.Function (on)
 import Data.List (foldl', partition)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
 import Data.Map (Map)
 import Data.Map qualified as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Monoid.Extra (mwhen)
 import Data.Ord (Down (Down), comparing)
 import Data.Scientific (Scientific)
@@ -165,18 +165,20 @@
 groupAnnotatedVertices brks g = (,[g]) <$> determineGroup' brks (aVertex g)
 
 moveSupportVertices
-  :: UpdateNamesMap
+  :: Set Text
+  -> UpdateNamesMap
   -> TransformationConfig
   -> VertexConnMap
-  -> M.Map VertexTreeType [AnnotatedVertex]
-  -> (VertexForest, M.Map VertexTreeType [AnnotatedVertex])
-moveSupportVertices newNames tfCfg connMap vsPerType =
+  -> Map VertexTreeType [AnnotatedVertex]
+  -> (VertexForest, Map VertexTreeType [AnnotatedVertex])
+moveSupportVertices protectedNames newNames tfCfg connMap vsPerType =
   let supportVertices :: [AnnotatedVertex]
       supportVertices =
         [ av
         | vs <- M.elems vsPerType
         , av <- vs
         , let name = vName (aVertex av)
+        , name `S.notMember` protectedNames
         , let vertexCount = length vs
               thrCount =
                 max 1 (round $ supportThreshold tfCfg / 100 * fromIntegral vertexCount)
@@ -199,13 +201,14 @@
                   ( SupportKey
                   , VertexTree
                       [sideComment SupportTree]
-                      ( let sorted = NE.sortBy (on compare $ vY . aVertex) vs
+                      ( let prefix = vertexPrefix newNames brks SupportTree
+                            sorted = NE.sortBy (on compare $ vY . aVertex) vs
                             (_, bandIndices) = mapAccumL (indexBand tfCfg) (0, firstY sorted) sorted
-                            bandSortedVertices =
-                              NE.map snd $
-                                NE.sortBy
-                                  (compareAV (vertexPrefix newNames brks SupportTree) SupportTree)
-                                  bandIndices
+                            bandSortedPairs =
+                              NE.sortBy
+                                (compareAV prefix SupportTree)
+                                bandIndices
+                            bandSortedVertices = NE.map snd bandSortedPairs
                             (_, renamedVertices') = mapAccumL assignSupportNames M.empty bandSortedVertices
                          in renamedVertices'
                       )
@@ -224,12 +227,13 @@
 notElemByVertexName vertex = S.notMember (anVertexName vertex)
 
 moveVerticesInVertexForest
-  :: Node
+  :: Set Text
+  -> Node
   -> UpdateNamesMap
   -> TransformationConfig
   -> VertexForest
   -> Either Text ([Node], VertexForest)
-moveVerticesInVertexForest topNode newNames tfCfg vertexTrees =
+moveVerticesInVertexForest triangleVertexNames topNode newNames tfCfg vertexTrees =
   let allVertices =
         concatMap
           (concatMap (NE.toList . tAnnotatedVertices . snd) . toList)
@@ -242,7 +246,7 @@
                 (badBeamNodes, conns) <-
                   vertexConns (maxSupportCoordinates tfCfg) topNode groupedVertices
                 let (supportForest, nonSupportVertices) =
-                      moveSupportVertices newNames tfCfg conns groupedVertices
+                      moveSupportVertices triangleVertexNames newNames tfCfg conns groupedVertices
                 newForest <-
                   foldM
                     (addVertexTreeToForest newNames tfCfg nonSupportVertices vertexTrees)
@@ -556,6 +560,41 @@
         Left err -> putErrorLine err
     Left err -> putErrorLine err
 
+trianglesQuery :: NP.NodePath
+trianglesQuery = fromList [NP.ObjectIndex 0, NP.ObjectKey "triangles"]
+
+{- | Vertex names referenced by the triangle rows in a "triangles" array.
+Comment and metadata (object) rows are skipped rather than treated as
+errors, because per-triangle metadata objects (e.g. `{"groundModel": "metal"}`)
+are normal in real jbeam files, the same tolerance BeamExtraction.possiblyBeam
+has for "beams". Any other row that isn't a [String, String, String]
+triple (the header row included, harmlessly) is likewise skipped rather
+than failing the whole section.
+-}
+extractTriangleVertexNames :: Vector Node -> Set Text
+extractTriangleVertexNames =
+  S.fromList
+    . concatMap (\(a, b, c) -> [a, b, c])
+    . mapMaybe extractTriple
+    . V.toList
+    . V.filter (\n -> not (isCommentNode n) && not (isObjectNode n))
+  where
+    extractTriple n = do
+      inner <- expectArray n
+      case V.toList inner of
+        [a, b, c] -> (,,) <$> maybeString a <*> maybeString b <*> maybeString c
+        _ -> Nothing
+
+{- | Names of all vertices referenced by any triangle in the "triangles"
+section. Returns an empty set (not an error) if the section is absent;
+fails only if the section exists but its value isn't an array at all.
+-}
+getTriangleVertexNames :: Node -> Either Text (Set Text)
+getTriangleVertexNames topNode =
+  case NP.queryNodes trianglesQuery topNode of
+    Left _ -> Right S.empty
+    Right node -> extractTriangleVertexNames <$> NP.expectArray trianglesQuery node
+
 transform
   :: UpdateNamesMap
   -> TransformationConfig
@@ -565,10 +604,16 @@
   getVertexForest (xGroupBreakpoints tfCfg) verticesQuery topNode
     >>= getNamesAndUpdateTree
   where
-    getNamesAndUpdateTree (badNodes, globals, vertexForest) =
+    getNamesAndUpdateTree (badNodes, globals, vertexForest) = do
+      triangleVertexNames <- getTriangleVertexNames topNode
       let vertexNames = getVertexNamesInForest vertexForest
-       in moveVerticesInVertexForest topNode newNames tfCfg vertexForest
-            >>= getUpdatedNamesAndUpdateGlobally badNodes globals vertexNames
+      moveVerticesInVertexForest
+        triangleVertexNames
+        topNode
+        newNames
+        tfCfg
+        vertexForest
+        >>= getUpdatedNamesAndUpdateGlobally badNodes globals vertexNames
     getUpdatedNamesAndUpdateGlobally badVertexNodes globals oldVertexNames (badBeamNodes, updatedVertexForest) =
       let updatedVertexNames = getVertexNamesInForest updatedVertexForest
           updateMap = M.fromList $ on zip M.elems oldVertexNames updatedVertexNames

src-extra/transformation/JbeamEdit/Transformation/BeamExtraction.hs

@@ -43,8 +43,6 @@ extractBeamFromArray sectionMeta vec
               effectiveMeta = M.union inlineMeta sectionMeta
            in Just (Beam (mkBeamPair n1 n2) effectiveMeta)
   where
-    maybeString (String t) = Just t
-    maybeString _ = Nothing
     maybeObject n@(Object _) = Just n
     maybeObject _ = Nothing
 

src/JbeamEdit/Core/Node.hs

@@ -6,6 +6,7 @@ module JbeamEdit.Core.Node (
   isNumberNode,
   isStringNode,
   maybeObjectKey,
+  maybeString,
   isSinglelineComment,
   commentIsAttachedToPreviousNode,
   isComplexNode,
@@ -42,12 +43,12 @@ import Data.Vector qualified as V
 newtype ArrayValue = ArrayValue
   { avElements :: Vector (Node, Bool)
   }
-  deriving (Eq, Ord, Read, Show)
+  deriving stock (Eq, Ord, Read, Show)
 
 newtype ObjectValue = ObjectValue
   { ovElements :: Vector (Node, Bool)
   }
-  deriving (Eq, Ord, Read, Show)
+  deriving stock (Eq, Ord, Read, Show)
 
 type ObjectKey = (Node, Node)
 
@@ -179,6 +180,10 @@ expectObject :: Node -> Maybe (Vector Node)
 expectObject (Object ov) = Just (ovNodes ov)
 expectObject _ = Nothing
 
+maybeString :: Node -> Maybe Text
+maybeString (String t) = Just t
+maybeString _ = Nothing
+
 possiblyChildren :: Node -> Maybe (Vector Node)
 possiblyChildren n = expectArray n <|> expectObject n
 

test-extra/transformation/Spec.hs

@@ -128,6 +128,24 @@ beamValidationSpec = do
     it "has no duplicate beams" $
       findDuplicateBeams internalBeams `shouldBe` []
 
+{- | Real jbeam files commonly interleave per-triangle metadata objects
+(e.g. `{"groundModel": "metal"}`) among triangle rows. That is normal,
+not malformed input. `getTriangleVertexNames` used to fail the whole
+`transform` call on the first such row instead of skipping it.
+-}
+trianglesWithMetadataFixture :: FilePath
+trianglesWithMetadataFixture = "examples/regression_jbeam/triangles-with-metadata-repro.jbeam"
+
+triangleMetadataSpec :: Spec
+triangleMetadataSpec =
+  describe "triangles with inline metadata rows"
+    . it "does not fail transform"
+    $ do
+      topNode <- parseJbeamFile trianglesWithMetadataFixture
+      case transform M.empty newTransformationConfig topNode of
+        Left err -> expectationFailure ("transform failed: " ++ T.unpack err)
+        Right _ -> pure ()
+
 nodesQuery :: NP.NodePath
 nodesQuery = fromList [NP.ObjectIndex 0, NP.ObjectKey "nodes"]
 
@@ -280,6 +298,7 @@ main = hspec $ do
   mapM_ (testFixedPoint "cfg-default" newTransformationConfig) inputFiles
   mapM_ (testFixedPoint "cfg-example" tfConfig) inputFiles
   beamValidationSpec
+  triangleMetadataSpec
   supportRenameIdempotencySpec
   letterEndingNodesSpec
   ySortingBandingSpec