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 +7/−0
- LICENSE +30/−0
- hgg-custom.cabal +40/−0
- src/Graphics/Hgg/Custom/Dendrogram.hs +105/−0
+ 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)