hgg-svg (empty) → 0.1.0.0
raw patch · 25 files changed
+3727/−0 lines, 25 filesdep +aesondep +basedep +bytestring
Dependencies added: aeson, base, bytestring, containers, directory, hgg-core, hgg-frame, hgg-svg, hspec, text, vector
Files
- CHANGELOG.md +7/−0
- LICENSE +30/−0
- examples/CustomMarkDemo.hs +69/−0
- examples/DagComparisonDemo.hs +373/−0
- examples/DagParityBench.hs +158/−0
- examples/DfPlotDemo.hs +85/−0
- examples/DocFig/Common.hs +73/−0
- examples/DocFig/Decoration.hs +239/−0
- examples/DocFig/EncodingScale.hs +34/−0
- examples/DocFig/Layers.hs +317/−0
- examples/DocFig/Quickstart.hs +26/−0
- examples/DocFigures.hs +24/−0
- examples/GalleryDemo.hs +1104/−0
- examples/JsonDump.hs +19/−0
- examples/ScatterDemo.hs +214/−0
- examples/Tutorial01Easy.hs +26/−0
- examples/Tutorial02Grammar.hs +32/−0
- examples/Tutorial03Overlay.hs +26/−0
- examples/Tutorial04Distribution.hs +36/−0
- examples/Tutorial05Theme.hs +28/−0
- examples/VegaLiteGallery.hs +191/−0
- hgg-svg.cabal +193/−0
- src/Graphics/Hgg/Backend/SVG.hs +332/−0
- src/Graphics/Hgg/Quick.hs +56/−0
- test/Spec.hs +35/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Changelog for `hgg-svg`++## 0.1.0.0 — 2026-07-18++First public release on Hackage.++- SVG backend (pure Haskell): `saveSVG` / `saveSVGBound` and friends.
+ 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/CustomMarkDemo.hs view
@@ -0,0 +1,69 @@+-- | Phase 51: custom mark (拡張可能な描画語彙) の最小作例。+--+-- core (@MarkKind@ の閉列挙) を **一切触らず**、@customMark id drawFn@ + @encX@/@encY@ で+-- 新しいプロット型 (ここでは簡易 dendrogram) を定義し、 @dendrogram "leaf" "height"@ と+-- 組み込み mark (@scatter x y@) と同じ書き味で使えるようにする。 draw 関数は @"leaf"@/@"height"@+-- 列を @rcResolver@ で読み、 'Primitive' 列を返すだけ。+--+-- @+-- cabal run custom-mark-demo+-- @+-- → カレントディレクトリに @custom-mark-demo.svg@ を生成。+--+-- 詳細な拡張ガイドは @docs/api-guide/10-custom-marks.md@。 canvas parity が欲しい時は同じ id で+-- PS registry (@Graphics.Hgg.Custom.registerMark@) に draw 関数を手登録する。+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Graphics.Hgg.Backend.SVG (saveSVGWith)+import Graphics.Hgg.Easy+import Graphics.Hgg.Primitive (Primitive (..), Point (..),+ TextStyle (..), TextAnchor (..), solid)+import Graphics.Hgg.Spec (RenderCtx (..), ColRef, ColData (..),+ customMark, encX, encY, resolveNum)+import Graphics.Hgg.Unit (px, (*~))+import qualified Data.Vector as V++-- | ① draw: @"leaf"@ (葉の x 位置)・@"height"@ (節の高さ) 列を 'rcResolver' で読み、 併合を+-- 「Π 字」の elbow で描く (簡単のため 4 葉固定トポロジ)。 座標は data 空間で作り 'rcProjectXY'+-- で px 化するので、 軸 scale/coord に自動追従する。+dendroDraw :: RenderCtx -> [Primitive]+dendroDraw ctx =+ let num nm = maybe [] V.toList (resolveNum (rcResolver ctx) nm) -- 列を読む+ p x y = uncurry Point (rcProjectXY ctx x y) -- data→px+ ls = solid (rcColor ctx) 1.5+ -- 子を高さ hy で併合する Π 字 (子の基準高さ by1/by2 から立てる)+ elbow cx1 by1 cx2 by2 hy =+ [ PLine (p cx1 by1) (p cx1 hy) ls+ , PLine (p cx2 by2) (p cx2 hy) ls+ , PLine (p cx1 hy) (p cx2 hy) ls ]+ ts = TextStyle (rcTextColor ctx) 10 "sans-serif" AnchorMiddle 0 "normal" False+ in case (num "leaf", num "height") of+ ([x0, x1, x2, x3], [_, h1, h2]) -> -- leaf=[0,1,2,3], height=[0,1,2]+ let m01 = (x0 + x1) / 2+ m23 = (x2 + x3) / 2+ in concat+ [ elbow x0 0 x1 0 h1 -- 葉0,1 → 高さ h1+ , elbow x2 0 x3 0 h1 -- 葉2,3 → 高さ h1+ , elbow m01 h1 m23 h1 h2 -- (0,1) と (2,3) → 高さ h2 = root+ , [ PText (p x (-0.12)) nm ts+ | (x, nm) <- zip [x0, x1, x2, x3] ["A", "B", "C", "D"] ] ]+ _ -> []++-- | ② 名前付き combinator = 普通の mark 化。 x/y 列を束ねて軸 range を自動化する。+dendrogram :: ColRef -> ColRef -> Layer+dendrogram x y = customMark "dendrogram" dendroDraw <> encX x <> encY y++main :: IO ()+main = do+ -- ③ 使う側 = scatter x y と同じ。 列は resolver (dat) / df |>> で供給。+ let dat "leaf" = Just (NumData (V.fromList [0, 1, 2, 3])) -- 葉の x 位置+ dat "height" = Just (NumData (V.fromList [0, 1, 2])) -- 節の高さ (葉基準0 / 1段 / root)+ dat _ = Nothing+ spec = purePlot+ <> layer (dendrogram "leaf" "height") -- ★ core 無改造・組み込み mark と同じ書き味+ <> title "Custom mark demo (簡易 dendrogram)"+ <> xLabel "leaf" <> yLabel "merge height"+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ saveSVGWith "custom-mark-demo.svg" dat spec+ putStrLn "wrote custom-mark-demo.svg (custom mark = 簡易 dendrogram・core 無改造)"
+ examples/DagComparisonDemo.hs view
@@ -0,0 +1,373 @@+-- | Phase 1 A2-A4 完了レビュー用 比較 demo。+--+-- @+-- cabal run dag-comparison-demo+-- @+-- → design/dag-parity/ に 6 SVG を書き出す。+--+-- * k33-before.svg / k33-after.svg+-- ─ K3,3 風 reverse pattern (= A→Z, B→Y, C→X)。+-- v0.1 は ID alphabetical で 3 crossing、 A3+A4 後は 0 crossing。+-- * hbm-before.svg / hbm-after.svg+-- ─ 中規模 HBM ModelGraph (= 9 node、 latent 群 → tau 群 → y)。+-- v0.1 は alphabetical 等間隔、 A3+A4 後は median 整列 + 親 anchor。+-- * chains-before.svg / chains-after.svg (= A4 効果が明瞭)+-- ─ 2 平行 chain (a1→a2→a3、 b1→b2→b3)。+-- v0.1 は a/b が各 rank 内 alphabetical の左右 (= 直線 vertical)。+-- A4 後も a と b が垂直 chain として保たれる (= 親 anchor が効く)。+-- ─ 加えて cross-link (= a2→b3) を追加して、 A4 の TD+BU median 効果+-- (= 親 + 子の中庸位置) を視覚化する。+--+-- "before" は 'Graphics.Hgg.Spec.LayoutManual' + 手計算 alphabetical 位置で+-- v0.1 layout を再現 (= 旧 code を取り出さず、 既存の Manual layout 経路で simulate)。+-- "after" は通常の 'Graphics.Hgg.DAG.dagPlot' (= LayoutHierarchical default、+-- A2 network simplex + A3 median + transpose + A4 Brandes-Köpfe TD+BU median) を使う。+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Graphics.Hgg.Backend.SVG (saveSVG)+import Graphics.Hgg.Unit (px, (*~))+import qualified Graphics.Hgg.DAG+import Graphics.Hgg.DAG ((~>))+import Graphics.Hgg.Easy+import qualified Graphics.Hgg.Spec as Spec+import Data.Text (Text)++main :: IO ()+main = do+ -- ===========================================================================+ -- K3,3 風 reverse pattern: A→Z, B→Y, C→X+ -- v0.1 (= alphabetical): top [A,B,C] / bottom [X,Y,Z] → 3 crossings+ -- A3 後 (= median heuristic): top [A,B,C] / bottom [Z,Y,X] → 0 crossings+ -- ===========================================================================+ let mkN i lbl x y kind = Spec.dagNode i lbl kind x y+ -- Before: alphabetical 等間隔 (= v0.1 layoutHierarchical 相当)+ k33Before =+ [ mkN "A" "A" 0.0 0.0 NodeLatent+ , mkN "B" "B" 0.5 0.0 NodeLatent+ , mkN "C" "C" 1.0 0.0 NodeLatent+ , mkN "X" "X" 0.0 1.0 NodeObserved+ , mkN "Y" "Y" 0.5 1.0 NodeObserved+ , mkN "Z" "Z" 1.0 1.0 NodeObserved+ ]+ k33Edges =+ [ Spec.dagEdge "A" "Z"+ , Spec.dagEdge "B" "Y"+ , Spec.dagEdge "C" "X"+ ]+ k33BeforeSpec = purePlot+ <> layer (Spec.dagFromLists k33Before k33Edges Spec.LayoutManual+ <> size 22)+ <> title "K3,3 reverse: BEFORE (v0.1 alphabetical, 3 crossings)"+ <> theme ThemeLight+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ k33Graph = ("A" :: Text) ~> "Z"+ <> ("B" :: Text) ~> "Y"+ <> ("C" :: Text) ~> "X"+ k33AfterSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlot k33Graph <> size 22)+ <> title "K3,3 reverse: AFTER (A2+A3, 0 crossings)"+ <> theme ThemeLight+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)++ saveSVG "design/dag-parity/k33-before.svg" k33BeforeSpec+ saveSVG "design/dag-parity/k33-after.svg" k33AfterSpec++ -- ===========================================================================+ -- 中規模 HBM 風: alpha/beta が gamma を経由して y に、 直接 y にも貢献+ -- 接続を意図的に "alphabetical で reorder したくなる" 順にして比較+ -- ===========================================================================+ let hbmBefore =+ [ mkN "alpha" "α" 0.00 0.0 NodeLatent+ , mkN "beta" "β" 0.25 0.0 NodeLatent+ , mkN "gamma" "γ" 0.50 0.0 NodeLatent+ , mkN "delta" "δ" 0.75 0.0 NodeLatent+ , mkN "epsilon" "ε" 1.00 0.0 NodeLatent+ , mkN "tau1" "τ₁" 0.00 0.5 NodeLatent+ , mkN "tau2" "τ₂" 0.50 0.5 NodeLatent+ , mkN "tau3" "τ₃" 1.00 0.5 NodeLatent+ , mkN "y" "y obs" 0.50 1.0 NodeObserved+ ]+ hbmEdges =+ [ Spec.dagEdge "alpha" "tau3" -- ⇒ alphabetical で長距離 cross+ , Spec.dagEdge "beta" "tau1"+ , Spec.dagEdge "gamma" "tau2"+ , Spec.dagEdge "delta" "tau1"+ , Spec.dagEdge "epsilon" "tau3"+ , Spec.dagEdge "tau1" "y"+ , Spec.dagEdge "tau2" "y"+ , Spec.dagEdge "tau3" "y"+ ]+ hbmBeforeSpec = purePlot+ <> layer (Spec.dagFromLists hbmBefore hbmEdges Spec.LayoutManual+ <> size 22)+ <> title "HBM 9-node: BEFORE (v0.1 alphabetical)"+ <> theme ThemeLight+ <> widthUnit (900 *~ px) <> heightUnit (600 *~ px)++ hbmGraph =+ ("alpha" :: Text) ~> "tau3"+ <> ("beta" :: Text) ~> "tau1"+ <> ("gamma" :: Text) ~> "tau2"+ <> ("delta" :: Text) ~> "tau1"+ <> ("epsilon" :: Text) ~> "tau3"+ <> ("tau1" :: Text) ~> "y"+ <> ("tau2" :: Text) ~> "y"+ <> ("tau3" :: Text) ~> "y"+ hbmAfterSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlot hbmGraph <> size 22)+ <> title "HBM 9-node: AFTER (A2 rank + A3 median+transpose)"+ <> theme ThemeLight+ <> widthUnit (900 *~ px) <> heightUnit (600 *~ px)++ saveSVG "design/dag-parity/hbm-before.svg" hbmBeforeSpec+ saveSVG "design/dag-parity/hbm-after.svg" hbmAfterSpec++ -- ===========================================================================+ -- 2 平行 chain + 1 cross-link: A4 効果が一番分かるケース+ -- v0.1: 各 rank 内 alphabetical (a1, b1) / (a2, b2) / (a3, b3) で等間隔 0/1+ -- A4 後: TD+BU median で同 chain が垂直整列、 cross-link は緩やかに引かれる+ -- ===========================================================================+ let chainsBefore =+ [ mkN "a1" "a1" 0.0 0.0 NodeLatent+ , mkN "b1" "b1" 1.0 0.0 NodeLatent+ , mkN "a2" "a2" 0.0 0.5 NodeLatent+ , mkN "b2" "b2" 1.0 0.5 NodeLatent+ , mkN "a3" "a3" 0.0 1.0 NodeObserved+ , mkN "b3" "b3" 1.0 1.0 NodeObserved+ ]+ chainsEdges =+ [ Spec.dagEdge "a1" "a2"+ , Spec.dagEdge "a2" "a3"+ , Spec.dagEdge "b1" "b2"+ , Spec.dagEdge "b2" "b3"+ , Spec.dagEdge "a2" "b3" -- cross-link+ ]+ chainsBeforeSpec = purePlot+ <> layer (Spec.dagFromLists chainsBefore chainsEdges Spec.LayoutManual+ <> size 22)+ <> title "Chains+cross: BEFORE (v0.1, evenly spaced)"+ <> theme ThemeLight+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ chainsGraph =+ ("a1" :: Text) ~> "a2"+ <> ("a2" :: Text) ~> "a3"+ <> ("b1" :: Text) ~> "b2"+ <> ("b2" :: Text) ~> "b3"+ <> ("a2" :: Text) ~> "b3"+ chainsAfterSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlot chainsGraph <> size 22)+ <> title "Chains+cross: AFTER (A2+A3+A4 TD+BU median anchor)"+ <> theme ThemeLight+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)++ saveSVG "design/dag-parity/chains-before.svg" chainsBeforeSpec+ saveSVG "design/dag-parity/chains-after.svg" chainsAfterSpec++ -- ===========================================================================+ -- Long edge (= rank 差 > 1) + spline routing: A5 効果が分かる+ -- a → b → c → d (chain) + a → d (long skip edge、 rank 差 3)+ -- v0.1: a→d は直線で b/c の塊を貫通する+ -- A5 後: a→d は dummy 経由の Catmull-Rom spline で迂回する+ -- ===========================================================================+ let longBefore =+ [ mkN "a" "a" 0.5 0.00 NodeLatent+ , mkN "b" "b" 0.5 0.33 NodeLatent+ , mkN "c" "c" 0.5 0.66 NodeLatent+ , mkN "d" "d" 0.5 1.00 NodeObserved+ ]+ longEdges =+ [ Spec.dagEdge "a" "b"+ , Spec.dagEdge "b" "c"+ , Spec.dagEdge "c" "d"+ , Spec.dagEdge "a" "d" -- long edge (= skip 2 ranks)+ ]+ longBeforeSpec = purePlot+ <> layer (Spec.dagFromLists longBefore longEdges Spec.LayoutManual+ <> size 22)+ <> title "Long skip edge: BEFORE (v0.1, a→d 直線で b/c を貫通)"+ <> theme ThemeLight+ <> widthUnit (600 *~ px) <> heightUnit (500 *~ px)+ longGraph =+ ("a" :: Text) ~> "b"+ <> ("b" :: Text) ~> "c"+ <> ("c" :: Text) ~> "d"+ <> ("a" :: Text) ~> "d" -- long+ longAfterSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlot longGraph <> size 22)+ <> title "Long skip edge: AFTER (A5 dummy + Catmull-Rom で迂回)"+ <> theme ThemeLight+ <> widthUnit (600 *~ px) <> heightUnit (500 *~ px)++ saveSVG "design/dag-parity/long-before.svg" longBeforeSpec+ saveSVG "design/dag-parity/long-after.svg" longAfterSpec++ -- ===========================================================================+ -- A6: plate (= cluster) aware layout+ -- 2 plate (= group A / group B) を持つ HBM 風モデル+ -- v0.1: plate 制約無し → A/B メンバが交互に並ぶことあり、 plate box が node 群を斜めに覆う+ -- A6 後: 同 plate メンバが rank 内で contiguous → plate box が綺麗な矩形+ -- ===========================================================================+ let plateNodes =+ [ mkN "muA" "μ_A" 0.20 0.0 NodeLatent+ , mkN "muB" "μ_B" 0.80 0.0 NodeLatent+ , mkN "a1" "a₁" 0.05 0.5 NodeLatent+ , mkN "b1" "b₁" 0.30 0.5 NodeLatent+ , mkN "a2" "a₂" 0.55 0.5 NodeLatent+ , mkN "b2" "b₂" 0.80 0.5 NodeLatent+ , mkN "y" "y" 0.50 1.0 NodeObserved+ ]+ plateEdges =+ [ Spec.dagEdge "muA" "a1"+ , Spec.dagEdge "muA" "a2"+ , Spec.dagEdge "muB" "b1"+ , Spec.dagEdge "muB" "b2"+ , Spec.dagEdge "a1" "y"+ , Spec.dagEdge "a2" "y"+ , Spec.dagEdge "b1" "y"+ , Spec.dagEdge "b2" "y"+ ]+ plateA = Spec.DAGPlate "plate A (n=2)" ["a1", "a2"]+ plateB = Spec.DAGPlate "plate B (n=2)" ["b1", "b2"]+ plateBeforeSpec = purePlot+ <> layer (Spec.dagFromListsWithPlates plateNodes plateEdges+ Spec.LayoutManual [plateA, plateB]+ <> size 22)+ <> title "Plate-aware: BEFORE (v0.1 a/b 交互配置、 plate box が斜め)"+ <> theme ThemeLight+ <> widthUnit (800 *~ px) <> heightUnit (500 *~ px)+ plateGraph =+ ("muA" :: Text) ~> "a1" <> ("muA" :: Text) ~> "a2"+ <> ("muB" :: Text) ~> "b1" <> ("muB" :: Text) ~> "b2"+ <> ("a1" :: Text) ~> "y" <> ("a2" :: Text) ~> "y"+ <> ("b1" :: Text) ~> "y" <> ("b2" :: Text) ~> "y"+ plateAfterSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlotWithPlates plateGraph [plateA, plateB]+ <> size 22)+ <> title "Plate-aware: AFTER (A6 plate メンバ contiguous、 box 矩形)"+ <> theme ThemeLight+ <> widthUnit (800 *~ px) <> heightUnit (500 *~ px)++ saveSVG "design/dag-parity/plate-before.svg" plateBeforeSpec+ saveSVG "design/dag-parity/plate-after.svg" plateAfterSpec++ -- ===========================================================================+ -- 並列 edge (= a→b を 3 本) の表現比較。 旧実装は完全に重なって 1 本にしか見えなかった。+ -- 新: 各並列 edge を perpendicular にずらした 3 点 spline 化、 dot 同等の「並ぶ曲線」 に。+ -- ===========================================================================+ let parGraph = (("a" :: Text) ~> "b")+ <> (("a" :: Text) ~> "b")+ <> (("a" :: Text) ~> "b")+ <> (("b" :: Text) ~> "c")+ <> (("b" :: Text) ~> "c")+ parAfterSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlot parGraph <> size 22)+ <> title "Parallel edges: AFTER (= perpendicular bend、 3 本 / 2 本)"+ <> theme ThemeLight+ <> widthUnit (500 *~ px) <> heightUnit (500 *~ px)+ saveSVG "design/dag-parity/parallel-after.svg" parAfterSpec++ -- ===========================================================================+ -- Phase 39 A2-8a: plate 跨ぎ skip edge。+ -- mu→{t1,t2}→y, s→y, plate[t1,t2]、 さらに mu→y (= plate の rank を跨ぐ skip)。+ -- 期待: mu→y は plate 箱を貫通せず、 箱の縦全域を外側で迂回する (graphviz cluster と同様)。+ -- ===========================================================================+ let pcPlate = Spec.DAGPlate "plate (n=2)" ["t1", "t2"]+ pcGraph =+ ("mu" :: Text) ~> "t1" <> ("mu" :: Text) ~> "t2"+ <> ("t1" :: Text) ~> "y" <> ("t2" :: Text) ~> "y"+ <> ("s" :: Text) ~> "y"+ <> ("mu" :: Text) ~> "y" -- plate 跨ぎ skip edge+ pcAfterSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlotWithPlates pcGraph [pcPlate]+ <> size 22)+ <> title "Plate-crossing skip: mu->y は plate 箱を外迂回すべき"+ <> theme ThemeLight+ <> widthUnit (700 *~ px) <> heightUnit (520 *~ px)+ saveSVG "design/dag-parity/plate-cross-after.svg" pcAfterSpec++ -- ===========================================================================+ -- 難ケース: plate box が src→snk skip の **直線経路上**に来る配置。+ -- src が plate 中央上、 snk が plate 中央下にあり、 src→snk を真っ直ぐ引くと+ -- box を貫通する。 box を避けて迂回できるか (= obstacle routing の本検証) を見る。+ -- 期待: src→snk は plate {p0,p1} を貫通せず外を迂回する。+ -- ===========================================================================+ let ptPlate = Spec.DAGPlate "plate (n=2)" ["p0", "p1"]+ ptGraph =+ ("src" :: Text) ~> "p0" <> ("src" :: Text) ~> "p1"+ <> ("p0" :: Text) ~> "snk" <> ("p1" :: Text) ~> "snk"+ <> ("src" :: Text) ~> "snk" -- box 直下を跨ぐ skip+ ptAfterSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlotWithPlates ptGraph [ptPlate]+ <> size 22)+ <> title "Plate-through skip: src->snk は box を貫通せず迂回すべき"+ <> theme ThemeLight+ <> widthUnit (640 *~ px) <> heightUnit (520 *~ px)+ saveSVG "design/dag-parity/plate-through-after.svg" ptAfterSpec++ -- ===========================================================================+ -- A4 検証用: nested plate (= 外側 plate の中に兄弟 inner plate 2 つ)。+ -- mu → {gA,gB}、 gA → {xa1,xa2}、 gB → {xb1,xb2}、 全 x → y。+ -- 外側 plate "model" が gA,gB,xa* ,xb* を、 inner "A"/"B" が各 xa*/xb* を囲む。+ -- 期待 (graphviz contain/separate_subclust): 外箱が内箱を完全内包し、 兄弟+ -- inner A/B が x 方向で重ならない。 現状 (A4 前) の重なりを実測する。+ -- ===========================================================================+ let nestGraph =+ ("mu" :: Text) ~> "gA" <> ("mu" :: Text) ~> "gB"+ <> ("gA" :: Text) ~> "xa1" <> ("gA" :: Text) ~> "xa2"+ <> ("gB" :: Text) ~> "xb1" <> ("gB" :: Text) ~> "xb2"+ <> ("xa1" :: Text) ~> "y" <> ("xa2" :: Text) ~> "y"+ <> ("xb1" :: Text) ~> "y" <> ("xb2" :: Text) ~> "y"+ nestOuter = Spec.DAGPlate "model" ["gA", "gB", "xa1", "xa2", "xb1", "xb2"]+ nestA = Spec.DAGPlate "A (n=2)" ["xa1", "xa2"]+ nestB = Spec.DAGPlate "B (n=2)" ["xb1", "xb2"]+ nestAfterSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlotWithPlates nestGraph+ [nestOuter, nestA, nestB] <> size 22)+ <> title "Nested plate: 外箱が内箱を内包・兄弟 A/B は非重複であるべき"+ <> theme ThemeLight+ <> widthUnit (760 *~ px) <> heightUnit (560 *~ px)+ saveSVG "design/dag-parity/nested-after.svg" nestAfterSpec++ -- ===========================================================================+ -- A4 stress 1: 3 レベル深い nest (outer ⊃ mid ⊃ inner)。 margin 累積を実測。+ -- 期待: 各境界が 1 段ぶん margin で離れる (= graphviz は各 level に CL_OFFSET)。+ -- ===========================================================================+ let deepGraph =+ ("a" :: Text) ~> "b" <> ("b" :: Text) ~> "c" <> ("c" :: Text) ~> "d"+ deepOuter = Spec.DAGPlate "L1" ["b", "c", "d"]+ deepMid = Spec.DAGPlate "L2" ["c", "d"]+ deepInner = Spec.DAGPlate "L3" ["d"]+ deepSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlotWithPlates deepGraph+ [deepOuter, deepMid, deepInner] <> size 22)+ <> title "Deep nest (L1 superset of L2 superset of L3): margin 累積"+ <> theme ThemeLight+ <> widthUnit (560 *~ px) <> heightUnit (640 *~ px)+ saveSVG "design/dag-parity/nested-deep-after.svg" deepSpec++ -- ===========================================================================+ -- A4 stress 2: 同 rank に 3 兄弟 inner plate。 兄弟分離 (= A1 keepout で+ -- 兄弟 member は互いに非member ゆえ排除される) を実測。 box 重なりが無いこと。+ -- ===========================================================================+ let triGraph =+ ("m" :: Text) ~> "p" <> ("m" :: Text) ~> "q" <> ("m" :: Text) ~> "r"+ <> ("p" :: Text) ~> "z" <> ("q" :: Text) ~> "z" <> ("r" :: Text) ~> "z"+ triOuter = Spec.DAGPlate "all" ["p", "q", "r"]+ triP = Spec.DAGPlate "P" ["p"]+ triQ = Spec.DAGPlate "Q" ["q"]+ triR = Spec.DAGPlate "R" ["r"]+ triSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlotWithPlates triGraph+ [triOuter, triP, triQ, triR] <> size 22)+ <> title "3 兄弟 inner plate: box 重なり無しであるべき"+ <> theme ThemeLight+ <> widthUnit (720 *~ px) <> heightUnit (520 *~ px)+ saveSVG "design/dag-parity/nested-tri-after.svg" triSpec++ putStrLn "Wrote 15 SVGs to design/dag-parity/"+ putStrLn " k33-before.svg / k33-after.svg (= reverse pattern、 3 crossings -> 0)"+ putStrLn " hbm-before.svg / hbm-after.svg (= 9-node HBM、 alphabetical -> median+anchor)"+ putStrLn " chains-before.svg / chains-after.svg (= A4 TD+BU 親 anchor が見える)"+ putStrLn " long-before.svg / long-after.svg (= A5 dummy 経由 spline で長 edge 迂回)"+ putStrLn " plate-before.svg / plate-after.svg (= A6 plate メンバ contiguous で box 矩形)"
+ examples/DagParityBench.hs view
@@ -0,0 +1,158 @@+-- | Phase 1 A9 — graphviz CLI との parity check 用 bench。+--+-- @+-- cabal run dag-parity-bench+-- @+-- → design/dag-parity/parity/{small,medium,large}/ に+-- hgg.svg + input.dot + crossings.txt を出力。+--+-- 後段 'scripts/dag-parity-check.sh' が dot CLI で input.dot を SVG 化 (= graphviz.svg)、+-- side-by-side HTML を生成する。 dot が無ければ hgg 出力のみ。+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Graphics.Hgg.Backend.SVG (saveSVG)+import qualified Graphics.Hgg.DAG+import Graphics.Hgg.DAG ((~>))+import Graphics.Hgg.DAG.Internal.Sugiyama+ (assignOrderFull, assignRanks,+ buildLayoutGraph, countCrossings)+import Graphics.Hgg.Easy+import qualified Graphics.Hgg.Spec as Spec+import Graphics.Hgg.Unit (px, (*~))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import System.Directory (createDirectoryIfMissing)++main :: IO ()+main = do+ -- canvas サイズは dot の見た目に合わせる: 各 case の rank 数 (= 縦) と+ -- rank あたり最大幅 (= 横) を見て、 dot 既定の出力 aspect に近づける。+ -- small (rank 5 程度、 幅 3-4): 400x500 (= 縦長気味)+ -- medium (rank ~30、 幅 1-2): 400x1400 (= かなり縦長、 dot chain と同形)+ -- large (rank ~12、 幅 5): 800x1100 (= dot の portrait に近い)+ mapM_ runCase+ [ ("small", buildSmall, "N=10、 単純な階層 HBM 様",+ 400, 500)+ , ("medium", buildMedium, "N=30、 chain + skip edges",+ 400, 1400)+ , ("large", buildLarge, "N=60、 5 chain 並列 + cross + long",+ 800, 1500)+ , ("isolated", buildIsolated,+ "孤立 4 node + chain 6 = 10、 孤立が上部に横並びになるか確認",+ 600, 400)+ ]+ putStrLn ""+ putStrLn "Done. 次に scripts/dag-parity-check.sh を実行して dot 比較 + HTML 生成。"++-- ===========================================================================+-- Test case 1: small (N=10)+-- ===========================================================================++buildSmall :: ([Text], [(Text, Text)])+buildSmall =+ let ns = [ "a", "b", "c", "d", "e", "f", "g", "h", "i", "j" ]+ es = [ ("a", "c"), ("b", "c"), ("c", "d"), ("c", "e")+ , ("d", "f"), ("e", "f"), ("d", "g"), ("e", "h")+ , ("f", "i"), ("g", "j"), ("h", "j"), ("i", "j")+ , ("a", "j") -- long skip edge+ ]+ in (ns, es)++buildMedium :: ([Text], [(Text, Text)])+buildMedium =+ let ns = [ T.pack ("n" <> show k) | k <- [0 .. 29 :: Int] ]+ -- chain n0 → n1 → n2 → ... → n29+ chain = [ (ns !! k, ns !! (k + 1)) | k <- [0 .. 28] ]+ -- 横方向 skip edges+ skips = [ (ns !! 0, ns !! 5), (ns !! 3, ns !! 10)+ , (ns !! 7, ns !! 15), (ns !! 12, ns !! 22)+ , (ns !! 18, ns !! 28)+ ]+ in (ns, chain <> skips)++-- | 孤立 node が含まれるケース。 isoX (= 4 個) は edge を持たず、 chain a-f (= 5 edge)+-- とは独立。 dot は孤立 4 個を上部に横並びで配置し、 hgg も同じ挙動 (= 'mkGraph'+-- が nodeIds 全てを 'vertex' で先に登録するため) を取る。+buildIsolated :: ([Text], [(Text, Text)])+buildIsolated =+ let ns = [ "a", "b", "c", "d", "e", "f"+ , "iso1", "iso2", "iso3", "iso4" ]+ es = [ ("a","b"), ("b","c"), ("c","d"), ("d","e"), ("e","f") ]+ in (ns, es)++buildLarge :: ([Text], [(Text, Text)])+buildLarge =+ let ns = [ T.pack ("v" <> show k) | k <- [0 .. 59 :: Int] ]+ -- 5 disjoint chain × 12 node = 60 node、 全 node が edge を持つ。+ -- chain c は node [12c .. 12c+11] を使う (= 旧実装の indexing 重複 bug を修正、+ -- 孤立 22 node が rank 0 に山積みになるのを防ぐ)。+ chains = [ (ns !! (12 * c + k), ns !! (12 * c + k + 1))+ | c <- [0 .. 4], k <- [0 .. 10] ]+ -- 同 rank 間の cross-link (= chain c の rank k → chain c+1 の rank k)+ cross = [ (ns !! (12 * c + k), ns !! (12 * (c + 1) + k))+ | c <- [0 .. 3], k <- [0, 4, 8] ]+ -- chain 内の長 skip edge+ longs = [ (ns !! 0, ns !! 11), (ns !! 12, ns !! 22)+ , (ns !! 24, ns !! 35) ]+ in (ns, chains <> cross <> longs)++-- ===========================================================================+-- Case runner+-- ===========================================================================++runCase :: (FilePath, ([Text], [(Text, Text)]), String, Double, Double) -> IO ()+runCase (name, (nodeIds, edges), desc, w, h) = do+ let dir = "design/dag-parity/parity/" <> name+ createDirectoryIfMissing True dir++ -- hgg SVG 生成 (canvas は case ごとに調整、 dot の auto sizing に合わせる)+ let g = mkGraph nodeIds edges+ spec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlot g <> size 11)+ <> title (T.pack (name <> " (" <> desc <> ")"))+ <> theme ThemeLight+ <> widthUnit (w *~ px) <> heightUnit (h *~ px)+ saveSVG (dir <> "/hgg.svg") spec++ -- DOT 出力 (= graphviz CLI 用入力)+ TIO.writeFile (dir <> "/input.dot") (toDot name nodeIds edges)++ -- hgg 内部の crossings 数を計測 (= LayoutGraph 経由)+ let lg0 = assignRanks (buildLayoutGraph nodeIds edges)+ (lg1, om, _) = assignOrderFull lg0+ crossings = countCrossings lg1 om+ writeFile (dir <> "/crossings.txt")+ ("hgg crossings: " <> show crossings <> "\n"+ <> "N nodes: " <> show (length nodeIds) <> "\n"+ <> "N edges: " <> show (length edges) <> "\n")++ putStrLn $ " " <> name <> ": " <> show (length nodeIds)+ <> " nodes, " <> show (length edges) <> " edges, "+ <> "hgg crossings = " <> show crossings++-- ===========================================================================+-- Helpers+-- ===========================================================================++-- | Text 列 + edge 列を Graph に。+-- 全 nodeIds を 'vertex' で先に登録してから edge を overlay する。 これで edge に+-- 含まれない孤立 node も Graph に残り、 dot の DOT (= 全 node 宣言) と挙動が揃う。+mkGraph :: [Text] -> [(Text, Text)] -> Graphics.Hgg.DAG.Graph Text+mkGraph nodeIds edges =+ let vs = foldr (\v acc -> acc <> Graphics.Hgg.DAG.vertex v) mempty nodeIds+ es = foldr (\(f, t) acc -> acc <> (f ~> t)) mempty edges+ in vs <> es++-- | DOT 文字列を生成。 graphviz CLI の `dot -Tsvg input.dot` で SVG 化可。+toDot :: String -> [Text] -> [(Text, Text)] -> Text+toDot name ns es = T.unlines $+ [ T.pack ("digraph " <> name <> " {")+ , " rankdir=TB;"+ , " node [shape=ellipse, fontsize=10];"+ ] <> [ " " <> sanitize n <> ";" | n <- ns ]+ <> [ " " <> sanitize f <> " -> " <> sanitize t <> ";" | (f, t) <- es ]+ <> [ "}" ]+ where+ sanitize = T.replace "-" "_"
+ examples/DfPlotDemo.hs view
@@ -0,0 +1,85 @@+-- | api-guide 05-dataframe (DataFrame 連携) 用の図生成デモ。+-- ゼロ依存の Map ベース df を @(|>>)@ でバインドし、 列名だけで図を書く。+--+-- @cabal run df-plot-demo@ → @design/df-plot/*.svg@ を生成。+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Graphics.Hgg.Backend.SVG (saveSVGBound)+import Graphics.Hgg.Easy+import Graphics.Hgg.Frame ((|>>), BoundPlot, bpDiagnostics)+import Data.Text (Text)+import qualified Data.Map.Strict as M+import qualified Data.Vector as V+import System.Directory (createDirectoryIfMissing)++-- df の列値は ColData (NumData/TxtData)。 数値列・文字列列のヘルパ。+num :: [Double] -> ColData+num = NumData . V.fromList++txt :: [Text] -> ColData+txt = TxtData . V.fromList++out :: FilePath -> BoundPlot -> IO ()+out name = saveSVGBound ("design/df-plot/" <> name <> ".svg")++main :: IO ()+main = do+ createDirectoryIfMissing True "design/df-plot"++ -- 1 枚の df を用意 (Map Text ColData。 列名で参照する)+ let df = M.fromList+ [ ("x", num [1,2,3,4,5,6,7,8,9,10])+ , ("y", num [2.1,3.9,6.0,7.7,10.2,11.8,14.1,15.9,18.2,20.0])+ , ("size", num [2,8,3,9,4,7,5,6,3,8])+ , ("group", txt (take 10 (cycle ["A","B"]))) ] :: M.Map Text ColData++ -- (a) 散布図 + group で色分け + size で大きさ (全部「列名」で指定)+ out "01-scatter-color-size" $+ df |>> ( layer (scatter "x" "y" <> colorBy "group" <> sizeBy "size" <> alpha 0.85)+ <> title "df |>> scatter (color/size を列名で)" )++ -- (b) 重畳: 散布図 + 折れ線 (同じ df の別列を別 layer に)+ out "02-overlay" $+ df |>> ( layer (scatter "x" "y" <> size 6)+ <> layer (line "x" "y" <> color (fromHex "#d62728") <> stroke 1)+ <> title "df |>> (scatter <> line)" )++ -- (c) facet: group 列で小分け+ out "03-facet" $+ df |>> ( layer (scatter "x" "y" <> colorBy "group" <> size 6)+ <> facet "group"+ <> title "df |>> scatter <> facet \"group\"" )++ -- (d) 棒グラフ: カテゴリ列 + 群 + position (dodge)+ let dfB = M.fromList+ [ ("cat", txt (concatMap (replicate 3) ["A","B","C"]))+ , ("grp", txt (take 9 (cycle ["x","y","z"])))+ , ("val", num [3,5,2, 4,1,6, 2,3,4]) ] :: M.Map Text ColData+ out "04-bar-dodge" $+ dfB |>> ( layer (bar "cat" "val" <> colorBy "grp" <> position PosDodge)+ <> title "df |>> bar <> color <> position PosDodge" )++ -- (e) Phase 26 A2: vector field (quiver)。 格子点 (x,y) に渦巻き風の場 (u,v) の矢印。+ let gridPts = [ (gx, gy) | gx <- [-3,-2..3], gy <- [-3,-2..3::Double] ]+ uOf x y = -y/3 - x/6 -- 回転 + 内向き+ vOf x y = x/3 - y/6+ dfQ = M.fromList+ [ ("x", num [ x | (x,_) <- gridPts ])+ , ("y", num [ y | (_,y) <- gridPts ])+ , ("u", num [ uOf x y | (x,y) <- gridPts ])+ , ("v", num [ vOf x y | (x,y) <- gridPts ]) ] :: M.Map Text ColData+ out "05-quiver" $+ dfQ |>> ( layer (quiver "x" "y" "u" "v" <> color (fromHex "#1f77b4"))+ <> title "df |>> quiver \"x\" \"y\" \"u\" \"v\" (vector field)" )++ -- (f) Phase 26 A2: 同じ場を magnitude で連続色マップ (arrowColorByMagnitude)。+ out "06-quiver-magnitude" $+ dfQ |>> ( layer (quiver "x" "y" "u" "v" <> arrowColorByMagnitude <> arrowScale 1.2)+ <> title "df |>> quiver <> arrowColorByMagnitude (|u,v| -> viridis)" )++ -- バインド時の列名検証 (純関数・例外なし。 診断は値として載る)+ let bad = df |>> layer (scatter "x" "wieght") -- typo+ putStrLn ("診断 (typo 列): " <> show (bpDiagnostics bad))++ putStrLn "wrote design/df-plot/*.svg (6 examples)"
+ examples/DocFig/Common.hs view
@@ -0,0 +1,73 @@+-- | api-guide 図ジェネレータの共通基盤 (P3.1 = api-guide 再構成)。+-- ページ別モジュール (DocFig.Quickstart / DocFig.Layers / DocFig.Decoration) が+-- 'Figure' のリストを公開し、 Main がまとめて 'renderFigure' する。各 'Figure' の+-- ファイル名は静的リテラルなので、 orphan ゲート (md 参照 ↔ emit 突合) が build 無しで+-- emit 名を列挙できる。+{-# LANGUAGE OverloadedStrings #-}+module DocFig.Common+ ( Figure (..)+ , outDir+ , fig, figW, figR+ , renderFigure+ , linFit, lcg+ , module Graphics.Hgg.Easy+ ) where++import Graphics.Hgg.Easy+import Graphics.Hgg.Unit (px, (*~))+import Graphics.Hgg.Backend.SVG (saveSVG, saveSVGWith)++-- | 出力先 (repo root から)。+outDir :: FilePath+outDir = "docs/api-guide/images/"++-- ===================================================================+-- 図の宣言++-- | 1 枚の図 = 出力ファイル名 + (任意) 'Resolver' + 最終 spec (サイズ適用済)。+data Figure = Figure+ { figFile :: FilePath+ , figResolver :: Maybe Resolver+ , figSpec :: VisualSpec+ }++-- | 既定サイズ (640×420 px) を付けた図。+fig :: FilePath -> VisualSpec -> Figure+fig name spec = Figure name Nothing+ (spec <> widthUnit (640 *~ px) <> heightUnit (420 *~ px))++-- | サイズ明示の図 (subplots / gallery 等で横長・大判)。+figW :: FilePath -> Int -> Int -> VisualSpec -> Figure+figW name w h spec = Figure name Nothing+ (spec <> widthUnit (fromIntegral w *~ px) <> heightUnit (fromIntegral h *~ px))++-- | 列名 ('ColByName') の解決に 'Resolver' が要る図用 (facet 等)。既定サイズ。+figR :: FilePath -> Resolver -> VisualSpec -> Figure+figR name r spec = Figure name (Just r)+ (spec <> widthUnit (640 *~ px) <> heightUnit (420 *~ px))++renderFigure :: Figure -> IO ()+renderFigure (Figure name Nothing spec) = saveSVG (outDir ++ name) spec+renderFigure (Figure name (Just r) spec) = saveSVGWith (outDir ++ name) r spec++-- ===================================================================+-- 図を安定させる小道具++-- | 最小二乗 (傾き, 切片)。+linFit :: [Double] -> [Double] -> (Double, Double)+linFit xs ys =+ let m = fromIntegral (length xs)+ sx = sum xs; sy = sum ys+ sxx = sum (map (^ (2 :: Int)) xs)+ sxy = sum (zipWith (*) xs ys)+ a = (m * sxy - sx * sy) / (m * sxx - sx * sx)+ b = (sy - a * sx) / m+ in (a, b)++-- | 0..1 の決定的擬似乱数列 (線形合同法、 図を安定させる)。+lcg :: Int -> [Double]+lcg seed =+ let next s = (1103515245 * s + 12345) `mod` 2147483648+ go s = let s' = next s+ in fromIntegral s' / 2147483648 : go s'+ in go seed
+ examples/DocFig/Decoration.hs view
@@ -0,0 +1,239 @@+-- | 03-decoration.md の図 (ラベル / scale / theme / facet / subplot / 座標 /+-- 参照線 / 注釈 / 重畳)。+{-# LANGUAGE OverloadedStrings #-}+module DocFig.Decoration (figures) where++import Data.Text (Text)+import qualified Data.Vector as V+import DocFig.Common++figures :: [Figure]+figures =+ -- Lesson 4: 重畳 (scatter + 回帰直線 overlay)+ [ fig "lesson4-overlay.svg" $+ purePlot+ <> layer (scatter (inline oxs) (inline oys) <> alpha 0.85 <> size 6)+ <> layer (line (inline oxs) (inline ofit) <> color (fromHex "#dc2626") <> stroke 2)+ <> title "Lesson 4: 重畳 (散布 + 回帰直線)" <> xLabel "x" <> yLabel "y"++ -- 3c タイトル・ラベル: labs を一括+ , fig "s3c-labs.svg" $+ purePlot+ <> layer (scatter xs ys <> size 6)+ <> labs (emptyLabs+ { labsTitle = Just "3c. title"+ , labsSubtitle = Just "subtitle (副題)"+ , labsCaption = Just "caption (脚注)"+ , labsX = Just "x 軸", labsY = Just "y 軸" })++ -- 3d scale: 連続色 gradient (scaleColorGradient2)+ , fig "s3d-scale.svg" $+ purePlot+ <> layer (scatter xs ys <> colorContinuousBy cz <> size 9)+ <> scaleColorGradient2 "#2166AC" "#F7F7F7" "#B2182B" 3.0+ <> legend+ <> title "3d. scaleColorGradient2 (連続色)"++ -- 3e theme: ThemeDark+ , fig "s3e-theme.svg" $+ purePlot+ <> layer (scatter xs ys <> color (fromHex "#38bdf8") <> size 6)+ <> theme ThemeDark+ <> title "3e. theme ThemeDark"++ -- 3e theme gallery: 代表テーマ全 13 種を 1 枚に+ , figW "s3e-theme-gallery.svg" 1280 1040 $+ subplots (map themePanel allThemes) <> subplotCols 4+ <> title "theme 一覧 (代表テーマ 13 種)"++ -- 3e theme × subplots: 外側に theme を足すと全 panel に効く+ , figW "s3e-theme-subplots.svg" 960 400 $+ subplots [ layer (scatter xs ys <> color (fromHex "#38bdf8") <> size 5) <> title "散布"+ , layer (bar cats vals) <> title "棒" ]+ <> subplotCols 2 <> theme ThemeDark+ <> title "subplots <> theme ThemeDark (外側 theme が全 panel に伝播)"++ -- 3f facet: facetWrap で群ごとに小分け (facet 列は名前解決が要るため Resolver 版)+ , figR "s3f-facet.svg" rFacet $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "g" <> size 6)+ <> facetWrap "g" 2+ <> title "3f. facetWrap"++ -- 3f-2 subplot: 独立図の並置 (subplots) ─ geom も軸も別でよい+ , fig "s3f2-subplot.svg" $+ subplots [ layer (scatter (inline [1,2,3,4,5]) (inline [2,4,3,5,4])) <> title "散布"+ , layer (line (inline [1,2,3,4,5]) (inline [1,3,2,4,3])) <> title "折れ線"+ , layer (bar cats vals) <> title "棒" ]+ <> subplotCols 3+ <> title "3f-2. subplots ─ 独立図の並置"++ -- 3f-2 selectPanels (Phase 18 A1): repeatFields で量産した panel から名前で選択+ , fig "s3f2-select-panels.svg" $+ repeatFields ["a", "b", "c", "d"] selPanelOf+ <> selectPanels ["c", "a"]+ <> subplotCols 2+ <> title "3f-2. selectPanels ─ panel の名前選択 (c, a の順)"++ -- 3d discrete limits (Phase 18 A2): forest の行を選択 + 列挙順に並べ替え+ , fig "s3d-discrete-limits.svg" $+ layer (forest (inlineCat (["b0", "b1", "b2", "b3", "sigma"] :: [Text]))+ (inline [1.0, 2.0, 0.1, -0.45, 0.3])+ (inline [0.2, 0.4, 0.3, 0.1, 0.05])+ <> forestNull 0)+ <> scaleYDiscreteLimits ["b1", "b0", "sigma"]+ <> title "3d. scaleYDiscreteLimits ─ forest の行選択 + 並べ替え"++ -- 3f-2 nested: 入れ子 subplots (B1) ─ 主図 + 周辺分布を入れ子グリッドで+ , fig "s3f2-nested.svg" $+ subplots [ layer (scatter nx ny) <> title "主図 (x vs y)"+ , subplots [ layer (histogram nx) <> title "x 分布"+ , layer (histogram ny) <> title "y 分布" ]+ <> subplotCols 1 <> title "周辺分布 (入れ子)" ]+ <> subplotCols 2+ <> title "3f-2. nested subplots ─ 主図 + 入れ子グリッド"++ -- 3f-2 concat: 演算子 <-> / <:> での非対称合成 ─ (a <-> b <-> c) <:> d+ , fig "concat.svg" $+ ((cA <-> cB <-> cC) <:> cD)+ <> title "3f-2. (a <-> b <-> c) <:> d (横3列 + 全幅)"++ -- 3g coord: coordFlip で横棒+ , fig "s3g-coord.svg" $+ purePlot <> layer (bar cats vals)+ <> coordFlip+ <> title "3g. coordFlip (横棒)" <> xLabel "群" <> yLabel "値"++ -- 3h 補助: 参照線 + 凡例+ , fig "s3h-guides.svg" $+ purePlot+ <> layer (scatter xs ys <> colorBy gs <> size 6)+ <> refHorizontal 2.5+ <> refVertical 2.5+ <> legend+ <> title "3h. refHorizontal / refVertical + legend"++ -- 03 scale: 既製パレット okabeIto+ , fig "s3d-palette-okabe.svg" $+ purePlot <> layer (scatter xs ys <> colorBy gs <> size 7) <> palette okabeIto <> legend+ <> title "palette okabeIto (色覚多様性対応)"++ -- 03 theme: 要素単位の部分上書き+ , fig "s3e-theme-override.svg" $+ purePlot <> layer (scatter xs ys <> size 6)+ <> theme ThemeMinimal+ <> titleFont (fontSize 18 <> fontWeight "bold")+ <> tickFont (fontSize 10 <> fontColor "#64748b")+ <> panelBorder True <> themeGrid False <> themeAxisTextAngle 45+ <> title "theme 要素の部分上書き"++ -- 03 theme × facet strip+ , figR "s3e-theme-strip.svg" rFacet $+ purePlot <> layer (scatter "x" "y" <> colorBy "g") <> facet "g"+ <> themeStrip True <> stripFill "#eef2ff"+ <> title "facet strip 背景 (stripFill)"++ -- 03 guides: 軸の細かい制御 (log + 範囲 + 回転)+ , fig "s3h-axis.svg" $+ purePlot <> layer (scatter axx axy <> size 6)+ <> xAxis (logAxis <> axisRange 1 1000 <> axisRotate 45)+ <> yAxis (axisRange 0 100)+ <> title "xAxis (logAxis <> axisRange <> axisRotate)"++ -- 03 guides: 第 2 軸 (右 y)+ , figR "s3h-second-axis.svg" rSec $+ purePlot+ <> layer (line "t" "price" <> color (fromHex "#1f77b4") <> stroke 2)+ <> layer (line "t" "volume" <> toRightY <> color (fromHex "#d62728") <> stroke 2)+ <> yAxisRight (axisRange 0 1000000)+ <> title "第 2 軸 (price=左 / volume=右)"++ -- 03 guides: 注釈+ , fig "s3h-annotate.svg" $+ purePlot <> layer (scatter xs ys <> size 6)+ <> annotText 2.0 3.6 "注釈"+ <> annotArrow 1.4 3.0 1.95 3.5+ <> annotRect 3.0 1.0 4.0 2.0 "領域"+ <> marginalX+ <> insetAt 0.72 0.1 0.25 0.25 (layer (histogram xs))+ <> title "annotText / annotArrow / annotRect / marginalX / insetAt"++ -- 高度な図: 多数の設定を一枚に+ , fig "advanced.svg" $+ purePlot+ <> layer ( scatter (inline axs) (inline ays)+ <> colorContinuousBy (inline azs)+ <> sizeBy (inline asz)+ <> alpha 0.85 )+ <> layer ( line (inline axs) (inline afit)+ <> color (fromHex "#ef4444") <> stroke 2 )+ <> scaleSize 4 16+ <> refHorizontal 1.0+ <> theme ThemeMinimal+ <> legend+ <> labs (emptyLabs+ { labsTitle = Just "高度な図: 連続色 + サイズ + 回帰 + 参照線"+ , labsSubtitle = Just "colorContinuousBy / sizeBy / line overlay / refHorizontal / theme"+ , labsCaption = Just "hgg ─ <> で設定を積層"+ , labsX = Just "x"+ , labsY = Just "y" })+ ]+ where+ xs = inline [1,2,3,4, 1,2,3,4]+ ys = inline [2,3,1,4, 3,1,4,2]+ gs = inlineCat (concatMap (replicate 4) (["alpha","beta"] :: [Text]))+ cats = inlineCat (["A","B","C"] :: [Text])+ vals = inline [3.0, 7.0, 5.0]+ cz = inline [1.0, 2.5, 4.0, 1.5, 3.0, 4.5, 2.0, 3.5]++ oxs = [1,2,3,4,5,6,7,8,9,10] :: [Double]+ oys = [1.2, 1.9, 3.4, 3.1, 5.2, 5.0, 6.8, 7.3, 8.1, 9.4]+ (oa, ob) = linFit oxs oys+ ofit = [ oa * x + ob | x <- oxs ]++ themePanel (nm, th) =+ layer (scatter xs ys <> color (fromHex "#3b82f6") <> size 5) <> theme th <> title nm+ allThemes :: [(Text, ThemeName)]+ allThemes =+ [ ("Default", ThemeDefault), ("Minimal", ThemeMinimal), ("Dark", ThemeDark)+ , ("Light", ThemeLight), ("Grey", ThemeGrey), ("BW", ThemeBW)+ , ("Classic", ThemeClassic), ("Void", ThemeVoid), ("Linedraw", ThemeLinedraw)+ , ("Noir", ThemeNoir), ("Lumen", ThemeLumen)+ , ("Parchment", ThemeParchment), ("ParchmentDark", ThemeParchmentDark) ]++ selPanelOf f = layer (scatter (inline [1,2,3,4,5 :: Double])+ (inline [2,4,3,5,4 :: Double]))+ <> title f++ nx = inline [ sin (0.5 * fromIntegral i) + 0.15 * fromIntegral (i `mod` 7)+ | i <- [0 .. 60 :: Int] ]+ ny = inline [ cos (0.4 * fromIntegral i) | i <- [0 .. 60 :: Int] ]++ cA = layer (scatter (inline [1,2,3,4,5]) (inline [1,4,9,16,25])) <> title "x²"+ cB = layer (line (inline [1,2,3,4,5]) (inline [2,4,8,16,32])) <> title "2^x"+ cC = layer (bar (inlineCat (["a","b","c","d"] :: [Text])) (inline [3,7,5,9])) <> title "bar"+ cD = layer (scatter (inline [0,1,2,3,4]) (inline [0,3,1,4,2])) <> title "full-width row"++ axx = inline ([1,3,10,30,100,300,1000] :: [Double])+ axy = inline ([3,7,12,20,33,52,78] :: [Double])++ n = 60 :: Int+ axs = [ fromIntegral i * 0.18 | i <- [0 .. n - 1] ] :: [Double]+ noise = take n (lcg 12345)+ ays = [ 0.55 * x + 1.0 + (e - 0.5) * 2.2 | (x, e) <- zip axs noise ]+ azs = ays -- 連続色は y 値で+ asz = [ 0.5 + e | e <- noise ] -- サイズは別の擬似量+ (fa, fb) = linFit axs ays+ afit = [ fa * x + fb | x <- axs ]++ rFacet :: Resolver+ rFacet "x" = Just (NumData (V.fromList [1,2,3,4, 1,2,3,4]))+ rFacet "y" = Just (NumData (V.fromList [2,3,1,4, 3,1,4,2]))+ rFacet "g" = Just (TxtData (V.fromList (concatMap (replicate 4) ["A","B"])))+ rFacet _ = Nothing++ rSec :: Resolver+ rSec "t" = Just (NumData (V.fromList [1,2,3,4,5,6,7,8,9,10]))+ rSec "price" = Just (NumData (V.fromList [10,11,13,12,15,16,15,18,17,20]))+ rSec "volume" = Just (NumData (V.fromList [3e5,5e5,4e5,7e5,6e5,9e5,8e5,7e5,9e5,1e6]))+ rSec _ = Nothing
+ examples/DocFig/EncodingScale.hs view
@@ -0,0 +1,34 @@+-- | 03-encoding-scale.md の図。channel (列→視覚属性の写像) を 1 枚に集約した+-- カタログ図を所有する。scale / palette / 軸 (position scale) のデモ図は+-- 共有束縛の都合で当面 DocFig.Decoration が emit する (orphan ゲートは全 *.hs を+-- 横断するため所在は問わない)。+{-# LANGUAGE OverloadedStrings #-}+module DocFig.EncodingScale (figures) where++import Data.Text (Text)+import DocFig.Common++figures :: [Figure]+figures =+ -- §1 channel カタログ: 同じ散布を 4 つの channel で写し分ける+ -- (colorBy / sizeBy / shapeBy / linetypeBy)。mark カタログ (02-layers) は+ -- mark ごとの実例を持つので、ここは「列→視覚属性」の対比に専念する。+ [ figW "encoding-channels.svg" 960 760 $+ subplots+ [ layer (scatter xs ys <> colorBy g <> size 6) <> title "colorBy (カテゴリ→色)"+ , layer (scatter xs ys <> sizeBy sz) <> title "sizeBy (数値→点サイズ)"+ , layer (scatter xs ys <> shapeBy g <> size 6) <> title "shapeBy (カテゴリ→形)"+ , layer (line lx ly <> linetypeBy lg <> stroke 2) <> title "linetypeBy (カテゴリ→線種)" ]+ <> subplotCols 2+ <> legend+ <> title "channel ─ 列を視覚属性へ写像する"+ ]+ where+ xs = inline [1,2,3,4, 1,2,3,4]+ ys = inline [2,3,1,4, 3,1,4,2]+ g = inlineCat (replicate 4 "a" ++ replicate 4 "b" :: [Text])+ sz = inline [1,2,3,4, 4,3,2,1]++ lx = inline [1,2,3,4,5, 1,2,3,4,5]+ ly = inline [1,2,3,4,5, 2,3,3,4,5]+ lg = inlineCat (replicate 5 "p" ++ replicate 5 "q" :: [Text])
+ examples/DocFig/Layers.hs view
@@ -0,0 +1,317 @@+-- | 02-layers.md の図 (mark 索引 + 定型エントリ用サムネイル)。+-- 基本 / 分布 / 区間・エラー / 集計・統計 / 2D 場・行列 / ベクトル場 /+-- MCMC・ベイズ診断 / DAG の各 mark を 1 枚ずつ。+{-# LANGUAGE OverloadedStrings #-}+module DocFig.Layers (figures) where++import Data.Text (Text)+import qualified Data.Vector as V+import DocFig.Common++figures :: [Figure]+figures =+ -- 3a geom: bar (棒グラフ)+ [ fig "s3a-geom.svg" $+ purePlot <> layer (bar cats vals)+ <> title "3a. geom: bar" <> xLabel "群" <> yLabel "値"++ -- 3b layer 見た目: position dodge で群分け bar+ , fig "s3b-aes.svg" $+ purePlot+ <> layer (bar bx bv <> colorBy bg <> position PosDodge)+ <> legend+ <> title "3b. position PosDodge + color" <> xLabel "群" <> yLabel "値"++ -- 02 encoding: jitterX (整数 x に重なる点を散らす) + densityFill+ , figW "s2-jitter-density.svg" 960 380 $+ subplots [ layer (scatter jxs jys <> jitterX 0.25 <> alpha 0.6 <> size 5) <> title "jitterX (重なり点を散らす)"+ , layer (density densVals <> densityFill True <> alpha 0.4) <> title "densityFill" ]+ <> subplotCols 2++ -- 基本: scatter+ , fig "scatter.svg" $+ purePlot <> layer (scatter (inline [1,2,3,4,5]) (inline [2,4,3,5,7]))+ <> title "scatter" <> xLabel "x" <> yLabel "y"++ -- 基本: scatterPoints / linePoints+ , fig "scatterpoints.svg" $+ purePlot <> layer (scatterPoints [Point2 1 2, Point2 2 3.5, Point2 3 3, Point2 4 4.2, Point2 5 4])+ <> title "scatterPoints ([Point2])" <> xLabel "x" <> yLabel "y"++ -- 基本: text / label (ラベルは点の少し上に置いて重なりを避ける・label は枠付き)+ , fig "text.svg" $+ purePlot <> layer (scatter txX txY <> size 7) <> layer (label txX txYlab txN)+ <> title "text / label (点に注釈)" <> xLabel "x" <> yLabel "y"++ -- 基本: stem (lollipop)。 ★ stem は数値 x を取る (categorical 非対応)。+ , fig "stem.svg" $+ purePlot <> layer (stem (inline [1,2,3,4,5,6]) (inline [3,7,5,6,4,8]))+ <> title "stem (lollipop)" <> xLabel "x" <> yLabel "値"++ -- 基本: ecdf+ , fig "ecdf.svg" $+ purePlot <> layer (ecdf (inline [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9]))+ <> title "ecdf (経験累積分布)" <> xLabel "x" <> yLabel "F(x)"++ -- 分布: histogram+ , fig "histogram.svg" $+ purePlot <> layer (histogram (inline [1,2,2,3,3,3,4,4,5,2,3,4,3,5,4,3,2,4,3,5]) <> binCount 8)+ <> title "histogram (binCount 8)" <> xLabel "x" <> yLabel "count"++ -- 分布: boxplot (群色)+ , fig "boxplot.svg" $+ purePlot <> layer (boxplot dV <> colorBy dG) <> legend+ <> title "boxplot (群ごと colorBy)" <> yLabel "value"++ -- 分布: violin / strip / swarm+ , figW "violin.svg" 1280 420 $+ subplots [ layer (violin dV <> colorBy dG) <> title "violin"+ , layer (strip dV <> colorBy dG <> jitterX 0.15) <> title "strip"+ , layer (swarm dV <> colorBy dG) <> title "swarm" ]+ <> subplotCols 3 <> legend+ <> title "violin / strip / swarm"++ -- 分布: raincloud+ , fig "raincloud.svg" $+ purePlot <> layer (raincloud dV <> colorBy dG) <> legend+ <> title "raincloud (violin + box + strip)" <> yLabel "value"++ -- 分布: ridge (joyplot)+ , fig "ridge.svg" $+ purePlot <> layer (ridge rV <> colorBy rG) <> legend+ <> title "ridge (joyplot)" <> xLabel "value"++ -- 分布: qq+ , fig "qq.svg" $+ purePlot <> layer (qq (inline [-1.2,-0.3,0.1,0.5,-0.8,1.4,0.2,-0.1,0.9,-0.5,0.3,-0.6,1.1,-0.2,0.7]))+ <> title "qq (正規 QQ)" <> xLabel "理論分位点" <> yLabel "標本分位点"++ -- 区間: band + line+ , fig "band.svg" $+ purePlot <> layer (band bX bLo bHi <> alpha 0.3) <> layer (line bX bY)+ <> title "band (x, lo, hi) + line" <> xLabel "x" <> yLabel "y"++ -- 区間: lineRange / pointRange / crossbar (= (x, y, err) 対称)+ , figW "range.svg" 1280 420 $+ subplots [ layer (lineRange rgC rgY rgE) <> title "lineRange"+ , layer (pointRange rgC rgY rgE) <> title "pointRange"+ , layer (crossbar rgC rgY rgE) <> title "crossbar" ]+ <> subplotCols 3+ <> title "lineRange / pointRange / crossbar (y ± err)"++ -- 区間: forest (= (ラベル, 推定, err) 対称)+ , fig "forest.svg" $+ purePlot <> layer (forest (inlineCat (["b0","b1","b2","b3"] :: [Text]))+ (inline [0.2,-0.1,0.4,0.05]) (inline [0.15,0.2,0.1,0.12])+ <> forestNull 0)+ <> title "forest (推定 ± err, null=0)" <> xLabel "効果量"++ -- 区間: funnel (= (effect, SE))+ , fig "funnel.svg" $+ purePlot <> layer (funnel (inline [0.1,0.2,-0.1,0.15,0.05,0.12,-0.05,0.18])+ (inline [0.05,0.1,0.08,0.12,0.2,0.06,0.15,0.09]))+ <> title "funnel (effect vs SE)" <> xLabel "効果量" <> yLabel "SE"++ -- 集計: statFunction+ , fig "statfunction.svg" $+ purePlot <> layer (scatter (inline [1,3,5,7,9]) (inline [3,7,10,16,18]))+ <> layer (statFunction (\x -> 2 * x + 1) 0 10 100)+ <> title "statFunction (2x+1)" <> xLabel "x" <> yLabel "y"++ -- 集計: statMean (参照線)+ , fig "statmean.svg" $+ purePlot <> layer (histogram smX) <> layer (statMean smX <> linetype LtDashed)+ <> title "statMean (参照線)" <> xLabel "x" <> yLabel "count"++ -- 集計: countXY+ , fig "countxy.svg" $+ purePlot <> layer (countXY (inlineCat (["A","A","B","A","B","B","A","B","B"] :: [Text]))+ (inlineCat (["x","y","x","x","y","y","y","x","y"] :: [Text])))+ <> title "countXY (頻度)" <> xLabel "x" <> yLabel "y"++ -- 集計: histogramWide+ , fig "histogramwide.svg" $+ purePlot <> histogramWide [ inline [1,2,2,3,3,2,3], inline [2,3,3,4,4,3,4], inline [3,4,4,5,5,4,5] ]+ <> legend <> title "histogramWide (複数列重ね)" <> xLabel "x" <> yLabel "count"++ -- 2D 場: heatmap+ , fig "heatmap.svg" $+ purePlot <> layer (heatmap (inlineCat (map fst hmPts)) (inlineCat (map snd hmPts))+ (inline [1,0.3,0.1, 0.3,1,0.5, 0.1,0.5,1]))+ <> title "heatmap (カテゴリ grid)" <> xLabel "x" <> yLabel "y"++ -- 2D 場: pie+ , fig "pie.svg" $+ purePlot <> layer (pie (inlineCat (["A","B","C"] :: [Text])) (inline [30,50,20])) <> legend+ <> title "pie (円グラフ)"++ -- 2D 場: waterfall+ , fig "waterfall.svg" $+ purePlot <> layer (waterfall (inlineCat (["start","Q1","Q2","Q3"] :: [Text])) (inline [100,30,-20,15]))+ <> title "waterfall (累積寄与)" <> xLabel "段" <> yLabel "累積"++ -- 2D 場: parallelCoords (inline 列・軸名は無し)+ , fig "parallelcoords.svg" $+ purePlot <> layer (parallelCoords [ inline [1,2,3], inline [4,5,4], inline [2,1,3], inline [5,4,5] ]+ <> colorBy (inlineCat (["a","b","a"] :: [Text]))) <> legend+ <> title "parallelCoords (平行座標)"++ -- 2D 場: pairs (SPLOM、 inline 列・軸名は無し)+ , fig "pairs.svg" $+ purePlot <> pairs [ inline [1,2,3,4,5], inline [2,1,4,3,5], inline [1,3,2,5,4] ]+ <> title "pairs (散布図行列)"++ -- 集計2: contour (= 等高線図、 marching squares)+ , fig "contour.svg" $+ purePlot+ <> layer (contour ctX ctY ctZ)+ <> title "contour (等高線、 2 つの山)" <> xLabel "x" <> yLabel "y"++ -- 2D 場: bin2d (= binned heatmap、 contour の塗り版。 同データ)+ , fig "bin2d.svg" $+ purePlot+ <> layer (bin2d ctX ctY ctZ)+ <> title "bin2d (binned heatmap、 contour の塗り版)" <> xLabel "x" <> yLabel "y"++ -- 2D 場: hexbin (= 六角ビニング。 散布過密を六角セル件数の連続色で。 geom_hex)+ , fig "hexbin.svg" $+ purePlot+ <> layer (hexbin hxX hxY <> hexbinBins 12)+ <> title "hexbin (六角ビニング、 件数→連続色)" <> xLabel "x" <> yLabel "y"++ -- ベクトル場: quiver (= vector field、 Phase 26 A2)+ , fig "quiver.svg" $+ purePlot+ <> layer (quiver qX qY qU qV <> arrowColorByMagnitude)+ <> title "quiver (vector field、 magnitude 連続色)" <> xLabel "x" <> yLabel "y"++ -- MCMC: trace / traceLines (自己完結・reader が再現できる式で生成)+ , figW "trace.svg" 1080 420 $+ subplots [ layer (trace (inline (map fromIntegral tcIs)) (inline v1)) <> title "trace (1 chain)"+ , layer (traceLines tcIter tcVal tcCh) <> title "traceLines (chain 別)" ]+ <> subplotCols 2 <> legend+ <> title "trace / traceLines"++ -- MCMC: ess+ , fig "ess.svg" $+ purePlot <> layer (ess (inline [100,200,300,400,500,600])+ (inline [80,150,210,260,300,330]))+ <> title "ess (有効サンプルサイズ)" <> xLabel "iter" <> yLabel "ESS"++ -- MCMC: autocorr (AR(1) 風の減衰系列・自己完結式)+ , fig "autocorr.svg" $+ purePlot <> layer (autocorr (inline acSeries) <> autocorrMaxLag 40)+ <> title "autocorr (自己相関)" <> xLabel "lag" <> yLabel "ACF"++ -- 積層: stream (streamgraph)+ , fig "stream.svg" $+ purePlot <> layer (stream stX stY <> colorBy stS) <> legend+ <> title "stream (streamgraph)" <> xLabel "x" <> yLabel "y"++ -- DAG: y ~ Normal(a + b·x, s) の構造を手書き+ , fig "dag-manual.svg" $+ purePlot <> layer (dag dagNodes dagEdges <> size 22)+ <> title "手書き DAG (a,b→mu→y, s→y)"++ -- DAG: plate で観測ループ (mu/y) を囲む+ , fig "dag-plate.svg" $+ purePlot+ <> layer (dagFromListsWithPlates dagNodes dagEdges LayoutManual+ [ DAGPlate { dpLabel = "obs (N)", dpNodeIds = ["mu", "y"] } ] <> size 22)+ <> title "plate つき DAG (obs を N 個の枠で囲む)"++ -- distCols: 別列を別 mark で 1 パネルに併置 (= <+> の list 版・列名スロット)+ , figR "distcols.svg" rDist $+ distCols [ boxplot "a", violin "c", boxplot "d" ]+ <> title "distCols [box a, violin c, box d]" <> yLabel "value"++ -- distCols × colorBy: レーン内で群ごとに dodge 分割+ , figR "distcols-colorby.svg" rDist $+ distCols [ boxplot "a" <> colorBy "g", boxplot "c" ]+ <> legend+ <> title "distCols [box a <> colorBy g, box c]" <> yLabel "value"+ ]+ where+ cats = inlineCat (["A","B","C"] :: [Text])+ vals = inline [3.0, 7.0, 5.0]+ -- 群分け bar 用 (x category × group)+ bx = inlineCat (concatMap (replicate 2) (["A","B","C"] :: [Text]))+ bg = inlineCat (concat (replicate 3 (["g1","g2"] :: [Text])))+ bv = inline [3.0, 2.0, 5.0, 4.0, 4.0, 6.0]++ jxs = inline ([1,1,1,1,2,2,2,2,3,3,3,3,1,1,2,2,3,3,1,2,3,1,2,3] :: [Double])+ jys = inline ([2.0,2.4,2.1,1.8,2.6,2.2,2.5,2.0,3.1,3.4,2.9,3.3+ ,2.2,2.7,2.4,2.1,3.0,3.2,1.9,2.5,3.1,2.3,2.6,3.4] :: [Double])+ densVals = inline ([ 4.6,4.9,5.0,5.1,5.4,5.0,4.4,4.9,5.4,4.8,4.8,4.3,5.8,5.7,5.4+ , 5.1,5.7,5.1,5.4,5.1,4.6,5.1,4.8,5.0,5.0,5.2,5.2,4.7,4.8,5.4 ] :: [Double])++ txX = inline [1,2,3]; txY = inline [2,3,2.5]+ txYlab = inline [2.18,3.18,2.68]; txN = inlineCat (["P","Q","R"] :: [Text])++ dV = inline [4,5,6,5,7, 8,9,7,10,9, 5,6,7,6,8]+ dG = inlineCat (concatMap (replicate 5) (["a","b","c"] :: [Text]))++ rV = inline [1,2,2,3, 3,4,4,5, 5,6,6,7]+ rG = inlineCat (concatMap (replicate 4) (["a","b","c"] :: [Text]))++ bX = inline [1,2,3,4,5]; bY = inline [2,3,2.5,4,3.5]+ bLo = inline [1.5,2.4,2.0,3.4,3.0]; bHi = inline [2.5,3.6,3.0,4.6,4.0]++ rgC = inlineCat (["A","B","C"] :: [Text]); rgY = inline [2,3,2.5]; rgE = inline [0.4,0.6,0.3]++ smX = inline [1,2,2,3,3,3,4,4,5]++ hmCs = ["A","B","C"] :: [Text]+ hmPts = [ (a, b) | a <- hmCs, b <- hmCs ]++ ctGrid = [ (xi, yi) | xi <- [0.0, 0.4 .. 6.0], yi <- [0.0, 0.4 .. 6.0] ]+ ctX = inline (map fst ctGrid)+ ctY = inline (map snd ctGrid)+ ctZ = inline [ exp (-(((x - 3) ** 2) + ((y - 3) ** 2)) / 4)+ + 0.4 * exp (-(((x - 1.2) ** 2) + ((y - 4.5) ** 2)) / 1.5)+ | (x, y) <- ctGrid ]++ -- hexbin 用の相関した点群 (決定的・対角バンド + 正弦ばらつきで件数差を出す)+ hxPts = [ (x, y)+ | i <- [0 .. 299 :: Int]+ , let fi = fromIntegral i+ x = fromIntegral (i `mod` 20) * 0.3 + sin fi * 0.18+ y = fromIntegral (i `mod` 20) * 0.25 + cos (fi * 1.3) * 0.6+ + fromIntegral (i `div` 20) * 0.05 ]+ hxX = inline (map fst hxPts)+ hxY = inline (map snd hxPts)++ qGrid = [ (gx, gy) | gx <- [-3, -2 .. 3], gy <- [-3, -2 .. 3 :: Double] ]+ qX = inline (map fst qGrid)+ qY = inline (map snd qGrid)+ qU = inline [ -y / 3 - x / 6 | (x, y) <- qGrid ]+ qV = inline [ x / 3 - y / 6 | (x, y) <- qGrid ]++ tcN = 120 :: Int+ tcIs = [1 .. tcN]+ v1 = [ 1.0 + 0.3 * sin (fromIntegral i / 9) + 0.1 * sin (fromIntegral i * 7.1) | i <- tcIs ]+ v2 = [ 1.3 + 0.3 * sin (fromIntegral i / 9) + 0.1 * sin (fromIntegral i * 3.3) | i <- tcIs ]+ tcIter = inline (map fromIntegral (tcIs ++ tcIs))+ tcVal = inline (v1 ++ v2)+ tcCh = inlineCat (replicate tcN "1" ++ replicate tcN "2" :: [Text])++ rnd i = let h = sin (fromIntegral i * 12.9898) * 43758.5453 in h - fromIntegral (floor h :: Int)+ acSeries = scanl (\prev i -> 0.85 * prev + (rnd i - 0.5)) 0 [1 .. 300 :: Int]++ stX = inline [1,2,3, 1,2,3, 1,2,3]+ stY = inline [2,3,4, 1,2,1, 3,2,3]+ stS = inlineCat (["a","a","a","b","b","b","c","c","c"] :: [Text])++ dagNodes = [ dagNodeDist "a" "a" NodeLatent "Normal(0,10)" 0.15 0.0+ , dagNodeDist "b" "b" NodeLatent "Normal(0,10)" 0.45 0.0+ , dagNodeDist "s" "s" NodeLatent "HalfNormal(1)" 0.85 0.0+ , dagNode "mu" "mu" NodeDeterministic 0.30 0.5+ , dagNodeDist "y" "y" NodeObserved "Normal(mu,s)" 0.45 1.0 ]+ dagEdges = [ dagEdge "a" "mu", dagEdge "b" "mu", dagEdge "mu" "y", dagEdge "s" "y" ]++ rDist :: Resolver+ rDist "a" = Just (NumData (V.fromList [3,4,4.5,5,5,5.2,5.5,6,6.5,7,8,4.8]))+ rDist "c" = Just (NumData (V.fromList [6,6.5,7,7.2,7.5,8,8.3,9,9.5,7.8,6.9,8.1]))+ rDist "d" = Just (NumData (V.fromList [2,2.5,3,3.2,3.5,4,4.3,5,2.8,3.1,3.9,2.2]))+ rDist "g" = Just (TxtData (V.fromList (concatMap (replicate 6) ["x","y"])))+ rDist _ = Nothing
+ examples/DocFig/Quickstart.hs view
@@ -0,0 +1,26 @@+-- | 01-quickstart.md の図 (Easy / 文法レイヤ)。+{-# LANGUAGE OverloadedStrings #-}+module DocFig.Quickstart (figures) where++import Data.Text (Text)+import DocFig.Common++figures :: [Figure]+figures =+ [ -- Lesson 1: Easy+ fig "lesson1-easy.svg" $+ overlay [ points [1,2,3,4,5] [1,4,9,16,25] ]+ <> title "Lesson 1: y = x²" <> xLabel "x" <> yLabel "y"++ -- Lesson 2: Grammar (色分け + scale_color_manual + legend)+ , fig "lesson2-grammar.svg" $+ purePlot+ <> layer (scatter xs ys <> colorBy gs <> size 7)+ <> scaleColorManual [("alpha","#1B9E77"), ("beta","#D95F02")]+ <> legend+ <> title "Lesson 2: scale_color_manual" <> xLabel "x" <> yLabel "y"+ ]+ where+ xs = inline [1,2,3,4, 1,2,3,4]+ ys = inline [2,3,1,4, 3,1,4,2]+ gs = inlineCat (concatMap (replicate 4) (["alpha","beta"] :: [Text]))
+ examples/DocFigures.hs view
@@ -0,0 +1,24 @@+-- | docs/api-guide/ に埋め込む図を生成する (P3.1 = api-guide 再構成)。+-- 図はページ別モジュール (DocFig.Quickstart / Layers / Decoration) が 'Figure' の+-- リストとして宣言し、 ここはそれらをまとめて出力するだけの薄い入口。+-- @cabal run doc-figures@ (repo root から) で docs/api-guide/images/*.svg を生成。+-- ※ 05 (df/) / 06 (analyze-integration/) / 07 (3d/) の図は別ジェネレータ+-- (df-plot-demo / 各 bridge demo / plot3d-demo → design/* を api-guide へコピー) が担当。+module Main (main) where++import System.Directory (createDirectoryIfMissing)++import DocFig.Common (outDir, renderFigure)+import qualified DocFig.Quickstart as Quickstart+import qualified DocFig.Layers as Layers+import qualified DocFig.EncodingScale as EncodingScale+import qualified DocFig.Decoration as Decoration++main :: IO ()+main = do+ createDirectoryIfMissing True outDir+ let figs = Quickstart.figures ++ Layers.figures+ ++ EncodingScale.figures ++ Decoration.figures+ mapM_ renderFigure figs+ putStrLn ("doc figures written to " ++ outDir+ ++ " (" ++ show (length figs) ++ " figures)")
+ examples/GalleryDemo.hs view
@@ -0,0 +1,1104 @@+-- | Gallery demo: hgg の機能カタログ用 SVG 出力 (= design/gallery/ へ吐く)。+--+-- @+-- cabal run gallery-demo+-- @+--+-- → design/gallery/{basic,distribution,statistical,decoration,axes,theme,doe}/ 配下に+-- 各 chart 種別ごとに SVG を生成。 'design/gallery.md' でこれらを参照して表示。+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Graphics.Hgg.Backend.SVG (saveSVG, saveSVGWith)+import Graphics.Hgg.DAG (layoutHierarchicalFull)+import Graphics.Hgg.Render.Special (bakeDAGRoutesInSpec)+import Graphics.Hgg.Unit (px, (*~))+import Graphics.Hgg.Easy+import qualified Data.Aeson+import qualified Data.ByteString.Lazy+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified System.Directory+import System.Directory (createDirectoryIfMissing)++main :: IO ()+main = do+ let dirs = ["basic", "distribution", "statistical", "decoration",+ "axes", "theme", "palette", "doe", "coord", "scale"]+ mapM_ (\d -> createDirectoryIfMissing True ("design/gallery/" ++ d)) dirs++ putStrLn "Generating gallery SVGs..."++ -- ===========================================================================+ -- BASIC (= 1 列 chart)+ -- ===========================================================================+ let xs = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] :: [Double]+ ys = map (\x -> x * x) xs+ vals = [3.0, 4.0, 4.5, 5.0, 5.0, 5.2, 5.5, 6.0, 6.5, 7.0, 8.0, 12.0] :: [Double]++ -- scatter+ emit "basic/scatter.svg" $+ purePlot+ <> layer (scatter (inline xs) (inline ys) <> alpha 0.85 <> size 5)+ <> title "scatter: y = x²"+ <> xLabel "x" <> yLabel "y"++ -- line+ let xs2 = [0, 0.5 .. 6.28] :: [Double]+ ys2 = map sin xs2+ emit "basic/line.svg" $+ purePlot+ <> layer (line (inline xs2) (inline ys2) <> color (fromHex "#2563eb") <> stroke 2)+ <> title "line: y = sin(x)"++ -- bar+ emit "basic/bar.svg" $+ purePlot+ <> layer (bar (inlineCat (["A", "B", "C", "D", "E"] :: [Text]))+ (inline ([8.0, 5.0, 12.0, 6.5, 3.0] :: [Double])))+ <> title "bar (categorical)"++ -- Phase 9 B: position adjustment (dodge / stack / fill)。 long-form データ+ -- (= 各 row が (cat, group, value)) を color で群分けし、 position で並べ方を選ぶ。+ let posCats = inlineCat (concatMap (replicate 3) (["A","B","C"] :: [Text]))+ posGrp = inlineCat (concat (replicate 3 (["x","y","z"] :: [Text])))+ posVals = inline ([3.0,5.0,2.0, 4.0,1.0,6.0, 2.0,3.0,4.0] :: [Double])+ emit "basic/bar-dodge.svg" $+ purePlot+ <> layer (bar posCats posVals <> colorBy posGrp <> position PosDodge)+ <> title "bar (dodge = 横並び)"+ emit "basic/bar-stack.svg" $+ purePlot+ <> layer (bar posCats posVals <> colorBy posGrp <> position PosStack)+ <> title "bar (stack = 積み上げ)"+ emit "basic/bar-fill.svg" $+ purePlot+ <> layer (bar posCats posVals <> colorBy posGrp <> position PosFill)+ <> title "bar (fill = 100% 積み上げ)"++ -- Phase 10: coord_flip (= 横棒)。 軸ラベルは水平のまま・bar は横に伸びる。+ emit "coord/bar-flip.svg" $+ purePlot+ <> layer (bar (inlineCat (["A", "B", "C", "D", "E"] :: [Text]))+ (inline ([8.0, 5.0, 12.0, 6.5, 3.0] :: [Double])))+ <> coordFlip+ <> title "bar + coord_flip (横棒)"++ -- Phase 11 A7-a: coord_cartesian(xlim,ylim) = データを落とさない zoom。+ -- 全 11 点 (x=0..10, y=x^2) のうち x∈[2,6] の窓に絞り、 窓外の点は panel に clip+ -- される (= データは残るが描画は枠内のみ)。 axisRange と違いデータを切らない。+ emit "coord/cartesian-zoom.svg" $+ purePlot+ <> layer (scatter (inline ([0,1,2,3,4,5,6,7,8,9,10] :: [Double]))+ (inline ([0,1,4,9,16,25,36,49,64,81,100] :: [Double])))+ <> coordCartesian 2 6 0 40+ <> title "coord_cartesian (zoom x∈[2,6], y∈[0,40])"++ -- Phase 11 A7-c: coord_polar (theta="x")。 x を角度・y を半径に写す (= radar / rose)。+ -- 12 方位の値を閉じた折線で結ぶ (先頭を末尾に追加して 1 周)。+ emit "coord/polar-line.svg" $+ purePlot+ <> layer (line (inline ([0,1,2,3,4,5,6,7,8,9,10,11,12] :: [Double]))+ (inline ([6,8,5,9,7,10,6,8,5,9,7,10,6] :: [Double]))+ <> stroke 2)+ <> layer (scatter (inline ([0,1,2,3,4,5,6,7,8,9,10,11] :: [Double]))+ (inline ([6,8,5,9,7,10,6,8,5,9,7,10] :: [Double])) <> size 4)+ <> coordPolar+ <> title "coord_polar (theta=x、 radar)"++ -- Phase 11 A7-c: coord_polar + bar = rose / 円形棒グラフ (扇形 wedge)。+ emit "coord/polar-bar.svg" $+ purePlot+ <> layer (bar (inlineCat (["Mon","Tue","Wed","Thu","Fri","Sat","Sun"] :: [Text]))+ (inline ([4,7,5,9,6,11,8] :: [Double])))+ <> coordPolar+ <> title "coord_polar + bar (rose / 円形棒)"++ -- Phase 11 A4-a: scale_x_reverse / scale_y_reverse (軸反転 = range 入替)。+ -- tick/grid/glyph は scaleApply 経由で自動追従 (renderer 無変更)。+ emit "scale/reverse-x.svg" $+ purePlot+ <> layer (scatter (inline ([1.0, 2.0, 3.0, 4.0, 5.0] :: [Double]))+ (inline ([1.0, 4.0, 9.0, 16.0, 25.0] :: [Double])))+ <> reverseX+ <> title "scale_x_reverse (X 軸反転)"+ emit "scale/reverse-y.svg" $+ purePlot+ <> layer (scatter (inline ([1.0, 2.0, 3.0, 4.0, 5.0] :: [Double]))+ (inline ([1.0, 4.0, 9.0, 16.0, 25.0] :: [Double])))+ <> reverseY+ <> title "scale_y_reverse (Y 軸反転)"++ -- Phase 11 A4-b: linetype (固定) と linetypeBy (categorical 群分け = 巡回 dash)。+ -- line 系 mark の dash は LineStyle.lsDash 経由 (SVG stroke-dasharray / Canvas setLineDash)。+ emit "scale/linetype.svg" $+ purePlot+ <> layer (line (inline ([1.0, 2.0, 3.0, 4.0, 5.0] :: [Double]))+ (inline ([1.0, 3.0, 2.0, 5.0, 4.0] :: [Double]))+ <> stroke 2 <> linetype LtDashed)+ <> title "linetype = dashed (固定)"+ let ltX = inline (concat (replicate 2 ([1.0, 2.0, 3.0, 4.0, 5.0] :: [Double])))+ ltY = inline ([1.0, 3.0, 2.0, 5.0, 4.0, 2.0, 1.0, 4.0, 3.0, 6.0] :: [Double])+ ltG = inlineCat (concatMap (replicate 5) (["A", "B"] :: [Text]))+ emit "scale/linetype-by.svg" $+ purePlot+ <> layer (line ltX ltY <> stroke 2 <> linetypeBy ltG)+ <> title "linetype = factor(g) (A=solid, B=dashed)"++ -- Phase 11 A4-d: 明示 breaks / labels (= ggplot scale_*_continuous(breaks=,labels=))。+ -- X は break+label 対 (0→low, 50→mid, 100→high)、 Y は break のみ (自動 format)。+ emit "scale/breaks-labels.svg" $+ purePlot+ <> layer (scatter (inline ([0.0, 25.0, 50.0, 75.0, 100.0] :: [Double]))+ (inline ([10.0, 40.0, 55.0, 70.0, 90.0] :: [Double])))+ <> xAxis (axisBreaksLabeled [(0, "low"), (50, "mid"), (100, "high")])+ <> yAxis (axisBreaksAt [0, 25, 50, 75, 100])+ <> title "明示 breaks/labels (X=ラベル, Y=値刻み)"++ -- Phase 11 A4-e: 色/サイズ scale 拡充 (manual 辞書 / 発散 gradient2 / size range)。+ let aeX = inline (concat (replicate 2 ([1.0, 2.0, 3.0, 4.0] :: [Double])))+ aeY = inline ([2.0, 3.0, 1.0, 4.0, 3.0, 1.0, 4.0, 2.0] :: [Double])+ aeG = inlineCat (concatMap (replicate 4) (["alpha", "beta"] :: [Text]))+ emit "scale/color-manual.svg" $+ purePlot+ <> layer (scatter aeX aeY <> colorBy aeG <> size 6)+ <> scaleColorManual [("alpha", "#1B9E77"), ("beta", "#D95F02")]+ <> legend+ <> title "scale_color_manual (alpha→緑, beta→橙)"+ -- gradient2: z = -3..3、 midpoint 0 を白に (発散)。+ let gz = inline ([-3.0, -2.0, -1.0, 0.0, 1.0, 2.0, 3.0] :: [Double])+ gx = inline ([1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0] :: [Double])+ emit "scale/color-gradient2.svg" $+ purePlot+ <> layer (scatter gx gx <> colorContinuousBy gz <> size 8)+ <> scaleColorGradient2 "#2166AC" "#F7F7F7" "#B2182B" 0.0+ <> legend+ <> title "scale_color_gradient2 (midpoint 0 = 白)"+ -- size: 値に応じた半径 (range 4..20)。+ let sx = inline ([1.0, 2.0, 3.0, 4.0, 5.0] :: [Double])+ ssz = inline ([1.0, 5.0, 10.0, 20.0, 40.0] :: [Double])+ emit "scale/size.svg" $+ purePlot+ <> layer (scatter sx sx <> sizeBy ssz)+ <> scaleSize 4 20+ <> title "scale_size (range 4..20)"+ -- Phase 30 A8: alphaBy = 連続 alpha encoding (= ggplot scale_alpha)。+ -- 列値 min..max を alpha [0.1, 1.0] に map (薄→濃)。size 固定で alpha のみ変化。+ emit "scale/alpha.svg" $+ purePlot+ <> layer (scatter sx sx <> alphaBy ssz <> size 12)+ <> title "scale_alpha (alphaBy・薄→濃)"++ -- Phase 11 A6: geom_text / geom_label (データ駆動ラベル)。+ let gtX = inline ([1.0, 2.0, 3.0, 4.0, 5.0] :: [Double])+ gtY = inline ([2.0, 4.0, 3.0, 5.0, 4.5] :: [Double])+ gtL = inlineCat (["alpha", "beta", "gamma", "delta", "epsilon"] :: [Text])+ emit "basic/geom-text.svg" $+ purePlot+ <> layer (scatter gtX gtY <> size 4)+ <> layer (text gtX gtY gtL <> size 12)+ <> title "geom_text (各点にラベル)"+ <> xLabel "x" <> yLabel "y"+ emit "basic/geom-label.svg" $+ purePlot+ <> layer (label gtX gtY gtL <> size 12)+ <> title "geom_label (背景付きラベル)"+ <> xLabel "x" <> yLabel "y"++ -- Phase 11 A6-2: Q-Q plot (= ggplot geom_qq)。 正規サンプル N=120 を+ -- 理論正規分位点に対してプロット (= 正規性の視覚診断、 直線なら正規)。+ let qqVals = gaussian 7 0.0 1.0 120 :: [Double]+ emit "basic/qq.svg" $+ purePlot+ <> layer (qq (inline qqVals) <> size 5)+ <> title "Q-Q plot (正規分位点 vs サンプル)"+ <> xLabel "理論分位点" <> yLabel "標本分位点"++ -- Phase 11 A6-3: heatmap (= ggplot geom_tile)。 x/y カテゴリ grid を value の+ -- 連続色 (Viridis) で塗る。 long-form (各 row = (x, y, value))。+ let hmX = inlineCat (concatMap (replicate 3) (["A", "B", "C"] :: [Text]))+ hmY = inlineCat (concat (replicate 3 (["P", "Q", "R"] :: [Text])))+ hmV = inline ([1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0] :: [Double])+ emit "basic/heatmap.svg" $+ purePlot+ <> layer (heatmap hmX hmY hmV)+ <> title "heatmap (3×3 grid、 Viridis)"+ <> xLabel "x" <> yLabel "y"++ -- contour (= 等高線図、 marching squares)。 連続 x/y/z を正則格子に再標本化し+ -- z を等分した各レベルの等値線を描く。 z = exp(-((x-3)²+(y-3)²)/4) 的な釣鐘 (中心が高い)。+ let ctGrid = [ (xi, yi) | xi <- [0.0, 0.5 .. 6.0], yi <- [0.0, 0.5 .. 6.0] ]+ ctX = inline (map fst ctGrid)+ ctY = inline (map snd ctGrid)+ ctZ = inline [ exp (-(((x - 3) ** 2) + ((y - 3) ** 2)) / 4) | (x, y) <- ctGrid ]+ emit "basic/contour.svg" $+ purePlot+ <> layer (contour ctX ctY ctZ)+ <> title "contour (等高線、 中心が高い釣鐘)"+ <> xLabel "x" <> yLabel "y"++ -- bin2d (= ggplot geom_bin2d、 binned heatmap)。 contour と同データを塗りで。+ emit "basic/bin2d.svg" $+ purePlot+ <> layer (bin2d ctX ctY ctZ)+ <> title "bin2d (binned heatmap、 中心が高い釣鐘)"+ <> xLabel "x" <> yLabel "y"++ -- Phase 11 A6-4: ECDF (= ggplot stat_ecdf)。 正規サンプルの経験累積分布 (階段)。+ let ecdfVals = gaussian 13 0.0 1.0 80 :: [Double]+ emit "basic/ecdf.svg" $+ purePlot+ <> layer (ecdf (inline ecdfVals))+ <> title "ECDF (経験累積分布、 N=80)"+ <> xLabel "x" <> yLabel "F(x)"++ -- Phase 11 A6-4b: 区間 geom (linerange / pointrange / crossbar)。 x/y/err。+ let rbX = inline ([1.0, 2.0, 3.0, 4.0, 5.0] :: [Double])+ rbY = inline ([3.0, 4.5, 4.0, 5.5, 5.0] :: [Double])+ rbE = inline ([0.5, 0.8, 0.4, 0.6, 0.7] :: [Double])+ emit "basic/linerange.svg" $+ purePlot+ <> layer (lineRange rbX rbY rbE)+ <> title "linerange (y±err の縦線)" <> xLabel "x" <> yLabel "y"+ emit "basic/pointrange.svg" $+ purePlot+ <> layer (pointRange rbX rbY rbE)+ <> title "pointrange (縦線 + 中心点)" <> xLabel "x" <> yLabel "y"+ emit "basic/crossbar.svg" $+ purePlot+ <> layer (crossbar rbX rbY rbE)+ <> title "crossbar (幅付き箱 + 中央線)" <> xLabel "x" <> yLabel "y"++ -- Phase 11 A6-4c: stat_function (= ggplot stat_function)。 関数を構成時にサンプルして+ -- inline line に焼き込む。 ここでは sin を [0, 2π] で 100 点。+ emit "basic/stat-function.svg" $+ purePlot+ <> layer (statFunction sin 0.0 (2 * pi) 100 <> color (fromHex "#2563eb") <> stroke 2)+ <> title "stat_function (sin、 [0,2π] を 100 点)"+ <> xLabel "x" <> yLabel "sin x"++ -- histogram+ -- Phase 8 B8: N=200 正規分布、 bin 数は既定 (= ggplot と同じ 30)+ let histVals = gaussian 41 5.0 1.5 200 :: [Double]+ emit "basic/histogram.svg" $+ purePlot+ <> layer (histogram (inline histVals) <> alpha 0.8)+ <> title "histogram (N=200、 既定 30 bins)"++ -- box+ -- 単一群 box+ emit "basic/box.svg" $+ purePlot+ <> layer (boxplot (inline vals))+ <> title "box plot (単一群、 Q1/median/Q3 + whisker)"++ -- density+ let denseVals = take 200 $ cycle+ [3.0, 4.0, 4.5, 5.0, 5.0, 5.2, 5.5, 6.0, 6.5, 7.0, 8.0]+ emit "basic/density.svg" $+ purePlot+ <> layer (density (inline denseVals) <> color (fromHex "#16a34a"))+ <> title "density (KDE、 Silverman bw)"++ -- pie+ emit "basic/pie.svg" $+ purePlot+ <> layer (pie (inlineCat (["Eng", "Bio", "Math", "CS"] :: [Text]))+ (inline ([35.0, 22.0, 18.0, 25.0] :: [Double])))+ <> title "pie (proportion)"++ -- waterfall+ emit "basic/waterfall.svg" $+ purePlot+ <> layer (waterfall (inlineCat (["Start", "+A", "+B", "-C", "End"] :: [Text]))+ (inline ([100.0, 30.0, 20.0, -15.0, 0.0] :: [Double])))+ <> title "waterfall"++ -- step+ emit "basic/step.svg" $+ purePlot+ <> layer (step (inline xs) (inline ys) <> color (fromHex "#dc2626"))+ <> title "step plot"++ -- histogram wide-form (Phase 6 A10、 P1 解消) — 3 列を半透明で重ね+ -- Phase 8 B7: 各列 N=70 の正規分布 (平均をずらした 3 群)、 bin 境界は全列共通+ let h1 = gaussian 71 5.0 1.2 70 :: [Double]+ h2 = gaussian 83 6.5 1.0 70+ h3 = gaussian 97 4.0 1.4 70+ emit "basic/histogram-wide.svg" $+ histogramWide [inline h1, inline h2, inline h3]+ <> title "histogramWide [c1, c2, c3] (= 全列共通 bin、 N=70 ×3)"++ -- stem+ let stemX = [1, 2, 3, 4, 5, 6, 7, 8] :: [Double]+ stemY = [2.0, 4.5, 1.0, 5.5, 3.0, 6.0, 2.5, 4.0]+ emit "basic/stem.svg" $+ purePlot+ <> layer (stem (inline stemX) (inline stemY) <> color (fromHex "#7c3aed"))+ <> title "stem / lollipop"++ -- ===========================================================================+ -- DISTRIBUTION+ -- ===========================================================================++ let groups = inlineCat (["A", "A", "A", "B", "B", "B", "C", "C", "C"] :: [Text])+ gvalues = inline ([1.0, 2.5, 3.0, 4.0, 4.5, 5.5, 6.0, 7.5, 8.0] :: [Double])+ -- Phase 8 B2: 分布系の共用群データ (4 群 × N=90、 正規分布)+ (grpLabels, grpVals) = groupedDemo+ grpCat = inlineCat grpLabels+ grpNum = inline grpVals++ -- Phase 8 B3: violin も共用群データ (4 群 × N=90) で+ emit "distribution/violin.svg" $+ purePlot+ <> layer (violin grpNum <> groupBy grpCat)+ <> title "violin (4 群 × N=90)"+ <> xLabel "genotype" <> yLabel "weight gain (g/d)"++ -- Phase 8 B4: strip も共用群データ (4 群 × N=90)、 横 jitter で散らす+ emit "distribution/strip.svg" $+ purePlot+ <> layer (strip grpNum <> groupBy grpCat <> alpha 0.6 <> size 4)+ <> title "strip plot (4 群 × N=90、 jitter)"+ <> xLabel "genotype" <> yLabel "weight gain (g/d)"++ -- Phase 8 B5: swarm も共用群データ (4 群 × N=90)、 beeswarm 衝突回避+ emit "distribution/swarm.svg" $+ purePlot+ <> layer (swarm grpNum <> groupBy grpCat <> alpha 0.85 <> size 5)+ <> title "swarm (4 群 × N=90、 beeswarm)"+ <> xLabel "genotype" <> yLabel "weight gain (g/d)"++ -- Phase 8 B2: raincloud は群ごと N=90 の正規分布データで (= 群内分布を見せる図)+ emit "distribution/raincloud.svg" $+ purePlot+ <> layer (raincloud grpNum <> groupBy grpCat)+ <> title "raincloud (4 群 × N=90、 jitter + box + half-violin)"+ <> xLabel "genotype" <> yLabel "weight gain (g/d)"++ -- Phase 8 B6: ridge は (値, 群) の順。 群ごとに分布形が違うデータ (= joyplot は+ -- 群間の分布形状比較が主眼) で 4 群 × N=90。 引数順は ridge valCol groupCol。+ emit "distribution/ridge.svg" $+ purePlot+ <> layer (ridge grpNum <> groupBy grpCat)+ <> title "ridge / joyplot (4 群 × N=90)"+ <> xLabel "weight gain (g/d)"++ -- Phase 8 B9: 複数群 box (= boxplot valsCol <> groupBy groupCol)、 共用群データ 4 群 × N=90+ emit "distribution/box-grouped.svg" $+ purePlot+ <> layer (boxplot grpNum <> groupBy grpCat)+ <> title "box plot (4 群、 群別 Tukey box)"+ <> xLabel "genotype" <> yLabel "weight gain (g/d)"++ -- Phase 10: box + coord_flip (= 横向き box)。 群が縦に並び value が横に伸びる。+ emit "coord/box-flip.svg" $+ purePlot+ <> layer (boxplot grpNum <> groupBy grpCat)+ <> coordFlip+ <> title "box plot + coord_flip (横向き)"+ <> xLabel "genotype" <> yLabel "weight gain (g/d)"++ -- Phase 10 A5 ②: distribution 族の flip (violin/strip/swarm)。 自前軸 (cat ラベル/値 tick) が+ -- flip 配置に追従するか確認 (box-flip と同パターン)。+ emit "coord/violin-flip.svg" $+ purePlot+ <> layer (violin grpNum <> groupBy grpCat)+ <> coordFlip+ <> title "violin + coord_flip (横向き)"+ <> xLabel "genotype" <> yLabel "weight gain (g/d)"++ emit "coord/strip-flip.svg" $+ purePlot+ <> layer (strip grpNum <> groupBy grpCat <> alpha 0.6 <> size 4)+ <> coordFlip+ <> title "strip + coord_flip (横向き)"+ <> xLabel "genotype" <> yLabel "weight gain (g/d)"++ emit "coord/swarm-flip.svg" $+ purePlot+ <> layer (swarm grpNum <> groupBy grpCat <> alpha 0.85 <> size 5)+ <> coordFlip+ <> title "swarm + coord_flip (横向き)"+ <> xLabel "genotype" <> yLabel "weight gain (g/d)"++ -- Phase 10 A5 ②: waterfall の flip (standalone・自前 baseline/y tick/cat ラベル)。+ emit "coord/waterfall-flip.svg" $+ purePlot+ <> layer (waterfall (inlineCat (["Start", "+A", "+B", "-C", "End"] :: [Text]))+ (inline ([100.0, 30.0, 20.0, -15.0, 0.0] :: [Double])))+ <> coordFlip+ <> title "waterfall + coord_flip (横向き)"++ -- ===========================================================================+ -- STATISTICAL+ -- ===========================================================================++ -- regression line + CI: plot 側では fit しないので OLS 当てはめ値 yhat を作り+ -- band(信頼帯) + line で重ねる (自動 fit は analyze の statLm)。+ let rxs = [0, 1 .. 9] :: [Double]+ rys = map (\x -> 2 * x + 1 + sin x) rxs+ rN = fromIntegral (length rxs)+ rA = (rN * sum (zipWith (*) rxs rys) - sum rxs * sum rys)+ / (rN * sum (map (^ (2 :: Int)) rxs) - sum rxs ^ (2 :: Int))+ rB = (sum rys - rA * sum rxs) / rN+ yhat = [ rA * x + rB | x <- rxs ]+ rlo = map (subtract 0.6) yhat+ rhi = map (+ 0.6) yhat+ emit "statistical/regression-ci.svg" $+ purePlot+ <> layer (scatter (inline rxs) (inline rys) <> alpha 0.85 <> size 5)+ <> layer (band (inline rxs) (inline rlo) (inline rhi) <> color (fromHex "#dc2626") <> alpha 0.2)+ <> layer (line (inline rxs) (inline yhat) <> color (fromHex "#dc2626"))+ <> title "regression line + CI band"+ <> xLabel "x" <> yLabel "y"++ -- stat line (= 値系列に対する平均/中央値の水平基準線。 ggplot geom_hline 相当、+ -- DoE の grand-mean 線と同じ用法)。 旧版は histogram (count 軸) の上に値の水平線を+ -- 重ねており、 y 軸が count と値の混在で意味的に破綻 (= findings「y-range 微妙」) して+ -- いた。 statMean/statMedian は y=値 の水平線なので、 値そのものを y に取る系列+ -- (scatter + connect 折れ線) に重ねるのが正しい (Phase 8 B17)。+ let statIdx = map fromIntegral [1 .. length vals] :: [Double]+ emit "statistical/stat-line.svg" $+ purePlot+ <> layer (scatter (inline statIdx) (inline vals) <> connect <> alpha 0.85 <> size 5)+ <> layer (statMean (inline vals) <> color (fromHex "#dc2626") <> stroke 2)+ <> layer (statMedian (inline vals) <> color (fromHex "#2563eb") <> stroke 2)+ <> title "series + statMean (red) + statMedian (blue)"+ <> xLabel "index" <> yLabel "value"++ -- Forest plot (Phase 6 A2)+ let studies :: [Text]+ studies = ["Study 1", "Study 2", "Study 3", "Study 4", "Study 5", "Pooled"]+ ests :: [Double]+ ests = [0.3, -0.2, 0.5, 0.1, 0.4, 0.22]+ errs :: [Double]+ errs = [0.2, 0.15, 0.18, 0.25, 0.13, 0.08]+ emit "statistical/forest.svg" $+ purePlot+ <> layer (forest (inlineCat studies) (inline ests) (inline errs)+ <> color (fromHex "#377EB8") <> size 7)+ <> title "Forest plot (= meta-analysis、 中央 null line + horizontal CI)"+ <> xLabel "effect size" <> yLabel "study"++ -- Phase 10 A5 ②: forest の flip (standalone・自前 x tick / 群ラベル左 の flip 辺入替確認)。+ emit "coord/forest-flip.svg" $+ purePlot+ <> layer (forest (inlineCat studies) (inline ests) (inline errs)+ <> color (fromHex "#377EB8") <> size 7)+ <> coordFlip+ <> title "Forest plot + coord_flip"+ <> xLabel "effect size" <> yLabel "study"++ -- Streamgraph (Phase 52.D2): 中心化積層 area。 color aes で 3 系列に分割し、+ -- 各 x 点で系列を積層、 baseline を -(Σy)/2 から (silhouette 中心化) で描く。+ let streamT :: [Double]+ streamT = concat (replicate 3 [0, 1, 2, 3, 4, 5])+ streamV :: [Double]+ streamV = [ 1, 2, 4, 3, 2, 1 -- 系列 A+ , 2, 3, 3, 4, 5, 4 -- 系列 B+ , 1, 1, 2, 2, 3, 5 ] -- 系列 C+ streamG :: [Text]+ streamG = concat [ replicate 6 "A", replicate 6 "B", replicate 6 "C" ]+ emit "statistical/streamgraph.svg" $+ purePlot+ <> layer (stream (inline streamT) (inline streamV)+ <> colorBy (inlineCat streamG) <> alpha 0.85)+ <> title "Streamgraph (= 中心化積層 area、 ThemeRiver 風、 color で系列分割)"+ <> xLabel "time" <> yLabel "value (centered)"++ -- Funnel plot (Phase 6 A3)+ let funnelEff :: [Double]+ funnelEff = [0.3, 0.25, 0.4, 0.1, -0.2, 0.5, 0.35, 0.15, 0.45, 0.05, 0.6, -0.1]+ funnelSE :: [Double]+ funnelSE = [0.1, 0.15, 0.2, 0.18, 0.22, 0.25, 0.12, 0.28, 0.16, 0.3, 0.08, 0.35]+ emit "statistical/funnel.svg" $+ purePlot+ <> layer (funnel (inline funnelEff) (inline funnelSE)+ <> color (fromHex "#377EB8") <> size 6)+ <> title "Funnel plot (= publication bias、 ±1.96 SE envelope)"+ <> xLabel "effect size" <> yLabel "SE"++ -- autocorrelation (Phase 6 A4、 P19 解消)+ -- AR(1) process: x_{t+1} = 0.7 * x_t + ε_t+ let ar1Vals :: [Double]+ ar1Vals = take 500 $ iterate (\v -> 0.7 * v + 0.3 * sin (v * 13.0)) 0.5+ emit "statistical/autocorr.svg" $+ purePlot+ <> layer (autocorr (inline ar1Vals) <> autocorrMaxLag 30+ <> color (fromHex "#377EB8"))+ <> title "autocorr (= MCMC AR(1)、 max lag 30、 ±1.96/√N band)"+ <> xLabel "lag" <> yLabel "r(τ)"++ -- ESS (Phase 8 B13): パラメータごとの計算済み ESS 値を棒に (= ggplot/bayesplot 流、+ -- 計算は統計ライブラリの責務、 plot は値を描くだけ)。 閾値 100/400 で色分け。+ let essParams :: [Text]+ essParams = ["alpha", "beta", "sigma", "mu", "tau", "theta"]+ essValues :: [Double]+ essValues = [820.0, 640.0, 95.0, 410.0, 280.0, 55.0] -- sigma/theta が低い (= 要注意)+ emit "statistical/ess.svg" $+ purePlot+ <> layer (ess (inlineCat essParams) (inline essValues))+ <> title "ESS (= parameter ごとの有効サンプルサイズ、 閾値 100/400)"+ <> xLabel "parameter" <> yLabel "ESS"+ <> title "ESS (= 4 chain、 Geyer initial positive sequence)"+ <> xLabel "chain" <> yLabel "ESS"++ -- MCMC trace+ let mcmcSteps = [0, 1 .. 199] :: [Double]+ mcmcVals = map (\i -> sin (i * 0.05) + i * 0.001) mcmcSteps+ emit "statistical/trace.svg" $+ purePlot+ <> layer (trace (inline mcmcSteps) (inline mcmcVals) <> stroke 1.5)+ <> title "MCMC trace plot"+ <> xLabel "step" <> yLabel "θ"++ -- pairs plot (Phase 8 B16): N=50、 列間に相関 (height=正、 weight=負) + 名前付き列+ let p1 = gaussian 17 5.0 1.5 80 :: [Double] -- N=80 で単峰が安定+ p2 = zipWith (\a e -> 0.8 * a + e) p1 (gaussian 29 1.0 0.6 80) -- p1 と正相関+ p3 = zipWith (\a e -> negate 0.6 * a + e) p1 (gaussian 43 8.0 0.8 80) -- p1 と負相関+ p4 = gaussian 53 5.0 1.5 80 -- 独立+ p5 = zipWith (\a e -> 0.5 * a + e) p2 (gaussian 59 2.0 0.7 80)+ pairsResolver k = case k of+ "age" -> Just (NumData (V.fromList p1))+ "height" -> Just (NumData (V.fromList p2))+ "weight" -> Just (NumData (V.fromList p3))+ "bmi" -> Just (NumData (V.fromList p4))+ "score" -> Just (NumData (V.fromList p5))+ _ -> Nothing+ emitR "statistical/pairs.svg" pairsResolver+ (purePlot+ <> pairs ["age", "height", "weight", "bmi", "score"]+ <> title "pairs plot (5 変数 × N=80、 相関あり)")++ -- ===========================================================================+ -- DECORATION+ -- ===========================================================================++ -- facet (= Resolver 経由で column 解決が必要、 inline では不可なので別 demo)+ let facetResolver facetN = case facetN of+ "x" -> Just (NumData (V.fromList [1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4]))+ "y" -> Just (NumData (V.fromList [1, 4, 9, 16, 2, 5, 8, 12, 3, 6, 9, 15]))+ "g" -> Just (TxtData (V.fromList ["A","A","A","A","B","B","B","B","C","C","C","C"]))+ _ -> Nothing+ emitR "decoration/facet.svg" facetResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "g" <> size 6)+ <> facet "g"+ <> title "facet (= Trellis、 3 panel)"++ -- Phase 10 A5: facet + coord_flip。 各 panel が vsCoord を継承し、 flip scale も+ -- panelArea に retarget されて panel が重ならないことを確認 (罠5 = flip scale 伝播)。+ emitR "coord/facet-flip.svg" facetResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "g" <> size 6)+ <> facet "g"+ <> coordFlip+ <> title "facet + coord_flip (3 panel・各 panel flip)"++ -- Phase 8 C G7: facet_wrap 複数行 (ncol=3 → 5 群を 3 列 2 行に折り返し)。+ -- 最下行のみ x 軸・左端列のみ y 軸 (ggplot facet_wrap の内側軸 drop)。+ let facetWrapResolver facetN = case facetN of+ "x" -> Just (NumData (V.fromList (concat (replicate 5 [1,2,3,4]))))+ "y" -> Just (NumData (V.fromList+ [1,4,9,16, 2,5,8,12, 3,6,9,15, 2,3,7,10, 4,8,11,14]))+ "g" -> Just (TxtData (V.fromList (concatMap (replicate 4)+ ["A","B","C","D","E"])))+ _ -> Nothing+ emitR "decoration/facet-wrap.svg" facetWrapResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "g" <> size 6)+ <> facetWrap "g" 3+ <> title "facet_wrap (ncol=3、 5 panel → 2 行)"++ -- Phase 11 A7-b: facet free scales (= ggplot facet_wrap(scales="free"))。+ -- 群ごとに y のスケールが大きく違う (A: 0..16, B: 0..1200, C: 0..0.3)。 free だと+ -- 各 panel が自分のデータ範囲で軸を持ち、 全 panel に x/y 軸が出る。+ let facetFreeResolver facetN = case facetN of+ "x" -> Just (NumData (V.fromList [1,2,3,4, 1,2,3,4, 1,2,3,4]))+ "y" -> Just (NumData (V.fromList+ [1,4,9,16, 300,600,900,1200, 0.05,0.1,0.2,0.3]))+ "g" -> Just (TxtData (V.fromList (concatMap (replicate 4) ["A","B","C"])))+ _ -> Nothing+ emitR "decoration/facet-free.svg" facetFreeResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "g" <> size 6)+ <> facet "g"+ <> facetScales FacetFree+ <> title "facet free scales (各 panel 独立 y 軸)"++ -- Phase 8 C G7 part-b: facet_grid(row ~ col) 2 変数 cross (2 行 × 3 列)。+ -- 上 strip = col 名 (各列頭)、 右 strip = row 名 (各行端・縦書き)、 軸は最下行 x・左端列 y。+ let fgRows = ["top","bot"]+ fgCols = ["L","M","R"]+ fgX = concat (replicate 6 [1,2,3,4])+ fgY = [1,2,3,4, 1,3,5,7, 1,4,7,10, 2,2,2,2, 4,3,2,1, 1,5,3,8]+ fgR = concatMap (replicate 12) fgRows+ fgC = concat (replicate 2 (concatMap (replicate 4) fgCols))+ facetGridResolver fn = case fn of+ "x" -> Just (NumData (V.fromList fgX))+ "y" -> Just (NumData (V.fromList fgY))+ "r" -> Just (TxtData (V.fromList fgR))+ "c" -> Just (TxtData (V.fromList fgC))+ _ -> Nothing+ emitR "decoration/facet-grid.svg" facetGridResolver $+ purePlot+ <> layer (scatter "x" "y" <> size 6)+ <> facetGrid "r" "c"+ <> title "facet_grid (r ~ c、 2 行 × 3 列)"++ -- Phase 11 A7-b: facet_grid free scales + space="free"。 列ごとに x 範囲が違い+ -- (L:0..3, M:0..6, R:0..12 = 1:2:4)、 行ごとに y 範囲が違う (top:0..4, bot:0..8 = 1:2)。+ -- free_x = 列共有 x domain、 free_y = 行共有 y domain。 space free で列幅/行高を+ -- data 範囲に比例 (= 各 panel の単位長が揃う)。 A6: 旧データは 1:10:100 / 1:100 と+ -- 範囲差が極端で L列・top行が比例で極小化し潰れたため、 穏当な比に緩和 (計算ロジックは不変)。+ let fgfX = [ 0,1,2,3, 0,2,4,6, 0,4,8,12 -- top 行: L/M/R (範囲 3:6:12 = 1:2:4)+ , 0,1,2,3, 0,2,4,6, 0,4,8,12 ] -- bot 行+ fgfY = [ 1,2,3,4, 1,2,3,4, 1,2,3,4 -- top 行: y 範囲 3+ , 2,4,6,8, 2,4,6,8, 2,4,6,8 ] -- bot 行: y 範囲 6 (top:bot = 1:2)+ facetGridFreeResolver fn = case fn of+ "x" -> Just (NumData (V.fromList fgfX))+ "y" -> Just (NumData (V.fromList fgfY))+ "r" -> Just (TxtData (V.fromList (concatMap (replicate 12) ["top","bot"])))+ "c" -> Just (TxtData (V.fromList (concat (replicate 2 (concatMap (replicate 4) ["L","M","R"])))))+ _ -> Nothing+ emitR "decoration/facet-grid-free.svg" facetGridFreeResolver $+ purePlot+ <> layer (scatter "x" "y" <> size 6)+ <> facetGrid "r" "c"+ <> facetScales FacetFree+ <> facetSpace SpaceFree+ <> title "facet_grid free + space (列x/行y 独立・幅比例)"++ -- facet strip.background (灰矩形) の theme 連動デモ。 Parchment (羊皮紙 strip) で+ -- strip 帯が panel/grid と調和して描かれることを確認。 facet_grid で 上 strip + 右 strip 両方。+ emitR "decoration/facet-strip-themed.svg" facetGridResolver $+ purePlot+ <> layer (scatter "x" "y" <> size 6)+ <> facetGrid "r" "c"+ <> theme ThemeParchment+ <> title "facet strip + theme (parchment 羊皮紙 strip)"++ -- subplots+ let sp1 = purePlot+ <> layer (scatter (inline [1.0,2,3,4,5 :: Double]) (inline [1.0,4,9,16,25]))+ <> title "x²"+ sp2 = purePlot+ <> layer (line (inline [1.0,2,3,4,5 :: Double]) (inline [2.0,4,8,16,32]))+ <> title "2^x"+ sp3 = purePlot+ <> layer (bar (inlineCat (["a","b","c","d"] :: [Text]))+ (inline [3.0,7,5,9]))+ <> title "bar"+ emit "decoration/subplots.svg" $+ purePlot+ <> subplots [sp1, sp2, sp3]+ <> subplotCols 3+ <> title "subplots (任意 spec 並列)"+ <> widthUnit (900 *~ px) <> heightUnit (350 *~ px)++ -- Phase 52.D concat 合成 (Vega-Lite hconcat/vconcat 相当・patchwork 風演算子)。+ -- (a <-> b <-> c) <:> d = 1 行目 3 列 + 2 行目を全幅 (1 行目セルの 3 倍幅)。+ let sp4 = purePlot+ <> layer (scatter (inline [0.0,1,2,3,4 :: Double]) (inline [0.0,3,1,4,2]))+ <> title "full-width row"+ emit "decoration/concat.svg" $+ ((sp1 <-> sp2 <-> sp3) <:> sp4)+ <> title "(a <-> b <-> c) <:> d (横3列 + 全幅)"+ <> widthUnit (900 *~ px) <> heightUnit (500 *~ px)++ -- annotation (Phase 8 B20: 機能を並べるだけでなく「外れ値を指す」実用的な配置に)。+ -- データはほぼ y=8x の直線だが x=3 だけ外れ値 (70、 本来 24)。 トレンド線 (Line)、+ -- 外れ値を囲む focus 枠 (Rect)、 ラベル (Text) と そこから点への矢印 (Arrow) を連携させる。+ let axs = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] :: [Double]+ ays = [0, 8, 16, 70, 32, 40, 48, 56, 64, 72] :: [Double]+ emit "decoration/annotation.svg" $+ purePlot+ <> layer (scatter (inline axs) (inline ays) <> size 5)+ <> annotLine 0.0 0.0 9.0 72.0 -- トレンド線 (y=8x)+ <> annotRect 2.5 62.0 1.0 16.0 "#f59e0b" -- 外れ値 (3,70) を囲む focus 枠 (amber)+ <> annotText 4.7 74.0 "outlier?" -- ラベル (点の右上)+ <> annotArrow 4.0 74.0 3.18 70.5 -- ラベル → 外れ値点 への矢印+ <> title "annotation (text / arrow / line / rect)"+ <> xLabel "x" <> yLabel "y"++ -- Phase 11 A5-a: labs (title / subtitle / caption / tag)。+ emit "decoration/labs.svg" $+ purePlot+ <> layer (scatter (inline axs) (inline ays) <> size 5)+ <> labs emptyLabs { labsTitle = Just "Fuel efficiency vs displacement"+ , labsSubtitle = Just "各点 = 1 車種 (sample data)"+ , labsCaption = Just "Source: hgg gallery demo"+ , labsTag = Just "A"+ , labsX = Just "displacement"+ , labsY = Just "mpg" }++ -- inset axes+ emit "decoration/inset.svg" $+ purePlot+ <> layer (scatter (inline xs) (inline ys) <> size 5)+ <> title "scatter + inset (zoom)"+ <> insetAt 0.6 0.05 0.35 0.35+ (purePlot+ <> layer (scatter (inline (take 4 xs)) (inline (take 4 ys)) <> size 7))++ -- marginal (= 軸外に x/y の周辺 histogram)。+ -- Phase 8 B18: 旧 demo は rxs=[0..9] (N=10) で各 bin がほぼ均一 → 周辺分布が見えなかった。+ -- gaussian で相関のある 2 変数 (N=200) にし、 x/y それぞれ正規分布の山が周辺 hist に+ -- 出るようにする (= seaborn jointplot 風)。+ let mgx = gaussian 211 5.0 1.5 200 :: [Double]+ mgy = zipWith (\a e -> a + 1.0 + e) mgx (gaussian 223 0.0 1.0 200) -- mgx と正相関+ emit "decoration/marginal.svg" $+ purePlot+ <> layer (scatter (inline mgx) (inline mgy) <> size 4 <> alpha 0.5)+ <> marginal+ <> title "scatter + marginal histograms"+ <> xLabel "x" <> yLabel "y"+ <> widthUnit (700 *~ px) <> heightUnit (700 *~ px)++ -- dual Y+ let dyL = map (* 1) ys+ dyR = map (\v -> v / 10) ys+ emit "decoration/dual-y.svg" $+ purePlot+ <> layer (line (inline xs) (inline dyL) <> color (fromHex "#2563eb") <> stroke 2)+ <> layer (line (inline xs) (inline dyR)+ <> color (fromHex "#dc2626") <> stroke 2 <> toRightY)+ <> yAxisRight (mempty <> axisFormat (AxisDecimalFmt 2))+ <> title "dual Y axis"++ -- legend chip: Resolver 経由で color encoding (= 凡例に表示する category)+ let legendResolver k = case k of+ "x" -> Just (NumData (V.fromList ([0, 1, 2, 3, 4, 5, 6, 7, 8, 9,+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9] :: [Double])))+ "y" -> Just (NumData (V.fromList ([0, 1, 4, 9, 16, 25, 36, 49, 64, 81,+ 0, 0.7, 2.8, 6.3, 11.2, 17.5, 25.2, 34.3, 44.8, 56.7] :: [Double])))+ "group" -> Just (TxtData (V.fromList (replicate 10 "Series A" ++ replicate 10 "Series B")))+ _ -> Nothing+ emitR "decoration/legend.svg" legendResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "group" <> size 5)+ <> legend+ <> legendPos LegendInsideTopLeft+ <> title "legend chip (top-left)"++ -- Phase 9 A-5: legend 配置を ggplot に揃える (panel を縮め図内に収める)。 Right (既定) は+ -- panel 右の予約域、 Bottom は panel 下の予約域、 continuous は gradient bar。 HS/PS 同一。+ emitR "decoration/legend-bottom.svg" legendResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "group" <> size 5)+ <> legendPos LegendBottom+ <> title "legend (bottom)"+ emitR "decoration/legend-continuous.svg" legendResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorContinuousBy "y" <> size 5)+ <> legend+ <> title "legend (continuous gradient)"++ -- Phase 11 A4-c: 凡例タイトル (= scale name / labs(color=))。 Right/Bottom 両方に出る。+ emitR "decoration/legend-title.svg" legendResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "group" <> size 5)+ <> legendTitle "Series"+ <> title "legend title (= scale name)"+ emitR "decoration/legend-title-bottom.svg" legendResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "group" <> size 5)+ <> legendPos LegendBottom+ <> legendTitle "Series"+ <> title "legend title (bottom)"++ -- Phase 11 A5-c: guides サブシステム (reverse / ncol / guide hide)。+ emitR "decoration/legend-reverse.svg" legendResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "group" <> size 5)+ <> legend+ <> legendReverse+ <> title "legend (reverse = キー逆順, 色は固定)"+ -- ncol: 6 カテゴリを 2 列に。+ let ncolResolver k = case k of+ "x" -> Just (NumData (V.fromList (map fromIntegral [0 .. 11 :: Int])))+ "y" -> Just (NumData (V.fromList (map (\i -> fromIntegral (i `mod` 6 :: Int)) [0 .. 11 :: Int])))+ "g" -> Just (TxtData (V.fromList (concatMap (replicate 2)+ (["cat-1", "cat-2", "cat-3", "cat-4", "cat-5", "cat-6"] :: [Text]))))+ _ -> Nothing+ emitR "decoration/legend-ncol.svg" ncolResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "g" <> size 5)+ <> legend+ <> legendNcol 2+ <> title "legend (ncol=2, 6 カテゴリ → 2 列)"+ -- guide hide: 色分けはするが凡例を出さない (= guides(color="none"))。+ emitR "decoration/guide-none.svg" legendResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "group" <> size 5)+ <> guideColorNone+ <> title "guides(color=none) = 凡例非表示"++ -- refLine+ emit "decoration/refline.svg" $+ purePlot+ <> layer (scatter (inline xs) (inline ys) <> size 5)+ <> refHorizontal 40+ <> title "scatter + reference horizontal at y=40"++ -- jitter (Phase 6 A8、 P14 解消)+ let jxs = concat $ replicate 4 [1.0, 2, 3, 4, 5] :: [Double]+ jys = concat $ replicate 4 [3.0, 3, 3, 3, 3]+ emit "decoration/jitter.svg" $+ purePlot+ <> layer (scatter (inline jxs) (inline jys)+ <> size 5+ <> jitterX 0.02 <> jitterY 0.02+ <> alpha 0.6)+ <> title "scatter with jitter (deterministic、 hash-rand offset)"++ -- ===========================================================================+ -- AXES+ -- ===========================================================================++ -- log axis+ let lxs = [1, 10, 100, 1000, 10000] :: [Double]+ lys = [2.0, 8.0, 16.0, 64.0, 256.0]+ emit "axes/log.svg" $+ purePlot+ <> layer (scatter (inline lxs) (inline lys) <> size 6)+ <> xAxis logAxis+ <> yAxis logAxis+ <> title "log-log axes"++ -- sqrt axis (Phase 6 A6 で Layout 対応済)+ emit "axes/sqrt.svg" $+ purePlot+ <> layer (scatter (inline xs) (inline ys) <> size 5)+ <> yAxis sqrtAxis+ <> title "sqrt y axis (= Phase 6 A6)"++ -- time axis (Phase 6 A7 で Layout + niceTimeTicks 対応)+ -- 入力: unix epoch (= seconds since 1970)+ let tdays = [1735689600.0, 1735776000, 1735862400, 1735948800, 1736035200, 1736121600] :: [Double]+ tvals = [10.0, 14.0, 11.0, 16.0, 18.0, 13.0]+ emit "axes/time.svg" $+ purePlot+ <> layer (line (inline tdays) (inline tvals) <> stroke 2)+ <> xAxis (timeAxis "%Y-%m-%d")+ <> title "time axis (= Phase 6 A7、 unix epoch + AxisTimeFmt)"++ -- format+ emit "axes/format.svg" $+ purePlot+ <> layer (scatter (inline xs) (inline (map (* 100000) ys)) <> size 5)+ <> yAxis (axisFormat (AxisExponentFmt 1))+ <> title "exponent y format"++ -- coord_fixed (Phase 8 A2 Step2): aspect = panel 高/幅比。 1.0 で正方 panel を+ -- 可用域内に取り中央寄せ (ggplot coord_fixed)。 600x400 なので左右に余白が出る。+ emit "axes/coord-fixed.svg" $+ purePlot+ <> layer (scatter (inline xs) (inline ys) <> size 5)+ <> aspectRatio 1.0+ <> title "coord_fixed (aspect = 1)"+ <> xLabel "x" <> yLabel "y"++ -- ===========================================================================+ -- THEME+ -- ===========================================================================++ emit "theme/dark.svg" $+ purePlot+ <> layer (scatter (inline xs) (inline ys) <> size 5 <> color (fromHex "#56B4E9"))+ <> theme ThemeDark+ <> title "dark theme"++ emit "theme/light.svg" $+ purePlot+ <> layer (scatter (inline xs) (inline ys) <> size 5)+ <> theme ThemeLight+ <> title "light theme (= default)"++ -- theme preset (ggplot theme_grey) + ブランド 3 種。+ -- color by group で各 theme の panel 背景・grid・既定 series palette を一度に確認。+ -- series palette は 7 色あるので 7 群 (A-G) を扇状にずらした直線で配置し、 全色を一度に確認。+ let gxs = [0,1,2,3,4,5,6,7] :: [Double]+ grpY i = [ fromIntegral (i * 3) + (1.0 + fromIntegral i * 0.18) * x | x <- gxs ]+ grpLabels = ["A","B","C","D","E","F","G"] :: [Text]+ themeResolver k = case k of+ "x" -> Just (NumData (V.fromList (concat (replicate 7 gxs))))+ "y" -> Just (NumData (V.fromList (concat [ grpY i | i <- [0..6] :: [Int] ])))+ "group" -> Just (TxtData (V.fromList (concat [ replicate 8 g | g <- grpLabels ])))+ _ -> Nothing+ themeDemo file thm ttl =+ emitR file themeResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "group" <> size 5)+ <> theme thm+ <> legend+ <> title ttl+ themeDemo "theme/grey.svg" ThemeGrey "theme_grey (ggplot 既定: 灰 panel + 白 grid)"+ themeDemo "theme/noir.svg" ThemeNoir "Noir (暗・寒色アクセント)"+ themeDemo "theme/lumen.svg" ThemeLumen "Lumen (白基調・深い差し色)"+ themeDemo "theme/canvas.svg" ThemeParchment "Parchment (明: 外周白 + 羊皮紙 panel)"+ themeDemo "theme/canvas-dark.svg" ThemeParchmentDark "Parchment Dark (Charcoal)"+ themeDemo "theme/bw.svg" ThemeBW "theme_bw (白背景 + 4 辺枠)"+ themeDemo "theme/classic.svg" ThemeClassic "theme_classic (grid なし + 下/左 軸線)"+ themeDemo "theme/void.svg" ThemeVoid "theme_void (背景・grid・枠 すべてなし)"+ themeDemo "theme/linedraw.svg" ThemeLinedraw "theme_linedraw (細い黒 grid + 黒枠)"++ -- 学術向け named series palette を theme と独立に適用するデモ (theme=Minimal 白背景固定で色だけ差替)。+ let paletteDemo file pal ttl =+ emitR file themeResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "group" <> size 5)+ <> theme ThemeMinimal+ <> palette pal+ <> legend+ <> title ttl+ paletteDemo "palette/okabe-ito.svg" okabeIto "Okabe-Ito (colorblind-safe)"+ paletteDemo "palette/tol-bright.svg" tolBright "Paul Tol bright (colorblind-safe)"+ paletteDemo "palette/brewer-set2.svg" brewerSet2 "ColorBrewer Set2"+ paletteDemo "palette/brewer-dark2.svg" brewerDark2 "ColorBrewer Dark2"++ -- A-2: element 単位 theme override の例 (preset に themeGrid/panelBorder 等を `<>` で重ねる)。+ let overrideDemo file extra ttl =+ emitR file themeResolver $+ purePlot+ <> layer (scatter "x" "y" <> colorBy "group" <> size 5)+ <> extra+ <> legend+ <> title ttl+ overrideDemo "theme/ov-grey-nogrid.svg"+ (theme ThemeGrey <> themeGrid False)+ "theme_grey + grid off (override)"+ overrideDemo "theme/ov-canvas-custom.svg"+ (theme ThemeParchment <> panelBorder True <> gridColor "#d8c9a8")+ "canvas + border on + custom grid (override)"++ -- A-3: 文字 theme 統合の例。 theme 経由で title / tick の font を上書き、 axis.text を回転。+ overrideDemo "theme/ov-font.svg"+ (theme ThemeMinimal+ <> themeTitleFont (fontSize 20 <> fontWeight "bold" <> fontColor "#7A1F23")+ <> themeTickFont (fontSize 13 <> fontColor "#3E6A6F"))+ "theme font override (title 20pt bold + tick 13pt teal)"+ overrideDemo "theme/ov-axis-angle.svg"+ (theme ThemeMinimal <> themeAxisTextAngle 45)+ "theme axis.text angle = 45° (x/y 両軸)"++ -- ===========================================================================+ -- STATISTICAL: DAG / ModelGraph (= Phase 1 完了の hbm 風)+ -- ===========================================================================++ let alphaN = ("alpha" :: Text, "α" :: Text, NodeLatent)+ betaN = ("beta" :: Text, "β" :: Text, NodeLatent)+ sigmaN = ("sigma" :: Text, "σ" :: Text, NodeLatent)+ muN = ("mu" :: Text, "μ" :: Text, NodeLatent)+ yN = ("y" :: Text, "y" :: Text, NodeObserved)+ nodes = [ dagNode (one t) (two t) (three t) 0 0+ | t <- [alphaN, betaN, sigmaN, muN, yN] ]+ edges = [ dagEdge "alpha" "mu"+ , dagEdge "beta" "mu"+ , dagEdge "mu" "y"+ , dagEdge "sigma" "y" ]+ one (a,_,_) = a; two (_,b,_) = b; three (_,_,c) = c+ -- ★ 階層 layout (Sugiyama) を適用して dnX/dnY を埋める。 これを通さないと+ -- 全 node が dnX=dnY=0 のまま 1 点に潰れる (dagPlotWith の内部処理と同一)。+ (positioned, routedEdges) = layoutHierarchicalFull nodes edges+ emit "statistical/dag-hbm.svg" $+ purePlot+ <> layer (dagFromLists positioned routedEdges LayoutHierarchical)+ <> title "DAG (HBM-like): Phase 1 Sugiyama framework"+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)++ putStrLn "Done. Outputs in design/gallery/"++-- ===========================================================================+-- helper: 共通 width/height + emptyResolver で saveSVG+-- ===========================================================================++-- ===========================================================================+-- helper: 決定論的 Gaussian (= 再現可能な demo データ生成、 Phase 8)+-- ===========================================================================++-- | 線形合同法 (LCG) による決定論的 [0,1) 一様乱数列。 seed 固定で再現可能。+-- glibc 系パラメータ (a=1103515245, c=12345, m=2^31)。+lcg01 :: Int -> [Double]+lcg01 seed = go (fromIntegral seed `mod` m)+ where+ a = 1103515245 :: Integer+ c = 12345 :: Integer+ m = 2147483648 :: Integer -- 2^31+ go s = let s' = (a * s + c) `mod` m+ in fromIntegral s' / fromIntegral m : go s'++-- | 決定論的 Gaussian N(mu, sigma) を n 個。 Box-Muller (LCG 一様列のペアから生成)。+gaussian :: Int -> Double -> Double -> Int -> [Double]+gaussian seed mu sigma n = take n (boxMuller (lcg01 seed))+ where+ boxMuller (u1 : u2 : rest) =+ let r = sqrt (negate 2 * log (max 1e-12 u1))+ z = r * cos (2 * pi * u2)+ in (mu + sigma * z) : boxMuller rest+ boxMuller _ = []++-- | Phase 8 B2: 分布系プロット (raincloud/violin/strip/swarm/ridge/box) で共用する+-- 群データ。 4 群 × 各 N=90、 群ごとに平均・分散を変えた正規分布 (= 参照画像の+-- DD/DR/RD/RR 風)。 決定論的なので compare 回帰に使える。+groupLabels :: [Text]+groupLabels = ["DD", "DR", "RD", "RR"]++groupSpecs :: [(Text, Int, Double, Double)] -- (label, seed, mu, sigma)+groupSpecs =+ [ ("DD", 11, 95.0, 22.0)+ , ("DR", 23, 82.0, 16.0)+ , ("RD", 37, 101.0, 20.0)+ , ("RR", 53, 78.0, 14.0)+ ]++-- | 群データを (繰り返しラベル, 値) の 2 列に flatten。 各群 N=90。+groupedDemo :: ([Text], [Double])+groupedDemo =+ let n = 90+ perGroup = [ (replicate n lbl, gaussian seed mu sigma n)+ | (lbl, seed, mu, sigma) <- groupSpecs ]+ in (concatMap fst perGroup, concatMap snd perGroup)++emit :: FilePath -> VisualSpec -> IO ()+emit relPath spec = do+ let sized = spec <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ saveSVG ("design/gallery/" ++ relPath) sized+ -- DAG layer を含む spec は edge routing (deRoute) を JSON へ焼き込む。+ -- PS canvas は routing を持たないため、 これで HS と同じ spline を再現できる+ -- (DAG を含まない spec には no-op)。+ writeSpecJSON relPath (bakeDAGRoutesInSpec sized)++emitR :: FilePath -> Resolver -> VisualSpec -> IO ()+emitR relPath r spec = do+ let sized = spec <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ saveSVGWith ("design/gallery/" ++ relPath) r sized+ -- Phase 8 B16: Resolver を JSON に焼き込む (ColByName → inline)。 PS は Resolver を+ -- 持たないため、 これをしないと pairs/facet/legend 等が PS で空になる。+ writeSpecJSON relPath (bakeSpec r sized)++-- | spec を JSON 化して design/gallery/specs/ に同名 .json で保存。+-- 比較 demo (= compare.html) で PS canvas backend に渡す入力になる。+-- Resolver は inline data 前提なので保存しない (= ColNum / ColTxt は inline で完結)。+writeSpecJSON :: FilePath -> VisualSpec -> IO ()+writeSpecJSON relPath spec = do+ let jsonPath = "design/gallery/specs/" ++ replaceExt relPath ".json"+ dir = takeDir jsonPath+ System.Directory.createDirectoryIfMissing True dir+ Data.ByteString.Lazy.writeFile jsonPath (Data.Aeson.encode spec)+ where+ replaceExt p _ = takeWhile (/= '.') p ++ ".json"+ takeDir p =+ let parts = reverse (splitOn '/' p)+ in case parts of+ [] -> "."+ [_] -> "."+ _:rest -> joinWith '/' (reverse rest)+ splitOn c s = case break (== c) s of+ (h, []) -> [h]+ (h, _:t) -> h : splitOn c t+ joinWith _ [] = ""+ joinWith _ [x] = x+ joinWith c (x:xs) = x ++ [c] ++ joinWith c xs
+ examples/JsonDump.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where+import Graphics.Hgg.Easy+import Graphics.Hgg.Unit (px, (*~))+import Data.Aeson (encode)+import qualified Data.ByteString.Lazy.Char8 as BL++main :: IO ()+main = do+ let s = purePlot+ <> layer (scatter "x" "y" <> alpha 0.7 <> size 5+ <> colorBy "g")+ <> layer (line (inline [1.0, 2.0, 3.0]) (inline [4.0, 5.0, 6.0])+ <> color (fromHex "#ff0000"))+ <> title "demo"+ <> theme ThemeDark+ <> facet "region"+ <> widthUnit (800 *~ px) <> heightUnit (600 *~ px)+ BL.putStrLn (encode s)
+ examples/ScatterDemo.hs view
@@ -0,0 +1,214 @@+-- | Phase 26 §A-2 新 API デモ: 全 helper を `<>` で paren 無し合成。+--+-- @+-- cabal run scatter-demo+-- @+-- → カレントディレクトリに @scatter-demo.svg@ が生成される。+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Graphics.Hgg.Backend.SVG (saveSVG, saveSVGWith, saveSVGInteractive)+import Graphics.Hgg.Unit (px, (*~))+import qualified Graphics.Hgg.DAG+import Graphics.Hgg.DAG ((~>))+import Graphics.Hgg.Easy+import qualified Graphics.Hgg.Spec+import Data.Text (Text)+import qualified Data.Vector as V++main :: IO ()+main = do+ -- y = x² + regression line を Layer monoid で構築+ let xs = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] :: [Double]+ ys = map (\x -> x * x) xs+ fitY = map (\x -> 8 * x - 12) xs -- 直線当てはめ (= demo 用)+ spec+ = purePlot+ <> layer (scatter (inline xs) (inline ys) <> alpha 0.85 <> size 5)+ <> layer (line (inline xs) (inline fitY) <> color (fromHex "#d62728") <> stroke 2)+ <> title "y = x² (with linear fit)"+ <> xLabel "x"+ <> yLabel "y"+ <> widthUnit (800 *~ px)+ <> heightUnit (600 *~ px)+ saveSVG "scatter-demo.svg" spec+ saveSVG "scatter-demo-dark.svg" (spec <> theme ThemeDark)+ -- categorical 色分け demo: 30 点を 3 group に+ let xs2 = [0, 1 .. 29] :: [Double]+ ys2 = [ sin (x / 3) * 5 + 10 | x <- xs2 ]+ grp = take 30 (cycle (["A", "B", "C"] :: [String]))+ spec2+ = purePlot+ <> layer (scatter (inline xs2) (inline ys2)+ <> colorBy (inlineCat grp)+ <> size 6+ <> alpha 0.85)+ <> title "Scatter by group (categorical color)"+ <> xLabel "t" <> yLabel "f(t)"+ saveSVG "scatter-categorical.svg" spec2+ -- Interactive (= hover tooltip + drag pan + wheel zoom、 ブラウザで開いて確認)+ saveSVGInteractive "scatter-interactive.svg" emptyResolver spec2+ -- Box + Density 統計 chart demo (= Phase 26 §E-2)+ let vals = [3.0, 4.0, 4.5, 5.0, 5.0, 5.2, 5.5, 6.0, 6.5, 7.0, 8.0, 12.0]+ boxSpec = purePlot <> layer (boxplot (inline vals))+ <> title "Boxplot demo" <> widthUnit (400 *~ px) <> heightUnit (600 *~ px)+ densSpec = purePlot <> layer (density (inline vals))+ <> title "Density (KDE) demo"+ <> xLabel "value" <> yLabel "density"+ saveSVG "box-demo.svg" boxSpec+ saveSVG "density-demo.svg" densSpec+ -- LogScale demo (= Phase 26 §C-2 #1)+ let xsLog = [1, 10, 100, 1000, 10000] :: [Double]+ ysLog = [2, 30, 500, 8000, 120000] :: [Double]+ logSpec = purePlot+ <> layer (scatter (inline xsLog) (inline ysLog) <> size 6)+ <> xAxis logAxis+ <> yAxis logAxis+ <> title "Log-Log demo (= xLog + yLog)"+ <> xLabel "x (log)" <> yLabel "y (log)"+ saveSVG "loglog-demo.svg" logSpec+ -- AxisFormat demo (= Phase 26 §C-2 #2)+ let fmtSpec = purePlot+ <> layer (scatter (inline [0.0, 1.0, 2.0]) (inline [0.001234, 0.05678, 1.234]))+ <> yAxis (axisFormat (AxisExponentFmt 2))+ <> xAxis (axisFormat AxisIntegerFmt)+ <> title "Axis format: Y=exp(2digit), X=integer"+ <> xLabel "x" <> yLabel "y"+ saveSVG "axisformat-demo.svg" fmtSpec+ -- Reference line demo (= Phase 26 §C-2 #3)+ let xsR = [0.0, 1.0, 2.0, 3.0, 4.0, 5.0] :: [Double]+ ysR = [0.1, 1.2, 1.8, 3.3, 4.1, 5.2] :: [Double]+ refSpec = purePlot+ <> layer (scatter (inline xsR) (inline ysR) <> size 6)+ <> refIdentity -- y = x (Actual vs Predicted の対角線)+ <> refHorizontal 2.5 -- y = 2.5+ <> refVertical 3.0 -- x = 3.0+ <> title "Reference lines (y=x / y=2.5 / x=3)"+ <> xLabel "predicted" <> yLabel "actual"+ saveSVG "refline-demo.svg" refSpec+ -- Trellis (facet) demo (= Phase 26 §C-2 #12)+ let r facetN = case facetN of+ "x" -> Just (NumData (V.fromList [1, 2, 3, 4, 1, 2, 3, 4, 1, 2, 3, 4]))+ "y" -> Just (NumData (V.fromList [1, 4, 9, 16, 2, 5, 8, 12, 3, 6, 9, 15]))+ "g" -> Just (TxtData (V.fromList ["A","A","A","A","B","B","B","B","C","C","C","C"]))+ _ -> Nothing+ facetSpec = purePlot+ <> layer (scatter "x" "y" <> colorBy "g" <> size 6)+ <> facet "g"+ <> title "Facet by group (3 panel)"+ <> xLabel "x" <> yLabel "y"+ saveSVGWith "facet-demo.svg" r facetSpec+ -- DAG demo (= §E-6: HBM ModelGraph、 algebraic-graphs 流 API)+ let alphaN = ("alpha" :: Text, "α" :: Text, NodeLatent)+ betaN = ("beta" :: Text, "β" :: Text, NodeLatent)+ sigmaN = ("sigma" :: Text, "σ" :: Text, NodeLatent)+ yN = ("y" :: Text, "y obs" :: Text, NodeObserved)+ hbmGraph = alphaN ~> sigmaN+ <> betaN ~> sigmaN+ <> sigmaN ~> yN+ <> alphaN ~> yN+ <> betaN ~> yN+ dagSpec = purePlot+ <> layer (Graphics.Hgg.DAG.dagPlot hbmGraph <> size 22)+ <> title "HBM ModelGraph (§E-6 DAG, hierarchical layout)"+ <> theme ThemeLight+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ saveSVG "dag-demo.svg" dagSpec+ -- ユーザ PyMC モデル再現 (= s_C/s_P/b_C/b_P/b1〜b4 priors + Weather/A/Score MutableData+ -- + x_J/x_C/x_P/x deterministic + Y Bernoulli observed、 record/course/person plates)+ let pymcLikeSpec = purePlot+ <> layer (Graphics.Hgg.Spec.dagFromListsWithPlates pymcNodes pymcEdges+ Graphics.Hgg.Spec.LayoutManual pymcPlates+ <> size 24)+ <> title "PyMC モデル再現 (自作 hgg)"+ <> theme ThemeLight+ <> widthUnit (1000 *~ px) <> heightUnit (720 *~ px)+ saveSVG "pymc-like-demo.svg" pymcLikeSpec+ -- TODO-3 (2026-05-29) sub-features demo: jitter + shapeBy + sizeBy + colorCats+ let xs3 = [1.0, 1.0, 2.0, 2.0, 3.0, 3.0, 4.0, 4.0, 5.0, 5.0] :: [Double]+ ys3 = [1.5, 1.8, 2.2, 2.6, 3.1, 3.5, 4.0, 4.4, 4.7, 5.2] :: [Double]+ g3 = ["A","B","A","B","A","B","A","B","A","B"] :: [Text]+ s3 = [1.0, 5.0, 2.0, 4.0, 3.0, 6.0, 4.5, 2.5, 5.5, 3.5] :: [Double]+ todo3Spec = purePlot+ <> layer (scatter (inline xs3) (inline ys3)+ <> jitterX 0.03+ <> jitterY 0.03+ <> colorBy (inlineCat g3)+ <> colorCats ["A", "B"]+ <> shapeBy (inlineCat g3)+ <> shapeMapEntry "A" MShTriangle+ <> shapeMapEntry "B" MShSquare+ <> sizeBy (inline s3)+ <> alpha 0.9)+ <> title "TODO-3 demo (jitter + shapeBy + sizeBy + colorCats)"+ <> xLabel "x" <> yLabel "y"+ <> widthUnit (700 *~ px) <> heightUnit (500 *~ px)+ <> xAxis (axisRotate 30)+ saveSVG "todo3-demo.svg" todo3Spec+ -- TODO-10 (2026-05-29) font sweep demo: titleFont / tickFont / axisLabelFont をカスタム+ let todo10Spec = purePlot+ <> layer (scatter (inline [1.0, 2.0, 3.0, 4.0, 5.0])+ (inline [1.0, 3.0, 2.0, 4.0, 3.5]) <> size 6)+ <> title "TODO-10 font sweep demo (bold italic title + monospace tick)"+ <> xLabel "x axis" <> yLabel "y axis"+ <> titleFont (fontSize 20 <> fontWeight "bold" <> fontItalic True+ <> fontColor "#c0392b")+ <> axisLabelFont (fontSize 14 <> fontFamily "Georgia"+ <> fontColor "#2c3e50")+ <> tickFont (fontSize 10 <> fontFamily "monospace"+ <> fontColor "#7f8c8d")+ <> widthUnit (700 *~ px) <> heightUnit (500 *~ px)+ saveSVG "todo10-demo.svg" todo10Spec+ putStrLn "wrote scatter + dark + categorical + interactive + box + density + loglog + axisformat + refline + facet + dag + pymc-like + todo3 + todo10"+ where+ -- PyMC モデル node 定義 (= LayoutManual で位置手動指定、 ユーザ画像と同じ配置)+ -- 画像から読み取り: 4 階層 (= prior super → prior → deterministic → observed)+ -- 上から: s_C/s_P → b_C/b_P/b1〜b4 + Weather/A/Score → x_J/x_C/x_P → x → Y+ pymcNodes :: [Graphics.Hgg.Spec.DAGNode]+ pymcNodes =+ [ -- 階層 0 (= 超事前、 y=0.05): HalfCauchy hyper-priors (s_C / s_P)+ Graphics.Hgg.Spec.dagNodeDist "sC" "s_C" Graphics.Hgg.Spec.NodeLatent "HalfCauchy" 0.30 0.05+ , Graphics.Hgg.Spec.dagNodeDist "sP" "s_P" Graphics.Hgg.Spec.NodeLatent "HalfCauchy" 0.55 0.05+ -- 階層 1 (= prior + data、 y=0.30)+ , Graphics.Hgg.Spec.dagNodeDist "weather" "Weather" Graphics.Hgg.Spec.NodeData "MutableData" 0.05 0.30+ , Graphics.Hgg.Spec.dagNodeDist "b4" "b4" Graphics.Hgg.Spec.NodeLatent "Flat" 0.18 0.30+ , Graphics.Hgg.Spec.dagNodeDist "bC" "b_C" Graphics.Hgg.Spec.NodeLatent "Normal" 0.30 0.30+ , Graphics.Hgg.Spec.dagNodeDist "b2" "b2" Graphics.Hgg.Spec.NodeLatent "Flat" 0.45 0.30+ , Graphics.Hgg.Spec.dagNodeDist "bP" "b_P" Graphics.Hgg.Spec.NodeLatent "Normal" 0.55 0.30+ , Graphics.Hgg.Spec.dagNodeDist "A" "A" Graphics.Hgg.Spec.NodeData "MutableData" 0.66 0.30+ , Graphics.Hgg.Spec.dagNodeDist "score" "Score" Graphics.Hgg.Spec.NodeData "MutableData" 0.78 0.30+ , Graphics.Hgg.Spec.dagNodeDist "b3" "b3" Graphics.Hgg.Spec.NodeLatent "Flat" 0.92 0.30+ -- 階層 2 (= deterministic、 y=0.55)+ , Graphics.Hgg.Spec.dagNodeDist "xJ" "x_J" Graphics.Hgg.Spec.NodeOther "Deterministic" 0.05 0.55+ , Graphics.Hgg.Spec.dagNodeDist "b1" "b1" Graphics.Hgg.Spec.NodeLatent "Flat" 0.20 0.55+ , Graphics.Hgg.Spec.dagNodeDist "xC" "x_C" Graphics.Hgg.Spec.NodeOther "Deterministic" 0.30 0.55+ , Graphics.Hgg.Spec.dagNodeDist "xP" "x_P" Graphics.Hgg.Spec.NodeOther "Deterministic" 0.66 0.55+ -- 階層 3 (= 合算 deterministic、 y=0.78)+ , Graphics.Hgg.Spec.dagNodeDist "x" "x" Graphics.Hgg.Spec.NodeOther "Deterministic" 0.10 0.78+ -- 階層 4 (= observed、 y=0.96)+ , Graphics.Hgg.Spec.dagNodeDist "Y" "Y" Graphics.Hgg.Spec.NodeObserved "Bernoulli" 0.10 0.96+ ]+ pymcEdges :: [Graphics.Hgg.Spec.DAGEdge]+ pymcEdges =+ [ Graphics.Hgg.Spec.dagEdge "sC" "bC"+ , Graphics.Hgg.Spec.dagEdge "sP" "bP"+ , Graphics.Hgg.Spec.dagEdge "weather" "xJ"+ , Graphics.Hgg.Spec.dagEdge "b4" "xJ"+ , Graphics.Hgg.Spec.dagEdge "bC" "xC"+ , Graphics.Hgg.Spec.dagEdge "b2" "xP"+ , Graphics.Hgg.Spec.dagEdge "bP" "xP"+ , Graphics.Hgg.Spec.dagEdge "A" "xP"+ , Graphics.Hgg.Spec.dagEdge "score" "xP"+ , Graphics.Hgg.Spec.dagEdge "b3" "x"+ , Graphics.Hgg.Spec.dagEdge "xJ" "x"+ , Graphics.Hgg.Spec.dagEdge "b1" "x"+ , Graphics.Hgg.Spec.dagEdge "xC" "x"+ , Graphics.Hgg.Spec.dagEdge "xP" "x"+ , Graphics.Hgg.Spec.dagEdge "x" "Y"+ ]+ pymcPlates :: [Graphics.Hgg.Spec.DAGPlate]+ pymcPlates =+ [ Graphics.Hgg.Spec.DAGPlate "record (2396)" ["xJ", "x", "Y"]+ , Graphics.Hgg.Spec.DAGPlate "course (10)" ["bC", "xC"]+ , Graphics.Hgg.Spec.DAGPlate "person (50)" ["bP", "A", "score", "xP"]+ ]
+ examples/Tutorial01Easy.hs view
@@ -0,0 +1,26 @@+-- | Tutorial 01 ─ Easy API (Layer 1)。 入門者向け、 [Double] を直接渡して 1 枚出す。+--+-- @+-- cabal run tutorial-01-easy+-- @+--+-- → カレントディレクトリに @tutorial-01-easy.svg@ を生成。+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Graphics.Hgg.Backend.SVG (saveSVG)+import Graphics.Hgg.Unit (px, (*~))+import Graphics.Hgg.Easy++main :: IO ()+main = do+ let xs = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] :: [Double]+ ys = map (\x -> x * x) xs+ -- Easy 層: `points` は値直接受け (= `scatter (inline xs) (inline ys)` の別名)、+ -- 重畳は `overlay` で包む (`scatter <> line` の落とし穴を回避)。+ saveSVG "tutorial-01-easy.svg" $+ overlay [ points xs ys ]+ <> title "Easy API: y = x\xb2"+ <> xLabel "x" <> yLabel "y"+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ putStrLn "wrote tutorial-01-easy.svg"
+ examples/Tutorial02Grammar.hs view
@@ -0,0 +1,32 @@+-- | Tutorial 02 ─ Grammar API (Layer 2、 ggplot 風)。 `inline`/`inlineCat` で+-- channel を作り、 `<>` で aesthetic を合成、 `scale_*` + `legend` で色分け。+--+-- @+-- cabal run tutorial-02-grammar+-- @+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Graphics.Hgg.Backend.SVG (saveSVG)+import Graphics.Hgg.Unit (px, (*~))+import Graphics.Hgg.Spec+import Data.Text (Text)++main :: IO ()+main = do+ -- long-form データ: 各 row が (x, y, group)。 group で色分けする。+ let xs = inline (concat (replicate 2 ([1.0, 2.0, 3.0, 4.0] :: [Double])))+ ys = inline ([2.0, 3.0, 1.0, 4.0, 3.0, 1.0, 4.0, 2.0] :: [Double])+ gs = inlineCat (concatMap (replicate 4) (["alpha", "beta"] :: [Text]))+ -- ggplot で言えば:+ -- ggplot(d, aes(x, y, color=group)) + geom_point(size=6) ++ -- scale_color_manual(values=c(alpha="#1B9E77", beta="#D95F02"))+ saveSVG "tutorial-02-grammar.svg" $+ purePlot+ <> layer (scatter xs ys <> colorBy gs <> size 6)+ <> scaleColorManual [("alpha", "#1B9E77"), ("beta", "#D95F02")]+ <> legend+ <> title "Grammar API: scale_color_manual"+ <> xLabel "x" <> yLabel "y"+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ putStrLn "wrote tutorial-02-grammar.svg"
+ examples/Tutorial03Overlay.hs view
@@ -0,0 +1,26 @@+-- | Tutorial 03 ─ 複数 layer の重畳。 散布点の上に折れ線を重ねる。+-- 各 `layer` は `<>` で合成され、 後に書いた layer が上に描かれる。+--+-- @+-- cabal run tutorial-03-overlay+-- @+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Graphics.Hgg.Backend.SVG (saveSVG)+import Graphics.Hgg.Unit (px, (*~))+import Graphics.Hgg.Spec++main :: IO ()+main = do+ let xs = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] :: [Double]+ ys = [0.2, 1.1, 3.9, 9.2, 15.8, 25.1, 36.2, 48.9, 64.1, 80.8] :: [Double]+ fit = map (\x -> x * x) xs+ saveSVG "tutorial-03-overlay.svg" $+ purePlot+ <> layer (scatter (inline xs) (inline ys) <> alpha 0.85 <> size 5)+ <> layer (line (inline xs) (inline fit) <> color (fromHex "#dc2626") <> stroke 2)+ <> title "Overlay: observed points + fitted curve"+ <> xLabel "x" <> yLabel "y"+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ putStrLn "wrote tutorial-03-overlay.svg"
+ examples/Tutorial04Distribution.hs view
@@ -0,0 +1,36 @@+-- | Tutorial 04 ─ 分布の可視化。 群ごとの violin と box を並べる。+-- 分布系 mark は (群ラベル channel, 値 channel) を取る。+--+-- @+-- cabal run tutorial-04-distribution+-- @+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Graphics.Hgg.Backend.SVG (saveSVG)+import Graphics.Hgg.Unit (px, (*~))+import Graphics.Hgg.Spec+import Data.Text (Text)++main :: IO ()+main = do+ -- 各 row が (群, 値)。 ここでは 3 群 × 各数点の小さな例。+ let cats = inlineCat (concatMap (replicate 6)+ (["control", "low", "high"] :: [Text]))+ vals = inline ([ 4.8, 5.1, 5.3, 4.9, 5.0, 5.2 -- control+ , 6.0, 6.4, 5.8, 6.2, 6.1, 6.3 -- low+ , 7.1, 7.5, 6.9, 7.3, 7.0, 7.4 -- high+ ] :: [Double])+ saveSVG "tutorial-04-violin.svg" $+ purePlot+ <> layer (violin vals <> groupBy cats)+ <> title "Distribution: violin by group"+ <> xLabel "dose" <> yLabel "response"+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ saveSVG "tutorial-04-box.svg" $+ purePlot+ <> layer (boxplot vals <> groupBy cats)+ <> title "Distribution: box by group"+ <> xLabel "dose" <> yLabel "response"+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ putStrLn "wrote tutorial-04-violin.svg / tutorial-04-box.svg"
+ examples/Tutorial05Theme.hs view
@@ -0,0 +1,28 @@+-- | Tutorial 05 ─ テーマと配色。 同じ図を ThemeDefault / ThemeDark で出し分ける。+-- `theme` は VisualSpec を返すだけなので `<>` で足すだけ。+--+-- @+-- cabal run tutorial-05-theme+-- @+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Graphics.Hgg.Backend.SVG (saveSVG)+import Graphics.Hgg.Unit (px, (*~))+import Graphics.Hgg.Spec+import Data.Text (Text)++main :: IO ()+main = do+ let xs = inline (concat (replicate 3 ([1.0, 2.0, 3.0, 4.0, 5.0] :: [Double])))+ ys = inline ([ 1, 2, 1.5, 3, 2.5, 2, 3, 2.5, 4, 3.5, 3, 4, 3.5, 5, 4.5 ] :: [Double])+ gs = inlineCat (concatMap (replicate 5) (["x", "y", "z"] :: [Text]))+ base nm = purePlot+ <> layer (scatter xs ys <> colorBy gs <> size 6)+ <> legend+ <> title nm+ <> xLabel "x" <> yLabel "y"+ <> widthUnit (600 *~ px) <> heightUnit (400 *~ px)+ saveSVG "tutorial-05-light.svg" (base "ThemeDefault" <> theme ThemeDefault)+ saveSVG "tutorial-05-dark.svg" (base "ThemeDark" <> theme ThemeDark)+ putStrLn "wrote tutorial-05-light.svg / tutorial-05-dark.svg"
+ examples/VegaLiteGallery.hs view
@@ -0,0 +1,191 @@+-- | Vega-Lite examples gallery (https://vega.github.io/vega-lite/examples/) の+-- 再現デモ。 各 Vega-Lite セクションの代表例を hgg で描き直す。+--+-- @cabal run vega-lite-gallery@ → @design/vega-lite-gallery/*.svg@ を生成。+--+-- ★描けない例 (地理 / 対話 / image = 仕様外、 concat/repeat 等 = 今後の課題) は+-- 本デモには含めない (docs/comparison-vega-lite.md の分類を参照)。+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Graphics.Hgg.Backend.SVG (saveSVG, saveSVGWith)+import Graphics.Hgg.Easy+import qualified Data.Vector as V+import System.Directory (createDirectoryIfMissing)++out :: FilePath -> VisualSpec -> IO ()+out name = saveSVG ("design/vega-lite-gallery/" <> name <> ".svg")++main :: IO ()+main = do+ createDirectoryIfMissing True "design/vega-lite-gallery"++ -- == Bar Charts ==========================================================+ -- Simple Bar Chart+ out "01-bar-simple" $ purePlot+ <> layer (bar (inlineCat (["A","B","C","D","E"] :: [String])) (inline [28,55,43,91,81]))+ <> title "Simple Bar Chart" <> xLabel "category" <> yLabel "value"++ -- Grouped Bar Chart (dodge)+ let gcat = inlineCat (concatMap (replicate 3) (["A","B","C"] :: [String]))+ ggrp = inlineCat (take 9 (cycle (["x","y","z"] :: [String])))+ gval = inline [3,5,2, 4,1,6, 2,3,4]+ out "02-bar-grouped" $ purePlot+ <> layer (bar gcat gval <> colorBy ggrp <> position PosDodge)+ <> title "Grouped Bar Chart (dodge)" <> xLabel "category" <> yLabel "value"++ -- Stacked Bar Chart+ out "03-bar-stacked" $ purePlot+ <> layer (bar gcat gval <> colorBy ggrp <> position PosStack)+ <> title "Stacked Bar Chart" <> xLabel "category" <> yLabel "value"++ -- Normalized (Percentage) Stacked Bar Chart+ out "04-bar-normalized" $ purePlot+ <> layer (bar gcat gval <> colorBy ggrp <> position PosFill)+ <> title "Normalized (Percentage) Stacked Bar Chart"++ -- == Histograms / Density / Cumulative ===================================+ let vals = [3.0,4.0,4.5,5.0,5.0,5.2,5.5,6.0,6.5,7.0,8.0,12.0+ ,4.8,5.1,5.3,5.9,6.2,6.8,7.5,4.2,5.6,6.1]+ out "05-histogram" $ purePlot+ <> layer (histogram (inline vals))+ <> title "Histogram" <> xLabel "x" <> yLabel "count"++ out "06-density" $ purePlot+ <> layer (density (inline vals))+ <> title "Density Plot" <> xLabel "x" <> yLabel "density"++ -- Cumulative Frequency Distribution+ out "07-ecdf" $ purePlot+ <> layer (ecdf (inline vals))+ <> title "Cumulative Frequency Distribution (ECDF)" <> xLabel "x" <> yLabel "F(x)"++ -- == Scatter & Strip Plots ===============================================+ let sx = [1.0,2,3,4,5,6,7,8,9,10]+ sy = [2.1,3.9,6.0,7.7,10.2,11.8,14.1,15.9,18.2,20.0]+ out "08-scatter" $ purePlot+ <> layer (scatter (inline sx) (inline sy) <> size 6)+ <> title "Scatterplot" <> xLabel "x" <> yLabel "y"++ -- Bubble Plot (color + size)+ let bgrp = inlineCat (take 10 (cycle (["A","B"] :: [String])))+ bsz = inline [2,8,3,9,4,7,5,6,3,8]+ out "09-bubble" $ purePlot+ <> layer (scatter (inline sx) (inline sy) <> colorBy bgrp <> sizeBy bsz <> alpha 0.8)+ <> title "Bubble Plot" <> xLabel "x" <> yLabel "y"++ -- 1D Strip Plot+ out "10-strip" $ purePlot+ <> layer (strip (inline vals) <> groupBy (inlineCat (replicate (length vals) ("v" :: String))))+ <> title "Strip Plot" <> yLabel "value"++ -- == Line Charts =========================================================+ let lx = [0.0,1,2,3,4,5,6,7,8,9]+ out "11-line" $ purePlot+ <> layer (line (inline lx) (inline (map (\x -> sin (x/2)*5+10) lx)) <> stroke 2)+ <> title "Line Chart" <> xLabel "t" <> yLabel "f(t)"++ -- Multi Series Line Chart+ out "12-line-multi" $ purePlot+ <> layer (line (inline lx) (inline (map (\x -> sin (x/2)*5+10) lx)) <> color (fromHex "#1f77b4") <> stroke 2)+ <> layer (line (inline lx) (inline (map (\x -> cos (x/2)*5+10) lx)) <> color (fromHex "#d62728") <> stroke 2)+ <> title "Multi Series Line Chart" <> xLabel "t" <> yLabel "f(t)"++ -- Step Chart+ out "13-step" $ purePlot+ <> layer (step (inline lx) (inline [0,0,1,1,3,3,2,2,4,4]) <> stroke 2)+ <> title "Step Chart" <> xLabel "t" <> yLabel "v"++ -- == Area Charts =========================================================+ -- Area Chart = band を 0..y で塗る+ let ax = [0.0,1,2,3,4,5,6,7,8,9]+ ay = [1.0,3,2,5,4,6,5,7,6,8]+ out "14-area" $ purePlot+ <> layer (band (inline ax) (inline (replicate 10 0.0)) (inline ay) <> alpha 0.5)+ <> layer (line (inline ax) (inline ay) <> stroke 2)+ <> title "Area Chart" <> xLabel "t" <> yLabel "v"++ -- == Table-based Plots ===================================================+ -- Table Heatmap+ let hx = inlineCat [ c | c <- ["A","B","C"] :: [String], _ <- [1::Int ..3] ]+ hy = inlineCat (take 9 (cycle (["P","Q","R"] :: [String])))+ hv = inline [1,5,9, 3,7,2, 8,4,6]+ out "15-heatmap" $ purePlot+ <> layer (heatmap hx hy hv)+ <> title "Table Heatmap" <> xLabel "col" <> yLabel "row"++ -- == Circular Plots ======================================================+ let pc = inlineCat (["A","B","C","D"] :: [String])+ pv = inline [30,25,25,20]+ out "16-pie" $ purePlot+ <> layer (pie pc pv)+ <> title "Pie Chart"++ -- Radial Plot (polar bar)+ out "17-radial" $ purePlot+ <> layer (bar pc pv <> colorBy pc)+ <> coordPolar+ <> title "Radial Plot (polar bar)"++ -- == Advanced Calculations ===============================================+ -- Linear Regression: plot 側では fit しないので OLS 当てはめ値 yhat を作り line で重ねる+ -- (データから自動 fit するなら analyze の statLm)。+ out "18-regression" $+ let n = fromIntegral (length sx)+ a = (n * sum (zipWith (*) sx sy) - sum sx * sum sy)+ / (n * sum (map (^ (2 :: Int)) sx) - sum sx ^ (2 :: Int))+ b = (sum sy - a * sum sx) / n+ yhat = [ a * x + b | x <- sx ]+ in purePlot+ <> layer (scatter (inline sx) (inline sy) <> size 6)+ <> layer (line (inline sx) (inline yhat) <> color (fromHex "#d62728") <> stroke 2)+ <> title "Linear Regression" <> xLabel "x" <> yLabel "y"++ -- Quantile-Quantile Plot (QQ Plot)+ out "19-qq" $ purePlot+ <> layer (qq (inline vals) <> size 6)+ <> title "Quantile-Quantile Plot (QQ Plot)" <> xLabel "theoretical" <> yLabel "sample"++ -- Parallel Coordinate Plot+ out "20-parallel" $ purePlot+ <> layer (parallelCoords [ inline [1,2,3,4], inline [4,3,2,1], inline [2,4,1,3] ])+ <> title "Parallel Coordinate Plot"++ -- Waterfall Chart of Monthly Profit and Loss+ out "21-waterfall" $ purePlot+ <> layer (waterfall (inlineCat (["Begin","Q1","Q2","Q3","Q4","End"] :: [String]))+ (inline [1000, 300, -200, 400, -100, 1400]))+ <> title "Waterfall Chart"++ -- == Error Bars & Error Bands ============================================+ -- Error Bars Showing Confidence Interval (pointRange = x, y, err)+ out "22-errorbar" $ purePlot+ <> layer (pointRange (inline [1.0,2,3,4,5]) (inline [2.0,3.5,3.0,4.2,5.1])+ (inline [0.5,0.8,0.4,0.6,0.7]))+ <> title "Error Bars Showing Confidence Interval" <> xLabel "x" <> yLabel "mean ± CI"++ -- == Box Plots ===========================================================+ out "23-boxplot" $ purePlot+ <> layer (boxplot (inline vals))+ <> title "Box Plot (Tukey 1.5 IQR)" <> yLabel "value"++ -- == Distributions =======================================================+ let dcat = inlineCat (concatMap (replicate 8) (["A","B","C"] :: [String]))+ dval = inline ([3,4,4.5,5,5.2,5.5,6,7] ++ [5,5.5,6,6.2,6.8,7,7.5,8] ++ [2,2.5,3,3.2,3.8,4,4.5,5])+ out "24-violin" $ purePlot <> layer (violin dval <> groupBy dcat) <> title "Violin Plot" <> yLabel "value"+ out "25-swarm" $ purePlot <> layer (swarm dval <> groupBy dcat) <> title "Swarm Plot" <> yLabel "value"+ out "26-raincloud"$ purePlot <> layer (raincloud dval <> groupBy dcat)<> title "Raincloud Plot"<> yLabel "value"+ out "27-ridge" $ purePlot <> layer (ridge dval <> groupBy dcat) <> title "Ridgeline Plot"<> yLabel "group"++ -- == Faceting (Trellis) ==================================================+ let r facetN = case facetN of+ "x" -> Just (NumData (V.fromList [1,2,3,4, 1,2,3,4, 1,2,3,4]))+ "y" -> Just (NumData (V.fromList [1,4,9,16, 2,5,8,12, 3,6,9,15]))+ "g" -> Just (TxtData (V.fromList ["A","A","A","A","B","B","B","B","C","C","C","C"]))+ _ -> Nothing+ saveSVGWith "design/vega-lite-gallery/28-trellis-scatter.svg" r $ purePlot+ <> layer (scatter "x" "y" <> colorBy "g" <> size 6)+ <> facet "g"+ <> title "Trellis Scatter Plot (facet)" <> xLabel "x" <> yLabel "y"++ putStrLn "wrote design/vega-lite-gallery/*.svg (28 examples)"
+ hgg-svg.cabal view
@@ -0,0 +1,193 @@+cabal-version: 3.0+name: hgg-svg+version: 0.1.0.0+extra-doc-files: CHANGELOG.md+synopsis: SVG backend for hgg (pure Haskell)+description:+ Browser-independent SVG output backend for hgg, written in pure+ Haskell. This is the backend most users go through to generate plots.+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.Backend.SVG+ Graphics.Hgg.Quick+ hs-source-dirs: src+ build-depends: base >= 4.17 && < 5+ , text >= 2.0 && < 2.2+ , vector >= 0.13 && < 0.14+ , hgg-core ^>= 0.1+ , hgg-frame ^>= 0.1+ default-language: Haskell2010++executable scatter-demo+ import: warnings+ main-is: ScatterDemo.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5+ , text+ , vector+ , hgg-core+ , hgg-svg+ default-language: Haskell2010++executable custom-mark-demo+ import: warnings+ main-is: CustomMarkDemo.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5+ , vector+ , hgg-core+ , hgg-svg+ default-language: Haskell2010++executable vega-lite-gallery+ import: warnings+ main-is: VegaLiteGallery.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5+ , vector+ , directory+ , hgg-core+ , hgg-svg+ default-language: Haskell2010++executable df-plot-demo+ import: warnings+ main-is: DfPlotDemo.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5+ , containers+ , directory+ , text+ , vector+ , hgg-core+ , hgg-frame+ , hgg-svg+ default-language: Haskell2010++executable gallery-demo+ import: warnings+ main-is: GalleryDemo.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5+ , text+ , vector+ , directory+ , aeson+ , bytestring+ , hgg-core+ , hgg-svg+ default-language: Haskell2010++executable dag-comparison-demo+ import: warnings+ main-is: DagComparisonDemo.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5+ , text+ , hgg-core+ , hgg-svg+ default-language: Haskell2010++executable dag-parity-bench+ import: warnings+ main-is: DagParityBench.hs+ hs-source-dirs: examples+ -- Safety net: cap the heap at 2.5G so a runaway case fails with a clean+ -- GHC RTS "heap overflow" exception instead of exhausting system memory.+ ghc-options: -rtsopts "-with-rtsopts=-M2500m"+ build-depends: base >= 4.17 && < 5+ , text+ , directory+ , hgg-core+ , hgg-svg+ default-language: Haskell2010++executable json-dump+ import: warnings+ main-is: JsonDump.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5+ , bytestring+ , aeson+ , hgg-core+ default-language: Haskell2010++-- Runnable examples for the docs/ tutorials (referenced from docs/getting-started.md / api-guide.md)+executable tutorial-01-easy+ import: warnings+ main-is: Tutorial01Easy.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5, hgg-core, hgg-svg+ default-language: Haskell2010++executable tutorial-02-grammar+ import: warnings+ main-is: Tutorial02Grammar.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5, text, hgg-core, hgg-svg+ default-language: Haskell2010++executable tutorial-03-overlay+ import: warnings+ main-is: Tutorial03Overlay.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5, hgg-core, hgg-svg+ default-language: Haskell2010++executable tutorial-04-distribution+ import: warnings+ main-is: Tutorial04Distribution.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5, text, hgg-core, hgg-svg+ default-language: Haskell2010++executable tutorial-05-theme+ import: warnings+ main-is: Tutorial05Theme.hs+ hs-source-dirs: examples+ build-depends: base >= 4.17 && < 5, text, hgg-core, hgg-svg+ default-language: Haskell2010++-- Generates the figures embedded in docs/ (cabal run doc-figures, from the repo root)+executable doc-figures+ import: warnings+ main-is: DocFigures.hs+ hs-source-dirs: examples+ other-modules: DocFig.Common+ , DocFig.Quickstart+ , DocFig.Layers+ , DocFig.EncodingScale+ , DocFig.Decoration+ build-depends: base >= 4.17 && < 5, text, vector, directory, hgg-core, hgg-svg+ default-language: Haskell2010++-- Smoke test for BoundPlot (df |>> spec) → SVG. Lives here rather than in+-- frame:test because cabal would see frame <-> svg as a package cycle.+test-suite hgg-svg-tests+ import: warnings+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ build-depends: base >= 4.17 && < 5+ , text+ , vector+ , containers+ , hgg-core+ , hgg-frame+ , hgg-svg+ , hspec >= 2.10 && < 2.12+ default-language: Haskell2010
+ src/Graphics/Hgg/Backend/SVG.hs view
@@ -0,0 +1,332 @@+-- |+-- Module : Graphics.Hgg.Backend.SVG+-- Description : SVG backend (Phase 26 §B-1 Resolver 対応版)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+{-# LANGUAGE OverloadedStrings #-}+module Graphics.Hgg.Backend.SVG+ ( -- * 通常 (Resolver 不要 = inline 列のみの図)+ renderSVG+ , saveSVG+ -- * Resolver 同伴 (= 'ColByName' を含む図)+ , renderSVGWith+ , saveSVGWith+ , renderSVGInteractive+ , saveSVGInteractive+ , plot+ -- * Phase 14: BoundPlot (df バインド済) を描画する+ , renderBound+ , saveSVGBound+ -- * Phase 3 A8: Primitive 列を直接 SVG にする helper (= hgg-3d 用)+ , renderPrimitivesSVG+ , savePrimitivesSVG+ ) where++import Graphics.Hgg.Frame (BoundPlot (..))+import Graphics.Hgg.Layout (Layout (..), Rect (..),+ ViewportSize (..), computeLayout)+import Graphics.Hgg.Render (FillStyle (..), LineStyle (..),+ PathSegment (..), Point (..),+ Primitive (..), StrokeStyle (..),+ TextAnchor (..), TextStyle (..),+ renderToPrimitives, scalePrimitives)+import Graphics.Hgg.Spec (MarkKind (..), Resolver, VisualSpec (..),+ emptyResolver, lyKind, vsDpi)+import Data.Monoid (getFirst, getLast)+import Graphics.Hgg.Validate (PlotDiagnostic, Severity (..),+ diagnosticSeverity, renderDiagnostic)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import System.IO (hPutStrLn, stderr)++-- | 'Resolver' を渡して 'VisualSpec' を SVG text に。 'ColByName' を含む図用。+renderSVGWith :: Resolver -> VisualSpec -> Text+renderSVGWith r spec =+ let layout = computeLayout r spec+ -- ★ Phase 33 B5: layout/primitive は純 pt。SVG (raster 想定) は dpi/72 を+ -- 一度だけ掛けて device px へ (唯一の dpi 適用点)。既定 96dpi → k=4/3。+ k = maybe 96 id (getLast (vsDpi spec)) / 72+ primitives = scalePrimitives k (renderToPrimitives r layout spec)+ ViewportSize wpt hpt = lpViewport layout+ w = round (fromIntegral wpt * k) :: Int+ h = round (fromIntegral hpt * k) :: Int+ header = T.concat+ [ "<svg xmlns=\"http://www.w3.org/2000/svg\" "+ , "width=\"", num w, "\" "+ , "height=\"", num h, "\" "+ , "viewBox=\"0 0 ", num w, " ", num h, "\">"+ ]+ in T.concat (header : primsToSvg primitives : ["</svg>"])++-- | render 'VisualSpec' to SVG text。 Resolver 不要 (= 全 ColRef が inline、+-- 'ColByName' が無い図で使う、 = 通常)。 列名参照を含む図は 'renderSVGWith'。+renderSVG :: VisualSpec -> Text+renderSVG = renderSVGWith emptyResolver++-- | 'Resolver' を渡して SVG ファイルに保存。 'ColByName' を含む図用。+saveSVGWith :: FilePath -> Resolver -> VisualSpec -> IO ()+saveSVGWith path r spec = TIO.writeFile path (renderSVGWith r spec)++-- | SVG ファイルに保存。 Resolver 不要 (= inline 列のみの図、 = 通常)。+-- 列名参照を含む図は 'saveSVGWith'、 DataFrame は 'saveSVGBound' (@df |>> spec@)。+saveSVG :: FilePath -> VisualSpec -> IO ()+saveSVG path = saveSVGWith path emptyResolver++-- | 'purePlot' (= 純粋値) と対をなす副作用関数。 中身は 'saveSVG' の alias、+-- SVG backend が default。 他 backend (PDF / PNG) を使う場合はそれぞれの+-- module の `plot` を import する。+--+-- > main = plot "out.svg" $ purePlot <> layer (scatter ...) <> title "..."+plot :: FilePath -> VisualSpec -> IO ()+plot = saveSVG++-- | Phase 14: 'BoundPlot' (= @df |>> spec@ の結果) を SVG text に。+-- 'renderSVGWith' を 'bpResolver' / 'bpSpec' で呼ぶ薄いラッパ。+-- 検証診断 ('bpDiagnostics') は副作用が無いここでは無視する+-- (報告は 'saveSVGBound' / 利用者が 'bpDiagnostics' を直接見る)。+renderBound :: BoundPlot -> Text+renderBound (BoundPlot r spec _) = renderSVGWith r spec++-- | Phase 14: 'BoundPlot' を SVG ファイルに保存。+-- 'bpDiagnostics' に Error severity があれば **stderr に報告**してから書き出す+-- (描画自体は止めない = 純値 '(|>>)' の lenient 既定。 無検証で通したい場合は+-- 'unBound' → 'saveSVGWith' を直接使う)。+saveSVGBound :: FilePath -> BoundPlot -> IO ()+saveSVGBound path bp@(BoundPlot _ spec diags) = do+ reportErrors diags+ warnUnresolvedStats spec+ TIO.writeFile path (renderBound bp)++-- | Phase 16 footgun 緩和: spec に未解決 stat layer (@MStatLM@/@MStatSmooth@) が残っていたら+-- stderr に警告 (描画では skip され回帰線が出ない)。 回帰を描くには analyze-bridge の+-- @saveSVGBoundStats@ / @resolveStats@ を使う。 stat を使わない通常図では何もしない。+warnUnresolvedStats :: VisualSpec -> IO ()+warnUnresolvedStats spec+ | any isStat (vsLayers spec) =+ hPutStrLn stderr+ "[hgg] 警告: 未解決の stat layer (statLm/statSmooth) があります。 \+ \回帰線は描画されません。 analyze-bridge の saveSVGBoundStats で描画してください。"+ | otherwise = pure ()+ where+ isStat ly = case getFirst (lyKind ly) of+ Just MStatLM -> True+ Just MStatSmooth -> True+ _ -> False++-- | Error severity の診断のみ stderr に出す。+reportErrors :: [PlotDiagnostic] -> IO ()+reportErrors diags =+ mapM_ (hPutStrLn stderr . T.unpack . renderDiagnostic)+ (filter ((== SevError) . diagnosticSeverity) diags)++-- | Interactive 版: hover tooltip (= 標準 native) に加えて、+-- ドラッグで pan / wheel で zoom できる inline JS を末尾に embed。+-- ブラウザで開いた時だけ動作、 raw SVG viewer では普通に静止画。+renderSVGInteractive :: Resolver -> VisualSpec -> Text+renderSVGInteractive r spec =+ let base = renderSVGWith r spec+ -- </svg> 直前に <script> を挿入+ (pre, post) = T.breakOn "</svg>" base+ in T.concat [pre, panZoomScript, post]++saveSVGInteractive :: FilePath -> Resolver -> VisualSpec -> IO ()+saveSVGInteractive path r spec = TIO.writeFile path (renderSVGInteractive r spec)++-- | Phase 3 A8: '[Primitive]' を直接 SVG にする helper。+-- 'renderSVG' は VisualSpec 経由だが、 hgg-3d のように外部で+-- Primitive 列を生成済の場合に使う。 既存の 'primToSvg' converter をそのまま流用、+-- 出力 SVG 構造 (= header + light bg + title + body) は 'renderSVG' と同形式。+renderPrimitivesSVG :: Int -> Int -> Text -> [Primitive] -> Text+renderPrimitivesSVG w h titleTxt prims =+ let header = T.concat+ [ "<svg xmlns=\"http://www.w3.org/2000/svg\" "+ , "width=\"", num w, "\" "+ , "height=\"", num h, "\" "+ , "viewBox=\"0 0 ", num w, " ", num h, "\">"+ ]+ -- bg + title+ bg = T.concat+ [ "<rect x=\"0\" y=\"0\" width=\"", num w+ , "\" height=\"", num h+ , "\" fill=\"#fafafa\"/>" ]+ -- ★ Phase 43 既定に合わせタイトルは左寄せ (ggplot theme_grey)。 3D backend は+ -- plotArea を持たないので左 margin は固定 20px。 2D の plot.title 左寄せと統一。+ title_ = if T.null titleTxt then "" else T.concat+ [ "<text x=\"20\" y=\"30\""+ , " text-anchor=\"start\" font-family=\"sans-serif\""+ , " font-size=\"16\" fill=\"#333\">", titleTxt, "</text>" ]+ in T.concat (header : bg : title_ : primsToSvg prims : ["</svg>"])++-- | 'renderPrimitivesSVG' をファイル書出し版。+savePrimitivesSVG :: FilePath -> Int -> Int -> Text -> [Primitive] -> IO ()+savePrimitivesSVG path w h t prims =+ TIO.writeFile path (renderPrimitivesSVG w h t prims)++-- | pan / zoom inline JS。 SVG の viewBox を操作するだけの最小実装。+panZoomScript :: Text+panZoomScript = T.concat+ [ "<script type=\"application/ecmascript\"><![CDATA[\n"+ , "(function(){\n"+ , " var svg = document.currentScript.parentNode;\n"+ , " var vb = svg.viewBox.baseVal;\n"+ , " var dragging = false, sx = 0, sy = 0, vx0 = 0, vy0 = 0;\n"+ , " svg.addEventListener('mousedown', function(e){\n"+ , " dragging = true; sx = e.clientX; sy = e.clientY;\n"+ , " vx0 = vb.x; vy0 = vb.y;\n"+ , " svg.style.cursor = 'grabbing';\n"+ , " });\n"+ , " window.addEventListener('mouseup', function(){\n"+ , " dragging = false; svg.style.cursor = 'default';\n"+ , " });\n"+ , " svg.addEventListener('mousemove', function(e){\n"+ , " if (!dragging) return;\n"+ , " var dx = (e.clientX - sx) * vb.width / svg.clientWidth;\n"+ , " var dy = (e.clientY - sy) * vb.height / svg.clientHeight;\n"+ , " vb.x = vx0 - dx; vb.y = vy0 - dy;\n"+ , " });\n"+ , " svg.addEventListener('wheel', function(e){\n"+ , " e.preventDefault();\n"+ , " var scale = e.deltaY > 0 ? 1.1 : 1/1.1;\n"+ , " var rect = svg.getBoundingClientRect();\n"+ , " var mx = vb.x + (e.clientX - rect.left) * vb.width / rect.width;\n"+ , " var my = vb.y + (e.clientY - rect.top) * vb.height / rect.height;\n"+ , " vb.x = mx - (mx - vb.x) * scale;\n"+ , " vb.y = my - (my - vb.y) * scale;\n"+ , " vb.width *= scale; vb.height *= scale;\n"+ , " });\n"+ , "})();\n"+ , "]]></script>"+ ]++-- ---------------------------------------------------------------------------+-- Primitive → SVG element+-- ---------------------------------------------------------------------------++-- | Phase 11 A7-a: clip stack を解決して SVG body に変換。 'PClipPush' で+-- @\<clipPath\>@ + @\<g clip-path\>@ を開き、 'PClipPop' で @\</g\>@ を閉じる。+-- clip プリミティブが無い列では @map primToSvg@ と完全同一出力なので既存 SVG ゼロ diff。+primsToSvg :: [Primitive] -> Text+primsToSvg = T.concat . go (0 :: Int)+ where+ go _ [] = []+ go n (PClipPush (Rect x y w h) : rest) =+ let cid = T.concat ["clip", num n]+ open = T.concat+ [ "<clipPath id=\"", cid, "\"><rect x=\"", numD x, "\" y=\"", numD y+ , "\" width=\"", numD w, "\" height=\"", numD h, "\"/></clipPath>"+ , "<g clip-path=\"url(#", cid, ")\">" ]+ in open : go (n + 1) rest+ go n (PClipPop : rest) = "</g>" : go n rest+ go n (p : rest) = primToSvg p : go n rest++primToSvg :: Primitive -> Text+primToSvg p = case p of+ PLine (Point x1 y1) (Point x2 y2) (LineStyle c w d) ->+ T.concat+ [ "<line x1=\"", numD x1, "\" y1=\"", numD y1+ , "\" x2=\"", numD x2, "\" y2=\"", numD y2+ , "\" stroke=\"", c, "\" stroke-width=\"", numD w, "\""+ , dashAttr d, "/>"+ ]+ PRect (Rect x y w h) (FillStyle fc fo) mStroke ->+ T.concat+ [ "<rect x=\"", numD x, "\" y=\"", numD y+ , "\" width=\"", numD w, "\" height=\"", numD h+ , "\" fill=\"", fc, "\" fill-opacity=\"", numD fo, "\""+ , strokeAttr mStroke+ , "/>"+ ]+ PCircle (Point cx cy) r (FillStyle fc fo) mStroke mTitle ->+ case mTitle of+ Nothing ->+ T.concat+ [ "<circle cx=\"", numD cx, "\" cy=\"", numD cy+ , "\" r=\"", numD r+ , "\" fill=\"", fc, "\" fill-opacity=\"", numD fo, "\""+ , strokeAttr mStroke+ , "/>"+ ]+ Just t ->+ -- <circle><title>label</title></circle> でブラウザ native hover tooltip+ T.concat+ [ "<circle cx=\"", numD cx, "\" cy=\"", numD cy+ , "\" r=\"", numD r+ , "\" fill=\"", fc, "\" fill-opacity=\"", numD fo, "\""+ , strokeAttr mStroke+ , "><title>", escapeXml t, "</title></circle>"+ ]+ PText (Point x y) s (TextStyle c sz fam anchor rot weight italic) ->+ let anchorAttr = case anchor of+ AnchorStart -> "start"+ AnchorMiddle -> "middle"+ AnchorEnd -> "end"+ -- Phase 50 A1: 内部 'tsRotate' は **CCW 正** (canonical)。 SVG rotate() は y-down で+ -- CW 正なので、 ここで **符号反転** して device の CW へ変換する (唯一の変換点)。+ rotAttr = if rot == 0+ then ""+ else T.concat [" transform=\"rotate(", numD (negate rot)+ , " ", numD x, " ", numD y, ")\""]+ -- TODO-10 (2026-05-29): font-weight / font-style emit (default 値は省略)+ weightAttr = if weight == "normal" || T.null weight+ then ""+ else T.concat [" font-weight=\"", weight, "\""]+ italicAttr = if italic then " font-style=\"italic\"" else ""+ in T.concat+ [ "<text x=\"", numD x, "\" y=\"", numD y+ , "\" fill=\"", c, "\" font-size=\"", numD sz+ , "\" font-family=\"", fam+ , "\" text-anchor=\"", anchorAttr, "\""+ , weightAttr, italicAttr+ , rotAttr+ , ">"+ , escapeXml s+ , "</text>"+ ]+ PPath segs (FillStyle fc fo) mStroke ->+ T.concat+ [ "<path d=\"", pathSegs segs+ , "\" fill=\"", fc, "\" fill-opacity=\"", numD fo, "\""+ , strokeAttr mStroke+ , "/>"+ ]+ PClipPush{} -> ""+ PClipPop -> ""+ PTransformPush{} -> ""+ PTransformPop -> ""++pathSegs :: [PathSegment] -> Text+pathSegs = T.intercalate " " . map seg+ where+ seg (MoveTo (Point x y)) = T.concat ["M ", numD x, " ", numD y]+ seg (LineTo (Point x y)) = T.concat ["L ", numD x, " ", numD y]+ seg (CurveTo (Point cx1 cy1) (Point cx2 cy2) (Point x y)) = T.concat+ ["C ", numD cx1, " ", numD cy1, " ", numD cx2, " ", numD cy2, " ", numD x, " ", numD y]+ seg ClosePath = "Z"++strokeAttr :: Maybe StrokeStyle -> Text+strokeAttr Nothing = " stroke=\"none\""+strokeAttr (Just (StrokeStyle c w)) =+ T.concat [" stroke=\"", c, "\" stroke-width=\"", numD w, "\""]++-- | Phase 11 A4-b: stroke-dasharray 属性。 空配列 (= 実線) は attr を出さない+-- (= 既存 SVG ゼロ diff の要)。 非空のみ \" stroke-dasharray=\\\"a,b,..\\\"\" を付す。+dashAttr :: [Double] -> Text+dashAttr [] = ""+dashAttr ds = T.concat [" stroke-dasharray=\"", T.intercalate "," (map numD ds), "\""]++num :: Int -> Text+num = T.pack . show++numD :: Double -> Text+numD = T.pack . show++escapeXml :: Text -> Text+escapeXml = T.concatMap esc+ where+ esc '<' = "<"+ esc '>' = ">"+ esc '&' = "&"+ esc '"' = """+ esc '\'' = "'"+ esc c = T.singleton c
+ src/Graphics/Hgg/Quick.hs view
@@ -0,0 +1,56 @@+-- |+-- Module : Graphics.Hgg.Quick+-- Description : Easy 層の IO ワンショット保存 (= 1 行で SVG 出力、 Phase 11 A3)+-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License : BSD-3-Clause+--+-- core は backend 非依存 (architecture §3.3) のため IO 保存ヘルパは backend 側+-- (本 module) に置く。 値を渡すだけで SVG が 1 ファイル出る入門用 API。+--+-- @+-- import Graphics.Hgg.Quick+--+-- main :: IO ()+-- main = do+-- quickScatter "scatter.svg" [1,2,3,4] [1,4,9,16]+-- quickPlot "overlay.svg" [ points [1,2,3] [1,4,9]+-- , lineXY [1,2,3] [1,4,9] ]+-- @+--+-- `Graphics.Hgg.Easy` を再 export するので、 本 module 1 つの import で+-- `points` / `lineXY` / `overlay` 等の Easy ヘルパも揃う。+{-# LANGUAGE OverloadedStrings #-}+module Graphics.Hgg.Quick+ ( -- * Easy 層 (再 export)+ module Graphics.Hgg.Easy+ -- * IO ワンショット保存 (= 値直接受け)+ , quickScatter+ , quickLine+ , quickBar+ , quickHist+ -- * layer 群をまとめて保存+ , quickPlot+ ) where++import Graphics.Hgg.Backend.SVG (saveSVG)+import Graphics.Hgg.Easy++-- | 散布図を 1 行で SVG 保存。 @quickScatter path xs ys@。+quickScatter :: FilePath -> [Double] -> [Double] -> IO ()+quickScatter path xs ys = quickPlot path [points xs ys]++-- | 折れ線を 1 行で SVG 保存。+quickLine :: FilePath -> [Double] -> [Double] -> IO ()+quickLine path xs ys = quickPlot path [lineXY xs ys]++-- | 棒グラフを 1 行で SVG 保存。+quickBar :: FilePath -> [Double] -> [Double] -> IO ()+quickBar path xs ys = quickPlot path [bars xs ys]++-- | ヒストグラムを 1 行で SVG 保存。+quickHist :: FilePath -> [Double] -> IO ()+quickHist path xs = quickPlot path [hist xs]++-- | layer 群を 'overlay' で重畳して SVG 保存 (= 最も汎用な Easy 保存)。+quickPlot :: FilePath -> [Layer] -> IO ()+quickPlot path = saveSVG path . overlay
+ test/Spec.hs view
@@ -0,0 +1,35 @@+-- | hgg-svg テスト。 Phase 14 A3 = BoundPlot (df |>> spec) → SVG smoke。+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Graphics.Hgg.Backend.SVG (renderBound)+import Graphics.Hgg.Frame ((|>>))+import Graphics.Hgg.Spec (ColData (..), layer, scatter)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import Test.Hspec++-- 列順違いで同一データ (Map vs assoc-list)+xyAssoc :: [(Text, ColData)]+xyAssoc =+ [ ("x", NumData (V.fromList [1, 2, 3]))+ , ("y", NumData (V.fromList [4, 5, 6]))+ ]++xyMap :: Map Text ColData+xyMap = M.fromList xyAssoc++main :: IO ()+main = hspec $+ describe "renderBound (df |>> spec)" $ do+ it "df |>> spec が SVG を出す" $ do+ let svg = renderBound (xyMap |>> layer (scatter "x" "y"))+ ("<svg" `T.isInfixOf` svg) `shouldBe` True+ ("</svg>" `T.isInfixOf` svg) `shouldBe` True+ it "Map と assoc-list で同一 SVG (同データ、 spec-2 §7)" $+ renderBound (xyMap |>> layer (scatter "x" "y"))+ `shouldBe`+ renderBound (xyAssoc |>> layer (scatter "x" "y"))