Concat.hs

-- |
-- Module      : Graphics.Hgg.Spec.Concat
-- Description : Composing figures (hconcat / vconcat / <-> / <:> plus pairs), patchwork-style
-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)
-- License     : BSD-3-Clause
--
-- [日本語]: 'Graphics.Hgg.Spec' の module 分割で切り出し。 複数 'VisualSpec' を
-- 1 枚に並べる合成 (Vega-Lite hconcat/vconcat 相当・patchwork 風演算子) と
-- 'pairs' (散布図行列) を持つ。 subplots + subplotCols の純粋な薄ラッパで、
-- レンダリングは既存 subplots 経路を使う。 公開 API は従来どおり
-- 'Graphics.Hgg.Spec' (facade) が re-export する。 挙動・出力は完全に不変。
--
-- [English]: A module split out of 'Graphics.Hgg.Spec'. Provides
-- composition that arranges multiple 'VisualSpec' values into one figure
-- (equivalent to Vega-Lite's hconcat/vconcat, with patchwork-style
-- operators), plus 'pairs' (a scatterplot matrix). A thin, pure wrapper
-- over subplots + subplotCols; rendering goes through the existing
-- subplots path. The public API is still re-exported by the
-- 'Graphics.Hgg.Spec' facade as before; behavior and output are completely
-- unchanged.
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Hgg.Spec.Concat
  ( hconcat
  , vconcat
  , (<->)
  , (<:>)
  , asHGroup
  , asVGroup
  , pairs
  ) where

import           Data.Monoid     (Last (..))

import           Graphics.Hgg.Spec.Axis (hideTicks)
import           Graphics.Hgg.Spec.Column (ColRef, colRefName)
import           Graphics.Hgg.Spec.Constructors (densityNorm, scatter)
import           Graphics.Hgg.Spec.Layer (alpha, size)
import           Graphics.Hgg.Spec.Setters
import           Graphics.Hgg.Spec.Visual

-- ===========================================================================
-- concat 合成 (Vega-Lite hconcat/vconcat 相当・patchwork 風演算子)
-- ===========================================================================
-- subplots + subplotCols の純粋な薄ラッパ。 レンダリングは既存 subplots 経路を
-- そのまま使う (render/parity への影響ゼロ)。
--
-- 演算子 '<->' (横) / '<:>' (縦) は同方向チェーンを **平坦化** する:
--   (a <-> b <-> c) は subplots [a,b,c] (3 等分列) になり、 二項ネスト
--   (= 2 列で左セルが a,b に分割) にはならない。 平坦化は「左辺が cols==列数の
--   水平グループなら末尾追加、 そうでなければ新規 2 要素」 で行う。 leaf プロットは
--   vsSubplots=[] ゆえ必ず新規開始 = 通常チャートを誤って取り込まない。
-- 例: @(a <-> b <-> c) <:> d@ = 1 行目 3 列 + 2 行目を全幅 (1 行目セルの 3 倍幅)。
--     これは @vconcat [hconcat [a,b,c], d]@ と同値。
--
-- ★演算子の選定: '<->'(横)・'<:>'(縦) は Prelude/標準ライブラリと衝突しない
--   (旧案 '<|>' は Control.Applicative の Alternative と衝突したため回避した)。

-- | [日本語]: 横並び (= Vega-Lite hconcat): n 要素を 1 行 n 列に。
--   [English]: Places elements side by side (equivalent to Vega-Lite's
--   hconcat): arranges n elements into 1 row of n columns.
hconcat :: [VisualSpec] -> VisualSpec
hconcat ss = subplots ss <> subplotCols (length ss)

-- | [日本語]: 縦並び (= Vega-Lite vconcat): n 要素を n 行 1 列に。
--   [English]: Stacks elements vertically (equivalent to Vega-Lite's
--   vconcat): arranges n elements into n rows of 1 column.
vconcat :: [VisualSpec] -> VisualSpec
vconcat ss = subplots ss <> subplotCols 1

-- ★ fixity: '<->' (横) と '<:>' (縦) を同 precedence infixl 6 に揃える (Phase 59)。
--   '<>' (Semigroup、 infixr 6) と同 precedence・異 associativity なので、
--   @a <:> b <> opt@ / @a <-> b <> opt@ は無括弧だと**コンパイルエラー**
--   (Haskell 2010 §10.6 = 同 precedence の infixl/infixr 混在は構文エラー) になり、
--   @(a <:> b) <> opt@ と括弧を強制できる = 全体オプションが右パネルだけに付く
--   サイレント誤りを防ぐ。 旧 '<:>'=infixl 5 は '<>' より緩く @a <:> (b <> opt)@ と
--   黙って結合してしまう footgun だった (横 '<->' は元から infixl 6 でエラー = 安全側。
--   縦だけ非対称に危険だったのを解消)。
infixl 6 <->
infixl 6 <:>

