packages feed

hanalyze-models-0.2.0.1: src/Hanalyze/Model/LiNGAM/Pairwise.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns      #-}
-- |
-- Module      : Hanalyze.Model.LiNGAM.Pairwise
-- Description : Pairwise LiNGAM (Hyvärinen-Smith 2013、2 変数間の因果方向推定)
-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)
-- License     : BSD-3-Clause
--
-- [日本語]: Pairwise LiNGAM: 2 変数間の因果方向 (x → y か y → x か) 推定。
--
-- ## アルゴリズム (Hyvärinen-Smith 2013)
--
-- 標準化された (x, y) について、 非ガウシアン独立性に基づき:
--
--   R(x → y) = - Cov(x³, y) · sign(Cov(x, y)) + Cov(x, y³)
--
-- の符号で方向を決定する近似的測度 (LIM, likelihood ratio approximation)。
--
-- - R > 0 → x → y
-- - R < 0 → y → x
-- - |R| 小 → 判定不能 (ガウシアン近接 or 弱依存)
--
-- 軽量で 2 変数の方向推定に直接使える。 3 変数以上には @DirectLiNGAM@ を使う。
--
-- ## リファレンス
--
-- Hyvärinen, A. & Smith, S. M. (2013) "Pairwise likelihood ratios for
-- estimation of non-Gaussian structural equation models", JMLR 14.
-- Python 実装は cdt15/lingam の `lingam/lim.py` (LIM = Likelihood-based
-- Independence Measure)。
--
-- [English]: Pairwise LiNGAM: estimates the causal direction between two
-- variables (x → y or y → x).
--
-- ## Algorithm (Hyvärinen-Smith 2013)
--
-- For standardized (x, y), based on non-Gaussian independence:
--
--   R(x → y) = - Cov(x³, y) · sign(Cov(x, y)) + Cov(x, y³)
--
-- is an approximate measure (LIM, likelihood ratio approximation) whose
-- sign determines direction.
--
-- - R > 0 → x → y.
-- - R < 0 → y → x.
-- - |R| small → inconclusive (near-Gaussian or weak dependence).
--
-- Lightweight and usable directly for two-variable direction estimation.
-- Use @DirectLiNGAM@ for three or more variables.
--
-- ## Reference
--
-- Hyvärinen, A. & Smith, S. M. (2013) "Pairwise likelihood ratios for
-- estimation of non-Gaussian structural equation models", JMLR 14. The
-- Python implementation is cdt15/lingam's `lingam/lim.py` (LIM =
-- Likelihood-based Independence Measure).
module Hanalyze.Model.LiNGAM.Pairwise
  ( PairwiseDirection (..)
  , PairwiseResult (..)
  , pairwiseLiNGAM
  , pairwiseScore
  ) where

import qualified Numeric.LinearAlgebra as LA

-- ===========================================================================
-- 型
-- ===========================================================================

data PairwiseDirection
  = XtoY          -- ^ [日本語]: x → y。 [English]: x → y.
  | YtoX          -- ^ [日本語]: y → x。 [English]: y → x.
  | Inconclusive  -- ^ [日本語]: |score| < threshold。 [English]: |score| < threshold.
  deriving (Show, Eq)

data PairwiseResult = PairwiseResult
  { prScore     :: !Double             -- ^ [日本語]: R(x → y) の値、 符号で方向決定。 [English]: The value of R(x → y); its sign determines the direction.
  , prDirection :: !PairwiseDirection
  , prMagnitude :: !Double             -- ^ [日本語]: |score|、 confidence の代理。 [English]: |score|, a proxy for confidence.
  } deriving (Show)

-- ===========================================================================
-- 実装
-- ===========================================================================

-- | [日本語]: Pairwise LiNGAM の主関数。 threshold 未満は Inconclusive。
--   [English]: The main Pairwise LiNGAM function. Below the threshold,
--   returns Inconclusive.
pairwiseLiNGAM
  :: Double               -- threshold (default 0.0 = 符号だけで判定)
  -> LA.Vector Double     -- x
  -> LA.Vector Double     -- y
  -> PairwiseResult
pairwiseLiNGAM thr x y =
  let !s = pairwiseScore x y
      !mag = abs s
      !dir
        | mag < thr = Inconclusive
        | s > 0     = XtoY
        | otherwise = YtoX
  in PairwiseResult { prScore = s, prDirection = dir, prMagnitude = mag }

-- | [日本語]: スコア R = -Cov(x³, y)·sign(Cov(x,y)) + Cov(x, y³)
--   x, y は内部で標準化される (zero-mean、 unit-variance)。
--   [English]: The score R = -Cov(x³, y)·sign(Cov(x,y)) + Cov(x, y³). x, y
--   are standardized internally (zero-mean, unit-variance).
pairwiseScore :: LA.Vector Double -> LA.Vector Double -> Double
pairwiseScore xRaw yRaw =
  let !x = standardize xRaw
      !y = standardize yRaw
      !x3 = x * x * x
      !y3 = y * y * y
      !cov_x_y   = covar x  y
      !cov_x3_y  = covar x3 y
      !cov_x_y3  = covar x  y3
      !sgn = if cov_x_y >= 0 then 1.0 else (-1.0 :: Double)
  in - cov_x3_y * sgn + cov_x_y3

-- ===========================================================================
-- 内部
-- ===========================================================================

standardize :: LA.Vector Double -> LA.Vector Double
standardize v =
  let !n  = fromIntegral (LA.size v) :: Double
      !mu = LA.sumElements v / n
      !c  = v - LA.scalar mu
      !s  = sqrt (c `LA.dot` c / n)
      !sd = if s > 1e-12 then s else 1.0
  in LA.scale (1 / sd) c

covar :: LA.Vector Double -> LA.Vector Double -> Double
covar a b =
  let !n  = fromIntegral (LA.size a) :: Double
      !ma = LA.sumElements a / n
      !mb = LA.sumElements b / n
      !ca = a - LA.scalar ma
      !cb = b - LA.scalar mb
  in ca `LA.dot` cb / n