hanalyze-0.2.0.0: test/Hanalyze/Design/TaguchiSpec.hs
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Hanalyze.Design.TaguchiSpec (spec) where
import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck
import Hanalyze.Model.Formula
import Hanalyze.Model.Formula.Frame
import Hanalyze.Model.Formula.Design
import Hanalyze.Model.Formula.RFormula
import Hanalyze.Model.Formula.Nonlinear
import Hanalyze.Model.Formula.Mixed
import Hanalyze.Model.GLMM
import Hanalyze.Model.GLM (Family (..), LinkFn (..))
import Hanalyze.Stat.Distribution (Transform)
import Data.List (sort, nub)
import Control.Monad (forM, forM_)
import System.IO.Temp (withSystemTempFile)
import System.IO (hPutStr, hClose)
import Hanalyze.Model.HBM.Ast (Expr (..), Lit (..), DoStmt (..), Err)
import Data.IORef (newIORef, readIORef, modifyIORef')
import qualified Hanalyze.Design.Orthogonal as OA
import qualified Hanalyze.Design.Taguchi as TG
import SpecHelper
spec :: Spec
spec = do
describe "Hanalyze.Design.Taguchi" $ do
it "smaller-the-better SN: lower y → higher η" $ do
let etaSmall = TG.snRatio TG.SmallerBetter [0.5, 0.5, 0.5]
etaLarge = TG.snRatio TG.SmallerBetter [5.0, 5.0, 5.0]
etaSmall `shouldSatisfy` (> etaLarge)
it "larger-the-better SN: higher y → higher η" $ do
let etaLarge = TG.snRatio TG.LargerBetter [10, 10, 10]
etaSmall = TG.snRatio TG.LargerBetter [1, 1, 1]
etaLarge `shouldSatisfy` (> etaSmall)
it "nominal-the-best SN: high mean / low var → high η" $ do
let highSN = TG.snRatio TG.NominalBest [10, 10.01, 9.99, 10]
lowSN = TG.snRatio TG.NominalBest [1, 4, 7, 10]
highSN `shouldSatisfy` (> lowSN)
it "nominal-target SN: closer to target → higher η" $ do
let closer = TG.snRatio (TG.NominalBestTarget 5) [4.9, 5.0, 5.1]
farther = TG.snRatio (TG.NominalBestTarget 5) [3, 5, 7]
closer `shouldSatisfy` (> farther)
it "snRatio on empty list is 0" $
TG.snRatio TG.SmallerBetter [] `shouldBe` 0
it "snRatioRows produces same length as input" $ do
let yMatrix = [[1.0, 2.0], [3.0, 4.0], [5.0, 6.0]]
length (TG.snRatioRows TG.SmallerBetter yMatrix) `shouldBe` 3
it "analyzeSN gives one FactorEffect per assigned factor" $ do
let specs = [ OA.FactorSpec "A" [OA.LText "lo", OA.LText "hi"]
, OA.FactorSpec "B" [OA.LText "lo", OA.LText "hi"]
, OA.FactorSpec "C" [OA.LText "lo", OA.LText "hi"]
]
Right ad = OA.assignFactors OA.l4 specs
fes = TG.analyzeSN ad [10, 20, 30, 40]
length fes `shouldBe` 3
map TG.feFactor fes `shouldBe` ["A", "B", "C"]
mapM_ (\fe -> length (TG.feSNByLevel fe) `shouldBe` 2) fes
it "optimalLevels picks max-SN level per factor" $ do
let specs = [ OA.FactorSpec "A" [OA.LText "lo", OA.LText "hi"]
, OA.FactorSpec "B" [OA.LText "lo", OA.LText "hi"]
, OA.FactorSpec "C" [OA.LText "lo", OA.LText "hi"]
]
Right ad = OA.assignFactors OA.l4 specs
-- L4 row 1 ("hi" for A,B,C) has SN=100; others 0
sns = [0, 0, 0, 100]
fes = TG.analyzeSN ad sns
opts = TG.optimalLevels fes
length opts `shouldBe` 3
-- Row 4 has all "hi" by L4 structure (2,2,1) — verify each factor's best
mapM_ (\(_, _, eta) -> eta `shouldSatisfy` (>= 0)) opts
-- ─────────────────────────────────────────────────────────────────────
describe "Hanalyze.Design.Taguchi extras" $ do
it "snRatioWithDetails: SmallerBetter on [1, 2, 3]" $ do
let d = TG.snRatioWithDetails TG.SmallerBetter [1.0, 2.0, 3.0]
TG.sdN d `shouldBe` 3
TG.sdMean d `shouldSatisfy` (\v -> abs (v - 2.0) < 1e-12)
TG.sdVariance d `shouldSatisfy` (\v -> abs (v - 1.0) < 1e-12)
-- η = -10 log10((1+4+9)/3) = -10 log10(14/3) ≈ -6.690
TG.sdSN d `shouldSatisfy` (\v -> abs (v - (-6.690)) < 1e-2)
it "factorEffectsTable: contributions sum to 1" $ do
let specs = [ OA.FactorSpec "A" [OA.LText "lo", OA.LText "hi"]
, OA.FactorSpec "B" [OA.LNumeric 0, OA.LNumeric 1]
]
case OA.assignFactors OA.l4 specs of
Right ad -> do
let sns = [10.0, 12.0, 11.0, 13.0]
ext = TG.factorEffectsTable ad sns
length ext `shouldBe` 2
let totalC = sum (map TG.feeContribution ext)
totalC `shouldSatisfy` (\v -> abs (v - 1.0) < 1e-12)
all ((>= 0) . TG.feeRange) ext `shouldBe` True
Left e -> expectationFailure (show e)
-- ─────────────────────────────────────────────────────────────────────