-- | [日本語]: 横結合演算子 (= hconcat の二項・同方向チェーンを平坦化)。
--   [English]: The horizontal-combine operator (the binary form of
--   hconcat; flattens chains in the same direction).
(<->) :: VisualSpec -> VisualSpec -> VisualSpec
a <-> b = case asHGroup a of
  Just xs -> hconcat (xs ++ [b])
  Nothing -> hconcat [a, b]

-- | [日本語]: 縦結合演算子 (= vconcat の二項・同方向チェーンを平坦化)。
--   [English]: The vertical-combine operator (the binary form of vconcat;
--   flattens chains in the same direction).
(<:>) :: VisualSpec -> VisualSpec -> VisualSpec
a <:> b = case asVGroup a of
  Just xs -> vconcat (xs ++ [b])
  Nothing -> vconcat [a, b]

-- | [日本語]: spec が「純粋な水平グループ (subplots=xs (>1 要素)・cols==要素数)」
--   なら xs。
--   [English]: If the spec is "a pure horizontal group" (subplots=xs with
--   more than 1 element, and cols equal to the element count), returns xs.
asHGroup :: VisualSpec -> Maybe [VisualSpec]
asHGroup s = case getLast (vsSubplotCols s) of
  Just c | let xs = vsSubplots s, length xs > 1, c == length xs -> Just (vsSubplots s)
  _ -> Nothing

-- | [日本語]: spec が「純粋な垂直グループ (subplots=xs (>1 要素)・cols==1)」 なら xs。
--   [English]: If the spec is "a pure vertical group" (subplots=xs with
--   more than 1 element, and cols equal to 1), returns xs.
asVGroup :: VisualSpec -> Maybe [VisualSpec]
asVGroup s = case getLast (vsSubplotCols s) of
  Just 1 | length (vsSubplots s) > 1 -> Just (vsSubplots s)
  _ -> Nothing

-- | [日本語]: pairs plot (= N 列の posterior 等を N×N grid で対角は density、
--   非対角は scatter)。
--   [English]: A pairs plot (arranges N columns, such as posterior
--   samples, into an N×N grid where the diagonal shows density and the
--   off-diagonal shows scatter).
pairs :: [ColRef] -> VisualSpec
pairs cols =
  let n = length cols
      -- Phase 7 A6: 内側パネルの軸目盛りを抑制 (= seaborn/ggpairs 流)。
      --   x tick は最下段 (i == n-1) のみ、 y tick は左端列 (j == 0) のみ表示。
      --   対角 (i == j) は density で y = count スケールのため、 左端の (0,0) も y は抑制。
      -- ※ axShowTicks (Bool) は HS が真の JSON boolean で出力する。 PS Codec の
      --   decodeBoolean を boolean 両対応にして HS→PS decode を通るようにした。
      mkPanel i j =
        let showXAxis = i == n - 1
            -- 左端列 (j==0) は対角も含め y 軸目盛りを表示 (= その行の変数値スケール)。
            showYAxis = j == 0
            axisCfg = (if showXAxis then mempty else xAxis hideTicks)
                   <> (if showYAxis then mempty else yAxis hideTicks)
            -- seaborn/ggpairs 流: 軸ラベル (変数名) は最下段 x・左端 y のみ。
            -- inline 列は名前を持たない (placeholder) ので、 その場合はラベルを付けない
            -- (= xLabel/yLabel を呼ばず mempty。 空ラベルの margin 予約も避けて詰める)。
            axName c = let nm = colRefName c
                       in if nm == "<inline-num>" || nm == "<inline-txt>" then "" else nm
            xLab c = if i == n - 1 && axName c /= "" then xLabel (axName c) else mempty
            yLab c = if j == 0     && axName c /= "" then yLabel (axName c) else mempty
            base
              -- 対角 (i==j): densityNorm (= y 軸 = 値範囲、 KDE は panel 高さに正規化、
              -- seaborn pairplot 対角)。 左端列なら y タイトルも。
              | i == j    = case cols !? i of
                  Just c  -> purePlot <> layer (densityNorm c) <> xLab c <> yLab c
                  Nothing -> purePlot
              | otherwise = case (cols !? j, cols !? i) of
                  (Just xc, Just yc) -> purePlot
                    <> layer (scatter xc yc <> alpha 0.3 <> size 2.5)
                    <> xLab xc <> yLab yc
                  _ -> purePlot
        in base <> axisCfg
      panels = [ mkPanel i j | i <- [0..n-1], j <- [0..n-1] ]
  in subplots panels <> subplotCols n <> title "Pairs plot"
  where
    (!?) :: [a] -> Int -> Maybe a
    xs !? i = if i < 0 || i >= length xs then Nothing else Just (xs !! i)