hgg-core-0.2.0.0: src/Graphics/Hgg/Render/Statistical.hs
-- |
-- Module : Graphics.Hgg.Render.Statistical
-- Description : Statistical marks: qq, ecdf, rangebar, heatmap, contour, regression, density, statline
-- Copyright : (c) 2026 Aelysce Project (Toshiaki Honda)
-- License : BSD-3-Clause
--
-- [日本語]: Render モノリス分割 (出力中立・純粋移動)。
-- [English]: Split out from the Render monolith (an output-neutral, pure move).
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Graphics.Hgg.Render.Statistical where
import Graphics.Hgg.Layout (numToText,
Layout (..), Rect (..), Scale (..),
ViewportSize (..), computeLayout,
ggAxTextMar, ggAxTitleMar, ggHalfLine,
ggTickLen, niceTicks, scaleApply,
Track (..), solveTracks,
needsLegend, effectiveLegendPos,
coordOf, isPolar, polarCenter, polarPoint,
domFrac, projectXY, projectRectData,
projectBarRect, projectSegment,
CrossLoc (..), BarShape (..),
projectCrossBar, projectCrossSpan,
catUnitPx, resolutionOf,
AxisPlacement (..),
coordXAxisPlacement, coordYAxisPlacement,
coordXGridIsVertical)
import Graphics.Hgg.Layout.RangeOf (qqPoints, ecdfPoints) -- Phase 11 A6-2/A6-4
import Graphics.Hgg.Math.Griddata (gridOf, marchingSegments, innerLevels) -- Phase 24 A4/A5
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified Data.Time.Format as Data.Time.Format
import Graphics.Hgg.Spec (Annotation (..), AxisFormat (..),
ColData (..), ColRef,
ColorEnc (..), ConnectSpec (..),
DAGEdge (..), DAGLayoutAlgorithm (..),
DAGNode (..), DAGNodeKind (..),
DAGPlate (..), DAGSpec (..), Layer (..),
LegendPosition (..), LegendSpec (..),
Inset (..), MarginalSpec (..), MarkKind (..),
MarkShape (..), ShapeMapEntry (..),
LineType (..), lineTypeDash, lineTypeForIndex,
ReferenceLine (..), Resolver,
Position (..), Coord (..),
FacetScales (..), freeScaleX, freeScaleY,
FacetSpace (..), freeSpaceX, freeSpaceY,
ThemeOverride (..),
VisualSpec (..), YAxisSide (..), axisFormatOf,
axisRotateOf, resolveAxisAngle, axisShowTicksOf,
axShowGrid,
FontSpec (..), orderedCats, histBinning,
HexCell (..), hexbinLayerCells,
colRefName, resolveCol, resolveNum)
import Data.Maybe (mapMaybe, isJust)
import Data.List (sortOn, foldl')
import qualified Data.Map.Strict as Map
import Data.List (dropWhile, elemIndex, groupBy, nub,
sort, takeWhile)
import qualified Graphics.Hgg.Spec
import Data.Monoid (First (..), Last (..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import Numeric (showEFloat, showFFloat)
import Graphics.Hgg.Primitive
import Graphics.Hgg.Render.Common
-- | [日本語]: Q-Q plot (= ggplot geom_qq)。 sample (encY) をソートして
-- order statistic を y、 理論正規分位点 Φ⁻¹((i-0.5)/n) を x に取り点を描く。
-- 理論分位点は 'qqPoints' (RangeOf) を単一情報源として共有 (= x range と一致)。
-- 参照線 (qq line) は ggplot でも別 geom (geom_qq_line) なので本 geom は点のみ。
-- [English]: A Q-Q plot (ggplot's geom_qq). Sorts the sample (encY) and
-- plots points with the order statistic as y and the theoretical normal
-- quantile Φ⁻¹((i-0.5)/n) as x. The theoretical quantiles are shared from
-- a single source, 'qqPoints' (RangeOf), so they match the x range. Even in
-- ggplot the reference line (qq line) is a separate geom (geom_qq_line), so
-- this geom draws only the points.
renderQQ :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderQQ r layout pal ly =
let sample = V.toList (vecOr (lyEncY ly) r)
pts = qqPoints sample -- [(theoretical x, ordered y)]
c = staticColorOr ly (tpDefault pal)
a = doubleOr (lyAlpha ly) 0.85
ptSz = doubleOr (lySize ly) (mmPt 1.5)
coord = lpCoord layout
in [ PCircle (projectPoint coord layout xt y) (ptSz / 2)
(FillStyle c a) (Just (StrokeStyle c 1.0)) Nothing
| (xt, y) <- pts ]
-- | [日本語]: ECDF (= ggplot stat_ecdf)。 sample (encX) をソートして右連続の
-- 階段 F(x)=#(≤x)/n を描く。 角点列 'ecdfPoints' を単一情報源とし連続線で結ぶ。
-- [English]: An ECDF (ggplot's stat_ecdf). Sorts the sample (encX) and draws
-- the right-continuous step function F(x)=#(≤x)/n. The corner points come
-- from a single source, 'ecdfPoints', connected with a continuous line.
renderEcdf :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderEcdf r layout pal ly =
let sample = V.toList (vecOr (lyEncX ly) r)
verts = ecdfPoints sample
c = staticColorOr ly (tpDefault pal)
w = doubleOr (lyStroke ly) (mmPt 0.5)
dash = maybe [] lineTypeDash (getLast (lyLinetype ly))
ls = LineStyle c w dash
coord = lpCoord layout
pp = projectPoint coord layout
mkSeg ((x1,y1),(x2,y2)) = PLine (pp x1 y1) (pp x2 y2) ls
in case verts of
[] -> []
_ -> map mkSeg (zip verts (tail verts))
-- | [日本語]: 区間 geom (linerange / pointrange / crossbar)。 各 (x,y) に縦区間
-- y±errorY を描く。 withPoint=中心点を足す (pointrange)、 asBox=幅付き箱+中央線 (crossbar)。
-- 箱は投影層 ('projectCrossBar' / 'projectCrossSpan') 経由 (Phase 71 A2):
-- 直線座標系は px 半幅 (旧式 byte 一致)、 polar は data 半幅の wedge + 弧。
-- [English]: A range geom (linerange / pointrange / crossbar). Draws a
-- vertical interval y±errorY at each (x,y). withPoint adds a center point
-- (pointrange); asBox draws a box with a width plus a center line
-- (crossbar). The box goes through the projection layer ('projectCrossBar'
-- / 'projectCrossSpan', Phase 71 A2): linear coordinate systems use the
-- pixel half-width (byte identical to the old formula), polar uses a wedge
-- and arcs at the data half-width.
renderRangeBar :: Resolver -> Layout -> ThemePalette -> Layer -> Bool -> Bool -> [Primitive]
renderRangeBar r layout pal ly withPoint asBox =
let xs = V.toList (vecOr (lyEncX ly) r)
ys = V.toList (vecOr (lyEncY ly) r)
es = V.toList (vecOr (lyErrorY ly) r)
n = minimum [length xs, length ys, length es]
c = staticColorOr ly (tpDefault pal)
w = doubleOr (lyStroke ly) (mmPt 0.5)
ptSz = doubleOr (lySize ly) (mmPt 1.5)
ls = solid c w
coord = lpCoord layout
pp = projectPoint coord layout
-- ★ Phase 41: crossbar 箱の半幅を ggplot 同様データ単位化 (width = markWidth × resolution)。
-- boxplot bw と同型 (catUnitPx × 幅係数)・resolution で連続 x にも追従。 旧 px 固定 10 を置換。
capWFactor = doubleOr (lyMarkWidth ly) 0.9 -- ggplot geom_crossbar 既定 width = 0.9
finite v = not (isNaN v) && not (isInfinite v)
resX = resolutionOf (filter finite xs)
halfW = 0.5 * capWFactor * resX * catUnitPx coord layout
-- ★ Phase 71 A2: crossbar の箱幅は px (halfW) と data (halfD) の両建てで
-- 投影層へ渡す (boxAtCross と同じ契約: 直線座標系 = halfW px で旧式 byte
-- 一致、 polar = halfD data 単位の wedge)。
halfD = 0.5 * capWFactor * resX
mkOne i =
let x = xs !! i; y = ys !! i; e = es !! i
Point pmx pmy = pp x y
in if asBox
then -- crossbar: 箱 + 中央線を投影層経由で組む
-- ★ Phase 71 A2: 旧実装は px 空間の PRect 直書きで、 polar は平面
-- 矩形のまま (Phase 64 A5 除外)、 flip は pp x (y±e) の第 2 成分が
-- 両方 cross 位置になり箱の高さ 0 (実バグ、 md A1 実測) だった。
-- 'projectCrossBar' / 'projectCrossSpan' 経由で cartesian は旧式
-- byte 一致・flip は正しい向きの箱・polar は wedge + 弧になる。
let loc = CrossAt x
body = case projectCrossBar coord layout loc 0 halfW halfD (y - e) (y + e) of
BarRect rect -> PRect rect (FillStyle c 0.15) (Just (StrokeStyle c w))
BarWedge segs -> PPath segs (FillStyle c 0.15) (Just (StrokeStyle c w))
center = projectCrossSpan coord layout loc 0 halfW halfD y
in body : [ PLine p q ls | (p, q) <- zip center (drop 1 center) ]
else -- linerange: 値軸方向の区間。 pointrange は中心点を追加
-- ★ Phase 64 A5: 旧実装は低端の px x を両端に流用して画面垂直の線分を
-- 組んでいたため、 polar では半径方向にならず・flip では両端が同一点に
-- 潰れて (= 長さ 0) 誤差棒が消えていた。 'projectSegment' に委譲すると
-- 直線座標系は 2 点で旧 px 式と bit 一致、 polar は半径方向の線分、
-- CoordPolarY は弧になる。
let pts = projectSegment coord layout (x, y - e) (x, y + e)
in [ PLine p q ls | (p, q) <- zip pts (drop 1 pts) ]
++ (if withPoint
then [ PCircle (Point pmx pmy) (ptSz / 2)
(FillStyle c 1.0) (Just (StrokeStyle c 1.0)) Nothing ]
else [])
in if n <= 0 then [] else concatMap mkOne [0 .. n - 1]
-- | [日本語]: heatmap (= ggplot geom_tile)。 x/y はカテゴリ列、 value (= lyColor の
-- ColorByContinuous) を各 (x,y) セルの連続色 (Viridis) に写して矩形で塗る。 セルは data 空間で
-- カテゴリ中心 ±0.5 の 1 単位四方 (= projectRectData で flip も自動追従)。 cell 間は背景色の
-- 細い枠で区切る (= grid 状)。 同 (x,y) が重複する行は後勝ち (= 描画順で上書き)。
-- [English]: A heatmap (ggplot's geom_tile). x/y are categorical columns;
-- the value (lyColor's ColorByContinuous) is mapped to a continuous color
-- (Viridis) and painted as a rectangle for each (x,y) cell. Cells are a
-- one-unit square in data space, category center ±0.5 (using
-- projectRectData, so flip is handled automatically). Cells are separated
-- by a thin border in the background color (a grid look). When (x,y) is
-- duplicated across rows, the last one wins (overwritten in draw order).
renderHeatmap :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderHeatmap r layout pal ly =
let toLabels mcr = case getLast mcr of
Just cr -> case resolveCol r cr of
Just (TxtData v) -> V.toList v
Just (NumData v) -> V.toList (V.map numToText v)
Nothing -> []
Nothing -> []
xs = toLabels (lyEncX ly)
ys = toLabels (lyEncY ly)
n = min (length xs) (length ys)
cs = colorVector r layout pal ly n -- ColorByContinuous → Viridis 連続色
xLabels = lpXCategoryLabels layout
yLabels = lpYCategoryLabels layout
coord = lpCoord layout
a = doubleOr (lyAlpha ly) 1.0
mkCell i = do
xi <- elemIndex (xs !! i) xLabels
yi <- elemIndex (ys !! i) yLabels
let c = cs V.! i
xd = fromIntegral xi; yd = fromIntegral yi
rc = projectRectData coord layout (xd - 0.5) (xd + 0.5) (yd - 0.5) (yd + 0.5)
Just (PRect rc (FillStyle c a) (Just (StrokeStyle (tpBackground pal) 1.0)))
in if n <= 0 then [] else mapMaybe mkCell [0 .. n - 1]
-- | [日本語]: geom_count (Ch10 EDA、 = ggplot @geom_count()@ / @stat_sum@)。
-- x/y はともにカテゴリ列。 各 (x,y) セルの観測件数を集計し、 cell 中心に
-- __面積 ∝ 件数__ (= 半径 ∝ √件数) の点を打つ。 最大件数のセルが半径 maxR (px)、
-- 件数 0 のセルは描かない。 maxR は lySize で上書き可 (既定 18 → 半径 9)。
-- heatmap と同じカテゴリ軸 (lpX/YCategoryLabels) を用いるので両軸自動でカテゴリ化。
-- [English]: geom_count (Ch10 EDA, ggplot's @geom_count()@ / @stat_sum@).
-- Both x and y are categorical columns. Tallies the observation count per
-- (x,y) cell and plots a point at each cell center, sized so
-- __area is proportional to count__ (radius proportional to √count). The
-- highest-count cell gets radius maxR (px); cells with count 0 are not
-- drawn. maxR can be overridden via lySize (default 18, giving radius 9).
-- Uses the same categorical axes as heatmap (lpX/YCategoryLabels), so both
-- axes become categorical automatically.
renderCount :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderCount r layout pal ly =
let toLabels mcr = case getLast mcr of
Just cr -> case resolveCol r cr of
Just (TxtData v) -> V.toList v
Just (NumData v) -> V.toList (V.map numToText v)
Nothing -> []
Nothing -> []
xs = toLabels (lyEncX ly)
ys = toLabels (lyEncY ly)
n = min (length xs) (length ys)
xLabels = lpXCategoryLabels layout
yLabels = lpYCategoryLabels layout
coord = lpCoord layout
c = staticColorOr ly (tpDefault pal)
a = doubleOr (lyAlpha ly) 0.85
maxR = doubleOr (lySize ly) (mmPt 4.5) / 2 -- 最大件数セルの半径 (既定 4.5mm 径)
-- (xi, yi) セル → 件数 (カテゴリに無い水準は除外)
counts = Map.toList $ Map.fromListWith (+)
[ ((xi, yi), 1 :: Int)
| i <- [0 .. n - 1]
, Just xi <- [elemIndex (xs !! i) xLabels]
, Just yi <- [elemIndex (ys !! i) yLabels] ]
maxC = maximum (1 : map snd counts)
mkPt ((xi, yi), cnt) =
let xd = fromIntegral xi; yd = fromIntegral yi
rad = maxR * sqrt (fromIntegral cnt / fromIntegral maxC) -- 面積 ∝ 件数
in PCircle (projectPoint coord layout xd yd) rad
(FillStyle c a) (Just (StrokeStyle c 1.0)) Nothing
in if n <= 0 then [] else map mkPt counts
-- | [日本語]: contour (= 等高線図、 marching squares)。 連続 x/y/z を正則格子に再標本化
-- (inverse-distance weighting で散布点 → ノード) し、 z 範囲を等分した nLev 段の
-- __等値線__を marching squares で描く。 各等値線は z 値で連続色 (Viridis)。
-- 旧実装は binned heatmap だったが、 「contour = 等高線」 の名に合わせ isolines に
-- (binned heatmap が要るなら 'Graphics.Hgg.Spec.Constructors.bin2d')。 HS=PS 同式 (PS renderContour も同型)。
--
-- TODO (繰越、 2026-06-04): 等値線が__ガタつく__。 原因 = ① IDW は各データ点で
-- 尖る (cusp) ため格子データでも滑らかにならない、 ② 32×32 再標本化が粗い、 ③ marching
-- squares の線形補間で階段状になりやすい。 改善案 = (a) IDW を__双線形補間__ (元が格子なら
-- 格子直引き) に置換、 (b) 再標本化後に軽い Gaussian smoothing、 (c) 解像度↑。
-- HS/PS 両方に同じ修正が要る (parity 維持)。
-- [English]: A contour plot (isolines via marching squares). Resamples
-- continuous x/y/z onto a regular grid (scattered points to nodes, via
-- inverse-distance weighting) and draws __isolines__ at nLev levels evenly
-- spaced across the z range, using marching squares. Each isoline is
-- colored continuously (Viridis) by its z value. The previous
-- implementation was a binned heatmap, but this was changed to isolines to
-- match the name "contour" (use 'Graphics.Hgg.Spec.Constructors.bin2d' if a binned heatmap is needed).
-- HS and PS share the same formulas (PS's renderContour is structurally
-- identical).
--
-- TODO (carried over, 2026-06-04): the isolines are __jagged__. Causes: (1)
-- IDW cusps at each data point, so even gridded data does not smooth out;
-- (2) the 32×32 resampling is coarse; (3) marching squares' linear
-- interpolation tends to look stair-stepped. Possible fixes: (a) replace
-- IDW with __bilinear interpolation__ (reading the grid directly when the
-- source is already gridded), (b) light Gaussian smoothing after
-- resampling, (c) higher resolution. The same fix is needed in both HS and
-- PS (to keep parity).
renderContour :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderContour r layout _pal ly =
case contourInput r ly of
Nothing -> []
Just (xNodes, yNodes, gridV, zmin, zmax) ->
let levels = contourLevelsFor ly zmin zmax
coord = lpCoord layout
pp = projectPoint coord layout
gridL = map V.toList (V.toList gridV) -- 共有核 (Griddata) は [[Double]]
levelColor lv = continuousColor (lpContinuousPalette layout)
(if zmax == zmin then 0.5 else (lv - zmin)/(zmax - zmin))
drawLevel lv =
[ PLine (pp ax ay) (pp bx by) (solid (levelColor lv) 1.5)
| ((ax,ay),(bx,by)) <- marchingSegments xNodes yNodes gridL lv ]
in if zmax <= zmin then [] else concatMap drawLevel levels
-- | [日本語]: contour / filled contour の共通入力 — (x,y,z) triple を
-- 'gridOf' で格子化する。 ★規則 grid 入力 (計画格子・linspace 由来) は
-- __補間せず直入力__ (旧実装は常に全点 IDW で 32x32 再標本化しており、
-- 規則 grid でも等値線が歪む + 隅に偽輪郭が出るバグだった)。
-- 散布入力のみ k 近傍 IDW で 32x32 へ。 格子の向きは grid!!j!!i (行 = y)。
-- [English]: The shared input for contour / filled contour — grids
-- (x,y,z) triples via 'gridOf'. A regular grid input (a planned grid,
-- e.g. from linspace) is __used directly, without interpolation__ (the
-- old implementation always resampled all points to 32x32 via IDW, which
-- distorted the isolines and produced spurious contours at the corners
-- even for an already-regular grid). Only scattered input goes through
-- k-nearest-neighbor IDW to 32x32. Grid orientation is grid!!j!!i (rows
-- are y).
contourInput :: Resolver -> Layer
-> Maybe ([Double], [Double], V.Vector (V.Vector Double), Double, Double)
contourInput r ly =
let xs = V.toList (vecOr (lyEncX ly) r)
ys = V.toList (vecOr (lyEncY ly) r)
vs = case getLast (lyColor ly) of
Just (ColorByContinuous cr) -> maybe [] V.toList (resolveNum r cr)
_ -> []
n = minimum [length xs, length ys, length vs]
in if n < 4 then Nothing
else
let triples = [ (xs !! i, ys !! i, vs !! i) | i <- [0 .. n - 1] ]
(xNodes, yNodes, grid) = gridOf 32 triples
gridV = V.fromList (map V.fromList grid)
allZ = concat grid
in Just (xNodes, yNodes, gridV, minimum allZ, maximum allZ)
-- | [日本語]: 等高線レベル。 明示 breaks ('Graphics.Hgg.Spec.Constructors.contourBreaks') > 本数指定
-- ('Graphics.Hgg.Spec.Constructors.contourLevels'、 既定 8)。 既定は (zmin, zmax) の__内側等間隔__
-- (lv_k = zmin + (zmax-zmin)·k/(n+1)) — 端値ちょうどの退化等値線を避ける
-- (旧実装の 15%-95% クランプは廃止 = 端近くのレベルも出る)。
-- [English]: Contour levels. Explicit breaks ('Graphics.Hgg.Spec.Constructors.contourBreaks') take
-- priority over a count ('Graphics.Hgg.Spec.Constructors.contourLevels', default 8). The default is
-- __evenly spaced strictly inside__ (zmin, zmax)
-- (lv_k = zmin + (zmax-zmin)·k/(n+1)) — this avoids a degenerate isoline
-- exactly at an endpoint (the old 15%-95% clamp has been removed, so
-- levels near the edges are also produced).
contourLevelsFor :: Layer -> Double -> Double -> [Double]
contourLevelsFor ly zmin zmax =
case getLast (lyContourBreaks ly) of
Just bs -> bs
Nothing ->
innerLevels (max 1 (fromMaybe 8 (getLast (lyContourLevels ly)))) zmin zmax
-- | [日本語]: filled contour (等値帯の塗り)。 各セルを「最下帯の色で全塗り →
-- level 昇順に z >= lv の部分多角形を上塗り」 の累積方式で塗る (セル内は
-- marching squares と同じ線形補間の境界 = 'Graphics.Hgg.Spec.Constructors.contour' の線と整合)。
-- saddle セル (対角ケース) は頂点巡回順の単一多角形で近似 (v1 既知の限界)。
-- [English]: A filled contour (painting the isobands). Each cell is
-- painted by an accumulation method: fill the whole cell with the lowest
-- band's color, then overpaint the sub-polygon where z >= lv for each
-- level in ascending order (the boundary within a cell uses the same
-- linear interpolation as marching squares, so it stays consistent with
-- the lines drawn by 'Graphics.Hgg.Spec.Constructors.contour'). Saddle cells (the diagonal case) are
-- approximated as a single polygon following vertex traversal order (a
-- known limitation of v1).
renderContourFilled :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderContourFilled r layout _pal ly =
case contourInput r ly of
Nothing -> []
Just (xNodes, yNodes, gridV, zmin, zmax)
| zmax <= zmin -> []
| otherwise ->
let levels = contourLevelsFor ly zmin zmax
coord = lpCoord layout
pp = projectPoint coord layout
nx = length xNodes
ny = length yNodes
xAt i = xNodes !! i
yAt j = yNodes !! j
zAt i j = (gridV V.! j) V.! i
norm v = (v - zmin) / (zmax - zmin)
-- 帯色: level 列で区切った各帯の中央値の連続色
fences = zmin : levels ++ [zmax]
bandCol k = continuousColor (lpContinuousPalette layout)
(norm ((fences !! k + fences !! (k+1)) / 2))
-- セルの z >= lv 部分多角形: 角を巡回し、 含まれる角 + 辺の交点を拾う
polyAbove lv i j =
let cs = [ ((xAt i, yAt j), zAt i j)
, ((xAt (i+1), yAt j), zAt (i+1) j)
, ((xAt (i+1), yAt (j+1)), zAt (i+1) (j+1))
, ((xAt i, yAt (j+1)), zAt i (j+1)) ]
seg ((p1, z1), (p2, z2))
| z1 >= lv && z2 >= lv = [p2]
| z1 >= lv = [cross p1 z1 p2 z2]
| z2 >= lv = [cross p1 z1 p2 z2, p2]
| otherwise = []
cross (ax, ay) za (bx, by) zb =
let t = if zb == za then 0.5 else (lv - za) / (zb - za)
in (ax + t*(bx-ax), ay + t*(by-ay))
in concatMap seg (zip cs (drop 1 cs ++ [head cs]))
-- 塗りと同色の細 stroke = 隣接セル間の anti-alias 白筋 (seam) 埋め
fillPoly col pts = case map (uncurry pp) pts of
(p0 : rest@(_ : _ : _)) ->
[ PPath (MoveTo p0 : map LineTo rest ++ [ClosePath])
(FillStyle col 1.0)
(Just (StrokeStyle col 0.6)) ]
_ -> []
cellPrims i j =
let base = fillPoly (bandCol 0)
[ (xAt i, yAt j), (xAt (i+1), yAt j)
, (xAt (i+1), yAt (j+1)), (xAt i, yAt (j+1)) ]
ups = concat
[ fillPoly (bandCol k) (polyAbove lv i j)
| (k, lv) <- zip [1 ..] levels ]
in base ++ ups
in concat [ cellPrims i j | i <- [0 .. nx - 2], j <- [0 .. ny - 2] ]
-- | [日本語]: binned heatmap (= ggplot geom_bin2d)。 連続 x/y/z を nBins×nBins の grid に
-- binning し、 各セルの z 平均を連続色 (Viridis) で塗る。 'renderContour' (等高線) の
-- 塗り版。 セルは生 data 範囲 [xLo,xHi]×[yLo,yHi] を等分し projectRectData で投影
-- (flip 自動追従)。 空セルは描かない。 PS と同一式。
-- [English]: A binned heatmap (ggplot's geom_bin2d). Bins continuous x/y/z
-- onto an nBins×nBins grid and paints each cell's z average as a
-- continuous color (Viridis). The filled counterpart of 'renderContour'
-- (isolines). Cells evenly divide the raw data range
-- [xLo,xHi]×[yLo,yHi] and are projected via projectRectData (flip is
-- handled automatically). Empty cells are not drawn. Uses the same
-- formula as PS.
renderBin2d :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderBin2d r layout _pal ly =
let xs = V.toList (vecOr (lyEncX ly) r)
ys = V.toList (vecOr (lyEncY ly) r)
-- z (ColorByContinuous) があればセル平均 (= stat_summary_2d)、 無ければ
-- セル**件数** (= ggplot geom_bin2d 既定の fill=count)。
hasZ = case getLast (lyColor ly) of Just (ColorByContinuous _) -> True; _ -> False
vs = case getLast (lyColor ly) of
Just (ColorByContinuous cr) -> maybe [] V.toList (resolveNum r cr)
_ -> replicate (min (length xs) (length ys)) 0
n = minimum [length xs, length ys, length vs]
in if n < 3 then []
else
let triples = [ (xs !! i, ys !! i, vs !! i) | i <- [0 .. n - 1] ]
xLo = minimum [x | (x,_,_) <- triples]; xHi = maximum [x | (x,_,_) <- triples]
yLo = minimum [y | (_,y,_) <- triples]; yHi = maximum [y | (_,y,_) <- triples]
xSpan = xHi - xLo; ySpan = yHi - yLo
nBins = 12 :: Int
binOf lo sp p = max 0 (min (nBins - 1)
(floor ((p - lo) / sp * fromIntegral nBins)))
assigned = [ (binOf xLo xSpan x, binOf yLo ySpan y, v) | (x,y,v) <- triples ]
cellMean i j = let ms = [ v | (bx,by,v) <- assigned, bx == i, by == j ]
in if null ms then Nothing
else Just (if hasZ then sum ms / fromIntegral (length ms)
else fromIntegral (length ms)) -- count
cells = [ (i, j, cellMean i j) | i <- [0 .. nBins - 1], j <- [0 .. nBins - 1] ]
means = [ m | (_,_,Just m) <- cells ]
vMin = minimum means; vMax = maximum means
coord = lpCoord layout
drawCell (i, j, mm) = case mm of
Nothing -> []
Just m ->
let xd0 = xLo + fromIntegral i * xSpan / fromIntegral nBins
xd1 = xLo + fromIntegral (i + 1) * xSpan / fromIntegral nBins
yd0 = yLo + fromIntegral j * ySpan / fromIntegral nBins
yd1 = yLo + fromIntegral (j + 1) * ySpan / fromIntegral nBins
t = if vMax == vMin then 0.5 else (m - vMin) / (vMax - vMin)
col = continuousColor (lpContinuousPalette layout) (max 0 (min 1 t))
rc = projectRectData coord layout xd0 xd1 yd0 yd1
in [ PRect rc (FillStyle col 1.0) (Just (StrokeStyle "#ffffff" 0.3)) ]
in if null means then [] else concatMap drawCell cells
-- | [日本語]: geom_tile / geom_raster 相当。 __1 行 = 1 セル__。 連続 x/y をセル中心とし、
-- fill (colorBy = 'ColorByCol' 離散 / 'ColorByContinuous' 連続) の色で矩形をベタ塗りする。
-- bin2d と違い__再ビニングしない__ (事前計算済みグリッドをそのまま塗る)。 セル幅/高さは
-- sorted unique x/y の隣接差分の最小 = 格子間隔から自動 (ggplot @resolution()@ 相当・隙間なし)。
-- 決定境界の res×res グリッド塗り (縞解消) が主用途。 色/凡例は 'Graphics.Hgg.Render.Common.colorVector' + color-enc 駆動
-- guide が自動処理 (categorical なら離散パレット + 離散凡例)。 枠線なし = seamless。
-- [English]: The equivalent of geom_tile / geom_raster.
-- __Each row is one cell__. Treats continuous x/y as cell centers and
-- flat-fills each rectangle with the fill color (colorBy: discrete via
-- 'ColorByCol' or continuous via 'ColorByContinuous'). Unlike bin2d, it
-- __does not rebin__ (it paints the precomputed grid as-is). Cell width/height are
-- derived automatically from the grid spacing — the minimum adjacent
-- difference among sorted unique x/y values (equivalent to ggplot's
-- @resolution()@, with no gaps). Its main use is painting a res×res
-- decision-boundary grid (to remove banding). Color/legend handling is
-- automatic via 'Graphics.Hgg.Render.Common.colorVector' plus the color-enc-driven guide (a discrete
-- palette and discrete legend for categorical data). No border, i.e. seamless.
renderTile :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderTile r layout pal ly =
let xs = V.toList (vecOr (lyEncX ly) r)
ys = V.toList (vecOr (lyEncY ly) r)
n = min (length xs) (length ys)
cs = colorVector r layout pal ly n -- ColorByCol=離散 / ColorByContinuous=連続 両対応
coord = lpCoord layout
a = doubleOr (lyAlpha ly) 1.0
dx = gridStep xs
dy = gridStep ys
mkCell i =
let x = xs !! i; y = ys !! i
c = cs V.! i
rc = projectRectData coord layout (x - dx/2) (x + dx/2) (y - dy/2) (y + dy/2)
in PRect rc (FillStyle c a) Nothing -- 隙間なし = 枠線なし (seamless)
in if n <= 0 then [] else map mkCell [0 .. n - 1]
-- | [日本語]: sorted unique 値の隣接差分の最小を格子間隔とする (ggplot @resolution()@)。
-- 単一値 / 差分無しは 1.0 fallback。
-- [English]: Takes the minimum adjacent difference among sorted unique
-- values as the grid spacing (ggplot's @resolution()@). Falls back to
-- 1.0 for a single value or when there is no difference.
gridStep :: [Double] -> Double
gridStep vs =
let us = map head (groupBy (==) (sort vs)) -- sorted unique
diffs = [ b - x | (x, b) <- zip us (drop 1 us), b > x ]
in if null diffs then 1.0 else minimum diffs
-- | [日本語]: hexbin (= ggplot @geom_hex@ / matplotlib @hexbin@)。 連続 x/y を六角格子に
-- binning し、 各セルの__件数__を連続色 (Viridis) の pointy-top 六角形で塗る。 セル分割数は
-- 'lyBinCount' (既定 30)。 binning は純関数 'Graphics.Hgg.Spec.Constructors.hexbinCells' (d3-hexbin)、 描画はその 6 頂点を
-- 'projectPoint' で screen へ投影して 'PPath' で塗る。 colorbar は count guide (別途) が出す。
-- [English]: A hexbin (ggplot's @geom_hex@ / matplotlib's @hexbin@). Bins
-- continuous x/y onto a hexagonal grid and paints each cell's __count__ as
-- a pointy-top hexagon in a continuous color (Viridis). The number of
-- cells is controlled by 'lyBinCount' (default 30). Binning is the pure
-- function 'Graphics.Hgg.Spec.Constructors.hexbinCells' (d3-hexbin); drawing projects its 6 vertices to
-- screen space via 'projectPoint' and paints them as a 'PPath'. The
-- colorbar is emitted separately by the count guide.
renderHexbin :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderHexbin r layout _pal ly =
case hexbinLayerCells r ly of
[] -> []
cells ->
let counts = map hexCount cells
vMin = fromIntegral (minimum counts) :: Double
vMax = fromIntegral (maximum counts) :: Double
coord = lpCoord layout
pp = projectPoint coord layout
drawCell c =
let t = if vMax == vMin then 1.0
else (fromIntegral (hexCount c) - vMin) / (vMax - vMin)
col = continuousColor (lpContinuousPalette layout) (max 0 (min 1 t))
in case map (uncurry pp) (hexVerts c) of
(p0 : rest@(_ : _ : _)) ->
[ PPath (MoveTo p0 : map LineTo rest ++ [ClosePath])
(FillStyle col 1.0) (Just (StrokeStyle col 0.5)) ]
_ -> []
in concatMap drawCell cells
renderStatLine :: Resolver -> Layout -> ThemePalette -> Layer
-> ([Double] -> Double) -> [Primitive]
renderStatLine r layout pal ly statF =
let vs = V.toList (vecOr (lyEncY ly) r)
in if null vs then [] else
let v = statF vs
sy = scaleApply (lpYScale layout)
a = lpPlotArea layout
c = staticColorOr ly (tpAxis pal)
w = doubleOr (lyStroke ly) (mmPt 0.5)
in [ PLine (Point (rX a) (sy v)) (Point (rX a + rW a) (sy v))
(solid c w) ]
-- | [日本語]: Density plot (= Gaussian KDE 簡易版)。 lyEncX = 値ベクター。
-- bandwidth は Silverman の経験則、 100 grid 点で評価して PPath で曲線描画。
--
-- color/fill aesthetic (= 'ColorByCol') があるときは群ごとに分割し、 各群を
-- 独立に正規化した KDE 曲線を群色で重ねて描く (= ggplot @geom_density(aes(color=g))@)。
-- 各群の peak が異なるので y domain も群対応 (RangeOf.densityYRange と整合)。
-- [English]: A density plot (a simplified Gaussian KDE). lyEncX is the
-- value vector. Bandwidth follows Silverman's rule of thumb, evaluated at
-- 100 grid points and drawn as a curve via 'PPath'.
--
-- When a color/fill aesthetic ('ColorByCol') is present, splits by group
-- and overlays each group's independently normalized KDE curve in its
-- group color (ggplot's @geom_density(aes(color=g))@). Since each group's
-- peak differs, the y domain is also group-aware (consistent with
-- RangeOf.densityYRange).
renderDensity :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderDensity r layout pal ly =
let xsFull = V.toList (vecOrFull (lyEncX ly) r) -- 長さ保持 (群キーと整列するため)
xs = filter (not . isNaN) xsFull -- 単群 KDE 用 (NaN = Maybe の Nothing を除去)
w = doubleOr (lyStroke ly) (mmPt 0.5)
isNorm = getLast (lyDensityNorm ly) == Just True
-- Phase 28: density 曲線下の塗り (= ggplot geom_density(aes(fill=)))。 alpha と併用。
doFill = getLast (lyDensityFill ly) == Just True
fillA = doubleOr (lyAlpha ly) 0.5
coord = lpCoord layout
nGrid = 100 :: Int
-- x grid は data 範囲だけでなく x axis 全体 (= padded range) を評価
-- (= padded 領域でも density が tail 値で描画される。 matplotlib seaborn 流)
xDomLo = lsDomainLo (lpXScale layout)
xDomHi = lsDomainHi (lpXScale layout)
step = (xDomHi - xDomLo) / fromIntegral (nGrid - 1)
gridX = [ xDomLo + fromIntegral i * step | i <- [0 .. nGrid - 1] ]
-- 1 群 (= 1 系列) の Silverman KDE を gridX で評価。
kdeYs gxs =
let n = length gxs
mu = sum gxs / fromIntegral n
sd = sqrt (sum [(x - mu)^(2 :: Int) | x <- gxs] / fromIntegral (n - 1))
bw = max (1.06 * sd * fromIntegral n ** (-0.2 :: Double)) 1e-9
kde x = sum [ exp (negate ((x - xi) ** 2) / (2 * bw ** 2))
| xi <- gxs ] / (fromIntegral n * bw * sqrt (2 * pi))
in map kde gridX
-- projectPoint 経由の曲線 PPath (通常 density)。
curveOf col gxs
| length gxs < 2 = []
| otherwise =
let pts = zipWith (\x y -> projectPoint coord layout x y) gridX (kdeYs gxs)
segs = case pts of { [] -> []; (p:rest) -> MoveTo p : map LineTo rest }
-- Phase 28: doFill なら曲線下を col×fillA で塗る (= 曲線 → 右端 base →
-- 左端 base へ閉じた polygon)。 既定は ggplot 同様 fill=NA = 線のみ。
fillPrim
| not doFill = []
| otherwise =
let baseR = projectPoint coord layout (last gridX) 0
baseL = projectPoint coord layout (head gridX) 0
fsegs = segs ++ [LineTo baseR, LineTo baseL]
in [ PPath fsegs (FillStyle col fillA) Nothing ]
in fillPrim ++ [ PPath segs (FillStyle "" 0) (Just (StrokeStyle col w)) ]
-- 群別 density 判定: lyColor = ColorByCol で群キーが xs と整列。
-- isNorm (= pairs 対角) は値軸ゆえ群分割の対象外 (従来通り 1 本)。
grouped = case getLast (lyColor ly) of
Just (ColorByCol gcr) | not isNorm ->
case groupKeysOf r gcr of
-- ★ 群キーは値列と同じ全長で整列。 NaN 値の行を両方から落として対応を保つ
-- (vecOr で先に縮めると length 不一致で群分割が無効化していた)。
Just ks | length ks == length xsFull ->
Just (unzip [ (k, x) | (k, x) <- zip ks xsFull, not (isNaN x) ])
_ -> Nothing
_ -> Nothing
in case grouped of
-- === 群別: colorVector と同じ規則で群色を割当て、 群ごとに曲線を重ねる ===
Just (ks, gxsVals) ->
let distinct = let cats = lyColorCats ly in if null cats then orderedCats ks else cats
palArr = lpCategoricalPalette layout
manual = lpColorManual layout
colorOf t = case lookup t manual of
Just cc -> cc
Nothing -> case elemIndex t distinct of
Just i -> palArr !! (i `mod` length palArr)
Nothing -> tpDefault pal
grps = orderedGroups ks gxsVals -- [(key,[x])] 初出順
-- distinct (= 凡例) 順で描画し色を一致させる。
ordered = [ (g, vs) | g <- distinct, Just vs <- [lookup g grps] ]
in concat [ curveOf (colorOf g) gxs | (g, gxs) <- ordered ]
-- === 非 group / pairs 対角: 従来どおり全データ 1 本 ===
Nothing ->
let c = staticColorOr ly (tpDefault pal)
in if length xs < 2 then [] else
let ys = kdeYs xs
sx = scaleApply (lpXScale layout)
-- Phase 8 B16: densityNorm (pairs 対角) は y 軸 = 値範囲なので panel
-- 高さに独立正規化して描く (= seaborn pairplot 対角の挙動)。
area = lpPlotArea layout
yPeak = maximum (1e-12 : ys)
syNorm v = rY area + rH area - (v / yPeak) * rH area * 0.95
pts = if isNorm
then zipWith (\x y -> Point (sx x) (syNorm y)) gridX ys
else zipWith (\x y -> projectPoint coord layout x y) gridX ys
segs = case pts of { [] -> []; (p:rest) -> MoveTo p : map LineTo rest }
-- Phase 28: doFill なら曲線下を塗る (isNorm 時は基線が panel 下端)。
fillPrim
| not doFill = []
| otherwise =
let (baseR, baseL)
| isNorm = ( Point (sx (last gridX)) (rY area + rH area)
, Point (sx (head gridX)) (rY area + rH area) )
| otherwise = ( projectPoint coord layout (last gridX) 0
, projectPoint coord layout (head gridX) 0 )
in [ PPath (segs ++ [LineTo baseR, LineTo baseL]) (FillStyle c fillA) Nothing ]
in fillPrim ++ [ PPath segs (FillStyle "" 0) (Just (StrokeStyle c w)) ]
-- | [日本語]: 頻度多角形 (Ch10 EDA): @geom_freqpoly@。 histogram と同じ bin 化
-- ('histBinning') で各 bin の count を求め、 bin 中心 @origin+(i+0.5)*binW@ と count を
-- 折れ線で結ぶ (KDE の 'renderDensity' とは別物 = ビン頻度の生の折れ線)。 空 bin は
-- count 0 として線が底に落ちる (ggplot geom_freqpoly と同じ)。 'lyHistDensity' True で
-- after_stat(density) = count/(群N*binW) に正規化 (面積 1)。 color 群分割
-- (lyColor = ColorByCol) は 'renderDensity' と同方式で群ごとに別色の折れ線を重ねる。
-- [English]: A frequency polygon (Ch10 EDA): @geom_freqpoly@. Uses the same
-- binning as histogram ('histBinning') to get each bin's count, then
-- connects the bin center @origin+(i+0.5)*binW@ and count with a line
-- (distinct from the KDE-based 'renderDensity' — this is the raw polyline
-- of bin frequencies). Empty bins fall to count 0, so the line drops to
-- the baseline (same as ggplot's geom_freqpoly). With 'lyHistDensity' set
-- to True, normalizes to after_stat(density) = count/(groupN*binW) (area
-- 1). Color-based grouping (lyColor = ColorByCol) overlays a differently
-- colored line per group, the same way as 'renderDensity'.
renderFreqPoly :: Resolver -> Layout -> ThemePalette -> Layer -> [Primitive]
renderFreqPoly r layout pal ly =
let xs = V.toList (vecOr (lyEncX ly) r)
w = doubleOr (lyStroke ly) (mmPt 0.5)
isDensity = getLast (lyHistDensity ly) == Just True
coord = lpCoord layout
in if null xs then [] else
let (origin, binW, nB) = histBinning ly (minimum xs, maximum xs)
binIx x = min (nB - 1) (max 0 (floor ((x - origin) / binW)))
center i = origin + (fromIntegral i + 0.5) * binW
-- 1 群 (= 1 系列) の bin count → bin 中心折れ線。
polyOf col gxs
| null gxs = []
| otherwise =
let cs = foldl (\acc x -> let i = binIx x
in take i acc <> [acc !! i + 1] <> drop (i+1) acc)
(replicate nB (0 :: Int)) gxs
gN = fromIntegral (length gxs) :: Double
toY c = if isDensity && gN > 0 && binW > 0
then fromIntegral c / (gN * binW)
else fromIntegral c
pts = [ projectPoint coord layout (center i) (toY c)
| (i, c) <- zip [0 ..] cs ]
segs = case pts of { [] -> []; (p:rest) -> MoveTo p : map LineTo rest }
in [ PPath segs (FillStyle "" 0) (Just (StrokeStyle col w)) ]
-- 群分割判定 (= renderDensity と同規則)。
grouped = case getLast (lyColor ly) of
Just (ColorByCol gcr) ->
case groupKeysOf r gcr of
Just ks | length ks == length xs -> Just ks
_ -> Nothing
_ -> Nothing
in case grouped of
Just ks ->
let distinct = let cats = lyColorCats ly in if null cats then orderedCats ks else cats
palArr = lpCategoricalPalette layout
manual = lpColorManual layout
colorOf t = case lookup t manual of
Just cc -> cc
Nothing -> case elemIndex t distinct of
Just i -> palArr !! (i `mod` length palArr)
Nothing -> tpDefault pal
grps = orderedGroups ks xs
ordered = [ (g, vs) | g <- distinct, Just vs <- [lookup g grps] ]
in concat [ polyOf (colorOf g) gxs | (g, gxs) <- ordered ]
Nothing ->
let c = staticColorOr ly (tpDefault pal)
in polyOf c xs