hgg-analyze-bridge (empty) → 0.1.0.0
raw patch · 9 files changed
+1247/−0 lines, 9 filesdep +basedep +containersdep +dataframe-core
Dependencies added: base, containers, dataframe-core, directory, hanalyze, hgg-analyze-bridge, hgg-core, hgg-frame, hgg-svg, hmatrix, hspec, text, vector
Files
- CHANGELOG.md +7/−0
- LICENSE +30/−0
- examples/StatInDemo.hs +100/−0
- examples/ThreeRoutesDemo.hs +102/−0
- hgg-analyze-bridge.cabal +88/−0
- src/Graphics/Hgg/Bridge/Analyze.hs +175/−0
- src/Graphics/Hgg/Bridge/Analyze/Internal.hs +105/−0
- src/Graphics/Hgg/Bridge/Stat.hs +296/−0
- test/Spec.hs +344/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Changelog for `hgg-analyze-bridge`++## 0.1.0.0 — 2026-07-18++First public release on Hackage.++- Bridge from hanalyze: draw fitted models (`toPlot` / `statLm`) and HBM `ModelGraph` DAGs directly.
+ LICENSE view
@@ -0,0 +1,30 @@+BSD 3-Clause License++Copyright (c) 2026, Toshiaki Honda+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ examples/StatInDemo.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}++-- | 系統 B (ggplot 風スタット・イン) デモ (Phase 16)。+--+-- df を 1 回参照し、 stat layer (statLm / statSmooth) を通常 geom と同じく @<>@ で重ねる。+-- 描画は 'saveSVGBoundStats' = bpResolver で resolveStats してから SVG 保存 (回帰計算は+-- hanalyze に委譲、 = ggplot @geom_smooth(method="lm")@ 相当)。 装飾も通常 geom と同じ。+-- 出力 = design/stat-in/*.svg (gitignore 想定)。 rsvg で PNG 化して目視。+module Main where++import qualified Data.Map.Strict as M+import Data.Text (Text)+import qualified Data.Vector as V++import Graphics.Hgg.Bridge.Stat (saveSVGBoundStats)+import Graphics.Hgg.Frame ((|>>))+import Graphics.Hgg.Spec (ColData (..), color, colorBy, fromHex,+ layer, scatter, statLm, statLmLevel,+ statPoly, statResid, statSmooth,+ statSmoothCI, stroke, title)+import System.Directory (createDirectoryIfMissing)++-- 線形データ: y = 2x + 3 + 軽いノイズ。+linX, linY :: V.Vector Double+linX = V.fromList [1 .. 30]+linY = V.fromList [ 2 * x + 3 + noise i | (i, x) <- zip [0 ..] [1 .. 30] ]+ where noise i = 2.5 * sin (fromIntegral (i :: Int) * 1.3)++-- 非線形データ: y = sin(x) 波形 + ノイズ (smooth 用)。+smX, smY :: V.Vector Double+smX = V.fromList [ fromIntegral i * 0.3 | i <- [0 .. 40 :: Int] ]+smY = V.fromList [ sin (fromIntegral i * 0.3) + 0.15 * c i | i <- [0 .. 40 :: Int] ]+ where c i = sin (fromIntegral i * 2.7)++-- 二次データ: y = 0.5x² - 4x + 10 + ノイズ (poly 用)。+quX, quY :: V.Vector Double+quX = V.fromList [ fromIntegral i * 0.5 | i <- [0 .. 30 :: Int] ]+quY = V.fromList [ 0.5 * x * x - 4 * x + 10 + 3 * sin (fromIntegral i * 1.7)+ | (i, x) <- zip [0 :: Int ..] [ fromIntegral j * 0.5 | j <- [0 .. 30 :: Int] ] ]++-- 2 群データ (B2 group 別 fit 用): g="A" 傾き 1.5 / g="B" 傾き 3.5、 各 20 点。+grpX, grpY :: V.Vector Double+grpG :: V.Vector Text+grpX = V.fromList (xa ++ xa) where xa = [1 .. 20]+grpY = V.fromList (map (\x -> 1.5 * x + 2 + nz x) xa+ ++ map (\x -> 3.5 * x + 2 + nz x) xa)+ where xa = [1 .. 20]; nz x = 2.0 * sin (x * 1.9)+grpG = V.fromList (replicate 20 "A" ++ replicate 20 "B")++main :: IO ()+main = do+ createDirectoryIfMissing True "design/stat-in"++ -- (1) lm: 散布図 + 回帰線 + 95% 信頼帯。 df 1 回参照・装飾込み (ggplot geom_smooth(method="lm") 相当)+ let dfLin = M.fromList [ ("x", NumData linX), ("y", NumData linY) ] :: M.Map Text ColData+ saveSVGBoundStats "design/stat-in/lm-stat-in.svg" $+ dfLin |>> ( layer (scatter "x" "y")+ <> layer (statLm "x" "y" <> color (fromHex "#d62728") <> stroke 2)+ <> title "stat-in: lm (df 1 回・装飾込み)" )++ -- (2) smooth: 散布図 + B-spline 平滑曲線 (帯なし)+ let dfSm = M.fromList [ ("x", NumData smX), ("y", NumData smY) ] :: M.Map Text ColData+ saveSVGBoundStats "design/stat-in/smooth-stat-in.svg" $+ dfSm |>> ( layer (scatter "x" "y")+ <> layer (statSmooth "x" "y" 6 <> color (fromHex "#1f77b4") <> stroke 2)+ <> title "stat-in: smooth (B-spline)" )++ -- (3) B1: statLmLevel 0.99 = 信頼水準を可変に (帯が 95% より広い)+ saveSVGBoundStats "design/stat-in/lm-level99-stat-in.svg" $+ dfLin |>> ( layer (scatter "x" "y")+ <> layer (statLmLevel "x" "y" 0.99 <> color (fromHex "#d62728") <> stroke 2)+ <> title "stat-in: statLmLevel 0.99 (帯が広い)" )++ -- (4) B1: statSmoothCI = B-spline 平滑 + 信頼帯 (statSmooth は帯なし)+ saveSVGBoundStats "design/stat-in/smooth-ci-stat-in.svg" $+ dfSm |>> ( layer (scatter "x" "y")+ <> layer (statSmoothCI "x" "y" 6 <> color (fromHex "#1f77b4") <> stroke 2)+ <> title "stat-in: statSmoothCI (B-spline + 帯)" )++ -- (5) B3: statPoly = 多項式回帰 (deg=2) + 信頼帯+ let dfQu = M.fromList [ ("x", NumData quX), ("y", NumData quY) ] :: M.Map Text ColData+ saveSVGBoundStats "design/stat-in/poly-stat-in.svg" $+ dfQu |>> ( layer (scatter "x" "y")+ <> layer (statPoly "x" "y" 2 <> color (fromHex "#2ca02c") <> stroke 2)+ <> title "stat-in: statPoly deg=2 (二次回帰 + 帯)" )++ -- (6) B3: statResid = 残差 vs fitted 診断散布 (= base R plot(lm) #1)+ saveSVGBoundStats "design/stat-in/resid-stat-in.svg" $+ dfQu |>> ( layer (statResid "x" "y" <> color (fromHex "#9467bd"))+ <> title "stat-in: statResid (残差 vs fitted)" )++ -- (7) B2: group 別 fit = statLm <> colorBy "g" (群ごとに回帰線+帯を ggplotHue で色分け)+ let dfGrp = M.fromList [ ("x", NumData grpX), ("y", NumData grpY)+ , ("g", TxtData grpG) ] :: M.Map Text ColData+ saveSVGBoundStats "design/stat-in/group-lm-stat-in.svg" $+ dfGrp |>> ( layer (scatter "x" "y" <> colorBy "g")+ <> layer (statLm "x" "y" <> colorBy "g" <> stroke 2)+ <> title "stat-in: group 別 lm (statLm <> colorBy g)" )++ putStrLn "wrote design/stat-in/*.svg (7 files incl group-lm)"
+ examples/ThreeRoutesDemo.hs view
@@ -0,0 +1,102 @@+-- | Phase 2 A6: 3 ルート並列出力 demo。+--+-- 同じ 'ModelGraph' を 3 種類の出力ルート (Mermaid HTML / Graphviz DOT /+-- hgg SVG) で同時生成し、 ユーザが用途別に比較できるようにする。+--+-- @+-- cabal run three-routes-demo+-- @+-- → @design/three-routes/@ に下記 3 形式 × 3 model (= 計 9 ファイル) を出力。+--+-- Demo モデル: 単純 LM / 階層 LM (= 2 plate) / nested plate (= 多重所属) の 3 種。+--+-- 注: 本 demo は analyze 自体に置けない (= analyze は hgg に依存しない、+-- 計画 §4.1 依存方向規律)。 bridge package 内 demo として配置。+{-# LANGUAGE OverloadedStrings #-}+module Main where++import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import System.Directory (createDirectoryIfMissing)++import Hanalyze.Model.HBM (ModelGraph (..), Node (..),+ NodeKind (..))+import qualified Hanalyze.Viz.ModelGraph as Mermaid+import qualified Hanalyze.Viz.ModelGraphDot as Dot++import Graphics.Hgg.Bridge.Analyze+ (renderModelGraphSVG)++-- ===========================================================================+-- Demo モデル (= A2 test fixture と同じ、 再利用)+-- ===========================================================================++simpleLM :: ModelGraph+simpleLM = ModelGraph+ { mgNodes =+ [ Node "alpha" LatentN "Normal" Set.empty []+ , Node "beta" LatentN "Normal" Set.empty []+ , Node "y" (ObservedN 100) "Normal" Set.empty []+ ]+ , mgEdges = [("alpha", "y"), ("beta", "y")]+ , mgPlates = Map.empty+ }++hierLM :: ModelGraph+hierLM = ModelGraph+ { mgNodes =+ [ Node "mu_g" LatentN "Normal" Set.empty []+ , Node "sig_g" LatentN "HalfCauchy" Set.empty []+ , Node "mu" LatentN "Normal" Set.empty ["group"]+ , Node "y" (ObservedN 200) "Normal" Set.empty ["record"]+ ]+ , mgEdges = [("mu_g", "mu"), ("sig_g", "mu"), ("mu", "y")]+ , mgPlates = Map.fromList [("group", 5), ("record", 200)]+ }++nestedPlate :: ModelGraph+nestedPlate = ModelGraph+ { mgNodes =+ [ Node "mu" LatentN "Normal" Set.empty []+ , Node "mu_c" LatentN "Normal" Set.empty ["condition"]+ , Node "y" (ObservedN 200) "Normal" Set.empty ["record", "condition"]+ ]+ , mgEdges = [("mu", "mu_c"), ("mu_c", "y")]+ , mgPlates = Map.fromList [("record", 200), ("condition", 3)]+ }++-- ===========================================================================+-- Runner+-- ===========================================================================++main :: IO ()+main = do+ let outDir = "design/three-routes"+ createDirectoryIfMissing True outDir+ mapM_ (renderAllRoutes outDir)+ [ ("simple-lm", "Simple LM (= 3 node、 plate 無し)", simpleLM)+ , ("hier-lm", "Hierarchical LM (= 2 plate、 disjoint)", hierLM)+ , ("nested-plate","Nested plate (= y が 2 plate に属す)", nestedPlate)+ ]+ putStrLn ""+ putStrLn $ "Wrote 9 files to " <> outDir <> "/"+ putStrLn " *-mermaid.html (= Mermaid CDN 経由ブラウザ描画)"+ putStrLn " *-graphviz.dot (= dot CLI で SVG/PNG 化用)"+ putStrLn " *-hgg.svg (= hgg 直 SVG、 依存ゼロ)"++renderAllRoutes :: FilePath -> (String, T.Text, ModelGraph) -> IO ()+renderAllRoutes outDir (slug, titleTxt, mg) = do+ let base = outDir <> "/" <> slug++ -- Route 1: Mermaid HTML+ Mermaid.renderModelGraph (base <> "-mermaid.html") titleTxt mg++ -- Route 2: Graphviz DOT (= .dot 中間 text)+ TIO.writeFile (base <> "-graphviz.dot") (Dot.renderModelGraphDot mg)++ -- Route 3: hgg SVG (= 依存ゼロの直描画)+ renderModelGraphSVG (base <> "-hgg.svg") titleTxt mg++ putStrLn $ " " <> slug <> ": 3 形式 出力 (mermaid.html / graphviz.dot / hgg.svg)"
+ hgg-analyze-bridge.cabal view
@@ -0,0 +1,88 @@+cabal-version: 3.0+name: hgg-analyze-bridge+version: 0.1.0.0+extra-doc-files: CHANGELOG.md+synopsis: Bridge from hanalyze (Hanalyze.Model.HBM.ModelGraph) to hgg DAG rendering+description:+ Renders hanalyze's HBM ModelGraph directly to SVG / PNG / PDF via hgg.+ No graphviz CLI or Mermaid CDN dependency, which makes it suitable for+ embedding in production applications and for offline batch use.+ .+ The existing Mermaid HTML (Hanalyze.Viz.ModelGraph) and Graphviz DOT+ (Hanalyze.Viz.ModelGraphDot) routes in hanalyze remain available;+ choose whichever fits the use case.+license: BSD-3-Clause+homepage: https://github.com/frenzieddoll/hgg+license-file: LICENSE+author: Toshiaki Honda+maintainer: frenzieddoll@gmail.com+copyright: 2026 Aelysce Project (Toshiaki Honda)+category: Graphics+build-type: Simple++common warnings+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Wpartial-fields+ -Wredundant-constraints++library+ import: warnings+ exposed-modules: Graphics.Hgg.Bridge.Analyze+ Graphics.Hgg.Bridge.Analyze.Internal+ Graphics.Hgg.Bridge.Stat+ hs-source-dirs: src+ build-depends: base >= 4.17 && < 5+ , text >= 2.0 && < 2.2+ , containers >= 0.6 && < 0.8+ , vector >= 0.12 && < 0.14+ , dataframe-core ^>= 1.1+ , hgg-core ^>= 0.1+ , hgg-frame ^>= 0.1+ , hgg-svg ^>= 0.1+ , hanalyze >= 0.2 && < 0.3+ , hmatrix >= 0.20 && < 0.21+ default-language: Haskell2010++executable three-routes-demo+ import: warnings+ main-is: ThreeRoutesDemo.hs+ hs-source-dirs: examples+ build-depends: base+ , text+ , containers+ , directory+ , hgg-analyze-bridge+ , hanalyze >= 0.2 && < 0.3+ default-language: Haskell2010++executable stat-in-demo+ import: warnings+ main-is: StatInDemo.hs+ hs-source-dirs: examples+ build-depends: base+ , vector >= 0.12 && < 0.14+ , containers+ , text+ , directory+ , hgg-analyze-bridge+ , hgg-core+ , hgg-frame+ , hgg-svg+ default-language: Haskell2010++test-suite hgg-analyze-bridge-tests+ import: warnings+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ build-depends: base+ , text+ , containers+ , vector >= 0.12 && < 0.14+ , dataframe-core ^>= 1.1+ , hgg-analyze-bridge+ , hgg-core+ , hgg-frame+ , hanalyze >= 0.2 && < 0.3+ , hspec >= 2.10 && < 2.12+ default-language: Haskell2010
+ src/Graphics/Hgg/Bridge/Analyze.hs view
@@ -0,0 +1,175 @@+-- |+-- Module : Graphics.Hgg.Bridge.Analyze+-- Description : hanalyze ModelGraph → hgg SVG/PNG/PDF 直描画 bridge+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- hanalyze の 'Hanalyze.Model.HBM.ModelGraph' を、 hgg 経由で+-- 直接 SVG / PNG / PDF に描画する公開 API。 graphviz CLI / Mermaid CDN 依存なし。+--+-- == 3 ルートの選び方+--+-- 同じ 'ModelGraph' を出力する 3 種類のルートがある。 用途に応じて使い分け:+--+-- +---------------+---------------------------------------------+--------------------+-----------------------++-- | ルート | 場所 | 出力 / 描画依存 | 推奨用途 |+-- +===============+=============================================+====================+=======================++-- | Mermaid HTML | @Hanalyze.Viz.ModelGraph.renderModelGraph@ | .html + CDN script | GitHub README、 ノート |+-- +---------------+---------------------------------------------+--------------------+-----------------------++-- | Graphviz DOT | @Hanalyze.Viz.ModelGraphDot.toDot@ | .dot text + dot CLI| graphviz 連携、 加工 |+-- +---------------+---------------------------------------------+--------------------+-----------------------++-- | 本 module | 'renderModelGraphSVG' (= A3 完了) | 依存ゼロ | production、 offline |+-- | | 'renderModelGraphPNG' / 'renderModelGraphPDF' (= A4 stub、 backend 待ち) | | |+-- +---------------+---------------------------------------------+--------------------+-----------------------++--+-- 3 ルートとも同じ 'ModelGraph' 構造 (= node / edge / plate) を表現する。+-- visual layout は実装ごとに異なる: 本ルートは graphviz dot 70-80% 同等品質+-- (Phase 1 §10.1)。+--+-- == 使用例 (= A3 で 'renderModelGraphSVG' 公開予定)+--+-- @+-- import Graphics.Hgg.Bridge.Analyze (modelGraphToDAGSpec)+-- import Hanalyze.Model.HBM (buildModelGraph)+--+-- main = do+-- let mg = buildModelGraph myModel+-- (nodes, edges, plates) = modelGraphToDAGSpec mg+-- -- → A3 で renderModelGraphSVG file title mg として 1 行で完結予定+-- @+{-# LANGUAGE OverloadedStrings #-}+module Graphics.Hgg.Bridge.Analyze+ ( -- * ModelGraph → DAGSpec 変換 (Phase 2 A2)+ modelGraphToDAGSpec+ , modelGraphToDAGNodes+ , modelGraphToDAGEdges+ , modelGraphToDAGPlates+ -- * 直描画 API (Phase 2 A3 SVG)+ , renderModelGraphSVG+ , renderModelGraphSVGBytes+ , modelGraphToVisualSpec+ -- * 直描画 API (Phase 2 A4 PNG / PDF、 backend 未実装の stub)+ , renderModelGraphPNG+ , renderModelGraphPDF+ ) where++import Data.Text (Text)+import qualified Data.Text.IO as TIO++import qualified Graphics.Hgg.Backend.SVG as SVGBackend+import qualified Graphics.Hgg.DAG as DAG+import qualified Graphics.Hgg.Easy as Easy+import qualified Graphics.Hgg.Spec as Spec+import Hanalyze.Model.HBM (ModelGraph)++import qualified Graphics.Hgg.Bridge.Analyze.Internal as I++-- | 'ModelGraph' を ('[DAGNode]', '[DAGEdge]', '[DAGPlate]') の triple に変換。+-- 各要素は 'Graphics.Hgg.Spec.dagFromListsWithPlates' に渡せる形になっている。+modelGraphToDAGSpec+ :: ModelGraph -> ([Spec.DAGNode], [Spec.DAGEdge], [Spec.DAGPlate])+modelGraphToDAGSpec = I.toDAGTriple++-- | 'modelGraphToDAGSpec' の node 部分のみ。+modelGraphToDAGNodes :: ModelGraph -> [Spec.DAGNode]+modelGraphToDAGNodes = I.toDAGNodes++-- | 'modelGraphToDAGSpec' の edge 部分のみ (= dePath は 'Nothing'、 layout で埋まる)。+modelGraphToDAGEdges :: ModelGraph -> [Spec.DAGEdge]+modelGraphToDAGEdges = I.toDAGEdges++-- | 'modelGraphToDAGSpec' の plate 部分のみ (= plate label は @"\<name\> (N=\<size\>)"@)。+modelGraphToDAGPlates :: ModelGraph -> [Spec.DAGPlate]+modelGraphToDAGPlates = I.toDAGPlates++-- ===========================================================================+-- Phase 2 A3: SVG 直描画 API+-- ===========================================================================++-- | 'ModelGraph' を Phase 1 完了の DAG layout (= Sugiyama framework + plate-aware+-- ordering + Catmull-Rom spline + port snap) でレンダリングし、 'VisualSpec' に+-- 包んで返す。 ユーザは title / theme / size 等を追加合成可能。+--+-- @+-- let spec = modelGraphToVisualSpec mg+-- \<\> title \"My HBM\"+-- \<\> theme ThemeDark+-- \<\> widthMm 1200 \<\> heightMm 800+-- @+modelGraphToVisualSpec :: ModelGraph -> Spec.VisualSpec+modelGraphToVisualSpec mg =+ let (nodes, edges, plates) = modelGraphToDAGSpec mg+ -- Phase 1 layout pipeline を直接適用 (= Graph rebuild ではなく [DAGNode] + [DAGEdge] 経由)+ -- これで isolated node + 多重所属 plate も保たれ、 O(N) で済む+ (positioned, routed) =+ DAG.layoutHierarchicalFullWithPlates nodes edges plates+ dagSpec = Spec.dagFromListsWithPlates+ positioned routed Spec.LayoutHierarchical plates+ in Easy.purePlot <> Easy.layer (dagSpec <> Easy.size 22)++-- | 'ModelGraph' を SVG ファイルに直描画。 title は plot 上部に表示。+-- size / theme 等を細かく指定したい場合は 'modelGraphToVisualSpec' + 'plot' を使う。+--+-- @+-- renderModelGraphSVG \"out\/dag.svg\" \"My HBM\" mg+-- @+renderModelGraphSVG :: FilePath -> Text -> ModelGraph -> IO ()+renderModelGraphSVG path titleTxt mg =+ let spec = modelGraphToVisualSpec mg+ <> Easy.title titleTxt+ <> Easy.theme Easy.ThemeLight+ <> Easy.widthMm 900+ <> Easy.heightMm 700+ in SVGBackend.saveSVG path spec++-- | 'renderModelGraphSVG' の ByteString 版 (= ファイル書き出さず Text で返す)。+-- web server / pipeline で SVG を直接他経路に流したいときに使う。+renderModelGraphSVGBytes :: Text -> ModelGraph -> Text+renderModelGraphSVGBytes titleTxt mg =+ let spec = modelGraphToVisualSpec mg+ <> Easy.title titleTxt+ <> Easy.theme Easy.ThemeLight+ <> Easy.widthMm 900+ <> Easy.heightMm 700+ in SVGBackend.renderSVG spec++-- 上記 helper 群は OverloadedStrings + qualified imports で標準的に書ける形。+-- 内部実装の細かい調整 (= サイズ default / theme) は今後の利用で feedback ベースで変える。+_unusedTextIO :: FilePath -> Text -> IO ()+_unusedTextIO = TIO.writeFile++-- ===========================================================================+-- Phase 2 A4: PNG / PDF 直描画 API (= backend 未実装の stub)+-- ===========================================================================++-- | __現状 stub__: hgg-rasterific backend は未実装の placeholder+-- (= 実行すると @error \"not implemented yet\"@)。 本 API は signature を先に+-- 公開しておき、 backend 実装後に自動的に動くようにする。+--+-- 暫定的に PNG が必要なら 'renderModelGraphSVG' で SVG を出力し、 別 tool+-- (= @inkscape@ / @rsvg-convert@ 等) で PNG 化する経路を推奨。+renderModelGraphPNG :: FilePath -> Text -> ModelGraph -> IO ()+renderModelGraphPNG _path _titleTxt _mg =+ error $ unlines+ [ "renderModelGraphPNG: hgg-rasterific backend が未実装の placeholder です。"+ , " 暫定回避: renderModelGraphSVG で SVG を出力し、 別 tool で PNG 化してください。"+ , " 例: rsvg-convert input.svg -o output.png"+ , " inkscape input.svg --export-png=output.png"+ , " 本 API は backend 実装後に自動的に動作します (= signature 安定)。"+ ]++-- | __現状 stub__: hgg-pdf backend は未実装の placeholder+-- (= 実行すると @error \"not implemented yet\"@)。 本 API は signature を先に+-- 公開しておき、 backend 実装後に自動的に動くようにする。+--+-- 暫定的に PDF が必要なら 'renderModelGraphSVG' で SVG を出力し、 別 tool+-- (= @rsvg-convert -f pdf@ / @inkscape --export-pdf@ 等) で PDF 化する経路を推奨。+renderModelGraphPDF :: FilePath -> Text -> ModelGraph -> IO ()+renderModelGraphPDF _path _titleTxt _mg =+ error $ unlines+ [ "renderModelGraphPDF: hgg-pdf backend が未実装の placeholder です。"+ , " 暫定回避: renderModelGraphSVG で SVG を出力し、 別 tool で PDF 化してください。"+ , " 例: rsvg-convert -f pdf input.svg -o output.pdf"+ , " inkscape input.svg --export-pdf=output.pdf"+ , " 本 API は backend 実装後に自動的に動作します (= signature 安定)。"+ ]
+ src/Graphics/Hgg/Bridge/Analyze/Internal.hs view
@@ -0,0 +1,105 @@+-- |+-- Module : Graphics.Hgg.Bridge.Analyze.Internal+-- Description : ModelGraph → DAGSpec 変換 (= 公開 API は Bridge.Analyze)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- 本 module は internal。 直接利用は推奨しない (= API 安定保証なし)。+-- 公開 helper は @Graphics.Hgg.Bridge.Analyze@ に。+--+-- Phase 2 A2: 'toDAGNodes' / 'toDAGEdges' / 'toDAGPlates' / 'toDAGTriple' の+-- 変換関数群。 NodeKind / Distribution / Plate stack の mapping を担当。+{-# LANGUAGE OverloadedStrings #-}+module Graphics.Hgg.Bridge.Analyze.Internal+ ( -- * 変換+ toDAGNodes+ , toDAGEdges+ , toDAGPlates+ , toDAGTriple+ -- * 内部 helper (= test 用に export)+ , mapNodeKind+ , plateLabel+ ) where++import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T++import qualified Graphics.Hgg.Spec as Spec+import Hanalyze.Model.HBM (ModelGraph (..), Node (..),+ NodeKind (..))++-- ===========================================================================+-- 変換層+-- ===========================================================================++-- | 全体変換: 'ModelGraph' → ('[DAGNode]', '[DAGEdge]', '[DAGPlate]')。+-- 公開 API 側で 'Graphics.Hgg.DAG.dagPlotWithPlates' に渡す形に成形する。+toDAGTriple :: ModelGraph -> ([Spec.DAGNode], [Spec.DAGEdge], [Spec.DAGPlate])+toDAGTriple mg =+ ( toDAGNodes mg+ , toDAGEdges mg+ , toDAGPlates mg+ )++-- | 'mgNodes' を 'DAGNode' に変換。 dnX / dnY は 0 (= layout 計算で埋まる)、+-- dnDist には分布名を 'Just' で入れる (= 空文字列なら 'Nothing' に正規化)。+toDAGNodes :: ModelGraph -> [Spec.DAGNode]+toDAGNodes mg =+ [ Spec.DAGNode+ { Spec.dnId = nodeName n+ , Spec.dnLabel = nodeName n+ , Spec.dnKind = mapNodeKind (nodeKind n)+ , Spec.dnDist = nonEmpty (nodeDist n)+ , Spec.dnX = 0+ , Spec.dnY = 0+ }+ | n <- mgNodes mg+ ]+ where+ nonEmpty t = if T.null t then Nothing else Just t++-- | 'mgEdges' (= (parent, child) 列) を 'DAGEdge' に。 dePath = Nothing+-- (= layout 計算で routing される)。 deRoute = Nothing (= 未 bake・layout で確定)。+toDAGEdges :: ModelGraph -> [Spec.DAGEdge]+toDAGEdges mg = [ Spec.DAGEdge p c Nothing Nothing | (p, c) <- mgEdges mg ]++-- | 'mgPlates' (= plate 名 → サイズ N) を 'DAGPlate' に。+-- 各 plate の dpNodeIds は @nodePlates@ に当該 plate 名を含む node を列挙。+-- dpLabel は @"\<plate 名\> (N=\<size\>)"@ の形式 (= dot / PyMC 慣例に近い)。+toDAGPlates :: ModelGraph -> [Spec.DAGPlate]+toDAGPlates mg =+ let nodesInPlate :: Text -> [Text]+ nodesInPlate pname =+ [ nodeName n | n <- mgNodes mg, pname `elem` nodePlates n ]+ in [ Spec.DAGPlate+ { Spec.dpLabel = plateLabel pname size+ , Spec.dpNodeIds = nodesInPlate pname+ }+ | (pname, size) <- Map.toAscList (mgPlates mg)+ ]++-- ===========================================================================+-- Helpers+-- ===========================================================================++-- | analyze の 'NodeKind' を hgg の 'DAGNodeKind' に。+--+-- * 'LatentN' → 'Spec.NodeLatent' (= 楕円、 stochastic latent)+-- * 'ObservedN _' → 'Spec.NodeObserved' (= 楕円 + 灰塗、 観測)+mapNodeKind :: NodeKind -> Spec.DAGNodeKind+mapNodeKind LatentN = Spec.NodeLatent+mapNodeKind (ObservedN _) = Spec.NodeObserved++-- | plate label を @"\<name\> (N=\<size\>)"@ の形式で生成。+-- analyze の Mermaid / Graphviz DOT 出力と同じ形式。+plateLabel :: Text -> Int -> Text+plateLabel name size = name <> " (N=" <> T.pack (show size) <> ")"++-- ===========================================================================+-- 未使用警告抑止+-- ===========================================================================++_unused :: Map Text Int -> Int+_unused = Map.size
+ src/Graphics/Hgg/Bridge/Stat.hs view
@@ -0,0 +1,296 @@+-- |+-- Module : Graphics.Hgg.Bridge.Stat+-- Description : ggplot 風 stat-in (statLm/statSmooth) の回帰計算を hanalyze に委譲して解決 (Phase 16)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- 系統 B (ggplot 風スタット・イン) の解決ロジック (Phase 16)。+--+-- ggplot の @geom_smooth(method="lm")@ / @stat_smooth@ に相当。 ユーザは plot-core の+-- __stat layer__ (@statLm@ / @statSmooth@) を通常 geom と同じく @<>@ で重ねる:+--+-- @+-- df |>> ( layer (scatter "x" "y")+-- <> layer (statLm "x" "y" <> colorStatic "red" <> stroke 2) -- 装飾も通常 geom と同じ+-- <> title "fit" )+-- @+--+-- stat layer (@MStatLM@/@MStatSmooth@) は plot-core が持つ純タグで、 描画前に本モジュールの+-- 'resolveStats' が **回帰計算を hanalyze に委譲**して具体 layer (band + line) に展開する。+--+-- ★依存方向 (最重要): @plot-core@ は analyze 非依存のまま (タグを持つだけ)。 回帰 fit は+-- @plot → analyze@ の逆エッジゆえ本 opt-in 隔離 package (`hgg-analyze-bridge`) のみで行う。+--+-- ★使い方: バインド後に 'saveSVGBoundStats' / 'renderBoundStats' を使えば、 bpResolver で+-- 自動的に 'resolveStats' してから描画する (df は 1 回参照)。+--+-- ★委譲の内訳: @statLm@ = §3.6 @parseModel "y ~ x"@ + @fitLMF@ で fit + LM @confidenceBand@ で+-- 信頼帯 (設計行列は @designMatrix@、 fitLMF と同一 [1,x] 設計)。 @statSmooth@ = @y ~ bs(x,n)@ の+-- fitLMF (B-spline、 曲線のみ・帯なし)。 stat layer の装飾 (color/stroke/alpha) は展開後の+-- band/line に引き継がれる。+{-# LANGUAGE OverloadedStrings #-}++module Graphics.Hgg.Bridge.Stat+ ( resolveStats+ , saveSVGBoundStats+ , renderBoundStats+ ) where++import Data.List (sortOn, zip4)+import Data.Monoid (First (..), Last (..))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified DataFrame.Internal.Column as DX+import qualified DataFrame.Internal.DataFrame as DX++import Graphics.Hgg.Backend.SVG (renderBound, saveSVGBound)+import Graphics.Hgg.Frame (BoundPlot (..))+import Graphics.Hgg.Palette (ggplotHue)+import Graphics.Hgg.Spec (ColRef (..), ColorEnc (..), Layer (..),+ MarkKind (..), Resolver, ThemeName (..),+ VisualSpec (..), alpha, band,+ orderedCats,+ line, scatter, stroke, resolveNum, resolveTxt,+ themeSeriesPalette)+import Graphics.Hgg.Unit (mm, (*~))+import Data.Maybe (fromMaybe)+import Hanalyze.Model.Core (FitResult, fittedList)+import Hanalyze.Model.Formula.Design (designMatrixF, fitLMF)+import Hanalyze.Model.Formula.Frame (modelFrame)+import Hanalyze.Model.Formula.RFormula (parseModel)+import qualified Hanalyze.Model.LM as LM+import qualified Numeric.LinearAlgebra as LA++-- ===========================================================================+-- resolveStats: VisualSpec 中の未解決 stat layer を band+line に展開+-- ===========================================================================++-- | 'VisualSpec' の各 layer を走査し、 未解決の stat layer (@MStatLM@/@MStatSmooth@) を+-- @Resolver@ でデータ解決 → hanalyze で fit → 具体 layer (band+line / line) に置換する。+-- それ以外の layer は不変。 解決/fit に失敗した stat layer は黙って除去 (描画を妨げない)。+resolveStats :: Resolver -> VisualSpec -> VisualSpec+resolveStats r vs = vs { vsLayers = concatMap (expandLayer pal r) (vsLayers vs) }+ where pal = statPalette vs++-- | B2 群色の元になる categorical palette。 ★Layout の catPalRaw と同じ規律で求める+-- (spec.palette 明示 > theme 既定 series)。 これで group 別 stat 線の色が ColorByCol+-- scatter (renderer は lpCategoricalPalette を index 参照) と一致する。+-- ggplot hue sentinel (["__ggplot_hue__"]) は群数依存ゆえ 'resolveGrouped' で展開する。+statPalette :: VisualSpec -> [Text]+statPalette vs =+ let themeDefaultPal = themeSeriesPalette (fromMaybe ThemeDefault (getLast (vsTheme vs)))+ in fromMaybe themeDefaultPal (getLast (vsPalette vs))++expandLayer :: [Text] -> Resolver -> Layer -> [Layer]+expandLayer pal r ly = case getFirst (lyKind ly) of+ Just MStatLM -> grouped resolveLM+ Just MStatSmooth -> grouped resolveSmooth+ Just MStatPoly -> grouped resolvePoly+ Just MStatResid -> grouped resolveResid+ _ -> [ly]+ where grouped f = either (const []) id (resolveGrouped pal r ly f)++-- | 単群 stat resolver の型。 装飾/オプションは 'Layer'、 データは xs/ys で受ける+-- (Resolver からの解決は 'resolveGrouped' が一度だけ行う)。+type StatFn = Layer -> V.Vector Double -> V.Vector Double -> Either String [Layer]++-- ===========================================================================+-- B2: group 別 fit (= ggplot geom_smooth(aes(color=g)))+-- ===========================================================================++-- | stat layer の color encoding が群列 ('ColorByCol') を指すなら、 群ごとに分割 fit し+-- 群色 (ggplotHue) で複数 line/band を重畳する。 群指定が無ければ単群で 1 回 fit (B1/B3 同等)。+resolveGrouped :: [Text] -> Resolver -> Layer -> StatFn -> Either String [Layer]+resolveGrouped palRaw r ly f = do+ xs0 <- colOf r (lyEncX ly)+ ys0 <- colOf r (lyEncY ly)+ -- ★ NaN (= Maybe 列の Nothing / 欠損) を持つ行を fit から落とす (mark の na.rm と同じ挙動)。+ -- x/y どちらかが NaN の点を除外し、 群列も同じ有効行に整列させる。+ let n0 = min (V.length xs0) (V.length ys0)+ valid = V.fromList [ i | i <- [0 .. n0 - 1]+ , not (isNaN (xs0 V.! i)), not (isNaN (ys0 V.! i)) ]+ xs = V.map (xs0 V.!) valid+ ys = V.map (ys0 V.!) valid+ case groupColumn r ly of+ Nothing -> f ly xs ys -- 単群 (B1/B3)+ Just gs0 -> do+ let gs = V.map (gs0 V.!) valid -- 群列を有効行に整列+ groups = orderedCats (V.toList gs) -- Phase 28: ggplot factor 既定 = アルファベット順+ -- ★ColorByCol scatter と同色: hue sentinel は群数で展開、 他は spec/theme palette を index 参照+ palette | palRaw == ["__ggplot_hue__"] = ggplotHue (length groups)+ | otherwise = palRaw+ gv = V.toList gs+ perGroup (i, g) =+ let idxs = [ j | (j, gg) <- zip [0 ..] gv, gg == g ]+ gx = V.fromList [ xs V.! j | j <- idxs ]+ gy = V.fromList [ ys V.! j | j <- idxs ]+ col = palette !! (i `mod` max 1 (length palette))+ -- 群色で上書き (内部 palette は Text 経路ゆえ ColorStatic 直構築で温存。+ -- Last 後勝ち → band/line/scatter に伝播)。+ ly' = ly <> mempty { lyColor = Last (Just (ColorStatic col)) }+ in either (const []) id (f ly' gx gy)+ Right (concatMap perGroup (zip [0 ..] groups))++-- | lyColor が 'ColorByCol' なら群列を Resolver で文字ベクタに解決 (= 群分割キー)。+groupColumn :: Resolver -> Layer -> Maybe (V.Vector Text)+groupColumn r ly = case getLast (lyColor ly) of+ Just (ColorByCol cr) -> resolveTxt r cr+ _ -> Nothing++-- | 出現順を保つ distinct (= Render.nubKeep 同等。 群の色対応を安定させる)。+nubKeepOrd :: Eq a => [a] -> [a]+nubKeepOrd = go []+ where go seen [] = reverse seen+ go seen (x:xs)+ | x `elem` seen = go seen xs+ | otherwise = go (x : seen) xs++-- | geom_smooth / stat_lm の回帰線の既定線幅 (Phase 34 A1: ggplot geom_smooth は+-- @linewidth = 2 × 既定線@ = 0.753mm)。@decoOf ly@ (= user 指定 stroke) が後置で+-- 上書きするので、user が 'stroke' を明示した場合はそちらが優先される。+smoothLineDefault :: Layer+smoothLineDefault = stroke (0.753 *~ mm)++-- | 装飾だけを抜き出した Layer (lyKind/encoding は持たない)。 band/line に @<>@ で合成すると+-- color/stroke/alpha/linetype が引き継がれ、 band/line 自身の lyKind は保たれる (First Monoid)。+decoOf :: Layer -> Layer+decoOf ly = mempty+ { lyColor = lyColor ly+ , lyStroke = lyStroke ly+ , lyAlpha = lyAlpha ly+ , lyLinetype = lyLinetype ly+ }++-- | stat layer の encoding 列を Resolver で数値ベクタに解決。+colOf :: Resolver -> Last ColRef -> Either String (V.Vector Double)+colOf r lc = case getLast lc >>= resolveNum r of+ Just v -> Right v+ Nothing -> Left "stat layer の x/y 列を数値として解決できません"++-- | lm: 回帰線 + 95% 信頼帯。 帯は半透明 (alpha 既定 0.2)、 線は装飾引き継ぎ。+resolveLM :: StatFn+resolveLM ly xs ys = do+ (fr, _) <- fitFormula "y ~ x" xs ys+ let lvl = fromMaybe 0.95 (getLast (lyStatLevel ly)) -- B1: statLmLevel で可変、 既定 0.95+ dm = LM.designMatrix xs -- [1, x] = fitLMF "y~x" と同一設計+ cib = LM.confidenceBand dm fr lvl+ rows = sortOn (\(x, _, _, _) -> x)+ (zip4 (V.toList xs) (fittedList fr)+ (LM.lowerBound cib) (LM.upperBound cib))+ sx = V.fromList [ x | (x, _, _, _) <- rows ]+ syh = V.fromList [ y | (_, y, _, _) <- rows ]+ slo = V.fromList [ l | (_, _, l, _) <- rows ]+ shi = V.fromList [ h | (_, _, _, h) <- rows ]+ bandLy = band (ColNum sx) (ColNum slo) (ColNum shi)+ <> mempty { lyColor = lyColor ly }+ <> maybe (alpha 0.2) alpha (getLast (lyAlpha ly))+ lineLy = line (ColNum sx) (ColNum syh) <> smoothLineDefault <> decoOf ly+ Right [ bandLy -- 帯を先に (背面)+ , lineLy ] -- 線を後に (前面)++-- | smooth: B-spline 平滑。 knot 数は lyBinCount (既定 6)。+-- B1: 'lyStatLevel' が Just (= 'statSmoothCI') なら bs 設計行列の 'LM.confidenceBand' で+-- 信頼帯 (band) + 曲線 (line)、 Nothing (= 'statSmooth') なら曲線のみ。+resolveSmooth :: StatFn+resolveSmooth ly xs ys = do+ let n = maybe 6 id (getLast (lyBinCount ly))+ formula = "y ~ bs(x," <> T.pack (show n) <> ")"+ (fr, _) <- fitFormula formula xs ys+ case getLast (lyStatLevel ly) of+ Nothing -> do+ let rows = sortOn fst (zip (V.toList xs) (fittedList fr))+ sx = V.fromList (map fst rows)+ syh = V.fromList (map snd rows)+ Right [ line (ColNum sx) (ColNum syh) <> smoothLineDefault <> decoOf ly ]+ Just lvl -> do+ dm <- designFor formula xs ys -- bs 基底設計行列 (= fitLMF と同一)+ let cib = LM.confidenceBand dm fr lvl+ rows = sortOn (\(x, _, _, _) -> x)+ (zip4 (V.toList xs) (fittedList fr)+ (LM.lowerBound cib) (LM.upperBound cib))+ sx = V.fromList [ x | (x, _, _, _) <- rows ]+ syh = V.fromList [ y | (_, y, _, _) <- rows ]+ slo = V.fromList [ l | (_, _, l, _) <- rows ]+ shi = V.fromList [ h | (_, _, _, h) <- rows ]+ bandLy = band (ColNum sx) (ColNum slo) (ColNum shi)+ <> mempty { lyColor = lyColor ly }+ <> maybe (alpha 0.2) alpha (getLast (lyAlpha ly))+ lineLy = line (ColNum sx) (ColNum syh) <> smoothLineDefault <> decoOf ly+ Right [ bandLy -- 帯を先に (背面)+ , lineLy ] -- 線を後に (前面)++-- | poly: 多項式回帰 (= ggplot stat_smooth(method="lm", formula=y~poly(x,deg)))。+-- 次数 deg は lyBinCount (既定 2)。 poly 設計行列の confidenceBand で band+line に展開。+resolvePoly :: StatFn+resolvePoly ly xs ys = do+ let deg = maybe 2 id (getLast (lyBinCount ly))+ lvl = fromMaybe 0.95 (getLast (lyStatLevel ly))+ formula = "y ~ poly(x," <> T.pack (show deg) <> ")"+ (fr, _) <- fitFormula formula xs ys+ dm <- designFor formula xs ys+ let cib = LM.confidenceBand dm fr lvl+ rows = sortOn (\(x, _, _, _) -> x)+ (zip4 (V.toList xs) (fittedList fr)+ (LM.lowerBound cib) (LM.upperBound cib))+ sx = V.fromList [ x | (x, _, _, _) <- rows ]+ syh = V.fromList [ y | (_, y, _, _) <- rows ]+ slo = V.fromList [ l | (_, _, l, _) <- rows ]+ shi = V.fromList [ h | (_, _, _, h) <- rows ]+ bandLy = band (ColNum sx) (ColNum slo) (ColNum shi)+ <> mempty { lyColor = lyColor ly }+ <> maybe (alpha 0.2) alpha (getLast (lyAlpha ly))+ lineLy = line (ColNum sx) (ColNum syh) <> smoothLineDefault <> decoOf ly+ Right [ bandLy -- 帯を先に (背面)+ , lineLy ] -- 線を後に (前面)++-- | resid: 残差 vs fitted 診断散布 (= base R plot(lm) #1)。 y~x で fit し、+-- 各点を (fitted, residual=y-fitted) に写した scatter に展開する (装飾は scatter に引き継ぐ)。+resolveResid :: StatFn+resolveResid ly xs ys = do+ (fr, _) <- fitFormula "y ~ x" xs ys+ let fitted = fittedList fr+ resid = zipWith (-) (V.toList ys) fitted+ fx = V.fromList fitted+ ry = V.fromList resid+ Right [ scatter (ColNum fx) (ColNum ry) <> decoOf ly ]++-- | x/y の 2 列 DataFrame を組み、 formula を parse → fitLMF (回帰計算を analyze に委譲)。+-- 列名は内部固定 ("x"/"y") で、 formula も "x"/"y" を参照する。+fitFormula :: Text -> V.Vector Double -> V.Vector Double+ -> Either String (FitResult, [Text])+fitFormula formula xs ys = do+ f <- parseModel formula+ fitLMF f (xyFrame xs ys)++-- | formula の設計行列 (= confidenceBand 用)。 fitLMF と同じ modelFrame→designMatrixF 経路を+-- 通すので、 bs(x,n) 等の基底展開も fit と完全一致する。+designFor :: Text -> V.Vector Double -> V.Vector Double+ -> Either String (LA.Matrix Double)+designFor formula xs ys = do+ f <- parseModel formula+ mf <- modelFrame f (xyFrame xs ys)+ (dm, _) <- designMatrixF f mf+ Right dm++-- | x/y 2 列の内部 DataFrame。+xyFrame :: V.Vector Double -> V.Vector Double -> DX.DataFrame+xyFrame xs ys = DX.fromNamedColumns+ [ ("x", DX.fromList (V.toList xs))+ , ("y", DX.fromList (V.toList ys)) ]++-- ===========================================================================+-- BoundPlot 向けの描画ラッパ (df 1 回参照・自動解決)+-- ===========================================================================++-- | バインド済プロットの spec を、 自分が持つ resolver で 'resolveStats' する。+resolveBound :: BoundPlot -> BoundPlot+resolveBound bp = bp { bpSpec = resolveStats (bpResolver bp) (bpSpec bp) }++-- | stat を解決してから SVG 保存 (= ggplot2 の geom_smooth 込み図を 1 回の df 参照で)。+saveSVGBoundStats :: FilePath -> BoundPlot -> IO ()+saveSVGBoundStats path = saveSVGBound path . resolveBound++-- | stat を解決してから SVG 文字列を返す。+renderBoundStats :: BoundPlot -> Text+renderBoundStats = renderBound . resolveBound
+ test/Spec.hs view
@@ -0,0 +1,344 @@+-- | Phase 2 A2 test: ModelGraph → DAGSpec 変換の round-trip 保存。+{-# LANGUAGE OverloadedStrings #-}+module Main where++import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Data.Monoid+import qualified Data.Text++import qualified Graphics.Hgg.Spec as Spec+import Graphics.Hgg.Palette (ggplotHue)+import Hanalyze.Model.HBM (ModelGraph (..), Node (..),+ NodeKind (..))++import Graphics.Hgg.Bridge.Analyze+ (modelGraphToDAGEdges,+ modelGraphToDAGNodes,+ modelGraphToDAGPlates,+ modelGraphToDAGSpec,+ modelGraphToVisualSpec,+ renderModelGraphPDF,+ renderModelGraphPNG,+ renderModelGraphSVG,+ renderModelGraphSVGBytes)+import qualified Graphics.Hgg.Bridge.Analyze.Internal as I++import Graphics.Hgg.Bridge.Stat (resolveStats)+import Graphics.Hgg.Frame ((|>>), bpSpec, bpResolver)+import qualified Data.Vector as V+import qualified DataFrame.Internal.Column as DX+import qualified DataFrame.Internal.DataFrame as DX+import qualified Hanalyze.Model.LM as LM+import Hanalyze.Model.Core (fittedList)+import Data.List (sortOn)+import Data.Monoid (getFirst, getLast)++import Test.Hspec++-- ===========================================================================+-- 代表 ModelGraph fixture+-- ===========================================================================++-- | 単純 LM 風: alpha (latent) + beta (latent) → y (observed, N=100)+simpleLM :: ModelGraph+simpleLM = ModelGraph+ { mgNodes =+ [ Node "alpha" LatentN "Normal" Set.empty []+ , Node "beta" LatentN "Normal" Set.empty []+ , Node "y" (ObservedN 100) "Normal" Set.empty []+ ]+ , mgEdges = [("alpha", "y"), ("beta", "y")]+ , mgPlates = Map.empty+ }++-- | 階層 LM 風: mu_g + sigma_g → mu (group plate G=5) → y (record plate R=200)+hierLM :: ModelGraph+hierLM = ModelGraph+ { mgNodes =+ [ Node "mu_g" LatentN "Normal" Set.empty []+ , Node "sig_g" LatentN "HalfCauchy" Set.empty []+ , Node "mu" LatentN "Normal" Set.empty ["group"]+ , Node "y" (ObservedN 200) "Normal" Set.empty ["record"]+ ]+ , mgEdges = [("mu_g", "mu"), ("sig_g", "mu"), ("mu", "y")]+ , mgPlates = Map.fromList [("group", 5), ("record", 200)]+ }++-- | nested plate (= record 内に condition plate がある):+-- mu → mu_c (= condition plate C=3、 record plate 外側) → y (record N=200 + condition)+nestedPlate :: ModelGraph+nestedPlate = ModelGraph+ { mgNodes =+ [ Node "mu" LatentN "Normal" Set.empty []+ , Node "mu_c" LatentN "Normal" Set.empty ["condition"]+ , Node "y" (ObservedN 200) "Normal" Set.empty ["record", "condition"]+ ]+ , mgEdges = [("mu", "mu_c"), ("mu_c", "y")]+ , mgPlates = Map.fromList [("record", 200), ("condition", 3)]+ }++-- ===========================================================================+-- Tests+-- ===========================================================================++main :: IO ()+main = hspec $ do++ describe "Phase 16 系統 B (resolveStats = stat-in 委譲)" $ do+ let xs = V.fromList [1,2,3,4,5,6,7,8] :: V.Vector Double+ ys = V.fromList [2.1,3.9,6.2,7.8,10.1,12.0,13.8,16.2] :: V.Vector Double+ r name+ | name == ("x" :: Data.Text.Text) = Just (Spec.NumData xs)+ | name == "y" = Just (Spec.NumData ys)+ | otherwise = Nothing+ -- df 1 回参照: scatter + statLm を <> で重ね resolveStats で展開+ specLM = Spec.layer (Spec.scatter "x" "y") <> Spec.layer (Spec.statLm "x" "y")+ specSm = Spec.layer (Spec.scatter "x" "y") <> Spec.layer (Spec.statSmooth "x" "y" 4)++ it "statLm: scatter + 回帰線 + 信頼帯 = 3 layer に展開" $+ length (Spec.vsLayers (resolveStats r specLM)) `shouldBe` 3+ it "statSmooth: scatter + 曲線 = 2 layer (帯なし)" $+ length (Spec.vsLayers (resolveStats r specSm)) `shouldBe` 2+ it "解決できない列の stat は除去 (scatter のみ残る)" $+ let bad = Spec.layer (Spec.scatter "x" "y") <> Spec.layer (Spec.statLm "x" "z")+ in length (Spec.vsLayers (resolveStats r bad)) `shouldBe` 1+ it "未解決 stat は resolveStats 後に残らない (全て band/line に展開)" $+ let kinds = [ getFirst (Spec.lyKind l) | l <- Spec.vsLayers (resolveStats r specLM) ]+ in (Just Spec.MStatLM `elem` kinds) `shouldBe` False++ it "回帰線の ŷ が analyze fitWithCI (= fitLM 直呼び) と一致 (委譲の証跡)" $ do+ let df = DX.fromNamedColumns+ [ ("x", DX.fromList (V.toList xs))+ , ("y", DX.fromList (V.toList ys)) ]+ Just (frRef, _) = LM.fitWithCI 0.95 df "x" "y"+ refSorted = map snd (sortOn fst (zip (V.toList xs) (fittedList frRef)))+ resolved = Spec.vsLayers (resolveStats r (Spec.layer (Spec.statLm "x" "y")))+ lineLayer = resolved !! 1 -- [band, line]+ Just (Spec.ColNum gotV) = getLast (Spec.lyEncY lineLayer)+ and (zipWith (\a b -> abs (a - b) < 1e-9) (V.toList gotV) refSorted)+ `shouldBe` True++ it "装飾 (stroke) が展開後の回帰線に引き継がれる" $ do+ let styled = Spec.layer (Spec.statLm "x" "y" <> Spec.stroke 3)+ resolved = Spec.vsLayers (resolveStats r styled)+ lineLayer = resolved !! 1+ getLast (Spec.lyStroke lineLayer) `shouldBe` Just 3++ it "df 1 回参照 (|>> の bpResolver を resolveStats に渡す)" $ do+ let df = Map.fromList [ ("x", Spec.NumData xs), ("y", Spec.NumData ys) ]+ :: Map.Map Data.Text.Text Spec.ColData+ bound = df |>> (Spec.layer (Spec.scatter "x" "y") <> Spec.layer (Spec.statLm "x" "y"))+ spec = resolveStats (bpResolver bound) (bpSpec bound)+ length (Spec.vsLayers spec) `shouldBe` 3++ -- B1: 信頼水準可変 + smooth 帯版+ it "statLmLevel: statLm 同様 3 layer (band+line) に展開" $+ length (Spec.vsLayers (resolveStats r+ (Spec.layer (Spec.statLmLevel "x" "y" 0.99)))) `shouldBe` 2+ it "statLmLevel 0.99 の帯は 0.95 より広い (band 半幅で確認)" $ do+ let halfWidth lvl =+ let resolved = Spec.vsLayers (resolveStats r (Spec.layer lvl))+ bandLy = head resolved -- [band, line]+ Just (Spec.ColNum lo) = getLast (Spec.lyEncY bandLy)+ Just (Spec.ColNum hi) = getLast (Spec.lyEncY2 bandLy)+ in V.sum (V.zipWith (\h l -> h - l) hi lo)+ halfWidth (Spec.statLmLevel "x" "y" 0.99)+ `shouldSatisfy` (> halfWidth (Spec.statLm "x" "y"))+ it "statSmoothCI: scatter なしでも band+line = 2 layer (帯あり)" $+ length (Spec.vsLayers (resolveStats r+ (Spec.layer (Spec.statSmoothCI "x" "y" 4)))) `shouldBe` 2+ it "statSmooth (帯なし) は 1 layer・statSmoothCI (帯あり) は 2 layer" $ do+ length (Spec.vsLayers (resolveStats r (Spec.layer (Spec.statSmooth "x" "y" 4)))) `shouldBe` 1+ length (Spec.vsLayers (resolveStats r (Spec.layer (Spec.statSmoothCI "x" "y" 4)))) `shouldBe` 2++ -- B3: statPoly / statResid+ it "statPoly: band+line = 2 layer に展開" $+ length (Spec.vsLayers (resolveStats r (Spec.layer (Spec.statPoly "x" "y" 2)))) `shouldBe` 2+ it "statResid: scatter 1 layer (残差 vs fitted)" $+ length (Spec.vsLayers (resolveStats r (Spec.layer (Spec.statResid "x" "y")))) `shouldBe` 1+ it "statResid の y = 残差 (= y - fitted、 委譲先 fitLM と一致)" $ do+ let df = DX.fromNamedColumns+ [ ("x", DX.fromList (V.toList xs))+ , ("y", DX.fromList (V.toList ys)) ]+ Just (frRef, _) = LM.fitWithCI 0.95 df "x" "y"+ residRef = zipWith (-) (V.toList ys) (fittedList frRef)+ resolved = Spec.vsLayers (resolveStats r (Spec.layer (Spec.statResid "x" "y")))+ Just (Spec.ColNum gotV) = getLast (Spec.lyEncY (head resolved))+ and (zipWith (\a b -> abs (a - b) < 1e-9) (V.toList gotV) residRef)+ `shouldBe` True+ it "statPoly deg=1 の ŷ は statLm と一致 (poly(x,1) = 線形)" $ do+ let polyY = let resolved = Spec.vsLayers (resolveStats r (Spec.layer (Spec.statPoly "x" "y" 1)))+ Just (Spec.ColNum v) = getLast (Spec.lyEncY (resolved !! 1))+ in V.toList v+ lmY = let resolved = Spec.vsLayers (resolveStats r (Spec.layer (Spec.statLm "x" "y")))+ Just (Spec.ColNum v) = getLast (Spec.lyEncY (resolved !! 1))+ in V.toList v+ and (zipWith (\a b -> abs (a - b) < 1e-7) polyY lmY) `shouldBe` True++ describe "Phase 16 B2 (group 別 fit = geom_smooth(aes(color=g)))" $ do+ -- 2 群: g="a" (傾き 1) / g="b" (傾き 3)。 g 列は TxtData で解決。+ let n = 6 :: Int+ xa = [1 .. fromIntegral n]+ xs = V.fromList (xa ++ xa) :: V.Vector Double+ ys = V.fromList (map (\x -> 1 * x + 0.5) xa+ ++ map (\x -> 3 * x + 0.5) xa) :: V.Vector Double+ gs = V.fromList (replicate n "a" ++ replicate n "b") :: V.Vector Data.Text.Text+ rg name+ | name == ("x" :: Data.Text.Text) = Just (Spec.NumData xs)+ | name == "y" = Just (Spec.NumData ys)+ | name == "g" = Just (Spec.TxtData gs)+ | otherwise = Nothing++ it "色なし statLm は単群 (band+line = 2 layer)" $+ length (Spec.vsLayers (resolveStats rg (Spec.layer (Spec.statLm "x" "y")))) `shouldBe` 2+ it "color g つき statLm は 2 群 (band+line ×2 = 4 layer)" $+ length (Spec.vsLayers (resolveStats rg+ (Spec.layer (Spec.statLm "x" "y" <> Spec.colorBy "g")))) `shouldBe` 4+ it "群色 = 既定 theme series palette (= ColorByCol scatter と一致)" $ do+ let resolved = Spec.vsLayers (resolveStats rg+ (Spec.layer (Spec.statLm "x" "y" <> Spec.colorBy "g")))+ -- line layer は index 1, 3 (各群の [band, line])+ colorOf l = getLast (Spec.lyColor l)+ -- ★Phase 28: 既定 series palette (themeSeriesPalette ThemeDefault) は具体色でなく+ -- hue sentinel ["__ggplot_hue__"] を返し、 renderer (Layout.catPal) /+ -- Bridge.resolveGrouped が群数 n で 'ggplotHue' n に展開する。 ここは 2 群なので+ -- 群色は ggplotHue 2 (= ColorByCol scatter と同じ) と一致しなければならない。+ defPal = ggplotHue 2+ colorOf (resolved !! 1) `shouldBe` Just (Spec.ColorStatic (defPal !! 0))+ colorOf (resolved !! 3) `shouldBe` Just (Spec.ColorStatic (defPal !! 1))+ it "群別 fit の傾きが分離 (b 群の ŷ が a 群より急 = 末尾で大)" $ do+ let resolved = Spec.vsLayers (resolveStats rg+ (Spec.layer (Spec.statLm "x" "y" <> Spec.colorBy "g")))+ lastY l = let Just (Spec.ColNum v) = getLast (Spec.lyEncY l) in V.last v+ -- a 群 line (idx1) の末尾 ŷ ≈ 6.5、 b 群 line (idx3) ≈ 18.5+ (lastY (resolved !! 3) > lastY (resolved !! 1)) `shouldBe` True++ describe "Phase 2 A2 mapNodeKind" $ do+ it "LatentN → NodeLatent" $+ I.mapNodeKind LatentN `shouldBe` Spec.NodeLatent+ it "ObservedN _ → NodeObserved (= 観測数は捨てる、 描画では使わない)" $ do+ I.mapNodeKind (ObservedN 1) `shouldBe` Spec.NodeObserved+ I.mapNodeKind (ObservedN 200) `shouldBe` Spec.NodeObserved++ describe "Phase 2 A2 plateLabel" $ do+ it "name + size を \"<name> (N=<size>)\" に整形" $+ I.plateLabel "group" 5 `shouldBe` "group (N=5)"+ it "size 0 / 大きい数も整形できる" $ do+ I.plateLabel "" 0 `shouldBe` " (N=0)"+ I.plateLabel "x" 9999 `shouldBe` "x (N=9999)"++ describe "Phase 2 A2 modelGraphToDAGNodes" $ do+ it "simpleLM: node 数 = 元 mgNodes と一致 (= round-trip)" $+ length (modelGraphToDAGNodes simpleLM) `shouldBe` length (mgNodes simpleLM)+ it "simpleLM: node 名・ kind・ dist が正しく mapping" $ do+ let ns = modelGraphToDAGNodes simpleLM+ byId i = head [n | n <- ns, Spec.dnId n == i]+ Spec.dnKind (byId "alpha") `shouldBe` Spec.NodeLatent+ Spec.dnKind (byId "y") `shouldBe` Spec.NodeObserved+ Spec.dnDist (byId "alpha") `shouldBe` Just "Normal"+ Spec.dnLabel (byId "y") `shouldBe` "y"+ it "空 distribution は dnDist = Nothing に正規化" $+ let mg = simpleLM { mgNodes = [ Node "n" LatentN "" Set.empty [] ] }+ (n:_) = modelGraphToDAGNodes mg+ in Spec.dnDist n `shouldBe` Nothing++ describe "Phase 2 A2 modelGraphToDAGEdges" $ do+ it "simpleLM: edge 数 = 元 mgEdges と一致" $+ length (modelGraphToDAGEdges simpleLM) `shouldBe` length (mgEdges simpleLM)+ it "edge from/to が保存、 dePath は Nothing default" $ do+ let es = modelGraphToDAGEdges simpleLM+ e = head es+ Spec.dePath e `shouldBe` Nothing+ (Spec.deFrom e, Spec.deTo e) `shouldBe` ("alpha", "y")++ describe "Phase 2 A2 modelGraphToDAGPlates" $ do+ it "plate 無し: 結果も空リスト" $+ modelGraphToDAGPlates simpleLM `shouldBe` []++ it "hierLM 2 plate: dpLabel に N=<size>、 dpNodeIds に該当 node 名" $ do+ let ps = modelGraphToDAGPlates hierLM+ length ps `shouldBe` 2+ let labels = map Spec.dpLabel ps+ memberss = map Spec.dpNodeIds ps+ "group (N=5)" `elem` labels `shouldBe` True+ "record (N=200)" `elem` labels `shouldBe` True+ -- 各 plate の member が正しい+ let groupPlate = head [p | p <- ps, Spec.dpLabel p == "group (N=5)"]+ recordPlate = head [p | p <- ps, Spec.dpLabel p == "record (N=200)"]+ Spec.dpNodeIds groupPlate `shouldBe` ["mu"]+ Spec.dpNodeIds recordPlate `shouldBe` ["y"]+ -- 全 plate の memberss 連結が空でない+ concat memberss `shouldNotBe` []++ it "nested plate: 1 node が 2 plate に属するケースを正しく扱う" $ do+ let ps = modelGraphToDAGPlates nestedPlate+ -- y は record + condition の両方に member+ let recordP = head [p | p <- ps, Spec.dpLabel p == "record (N=200)"]+ conditionP = head [p | p <- ps, Spec.dpLabel p == "condition (N=3)"]+ Spec.dpNodeIds recordP `shouldBe` ["y"]+ ("y" `elem` Spec.dpNodeIds conditionP) `shouldBe` True++ describe "Phase 2 A2 modelGraphToDAGSpec round-trip" $ do+ it "simpleLM: (nodes, edges, plates) の length が ModelGraph 各要素数と一致" $ do+ let (ns, es, ps) = modelGraphToDAGSpec simpleLM+ length ns `shouldBe` length (mgNodes simpleLM)+ length es `shouldBe` length (mgEdges simpleLM)+ length ps `shouldBe` Map.size (mgPlates simpleLM)+ it "hierLM: 同上" $ do+ let (ns, es, ps) = modelGraphToDAGSpec hierLM+ length ns `shouldBe` length (mgNodes hierLM)+ length es `shouldBe` length (mgEdges hierLM)+ length ps `shouldBe` Map.size (mgPlates hierLM)+ it "nestedPlate: 同上 (= 多重所属 node も誤って数えない)" $ do+ let (ns, es, ps) = modelGraphToDAGSpec nestedPlate+ length ns `shouldBe` length (mgNodes nestedPlate)+ length es `shouldBe` length (mgEdges nestedPlate)+ length ps `shouldBe` Map.size (mgPlates nestedPlate)++ describe "Phase 2 A3 modelGraphToVisualSpec + renderModelGraphSVG" $ do+ it "simpleLM: VisualSpec が空でない layer を含む (= layout 適用された)" $ do+ let spec = modelGraphToVisualSpec simpleLM+ length (Spec.vsLayers spec) `shouldBe` 1++ it "hierLM: layout 適用済 (= dnX / dnY が 0 以外に埋まる)" $ do+ let spec = modelGraphToVisualSpec hierLM+ -- layer の DAGSpec から positioned nodes を取出し+ dagLayer = head (Spec.vsLayers spec)+ Just ds = Data.Monoid.getLast (Spec.lyDAG dagLayer)+ ns = Spec.dsNodes ds+ allXs = map Spec.dnX ns+ allYs = map Spec.dnY ns+ -- LayoutHierarchical 経由なら少なくとも 1 つは ≠ 0 (= layout 計算済)+ any (/= 0) allXs `shouldBe` True+ any (/= 0) allYs `shouldBe` True++ it "renderModelGraphSVG: ファイル書出し + 内容が SVG header を含む" $ do+ let tmpFile = "/tmp/hgg-analyze-bridge-test.svg"+ renderModelGraphSVG tmpFile "Test HBM" simpleLM+ contents <- readFile tmpFile+ take 4 contents `shouldBe` "<svg"++ it "renderModelGraphSVGBytes: Text 返却 + 同 spec 同 output" $ do+ let bytes1 = renderModelGraphSVGBytes "T" simpleLM+ bytes2 = renderModelGraphSVGBytes "T" simpleLM+ bytes1 `shouldBe` bytes2 -- 決定論性 (Phase 1 §10.5)+ "<svg" `Data.Text.isPrefixOf` bytes1 `shouldBe` True++ it "hierLM: SVG 出力に plate label が含まれる" $ do+ let bytes = renderModelGraphSVGBytes "Hier LM" hierLM+ "group (N=5)" `Data.Text.isInfixOf` bytes `shouldBe` True+ "record (N=200)" `Data.Text.isInfixOf` bytes `shouldBe` True++ it "node 名が SVG label として出力に含まれる" $ do+ let bytes = renderModelGraphSVGBytes "T" simpleLM+ "alpha" `Data.Text.isInfixOf` bytes `shouldBe` True+ "y" `Data.Text.isInfixOf` bytes `shouldBe` True++ describe "Phase 2 A4 renderModelGraphPNG / PDF (= backend 未実装の stub)" $ do+ it "renderModelGraphPNG: 呼出時に error 投げる (= placeholder の honest 動作)" $+ renderModelGraphPNG "/tmp/x.png" "T" simpleLM+ `shouldThrow` anyErrorCall+ it "renderModelGraphPDF: 同上" $+ renderModelGraphPDF "/tmp/x.pdf" "T" simpleLM+ `shouldThrow` anyErrorCall