packages feed

hgg-custom (empty) → 0.1.0.0

raw patch · 4 files changed

+182/−0 lines, 4 filesdep +aesondep +basedep +hgg-core

Dependencies added: aeson, base, hgg-core, text, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,7 @@+# Changelog for `hgg-custom`++## 0.1.0.0 — 2026-07-18++First public release on Hackage.++- Non-standard custom marks (dendrogram etc.).
+ 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.
+ hgg-custom.cabal view
@@ -0,0 +1,40 @@+cabal-version:      3.0+name:               hgg-custom+version:            0.1.0.0+extra-doc-files:    CHANGELOG.md+synopsis:           Non-standard / advanced custom marks for hgg (dendrogram, ...)+description:+  An add-on package that isolates non-standard "custom marks" — new plot+  types built on hgg-core's customMark extension point — from the core+  library. It never touches core's MarkKind; it depends only on+  hgg-core's Primitive / customMark API. Add it as a dependency only when+  you need these specialized visualizations (e.g. for random forests or+  hierarchical clustering).+  .+  Currently ships a dendrogram mark (tree diagrams for hierarchical+  clustering), using pre-baked segments for easy cross-backend parity.+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.Custom.Dendrogram+  build-depends:    base             >= 4.16 && < 5+                  , hgg-core ^>= 0.1+                  , aeson            >= 2.0 && < 3+                  , text             >= 1.2 && < 3+                  , vector           >= 0.12 && < 0.14+  hs-source-dirs:   src+  default-language: Haskell2010+  default-extensions: OverloadedStrings
+ src/Graphics/Hgg/Custom/Dendrogram.hs view
@@ -0,0 +1,105 @@+-- |+-- Module      : Graphics.Hgg.Custom.Dendrogram+-- Description : 階層クラスタリングの樹形図 (dendrogram) を custom mark で描く+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- Phase 48: dendrogram を Phase 51 の **custom mark** で本実装する。 core (@MarkKind@) は+-- 触らない (add-on package)。+--+-- 設計 = __焼き込み (baked segments)__: 樹形図の U 字リンクを「計算済みの線分列 ('DendroSeg')」+-- として 'DendroPayload' に持ち、 それを @cmOptions@ (JSON) に焼き込む。 HS の draw closure は+-- payload を直接使い、 PS (canvas) の registry は同じ payload JSON を読む — どちらも「線分を+-- proj して 'PLine' で描くだけ」なので HS=PS parity が自明。 clustering/レイアウト算法は+-- __呼び出し側 (analyze の @dendrogramOf@ 等)__ が行い、 その結果の線分だけをここへ渡す。+--+-- 葉ラベル・軸は本 mark の外 (呼び出し側が数値 x 軸 + @axisBreaksLabeled@ で付ける)。 本 mark は+-- __U 字リンクの線分のみ__を描く。+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+module Graphics.Hgg.Custom.Dendrogram+  ( -- * 焼き込みペイロード+    DendroSeg(..)+  , DendroPayload(..)+    -- * mark+  , dendrogramMark+  , drawDendro+    -- * PS registry で使う mark id+  , dendrogramMarkId+  ) where++import           Data.Aeson    (FromJSON (..), ToJSON (..))+import qualified Data.Aeson    as Aeson+import qualified Data.Char     as Char+import           Data.Text     (Text)+import qualified Data.Vector   as V+import           GHC.Generics  (Generic)++import           Graphics.Hgg.Primitive (Point (..), Primitive (..), solid)+import           Graphics.Hgg.Spec      (ColRef (ColNum), Layer, RenderCtx (..),+                                        customMarkWith, encX, encY)++-- | dendrogram の 1 線分 (data 座標)。 x = 葉 slot / node 中点、 y = マージ高 (height)。+--   JSON キーは prefix @seg@ を落とす: @x1/y1/x2/y2/color/width@。+data DendroSeg = DendroSeg+  { segX1    :: !Double+  , segY1    :: !Double+  , segX2    :: !Double+  , segY2    :: !Double+  , segColor :: !Text+  , segWidth :: !Double+  } deriving (Show, Eq, Generic)++segOptions :: Aeson.Options+segOptions = Aeson.defaultOptions { Aeson.fieldLabelModifier = lowerFirst . drop 3 }++instance ToJSON DendroSeg where+  toJSON     = Aeson.genericToJSON segOptions+  toEncoding = Aeson.genericToEncoding segOptions+instance FromJSON DendroSeg where+  parseJSON  = Aeson.genericParseJSON segOptions++-- | dendrogram 全体の焼き込みペイロード。 線分列 + 軸 range (葉方向 / height 方向)。+--   JSON キーは prefix @dp@ を落とす: @segments/xRange/yRange@ (range は @[lo,hi]@ 配列)。+data DendroPayload = DendroPayload+  { dpSegments :: ![DendroSeg]+  , dpXRange   :: !(Double, Double)   -- ^ 葉方向 range (例 -0.6 .. n-0.4)+  , dpYRange   :: !(Double, Double)   -- ^ height 方向 range (例 0 .. maxH*1.05)+  } deriving (Show, Eq, Generic)++payloadOptions :: Aeson.Options+payloadOptions = Aeson.defaultOptions { Aeson.fieldLabelModifier = lowerFirst . drop 2 }++instance ToJSON DendroPayload where+  toJSON     = Aeson.genericToJSON payloadOptions+  toEncoding = Aeson.genericToEncoding payloadOptions+instance FromJSON DendroPayload where+  parseJSON  = Aeson.genericParseJSON payloadOptions++lowerFirst :: String -> String+lowerFirst (c : cs) = Char.toLower c : cs+lowerFirst []       = []++-- | PS registry (canvas) と共有する安定 mark id。+dendrogramMarkId :: Text+dendrogramMarkId = "dendrogram"++-- | dendrogram を 'Layer' として返す (= 普通の mark 同様 @layer (...)@ に入れて使う)。+--   線分を @cmOptions@ に焼き込み、 'encX'/'encY' で軸 range を束ねる (不可視 anchor 不要)。+dendrogramMark :: DendroPayload -> Layer+dendrogramMark p =+     customMarkWith dendrogramMarkId (toJSON p) (drawDendro p)+  <> encX (rangeCol (dpXRange p))+  <> encY (rangeCol (dpYRange p))+  where+    rangeCol (lo, hi) = ColNum (V.fromList [lo, hi])++-- | payload の線分を 'RenderCtx' で proj して 'PLine' を emit する draw 関数+--   (HS closure が源。 PS registry も同型の draw を手登録する = parity)。+drawDendro :: DendroPayload -> RenderCtx -> [Primitive]+drawDendro p ctx =+  [ PLine (proj (segX1 s) (segY1 s)) (proj (segX2 s) (segY2 s))+          (solid (segColor s) (segWidth s))+  | s <- dpSegments p ]+  where+    proj x y = uncurry Point (rcProjectXY ctx x y)