packages feed

hanalyze-design (empty) → 0.2.0.1

raw patch · 33 files changed

+10538/−0 lines, 33 filesdep +basedep +containersdep +dataframe-core

Dependencies added: base, containers, dataframe-core, dataframe-csv, hanalyze-core, hanalyze-frame, hanalyze-models, hmatrix, mwc-random, primitive, statistics, text, vector

Files

+ README.ja.md view
@@ -0,0 +1,106 @@+# hanalyze-design++[`hanalyze`](../README.ja.md) の**実験計画法 (DoE) 層**。 計画の+**生成** (要因計画 / 直交表 / RSM / 最適計画 / 空間充填 / 配合) と、+得られたデータの**評価** (分散分析 / 検出力 / 工程能力 / 測定システム解析) を+担う 30 module。++依存は `core` / `frame` / `models` の 3 層 + 外部 10 package。+モデル fit を `-models` に委ねるため、 RSM の二次モデルや最適計画の+情報行列計算はこの層で完結せず models 層の回帰を使う。 `-viz` は+この層の上に乗る。++## 主要 module (全 30 module)++### 古典的な計画の生成 (`Hanalyze.Design.*`)++| Module | 役割 |+|---|---|+| `Design.Factorial` | 完全 / 2 水準 / 3 水準 / 一部実施 / 混合水準の要因計画 = DoE の入口 |+| `Design.Orthogonal` / `Design.Taguchi` | 直交表 (L8 / L9 / L12 …) / SN 比と内側・外側配置のロバスト設計 |+| `Design.Mixed` / `Design.Block` | 混合水準計画 / ブロック化 (乱塊法) |+| `Design.DSD` | Definitive Screening Design (Jones-Nachtsheim 2011) |+| `Design.RSM` | 応答曲面法 — CCD / Box-Behnken の生成、 二次モデル fit、 極値の解析解 |++### 最適計画・空間充填・配合++| Module | 役割 |+|---|---|+| `Design.Optimal` | D / A / I / E / G-optimal (Fedorov 交換法) + 既存計画への追加 (`augmentDesign`) |+| `Design.SpaceFilling` | 空間充填計画 — LHS / Maximin LHS / Halton (コンピュータ実験用) |+| `Design.Mixture` | 配合計画 — Simplex Lattice / Simplex Centroid (成分比の合計 = 1) |+| `Design.MultiRSM` | 複数応答の同時最適化 (Desirability との併用) |++### Custom Design (`Design.Custom.*`)++因子・モデル・制約をユーザが組み立てる汎用計画生成系。 11 module。++| Module | 役割 |+|---|---|+| `Custom.Factor` / `Custom.Model` | 因子定義 (連続 / カテゴリ / 離散数値) / モデル項の指定 |+| `Custom.Constraint` / `Design.Constraint` | 線形・非線形制約下での候補点の絞り込み |+| `Custom.Augment` | 追加実験メニュー (`AddRuns` 等) — `Design.Optimal.augmentDesign` を呼ぶ |+| `Custom.SplitPlot` | 分割実験 (whole plot / sub plot) |+| `Custom.Bayesian` | Bayesian D-optimal (DuMouchel-Jones 1994) |+| `Custom.Power` / `Custom.Compare` | 検出力評価 / 複数計画の比較 |+| `Custom.Coordinate` / `Custom.Structured` / `Custom.RegionMoment` | 座標交換法 / 構造化計画 / 領域モーメント行列 (I-optimal) |++### 解析・評価++| Module | 役割 |+|---|---|+| `Design.Anova` | 分散分析 (要因効果の有意性) |+| `Design.Diagnostics` | 計画の診断 (交絡・エイリアス構造・条件数) |+| `Design.Power` | 検出力・必要実験数の計算 |+| `Design.Quality` | 工程能力指数 (Cp / Cpk 等) |+| `Design.GaugeRR` | Gauge R&R — 測定システム解析 (AIAG MSA 4th ed. 準拠) |++### 逐次・ワークフロー++| Module | 役割 |+|---|---|+| `Design.Sequential` | 逐次 RSM — 最急上昇パス生成と次の CCD 配置 |+| `Design.Workflow` | 計画 → 実験 → 解析 → 次の計画という一連の流れの支援 |++## 単体で使う++計画の生成だけなら、 この package 単体で足りる:++```cabal+build-depends: hanalyze-design+```++```haskell+import Hanalyze.Design.Factorial (twoLevelFactorial, fullFactorial)++main :: IO ()+main = do+  mapM_ print (twoLevelFactorial 3)+  -- [-1.0,-1.0,-1.0] / [-1.0,-1.0,1.0] / … / [1.0,1.0,1.0]  (2³ = 8 run)+  mapM_ print (fullFactorial [[180, 200, 220], [10, 20]])+  -- [180.0,10.0] / [180.0,20.0] / [200.0,10.0] / … / [220.0,20.0]  (3×2 = 6 run)+```++`twoLevelFactorial k` は coded (`±1`) の `2^k` 計画、 `fullFactorial` は+因子ごとの水準リストをそのまま直積するので**実単位のまま**計画表になる。++なお、 通常は umbrella package `hanalyze` を依存に書けば+`import Hanalyze` だけで上記もすべて使える。 層を直接指定するのは+依存を最小化したいときのみで十分。++## 関連 docs++- DoE 入口: [docs/doe/01-doe.ja.md](../docs/doe/01-doe.ja.md) /+  理論: [theory-doe.ja.md](../docs/doe/theory-doe.ja.md)+- 直交表・田口法: [02-orthogonal-taguchi.ja.md](../docs/doe/02-orthogonal-taguchi.ja.md)+- Custom Design: [usage-custom-design.ja.md](../docs/doe/usage-custom-design.ja.md) /+  [manual-custom-design.ja.md](../docs/doe/manual-custom-design.ja.md)+- 実験の追加・分割実験: [usage-augment-splitplot.ja.md](../docs/doe/usage-augment-splitplot.ja.md) /+  低レベル API: [usage-doptimal-augment.ja.md](../docs/doe/usage-doptimal-augment.ja.md)+- Bayesian D-optimal: [usage-bayesian-d.ja.md](../docs/doe/usage-bayesian-d.ja.md)+- 空間充填: [usage-space-filling.ja.md](../docs/doe/usage-space-filling.ja.md) /+  配合計画: [usage-mixture.ja.md](../docs/doe/usage-mixture.ja.md)+- 逐次 RSM: [usage-sequential-rsm.ja.md](../docs/doe/usage-sequential-rsm.ja.md)+- Gauge R&R: [usage-gauge-rr.ja.md](../docs/doe/usage-gauge-rr.ja.md)++← [repository README](../README.ja.md)
+ README.md view
@@ -0,0 +1,110 @@+# hanalyze-design++The **design of experiments (DoE) layer** of [`hanalyze`](../README.md).+It owns both the **generation** of designs (factorial / orthogonal arrays /+RSM / optimal design / space-filling / mixture) and the **evaluation** of the+resulting data (ANOVA / power / process capability / measurement system+analysis) — 30 modules in total.++It depends on the three layers `core` / `frame` / `models`, plus 10 external+packages. Because model fitting is delegated to `-models`, the quadratic+model for RSM and the information-matrix computation for optimal design are+not self-contained here — they use regression from the models layer. `-viz`+sits on top of this layer.++## Main modules (30 in total)++### Classical design generation (`Hanalyze.Design.*`)++| Module | Role |+|---|---|+| `Design.Factorial` | Full / two-level / three-level / fractional / mixed-level factorial designs — the entry point for DoE |+| `Design.Orthogonal` / `Design.Taguchi` | Orthogonal arrays (L8 / L9 / L12, …) / robust design via SN ratio and inner/outer arrays |+| `Design.Mixed` / `Design.Block` | Mixed-level designs / blocking (randomized block design) |+| `Design.DSD` | Definitive Screening Design (Jones-Nachtsheim 2011) |+| `Design.RSM` | Response surface methodology — CCD/Box-Behnken generation, quadratic model fit, analytical solution for the extremum |++### Optimal design, space filling, and mixture++| Module | Role |+|---|---|+| `Design.Optimal` | D / A / I / E / G-optimal (Fedorov exchange algorithm) plus augmenting an existing design (`augmentDesign`) |+| `Design.SpaceFilling` | Space-filling designs — LHS / Maximin LHS / Halton (for computer experiments) |+| `Design.Mixture` | Mixture designs — Simplex Lattice / Simplex Centroid (component proportions sum to 1) |+| `Design.MultiRSM` | Simultaneous optimization of multiple responses (used together with Desirability) |++### Custom Design (`Design.Custom.*`)++A general-purpose design-generation system where the user assembles factors,+model, and constraints. 11 modules.++| Module | Role |+|---|---|+| `Custom.Factor` / `Custom.Model` | Factor definitions (continuous / categorical / discrete numeric) / specifying model terms |+| `Custom.Constraint` / `Design.Constraint` | Narrowing candidate points under linear/nonlinear constraints |+| `Custom.Augment` | Menu for adding runs (`AddRuns`, etc.) — calls `Design.Optimal.augmentDesign` |+| `Custom.SplitPlot` | Split-plot experiments (whole plot / sub plot) |+| `Custom.Bayesian` | Bayesian D-optimal design (DuMouchel-Jones 1994) |+| `Custom.Power` / `Custom.Compare` | Power evaluation / comparison of multiple designs |+| `Custom.Coordinate` / `Custom.Structured` / `Custom.RegionMoment` | Coordinate-exchange algorithm / structured designs / region moment matrix (I-optimal) |++### Analysis & evaluation++| Module | Role |+|---|---|+| `Design.Anova` | Analysis of variance (significance of factor effects) |+| `Design.Diagnostics` | Design diagnostics (confounding / alias structure / condition number) |+| `Design.Power` | Power and required-sample-size calculations |+| `Design.Quality` | Process capability indices (Cp / Cpk, etc.) |+| `Design.GaugeRR` | Gauge R&R — measurement system analysis (per AIAG MSA 4th ed.) |++### Sequential & workflow++| Module | Role |+|---|---|+| `Design.Sequential` | Sequential RSM — steepest-ascent path generation and placement of the next CCD |+| `Design.Workflow` | Support for the design → experiment → analysis → next-design cycle |++## Using it standalone++If you only need to generate designs, this package alone is sufficient:++```cabal+build-depends: hanalyze-design+```++```haskell+import Hanalyze.Design.Factorial (twoLevelFactorial, fullFactorial)++main :: IO ()+main = do+  mapM_ print (twoLevelFactorial 3)+  -- [-1.0,-1.0,-1.0] / [-1.0,-1.0,1.0] / … / [1.0,1.0,1.0]  (2³ = 8 run)+  mapM_ print (fullFactorial [[180, 200, 220], [10, 20]])+  -- [180.0,10.0] / [180.0,20.0] / [200.0,10.0] / … / [220.0,20.0]  (3×2 = 6 run)+```++`twoLevelFactorial k` produces a coded (`±1`) `2^k` design; `fullFactorial`+takes the Cartesian product of the given per-factor level lists directly, so+the resulting design table stays **in the original units**.++Normally you would just depend on the umbrella package `hanalyze` and+get all of the above from a single `import Hanalyze`. Naming a layer+directly is only worth it when you want to minimize dependencies.++## Related docs++- DoE entry point: [docs/doe/01-doe.md](../docs/doe/01-doe.md) /+  theory: [theory-doe.md](../docs/doe/theory-doe.md)+- Orthogonal arrays and Taguchi methods: [02-orthogonal-taguchi.md](../docs/doe/02-orthogonal-taguchi.md)+- Custom Design: [usage-custom-design.md](../docs/doe/usage-custom-design.md) /+  [manual-custom-design.md](../docs/doe/manual-custom-design.md)+- Augmenting runs and split-plot experiments: [usage-augment-splitplot.md](../docs/doe/usage-augment-splitplot.md) /+  low-level API: [usage-doptimal-augment.md](../docs/doe/usage-doptimal-augment.md)+- Bayesian D-optimal: [usage-bayesian-d.md](../docs/doe/usage-bayesian-d.md)+- Space filling: [usage-space-filling.md](../docs/doe/usage-space-filling.md) /+  mixture designs: [usage-mixture.md](../docs/doe/usage-mixture.md)+- Sequential RSM: [usage-sequential-rsm.md](../docs/doe/usage-sequential-rsm.md)+- Gauge R&R: [usage-gauge-rr.md](../docs/doe/usage-gauge-rr.md)++← [repository README](../README.md)
+ hanalyze-design.cabal view
@@ -0,0 +1,88 @@+cabal-version: 3.0+name:          hanalyze-design+version:       0.2.0.1+synopsis:      Design-of-experiments layer of hanalyze (DoE / MSA)+description:+    The design-of-experiments layer of the hanalyze toolkit. Generates+    designs -- full and fractional factorials, orthogonal arrays and Taguchi+    robust designs, blocking, definitive screening designs, response surface+    designs (CCD / Box-Behnken), D/A/I/E/G-optimal designs by Fedorov+    exchange (including augmentation of an existing design), space-filling+    designs (LHS / maximin LHS / Halton), mixture designs and the Custom+    Design family with factor, model and constraint definitions -- and+    evaluates the resulting data: analysis of variance, design diagnostics,+    power and sample size, process capability, Gauge R&R measurement system+    analysis, and sequential RSM helpers.+    .+    Module names match the umbrella package hanalyze, which re-exports+    everything, so downstream imports stay identical. See README.md for the+    module map and a standalone usage example.+license:       BSD-3-Clause+author:        Toshiaki Honda+maintainer:    frenzieddoll@gmail.com+copyright:     2026 Aelysce Project (Toshiaki Honda)+category:      Math, Statistics, Numeric, Machine Learning+build-type:    Simple+tested-with:   GHC == 9.6.7+extra-source-files:+    README.md+    README.ja.md++common warnings+  ghc-options: -Wall -Wcompat -Widentities -Wredundant-constraints++-- Phase 108: design 層は -O1 検証中 (bench-custom-design gate で regression 無し+-- を確認できた場合のみ採用。実測 = bench/results/phase108/)。+-- -O1 は cabal 既定のため明示しない (明示 -O は Hackage の cabal check が reject)+common opt+  ghc-options: -funbox-strict-fields++library+  import:           warnings, opt+  hs-source-dirs:   src+  default-language: GHC2021+  exposed-modules:+    Hanalyze.Design.Anova+    Hanalyze.Design.Block+    Hanalyze.Design.Constraint+    Hanalyze.Design.Custom.Augment+    Hanalyze.Design.Custom.Bayesian+    Hanalyze.Design.Custom.Compare+    Hanalyze.Design.Custom.Constraint+    Hanalyze.Design.Custom.Coordinate+    Hanalyze.Design.Custom.Factor+    Hanalyze.Design.Custom.Model+    Hanalyze.Design.Custom.Power+    Hanalyze.Design.Custom.RegionMoment+    Hanalyze.Design.Custom.SplitPlot+    Hanalyze.Design.Custom.Structured+    Hanalyze.Design.DSD+    Hanalyze.Design.Diagnostics+    Hanalyze.Design.Factorial+    Hanalyze.Design.GaugeRR+    Hanalyze.Design.Mixed+    Hanalyze.Design.Mixture+    Hanalyze.Design.MultiRSM+    Hanalyze.Design.Optimal+    Hanalyze.Design.Orthogonal+    Hanalyze.Design.Power+    Hanalyze.Design.Quality+    Hanalyze.Design.RSM+    Hanalyze.Design.Sequential+    Hanalyze.Design.SpaceFilling+    Hanalyze.Design.Taguchi+    Hanalyze.Design.Workflow+  build-depends:+      base                 >= 4.14 && < 5+    , containers           >= 0.6  && < 0.8+    , hmatrix              >= 0.20 && < 0.22+    , mwc-random           >= 0.15 && < 0.16+    , primitive            >= 0.7  && < 0.10+    , statistics           >= 0.16 && < 0.17+    , text                 >= 1.2  && < 2.2+    , vector               >= 0.12 && < 0.14+    , dataframe-core        ^>= 1.1+    , dataframe-csv         ^>= 1.0.2+    , hanalyze-core == 0.2.0.1+    , hanalyze-frame == 0.2.0.1+    , hanalyze-models == 0.2.0.1
+ src/Hanalyze/Design/Anova.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Anova+-- Description : 一元配置・二元配置 ANOVA/ANCOVA 表の算出 (F 値・p 値・η² 効果量)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- ANOVA / ANCOVA tables.+--+-- Computes one-way and two-way analysis of variance, reporting F values,+-- p values, and the @η²@ effect size.+module Hanalyze.Design.Anova+  ( AnovaRow (..)+  , AnovaTable (..)+  , oneWayAnova+  , twoWayAnova+  , printAnovaTable+  ) where++import Data.Text (Text)+import qualified Data.Text as T+import Data.List (groupBy, sort)+import Data.Function (on)+import Text.Printf (printf)+import qualified Statistics.Distribution as SD+import qualified Statistics.Distribution.FDistribution as FD++-- | One row of an ANOVA table.+data AnovaRow = AnovaRow+  { arSource :: Text             -- ^ Source label.+  , arDF     :: Int              -- ^ Degrees of freedom.+  , arSS     :: Double           -- ^ Sum of squares.+  , arMS     :: Double           -- ^ Mean square (@SS / DF@).+  , arF      :: Maybe Double     -- ^ F statistic ('Nothing' for total / error rows).+  , arPVal   :: Maybe Double     -- ^ p-value.+  , arEtaSq  :: Maybe Double     -- ^ Effect size @η² = SS_factor / SS_total@.+  } deriving (Show)++-- | A complete ANOVA table.+newtype AnovaTable = AnovaTable [AnovaRow] deriving (Show)++-- | One-way ANOVA. The arguments are the group label per data point and+-- the corresponding values.+oneWayAnova :: [Text] -> [Double] -> AnovaTable+oneWayAnova labels values =+  let n         = length values+      grandMean = sum values / fromIntegral n+      groups    = groupBy ((==) `on` fst)+                $ sort (zip labels values)+      ssTotal   = sum [(v - grandMean)^(2::Int) | v <- values]+      -- グループ間平方和 (Between)+      ssBetween = sum+        [ let xs   = map snd g+              gm   = sum xs / fromIntegral (length xs)+              k    = length xs+          in fromIntegral k * (gm - grandMean)^(2::Int)+        | g <- groups ]+      ssWithin  = ssTotal - ssBetween+      kGroups   = length groups+      dfBetween = kGroups - 1+      dfWithin  = n - kGroups+      msBetween = ssBetween / fromIntegral dfBetween+      msWithin  = ssWithin  / fromIntegral dfWithin+      fStat     = msBetween / msWithin+      pVal      = if dfWithin <= 0 || msWithin <= 0+                    then 1+                    else SD.complCumulative+                          (FD.fDistribution dfBetween dfWithin) fStat+      etaSq     = ssBetween / ssTotal+  in AnovaTable+      [ AnovaRow "Between" dfBetween ssBetween msBetween+                 (Just fStat) (Just pVal) (Just etaSq)+      , AnovaRow "Within"  dfWithin  ssWithin  msWithin+                 Nothing Nothing Nothing+      , AnovaRow "Total"   (n - 1)   ssTotal   (ssTotal / fromIntegral (n - 1))+                 Nothing Nothing Nothing+      ]++-- | Two-way ANOVA (no interaction term).+--+-- Each cell @(a, b)@ is assumed to hold exactly one observation, and+-- the data is assumed balanced (all cells have the same observation+-- count).+twoWayAnova :: [Text]   -- ^ Factor A label per observation.+            -> [Text]   -- ^ Factor B label per observation.+            -> [Double] -- ^ Values.+            -> AnovaTable+twoWayAnova as bs values =+  let n    = length values+      gm   = sum values / fromIntegral n+      ssT  = sum [(v - gm)^(2::Int) | v <- values]+      -- 因子 A の主効果+      aGroups = groupBy ((==) `on` fst) (sort (zip as values))+      ssA  = sum+        [ let vs = map snd g+              m  = sum vs / fromIntegral (length vs)+          in fromIntegral (length vs) * (m - gm)^(2::Int)+        | g <- aGroups ]+      -- 因子 B の主効果+      bGroups = groupBy ((==) `on` fst) (sort (zip bs values))+      ssB  = sum+        [ let vs = map snd g+              m  = sum vs / fromIntegral (length vs)+          in fromIntegral (length vs) * (m - gm)^(2::Int)+        | g <- bGroups ]+      ssE  = ssT - ssA - ssB+      a    = length aGroups+      b    = length bGroups+      dfA  = a - 1+      dfB  = b - 1+      dfE  = n - a - b + 1+      msA  = ssA / fromIntegral dfA+      msB  = ssB / fromIntegral dfB+      msE  = if dfE > 0 then ssE / fromIntegral dfE else 1+      fA   = msA / msE+      fB   = msB / msE+      pA   = if dfE <= 0 then 1+               else SD.complCumulative (FD.fDistribution dfA dfE) fA+      pB   = if dfE <= 0 then 1+               else SD.complCumulative (FD.fDistribution dfB dfE) fB+  in AnovaTable+      [ AnovaRow "Factor A" dfA ssA msA (Just fA) (Just pA) (Just (ssA/ssT))+      , AnovaRow "Factor B" dfB ssB msB (Just fB) (Just pB) (Just (ssB/ssT))+      , AnovaRow "Error"    dfE ssE msE Nothing Nothing Nothing+      , AnovaRow "Total"    (n - 1) ssT (ssT / fromIntegral (n - 1))+                 Nothing Nothing Nothing+      ]++-- | Pretty-print the table to stdout.+printAnovaTable :: AnovaTable -> IO ()+printAnovaTable (AnovaTable rows) = do+  printf "%-12s %4s %12s %12s %10s %10s %8s\n"+    ("Source" :: String) ("DF" :: String) ("SS" :: String) ("MS" :: String)+    ("F" :: String) ("p-value" :: String) ("η²" :: String)+  putStrLn (replicate 76 '-')+  mapM_ printRow rows+  where+    printRow r = do+      printf "%-12s %4d %12.4f %12.4f"+             (T.unpack (arSource r)) (arDF r) (arSS r) (arMS r)+      let fmtMaybe :: Double -> String+          fmtMaybe v = printf "%10.4f" v+      case arF r of+        Just f  -> putStr (fmtMaybe f)+        Nothing -> putStr (printf "%10s" ("--" :: String))+      case arPVal r of+        Just p  -> putStr (fmtMaybe p)+        Nothing -> putStr (printf "%10s" ("--" :: String))+      case arEtaSq r of+        Just e  -> printf "%8.4f\n" e+        Nothing -> printf "%8s\n" ("--" :: String)
+ src/Hanalyze/Design/Block.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Block+-- Description : ブロック計画 (ラテン方格・グレコラテン方格・乱塊法) の生成+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- Block designs: Latin squares and randomized complete block designs.+--+--   - 'latinSquare'        — @n × n@ Latin square (efficient arrangement+--     of @n@ treatments).+--   - 'graecoLatinSquare'  — pair of orthogonal Latin squares.+--   - 'randomizedBlock'    — randomized block design (@b@ blocks × @t@+--     treatments).+--   - 'shuffleSeq'         — pseudo-random sequence shuffler (seed-driven+--     for reproducibility).+module Hanalyze.Design.Block+  ( latinSquare+  , graecoLatinSquare+  , randomizedBlock+  , shuffleSeq+  ) where++import Data.List (foldl')++-- | [日本語]: @n × n@ のラテン方格を作る。 セルの値は @1..n@。+--+--   標準形 (cyclic shift): row i, col j → ((i + j) mod n) + 1+--   [English]: Build an @n × n@ Latin square. Cell values are @1..n@.+--+--   Standard form (cyclic shift): row i, col j → ((i + j) mod n) + 1+latinSquare :: Int -> [[Int]]+latinSquare n+  | n < 1     = []+  | otherwise =+      [ [((i + j) `mod` n) + 1 | j <- [0 .. n - 1]]+      | i <- [0 .. n - 1] ]++-- | [日本語]: グレコラテン方格 (直交する 2 つのラテン方格の組)。+--   n が素数のとき構成可能 (n=6 は不可能)。 戻り値は (n × n) のセルごとに+--   (a, b) のペア (両方とも 1..n)。+--+--   構成: (i + j) mod n と (i + 2j) mod n+--   [English]: Graeco-Latin square (a pair of orthogonal Latin squares).+--   Constructible when n is prime (n=6 is not possible). The result is an+--   (n × n) grid of (a, b) pairs per cell (both in 1..n).+--+--   Construction: (i + j) mod n and (i + 2j) mod n+graecoLatinSquare :: Int -> Maybe [[(Int, Int)]]+graecoLatinSquare n+  | n < 3 || n == 6 = Nothing+  | otherwise = Just+      [ [ (((i + j)     `mod` n) + 1+          , ((i + 2 * j) `mod` n) + 1)+        | j <- [0 .. n - 1] ]+      | i <- [0 .. n - 1] ]++-- | Randomized complete block design: @b@ blocks of @t@ treatments.+--+-- Within each block, treatments @1..t@ are placed in a randomized order.+-- The result @[[Int]]@ has one row per block; values inside a row are+-- the application order of treatment IDs.+randomizedBlock :: Int             -- ^ Number of blocks @b@.+                -> Int             -- ^ Number of treatments @t@.+                -> Int             -- ^ Random seed.+                -> [[Int]]+randomizedBlock b t seed =+  [ shuffleSeq (seed + i * 1000) [1 .. t] | i <- [0 .. b - 1] ]++-- | Fisher-Yates pseudo-random shuffle (seeded for reproducibility).+-- Uses a simple internal LCG (test-quality only, not cryptographically+-- strong).+shuffleSeq :: Int -> [a] -> [a]+shuffleSeq seed xs =+  let n   = length xs+      lcg s = (s * 1103515245 + 12345) `mod` (2 ^ (31 :: Int))+      seeds = take n (drop 1 (iterate lcg seed))+      -- (rand, original_index) でソート → 擬似シャッフル+      paired = zip seeds xs+      sorted = foldl' insert [] paired+      insert acc p = mergeOne p acc+      mergeOne (k, x) ((k', y) : rest)+        | k < k' = (k, x) : (k', y) : rest+        | otherwise = (k', y) : mergeOne (k, x) rest+      mergeOne p [] = [p]+  in map snd sorted
+ src/Hanalyze/Design/Constraint.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Constraint+-- Description : DoE 古典側の設計制約 (線形不等式・禁止行の組合せ) によるフィルタ / 検証+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: DoE 古典側の設計制約。+--+-- 候補集合ベースの 'Hanalyze.Design.Optimal' に渡す前のフィルタ用途、+-- および手動構築した設計行列の事後検証用途を想定。+--+-- ADT は最小 2 種:+--+--   - 'LinearConstraint' coeffs rel rhs — 線形不等式 / 等式+--     @sum_i (coeffs[i] * x[i]) @rel@ rhs@+--   - 'ForbiddenCombination' values — 厳密に一致する row を禁止+--     (浮動小数比較は 'forbiddenTolerance' = 1e-9 で許容)+--+-- 条件付 (If-then) 制約は本モジュールでは扱わない (Custom Design spec 専有、+-- spec/hanalyze-doe-custom-design-spec.md §2.3 / §9 参照)。+--+-- spec: doe-spec v0.2 §2.8 / §3.12。+--+-- [English]: Design constraints on the classical DoE side.+--+-- Intended for use as a filter before candidate sets are passed to+-- 'Hanalyze.Design.Optimal', and for post-hoc verification of+-- manually constructed design matrices.+--+-- The ADT has a minimal 2 variants:+--+--   - 'LinearConstraint' coeffs rel rhs — linear inequality / equality+--     @sum_i (coeffs[i] * x[i]) @rel@ rhs@+--   - 'ForbiddenCombination' values — forbids a row that matches exactly+--     (floating-point comparison is tolerated via 'forbiddenTolerance' = 1e-9)+--+-- Conditional (if-then) constraints are not handled by this module (they+-- belong to the Custom Design spec; see+-- spec/hanalyze-doe-custom-design-spec.md §2.3 / §9).+--+-- spec: doe-spec v0.2 §2.8 / §3.12.+module Hanalyze.Design.Constraint+  ( ConstraintRel (..)+  , DesignConstraint (..)+  , checkRow+  , checkDesign+  , filterCandidates+  , forbiddenTolerance+  ) where++import qualified Numeric.LinearAlgebra as LA++-- ===========================================================================+-- 型+-- ===========================================================================++-- | [日本語]: 線形制約の関係子。 [English]: The relational operator for a+--   linear constraint.+data ConstraintRel = CLeq | CEq | CGeq+  deriving (Eq, Show)++-- | [日本語]: 設計行列に対する制約。 [English]: A constraint on a design matrix.+data DesignConstraint+  = LinearConstraint     ![Double] !ConstraintRel !Double+    -- ^ [日本語]: @sum_i (coeffs[i] * x[i]) \`rel\` rhs@。 coeffs の長さは row の+    --   次元と一致する必要 ('checkRow' は不一致を即 False として弾く)+    --   [English]: @sum_i (coeffs[i] * x[i]) \`rel\` rhs@. The length of+    --   coeffs must match the row's dimension ('checkRow' rejects a+    --   mismatch immediately as False).+  | ForbiddenCombination ![Double]+    -- ^ [日本語]: row がこの値と (許容誤差 'forbiddenTolerance' で) 一致したら違反。+    --   [English]: Violated when the row matches these values (within the+    --   tolerance 'forbiddenTolerance').+  deriving (Eq, Show)++-- | [日本語]: 'ForbiddenCombination' の浮動小数比較に用いる許容誤差。+--   [English]: The tolerance used for the floating-point comparison in+--   'ForbiddenCombination'.+forbiddenTolerance :: Double+forbiddenTolerance = 1e-9++-- ===========================================================================+-- 公開 API+-- ===========================================================================++-- | [日本語]: 1 row が全制約を満たすか。 制約違反 (= 不可) なら 'False'。+--   [English]: Whether a row satisfies all constraints. 'False' if any+--   constraint is violated (= infeasible).+checkRow :: [DesignConstraint] -> [Double] -> Bool+checkRow cs row = all (rowSatisfies row) cs++-- | [日本語]: 設計行列 (= 各 row が 1 試行) の制約違反 row index を返す。+--   row 数 0 のときは空 list。+--   [English]: Returns the row indices of a design matrix (each row = one+--   trial) that violate a constraint. An empty list when there are 0 rows.+checkDesign :: [DesignConstraint] -> LA.Matrix Double -> [Int]+checkDesign cs m =+  let rows = LA.toLists m+  in [ i | (i, r) <- zip [0 ..] rows, not (checkRow cs r) ]++-- | [日本語]: 候補集合から制約違反 row を除去する helper。 'Hanalyze.Design.Optimal'+--   の入力候補を作る前に挟む想定。 順序は保持。+--   [English]: A helper that removes constraint-violating rows from a+--   candidate set. Intended to be inserted before building the input+--   candidates for 'Hanalyze.Design.Optimal'. Order is preserved.+filterCandidates :: [DesignConstraint] -> [[Double]] -> [[Double]]+filterCandidates cs = filter (checkRow cs)++-- ===========================================================================+-- 内部+-- ===========================================================================++-- | [日本語]: 1 row が単一制約を満たすか判定。+--   [English]: Determines whether a single row satisfies a single constraint.+rowSatisfies :: [Double] -> DesignConstraint -> Bool+rowSatisfies row (LinearConstraint coeffs rel rhs)+  | length coeffs /= length row = False+  | otherwise =+      let lhs = sum (zipWith (*) coeffs row)+      in case rel of+           CLeq -> lhs <= rhs + forbiddenTolerance+           CEq  -> abs (lhs - rhs) <= forbiddenTolerance+           CGeq -> lhs >= rhs - forbiddenTolerance+rowSatisfies row (ForbiddenCombination vals)+  | length vals /= length row = True   -- 次元不一致 = forbidden ではない+  | otherwise =+      not (and (zipWith (\a b -> abs (a - b) <= forbiddenTolerance) row vals))
+ src/Hanalyze/Design/Custom/Augment.hs view
@@ -0,0 +1,465 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns      #-}+-- |+-- Module      : Hanalyze.Design.Custom.Augment+-- Description : Custom Design の Augment 5 メニュー (Replicate/AddCenter/AddAxial/AddRuns/Foldover)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Custom Design の Augment 5 メニュー。+--+-- spec: doe-custom-design-spec v0.1.1 §2.6 / §3。+-- 参考: JMP "Augment Design" platform。+--+-- ## 5 メニュー+--+--   - 'Replicate n'   : 既存 design を n 回複製+--   - 'AddCenter  n'  : 中心点 (全連続因子 = 0、 categorical は ref level) を n 行追加+--   - 'AddAxial   α'  : 1 因子だけを ±α、 他を 0 にした axial 点を全連続因子で追加+--                       (= 2 * #continuous-factors 行)+--   - 'AddRuns    n'  : 既存 augmentDesign (古典 Fedorov 交換) で N 行追加+--   - 'Foldover   k'  : 既存 design の sign-flipped 行を全部追加 (Full)、+--                       または指定因子のみ flip (Partial)+--+-- ## 制限 (現状の暫定仕様)+--+--   - 'cdsInitial' が 'Nothing' の場合は 'Left' (既存 design 必須)+--   - AddCenter / AddAxial は連続因子のみ。 categorical 列は ref index 0 を使う+--   - Foldover は 2 水準連続因子のみ正しく動作。 categorical はそのまま (flip しない)+--   - AddAxial は coded space ([-1, 1]) 想定、 raw range を考慮しない+--+-- [English]: Custom Design's 5 Augment menus.+--+-- spec: doe-custom-design-spec v0.1.1 §2.6 / §3.+-- Reference: JMP's "Augment Design" platform.+--+-- ## The 5 menus+--+--   - 'Replicate n'   : replicate the existing design n times+--   - 'AddCenter  n'  : add n center-point rows (all continuous factors =+--                       0, categorical uses the ref level)+--   - 'AddAxial   α'  : add axial points across all continuous factors,+--                       each with one factor set to ±α and the rest at 0+--                       (= 2 * #continuous-factors rows)+--   - 'AddRuns    n'  : add N rows via the existing augmentDesign+--                       (classic Fedorov exchange)+--   - 'Foldover   k'  : add all sign-flipped rows of the existing design+--                       (Full), or flip only specified factors (Partial)+--+-- ## Limitations (current provisional state)+--+--   - If 'cdsInitial' is 'Nothing', returns 'Left' (an existing design is+--     required)+--   - AddCenter \/ AddAxial only apply to continuous factors; categorical+--     columns use ref index 0+--   - Foldover only works correctly for 2-level continuous factors;+--     categorical columns are left as-is (not flipped)+--   - AddAxial assumes coded space ([-1, 1]); the raw range is not+--     considered+module Hanalyze.Design.Custom.Augment+  ( AugmentMenu (..)+  , FoldoverKind (..)+  , AugmentMenuResult (..)+  , augmentMenu+  ) where++import           Data.Text                (Text)+import qualified Data.Text                as T+import qualified Numeric.LinearAlgebra    as LA++import           Hanalyze.Design.Custom.Factor+import           Hanalyze.Design.Custom.Coordinate+                   (CustomDesignSpec (..))+import qualified Hanalyze.Design.Optimal  as Opt++-- ---------------------------------------------------------------------------+-- 型+-- ---------------------------------------------------------------------------++data AugmentMenu+  = Replicate !Int+  | AddCenter !Int+  | AddAxial  !Double !Bool+    -- ^ [日本語]: axial 点。 第 2 引数 @rawUnits@ が False のとき (= 既定) は coded+    --   @[-1, 1]@ 空間で center 0 + ±α (NCoded モデル想定)。 True のとき raw+    --   単位で center (lo+hi)/2 ± α·(hi-lo)/2 とする。 raw 形式の+    --   既存設計に直接 ±α coded 相当の axial 点を入れたいケースに使う+    --   [English]: Axial points. When the second argument @rawUnits@ is+    --   False (default), generated in coded @[-1, 1]@ space as center 0 ++    --   ±α (assumes an NCoded model). When True, generated in raw units+    --   as center (lo+hi)/2 ± α·(hi-lo)/2. Used when you want to insert+    --   ±α coded-equivalent axial points directly into an existing+    --   raw-format design.+  | AddRuns   !Int+  | Foldover  !FoldoverKind+  deriving (Show, Eq)++data FoldoverKind+  = FullFoldover+  | PartialFoldover ![Text]  -- ^ [日本語]: flip する因子名のリスト [English]: List of factor names to flip+  | CategoricalSwap ![(Text, [(Text, Text)])]+    -- ^ [日本語]: categorical 因子の level swap mapping。 各エントリ+    --   @(factor_name, [(old_level, new_level), ...])@ に対し、 既存設計の+    --   該当列の level を mapping で置換した行を追加。 連続因子の符号 flip は+    --   行わない (CategoricalSwap は categorical 専用)。 mapping に現れない+    --   level はそのまま (自分自身に map)+    --   [English]: A level swap mapping for a categorical factor. For+    --   each entry @(factor_name, [(old_level, new_level), ...])@, adds a+    --   row with the corresponding column's level replaced according to+    --   the mapping. Does not flip the sign of continuous factors+    --   (CategoricalSwap is categorical-only). Levels not appearing in+    --   the mapping are left as-is (mapped to themselves).+  deriving (Show, Eq)++data AugmentMenuResult = AugmentMenuResult+  { amrMatrix :: !(LA.Matrix Double)+    -- ^ [日本語]: 増補後の design (existing + added)+    --   [English]: The augmented design (existing + added)+  , amrAdded  :: !Int+    -- ^ [日本語]: 追加された行数 [English]: Number of rows added+  , amrMethod :: !Text+    -- ^ [日本語]: "Replicate" / "AddCenter" 等。 [English]: "Replicate" \/ "AddCenter" \/ etc.+  } deriving (Show)++-- ---------------------------------------------------------------------------+-- 公開 API+-- ---------------------------------------------------------------------------++augmentMenu :: CustomDesignSpec -> AugmentMenu -> IO (Either Text AugmentMenuResult)+augmentMenu spec menu =+  case cdsInitial spec of+    Nothing -> pure (Left (T.pack "augmentMenu: cdsInitial is required"))+    Just existing ->+      case menu of+        Replicate k    -> pure (augmentReplicate existing k)+        AddCenter k    -> pure (augmentAddCenter (cdsFactors spec) existing k)+        AddAxial alpha rawUnits ->+          pure (augmentAddAxial (cdsFactors spec) existing alpha rawUnits)+        AddRuns k      -> pure (augmentAddRuns spec existing k)+        Foldover kind  -> pure (augmentFoldover (cdsFactors spec) existing kind)++-- ---------------------------------------------------------------------------+-- Replicate+-- ---------------------------------------------------------------------------++augmentReplicate :: LA.Matrix Double -> Int -> Either Text AugmentMenuResult+augmentReplicate existing k+  | k < 1 = Left (T.pack "Replicate: k must be >= 1")+  | otherwise =+      let !rows = LA.toRows existing+          !reps = concat (replicate k rows)+          !added = LA.fromRows reps+          !full = LA.fromRows (rows ++ reps)+      in Right AugmentMenuResult+           { amrMatrix = full+           , amrAdded  = LA.rows added+           , amrMethod = T.pack "Replicate"+           }++-- ---------------------------------------------------------------------------+-- AddCenter+-- ---------------------------------------------------------------------------++-- | [日本語]: 中心点: 連続因子は 0、 categorical は level index 0 (= reference)。+--   [English]: Center points: 0 for continuous factors, level index 0+--   (= the reference) for categorical.+augmentAddCenter+  :: [Factor]+  -> LA.Matrix Double+  -> Int+  -> Either Text AugmentMenuResult+augmentAddCenter factors existing k+  | k < 1 = Left (T.pack "AddCenter: k must be >= 1")+  | LA.cols existing /= length factors =+      Left (T.pack "AddCenter: existing column count ≠ #factors")+  | otherwise =+      let !centerRow = LA.fromList (map factorCenter factors)+          !added = LA.fromRows (replicate k centerRow)+          !full  = existing LA.=== added+      in Right AugmentMenuResult+           { amrMatrix = full+           , amrAdded  = k+           , amrMethod = T.pack "AddCenter"+           }++factorCenter :: Factor -> Double+factorCenter f = case fKind f of+  Continuous  _ _ -> 0+  DiscreteNum xs  -> case xs of+                       []      -> 0+                       (h:_)   -> sum xs / fromIntegral (length xs)+                         where _ = h+  Mixture lo hi   -> (lo + hi) / 2+  Categorical _   -> 0+  Ordinal     _   -> 0++-- ---------------------------------------------------------------------------+-- AddAxial+-- ---------------------------------------------------------------------------++-- | [日本語]: axial / star 点: 各連続因子について、 その因子だけを +α / -α、+--   他を 0 (中心) にした 2 点ずつを追加。+--+--   @rawUnits@ False: coded 空間 (center 0 + ±α) で生成。 NCoded モデルで+--     raw 行列が既に coded されている前提。+--   @rawUnits@ True: 因子の (lo, hi) を使って center (lo+hi)/2 + ±α·(hi-lo)/2+--     で生成 (raw 単位、 coded ±α 相当の位置)。 Continuous / DiscreteNum /+--     Mixture でそれぞれの range を解釈する。+--+--   [English]: Axial \/ star points: for each continuous factor, adds two+--   points with that factor set to +α \/ -α and the rest at 0 (center).+--+--   @rawUnits@ False: generated in coded space (center 0 + ±α). Assumes+--     the raw matrix is already coded, as in an NCoded model.+--   @rawUnits@ True: generated using the factor's (lo, hi) as center+--     (lo+hi)/2 + ±α·(hi-lo)/2 (raw units, at the position equivalent to+--     coded ±α). The range is interpreted per factor for Continuous \/+--     DiscreteNum \/ Mixture.+augmentAddAxial+  :: [Factor]+  -> LA.Matrix Double+  -> Double+  -> Bool+  -> Either Text AugmentMenuResult+augmentAddAxial factors existing alpha rawUnits+  | alpha <= 0 = Left (T.pack "AddAxial: alpha must be > 0")+  | LA.cols existing /= length factors =+      Left (T.pack "AddAxial: existing column count ≠ #factors")+  | otherwise =+      let !contIxs =+            [ i | (i, f) <- zip [0 ..] factors, factorIsContinuous f ]+      in if null contIxs+           then Left (T.pack "AddAxial: no continuous factors to augment")+           else+             let !centers = if rawUnits+                              then map factorCenterRaw factors+                              else map factorCenter factors+                 axialOffset i = if rawUnits+                                   then alpha * factorHalfRange (factors !! i)+                                   else alpha+                 !rows =+                   [ LA.fromList+                       [ if j == i then (centers !! j) + sgn * axialOffset i+                                   else centers !! j+                       | j <- [0 .. length factors - 1]+                       ]+                   | i <- contIxs, sgn <- [1, -1]+                   ]+                 !added = LA.fromRows rows+                 !full  = existing LA.=== added+             in Right AugmentMenuResult+                  { amrMatrix = full+                  , amrAdded  = length rows+                  , amrMethod = T.pack "AddAxial"+                  }++-- | [日本語]: 因子の半幅 = (hi - lo) / 2 (Continuous / DiscreteNum / Mixture)。+--   raw 単位 axial の scale factor として使う。 Categorical / Ordinal は意味を+--   持たないため 0 を返す (caller 側 contIxs で除外済の想定)。+--   [English]: A factor's half-range = (hi - lo) / 2 (Continuous \/+--   DiscreteNum \/ Mixture). Used as the scale factor for raw-unit axial+--   points. Categorical \/ Ordinal have no meaningful value here, so+--   returns 0 (assumed already excluded by the caller's contIxs).+factorHalfRange :: Factor -> Double+factorHalfRange f = case fKind f of+  Continuous  lo hi -> (hi - lo) / 2+  DiscreteNum xs    -> case xs of+                         [] -> 0+                         _  -> (maximum xs - minimum xs) / 2+  Mixture     lo hi -> (hi - lo) / 2+  _                 -> 0++-- | [日本語]: 因子の raw 単位での中心 = (lo + hi) / 2 (AddAxial の+--   rawUnits=True 用)。 'factorCenter' は coded 空間想定 (Continuous → 0)、+--   これは raw 空間。+--   [English]: A factor's center in raw units = (lo + hi) / 2 (used for+--   AddAxial's rawUnits=True). 'factorCenter' assumes coded space+--   (Continuous → 0); this is the raw-space counterpart.+factorCenterRaw :: Factor -> Double+factorCenterRaw f = case fKind f of+  Continuous  lo hi -> (lo + hi) / 2+  DiscreteNum xs    -> case xs of+                         [] -> 0+                         _  -> (maximum xs + minimum xs) / 2+  Mixture     lo hi -> (lo + hi) / 2+  _                 -> 0++-- ---------------------------------------------------------------------------+-- AddRuns (既存 augmentDesign を wrap)+-- ---------------------------------------------------------------------------++-- | [日本語]: AddRuns: 既存 'Hanalyze.Design.Optimal.augmentDesign' を使い、+--   候補集合は連続因子は ±1 grid、 categorical は全 level の cartesian product。+--   候補集合サイズが大きくなりすぎる場合 (例 2^20 等) は呼び出し側で nRuns を+--   抑制すること。+--   [English]: AddRuns: uses the existing+--   'Hanalyze.Design.Optimal.augmentDesign', with a candidate set+--   of the ±1 grid for continuous factors and the cartesian product of+--   all levels for categorical. If the candidate set size grows too+--   large (e.g. 2^20), the caller should limit nRuns.+augmentAddRuns+  :: CustomDesignSpec+  -> LA.Matrix Double+  -> Int+  -> Either Text AugmentMenuResult+augmentAddRuns spec existing k+  | k < 1 = Left (T.pack "AddRuns: k must be >= 1")+  | otherwise =+      let factors  = cdsFactors spec+          cands    = candidateRows factors+          existRow = LA.toLists existing+          seed     = case cdsSeed spec of Just s -> s; Nothing -> 0+          arRes    = Opt.augmentDesign (cdsCriterion spec) existRow k cands seed+      in if length (Opt.arNewRows arRes) /= k+           then Left (T.pack+             ("AddRuns: failed to add " <> show k <> " rows (candidates may be too few)"))+           else+             let !added = LA.fromLists (Opt.arNewRows arRes)+                 !full  = existing LA.=== added+             in Right AugmentMenuResult+                  { amrMatrix = full+                  , amrAdded  = k+                  , amrMethod = T.pack "AddRuns"+                  }++-- | [日本語]: 候補集合: 連続因子は ±1、 categorical / ordinal は全 level、+--   DiscreteNum は xs、 Mixture は [lo, hi] の 2 点 とする+--   (簡略化、 将来 grid を拡張可能)。+--   [English]: Candidate set: ±1 for continuous factors, all levels for+--   categorical \/ ordinal, xs for DiscreteNum, and the 2 points [lo, hi]+--   for Mixture (a simplification; the grid can be extended in the+--   future).+candidateRows :: [Factor] -> [[Double]]+candidateRows = cart . map factorCandidates+  where+    factorCandidates f = case fKind f of+      Continuous _ _    -> [-1, 1]+      DiscreteNum xs    -> xs+      Mixture lo hi     -> [lo, hi]+      Categorical xs    -> [fromIntegral i | i <- [0 .. length xs - 1]]+      Ordinal     xs    -> [fromIntegral i | i <- [0 .. length xs - 1]]+    cart :: [[Double]] -> [[Double]]+    cart [] = [[]]+    cart (xs:xss) =+      [ x : ys | x <- xs, ys <- cart xss ]++-- ---------------------------------------------------------------------------+-- Foldover+-- ---------------------------------------------------------------------------++-- | [日本語]: Foldover: 既存 design の符号反転行を追加。+--   Full: 全因子の符号を flip。+--   Partial [names]: 指定因子のみ flip。+--   categorical 列は flip しない (符号の概念が無い)。+--   [English]: Foldover: adds sign-flipped rows of the existing design.+--   Full: flips the sign of all factors.+--   Partial [names]: flips only the specified factors.+--   Categorical columns are not flipped (there is no notion of sign).+augmentFoldover+  :: [Factor]+  -> LA.Matrix Double+  -> FoldoverKind+  -> Either Text AugmentMenuResult+augmentFoldover factors existing kind+  | LA.cols existing /= length factors =+      Left (T.pack "Foldover: existing column count ≠ #factors")+  | otherwise = case kind of+      CategoricalSwap entries -> applyCatSwap factors existing entries+      _ ->+        let !names = map fName factors+            !flipIdxs = case kind of+              FullFoldover -> [ i | (i, f) <- zip [0 ..] factors, factorIsContinuous f ]+              PartialFoldover ns ->+                [ i | (i, f) <- zip [0 ..] factors+                , factorIsContinuous f, fName f `elem` ns+                ]+              CategoricalSwap _ -> []  -- 上で処理済 (到達不可)+        in if null flipIdxs && case kind of { FullFoldover -> False; _ -> True }+             then Left (T.pack "Foldover: no factors to flip (check factor names)")+             else+               let !nE = LA.rows existing+                   !p  = LA.cols existing+                   !rows = LA.toLists existing+                   !flipped =+                     [ [ if j `elem` flipIdxs then negate (r !! j) else r !! j+                       | j <- [0 .. p - 1] ]+                     | r <- rows ]+                   !added = LA.fromLists flipped+                   !full  = existing LA.=== added+                   _ = names  -- 未使用警告対策+               in Right AugmentMenuResult+                    { amrMatrix = full+                    , amrAdded  = nE+                    , amrMethod = case kind of+                        FullFoldover     -> T.pack "Foldover/Full"+                        PartialFoldover _ -> T.pack "Foldover/Partial"+                        CategoricalSwap _ -> T.pack "Foldover/CatSwap"  -- 到達不可+                    }++-- | [日本語]: categorical level swap foldover。 各エントリ+--   @(factor_name, [(old, new), ...])@ について、 該当列の level index 値を+--   old → new mapping で置換する (raw 値は level index Double として保持)。+--   [English]: Categorical level-swap foldover. For each entry+--   @(factor_name, [(old, new), ...])@, replaces the corresponding+--   column's level-index value using the old → new mapping (the raw+--   value is kept as a level-index Double).+applyCatSwap+  :: [Factor]+  -> LA.Matrix Double+  -> [(Text, [(Text, Text)])]+  -> Either Text AugmentMenuResult+applyCatSwap factors existing entries+  | null entries = Left (T.pack "Foldover/CatSwap: empty mapping list")+  | otherwise = do+      perCol <- traverse (resolveSwap factors) entries+      let nE   = LA.rows existing+          p    = LA.cols existing+          rows = LA.toLists existing+          swapAt j v = case lookup j perCol of+            Nothing -> v+            Just m  -> case lookup (round v :: Int) m of+              Just newIx -> fromIntegral newIx+              Nothing    -> v+          newRows = [ [ swapAt j (r !! j) | j <- [0 .. p - 1] ] | r <- rows ]+          added = LA.fromLists newRows+          full  = existing LA.=== added+      pure AugmentMenuResult+        { amrMatrix = full+        , amrAdded  = nE+        , amrMethod = T.pack "Foldover/CatSwap"+        }++-- | [日本語]: factor 名 + level 名 mapping を、 列 index + level index mapping に解決。+--   [English]: Resolves a factor-name + level-name mapping into a+--   column-index + level-index mapping.+resolveSwap+  :: [Factor]+  -> (Text, [(Text, Text)])+  -> Either Text (Int, [(Int, Int)])+resolveSwap factors (fn, pairs) =+  case lookupWithIdx fn factors of+    Nothing -> Left (T.pack ("Foldover/CatSwap: factor not found: " <> T.unpack fn))+    Just (i, f) -> case fKind f of+      Categorical xs -> Right (i, mkPairs xs)+      Ordinal     xs -> Right (i, mkPairs xs)+      _ -> Left (T.pack+            ("Foldover/CatSwap: factor " <> T.unpack fn <> " is not categorical/ordinal"))+  where+    mkPairs xs = [ (idx old, idx new) | (old, new) <- pairs+                                      , idx old >= 0, idx new >= 0 ]+      where+        idx t = case lookup t (zip (map fst (zip xs [(0::Int)..])) [0..]) of+          Just k  -> k+          Nothing -> case elemIxOf t xs of Just k -> k; Nothing -> -1+    elemIxOf t = go 0+      where+        go _ [] = Nothing+        go k (x:xs') | t == x = Just k+                     | otherwise = go (k + 1) xs'+    lookupWithIdx :: Text -> [Factor] -> Maybe (Int, Factor)+    lookupWithIdx n fs = go 0 fs+      where+        go _ [] = Nothing+        go k (g:gs)+          | fName g == n = Just (k, g)+          | otherwise    = go (k + 1) gs
+ src/Hanalyze/Design/Custom/Bayesian.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Custom.Bayesian+-- Description : Bayesian D-optimality (DuMouchel-Jones 1994) の事前精度行列ヘルパ+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Bayesian D-optimality (DuMouchel-Jones 1994) のヘルパ。+--+-- spec: doe-custom-design-spec v0.1.1 §2.7。+-- 参考: DuMouchel & Jones (1994) "A Simple Bayesian Modification of D-Optimal+-- Designs to Reduce Dependence on an Assumed Model", Technometrics 36:37-47。+--+-- ## 概念+--+-- 通常の D-opt は @det(XᵀX)@ を最大化する。 Bayesian D-opt は事前情報 (= 興味の+-- 薄い高次項に対する事前分布) を K (prior precision matrix) で表現し、+-- @det(XᵀX + K)@ を最大化する。+--+-- K の典型構造 (DuMouchel-Jones):+--+--   - 主効果 / intercept: 興味あり → K_jj = 0 (= 事前情報無し)+--   - 2 因子交互作用 / 二乗項: 興味薄 → K_jj = τ² (= τ² の事前精度で「ほぼ 0」 と仮定)+--   - 非対角は 0+--+-- τ² は 「effect が 1σ_error 程度になる確信度」 から決まる、 既定 1.0 で開始して+-- 設計者が調整する慣例。+--+-- ## 使い方+--+-- @+-- import Hanalyze.Design.Custom.Bayesian+-- import Hanalyze.Design.Optimal (OptCriterion (..))+--+-- let k = priorPrecisionDefault factors model 1.0+--     spec = ... { cdsCriterion = BayesianD (precisionToMatrix k) }+-- @+--+-- [English]: Helper for Bayesian D-optimality (DuMouchel-Jones 1994).+--+-- spec: doe-custom-design-spec v0.1.1 §2.7.+-- Reference: DuMouchel & Jones (1994) "A Simple Bayesian Modification of+-- D-Optimal Designs to Reduce Dependence on an Assumed Model",+-- Technometrics 36:37-47.+--+-- ## Concept+--+-- Ordinary D-opt maximizes @det(XᵀX)@. Bayesian D-opt expresses prior+-- information (a prior distribution over higher-order terms of low+-- interest) as K (the prior precision matrix), and maximizes+-- @det(XᵀX + K)@.+--+-- K's typical structure (DuMouchel-Jones):+--+--   - Main effects \/ intercept: of interest -> K_jj = 0 (i.e. no prior+--     information)+--   - Two-factor interactions \/ quadratic terms: of low interest ->+--     K_jj = τ² (i.e. assumed "nearly 0" with prior precision τ²)+--   - Off-diagonal entries are all 0+--+-- τ² is determined from "confidence that the effect is on the order of+-- 1σ_error"; convention is to start at a default of 1.0 and have the+-- designer tune it.+--+-- ## Usage+--+-- @+-- import Hanalyze.Design.Custom.Bayesian+-- import Hanalyze.Design.Optimal (OptCriterion (..))+--+-- let k = priorPrecisionDefault factors model 1.0+--     spec = ... { cdsCriterion = BayesianD (precisionToMatrix k) }+-- @+module Hanalyze.Design.Custom.Bayesian+  ( PriorPrecision (..)+  , precisionToMatrix+  , priorPrecisionDefault+  , priorPrecisionFromTerms+  , bayesianDValueM+    -- * DuMouchel-Jones §2.2 規約 (Phase 28-12、 RegionMoment 再export)+  , DJTransform (..)+  , djFitTransform+  , djApplyTransform+  , djTransformColumns+  ) where++import qualified Numeric.LinearAlgebra    as LA++import           Hanalyze.Design.Custom.Factor+import           Hanalyze.Design.Custom.Model+import           Hanalyze.Design.Custom.Power (termColumnIndices, termName)+import           Hanalyze.Design.Custom.RegionMoment+                   ( DJTransform (..), djFitTransform, djApplyTransform+                   , djTransformColumns )++-- | [日本語]: Prior precision matrix のラッパ。 対角優位を想定するが、 一般 p × p 行列を+--   受け入れる (DuMouchel-Jones 1994 の対角構造は最も一般的だが、 ユーザが+--   任意の K を持ち込むのも妨げない)。+--   [English]: A wrapper for the prior precision matrix. Assumes+--   diagonal-dominance but accepts a general p x p matrix (DuMouchel-Jones+--   1994's diagonal structure is the most common case, but nothing stops a+--   user from bringing in an arbitrary K).+newtype PriorPrecision = PriorPrecision (LA.Matrix Double)+  deriving (Show)++-- | [日本語]: 内部 matrix を [[Double]] として取得 (OptCriterion.BayesianD への引き渡し用)。+--   [English]: Retrieves the internal matrix as [[Double]] (for passing to+--   OptCriterion.BayesianD).+precisionToMatrix :: PriorPrecision -> [[Double]]+precisionToMatrix (PriorPrecision m) = LA.toLists m++-- | [日本語]: DuMouchel-Jones の既定プリセット:+--+--     - intercept / 主効果: K_jj = 0+--     - 2fi (`TInter` len 2) / 二乗 (`TPower`) / nested: K_jj = τ²+--     - categorical 主効果 (K-1 列): K_jj = 0 (主効果扱い)+--+--   非対角は全て 0。 expand 後の列順 = `expandDesignMatrix` の出力順 と一致。+--   [English]: DuMouchel-Jones's default preset:+--+--     - intercept \/ main effects: K_jj = 0+--     - 2fi (`TInter` len 2) \/ quadratic (`TPower`) \/ nested: K_jj = τ²+--     - categorical main effects (K-1 columns): K_jj = 0 (treated as main+--       effects)+--+--   All off-diagonal entries are 0. The column order after expand matches+--   `expandDesignMatrix`'s output order.+priorPrecisionDefault :: [Factor] -> Model -> Double -> PriorPrecision+priorPrecisionDefault factors model tau2 =+  priorPrecisionFromTerms factors model (defaultClassifier tau2)++-- | [日本語]: 各 term に対する K_jj 値を返す classifier 経由で K を構築する一般版。+--   ユーザが「自分の問題では二乗だけ τ²、 2fi は 0」 などのカスタム classifier を+--   渡せる。+--   [English]: The general version that builds K via a classifier+--   returning the K_jj value for each term. Users can pass a custom+--   classifier such as "in my problem, only quadratic terms get τ², 2fi+--   get 0".+priorPrecisionFromTerms+  :: [Factor]+  -> Model+  -> (ModelTerm -> Double)  -- ^ [日本語]: term ごとの K_jj 値 [English]: The K_jj value per term+  -> PriorPrecision+priorPrecisionFromTerms factors model classifyKjj =+  let pairs   = termColumnIndices factors model+      nameMap = [ (termName t, classifyKjj t) | t <- mTerms model ]+      pTotal  = case pairs of+        [] -> 0+        _  -> 1 + maximum (concatMap snd pairs)+      diag = [ kjjForCol pairs nameMap j | j <- [0 .. pTotal - 1] ]+  in PriorPrecision (LA.diagl diag)++kjjForCol :: [(t, [Int])] -> [(t, Double)] -> Int -> Double+kjjForCol pairs nameMap col =+  case [ v | ((_, cols), (_, v)) <- zip pairs nameMap, col `elem` cols ] of+    (v:_) -> v+    []    -> 0++-- | [日本語]: DuMouchel-Jones 既定の classifier。+--   [English]: The DuMouchel-Jones default classifier.+defaultClassifier :: Double -> ModelTerm -> Double+defaultClassifier _    TIntercept     = 0+defaultClassifier _    (TMain _)      = 0+defaultClassifier tau2 (TInter ns)+  | length ns >= 2 = tau2+  | otherwise      = 0+defaultClassifier tau2 (TPower _ k)+  | k >= 2 = tau2+  | otherwise = 0+defaultClassifier tau2 (TNested _ _) = tau2++-- | [日本語]: Bayesian D-criterion (Matrix-native): @det(XᵀX + K)@ そのもの (符号なし)。+--   K の次元が X の列数と不一致なら 0。+--   [English]: The Bayesian D-criterion (Matrix-native): @det(XᵀX + K)@+--   itself (unsigned). Returns 0 if K's dimension doesn't match X's column+--   count.+bayesianDValueM :: PriorPrecision -> LA.Matrix Double -> Double+bayesianDValueM (PriorPrecision km) x =+  let p = LA.cols x+  in if LA.rows km /= p || LA.cols km /= p+       then 0+       else LA.det (LA.tr x LA.<> x + km)++-- ---------------------------------------------------------------------------+-- DuMouchel-Jones §2.2 規約 (Phase 28-12) — 実装は Custom.RegionMoment.hs に+-- 移動 (Coordinate ↔ Bayesian の module cycle 回避のため)。 本 module からは+-- 再 export のみ。+-- ---------------------------------------------------------------------------+--+-- DJ (1994) §2.2 (Technometrics 36:39) は、 prior τ² が「effect size 1σ_error」+-- と等価に解釈されるよう、 potential terms (TInter len≥2 / TPower k≥2 /+-- TNested) に以下の変換を要求する:+--+--   1. **centering**: 候補集合上で平均を引く (subtract mean over candidate)+--   2. **primary との直交化**: candidate 上の primary 列 (TIntercept / TMain /+--      TInter len 1) に LS regress して残差を取る+--   3. **range = 1 への正規化**: 直交化後の値の (max - min) で割る+--+-- paper §2.2 末尾の例 (primary {1, x}、 candidate {-1, -0.5, 0, 0.5, 1} 5 水準):+--+--   * x² → z₁ = x² − 0.5 (mean(x²)=0.5、 primary 直交、 range=1)+--   * x³ → z₂ = (x³ − 0.85x)/0.6 (E[x⁴]/E[x²]=0.85、 range=0.6)+--+-- 同一 K = diag(0..0, τ²..τ²) を当てた det(X'X + K) が paper の値と一致する+-- ためにはこの規約が必要。 'priorPrecisionDefault' は K のみを構築するので、+-- ユーザは expand 後に 'djTransformColumns' で列変換を適用してから+-- 'bayesianDValueM' を呼ぶ。 coordinateExchange への自動適用は未対応 (Phase 28-12+-- 範囲外)。++-- (実装は Custom.RegionMoment.hs を参照。 本 module からは re-export のみ)
+ src/Hanalyze/Design/Custom/Compare.hs view
@@ -0,0 +1,530 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns      #-}+-- |+-- Module      : Hanalyze.Design.Custom.Compare+-- Description : Custom Design 群の post-hoc 比較 (D/A/G/I efficiency・FDS・alias norm)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Custom Design の Design Comparison / FDS。+--+-- spec: doe-custom-design-spec v0.1.1 §2.8 / §3.5。+--+-- JMP "Design Evaluation" 相当の post-hoc 比較関数。 生成済の 'CustomDesign'+-- (複数) を受け取り、 D/A/G/I efficiency、 FDS (Fraction of Design Space)+-- 分布、 alias matrix の Frobenius norm を計算する。+--+-- === 設計判断+--+--   - __pure 関数__ (`IO` 不要): FDS の点サンプリングは Halton 列で deterministic、+--     reproducibility は seed 不要。+--   - __efficiency 算出__: D/A/G eff は 'Hanalyze.Design.Diagnostics.diagnostics'+--     を再利用。 I-eff は 'regionMomentMatrixAnalytic' 経由の+--     region 積分版 (連続 U[-1,1] + Categorical 等確率 で M_R を解析構築、+--     I-eff = @1 / (n · trace((X'X)⁻¹ · M_R))@)。 Mixture を含む等で M_R 構築+--     失敗時は旧 self-moment 近似 (= @1/p@) に fallback。+--   - __FDS 規定__: N=500 点を Halton で抽出、 各因子型ごとに [0, 1] → 因子値に+--     マップ (Continuous は [-1, 1]、 DiscreteNum / Mixture / Categorical /+--     Ordinal はそれぞれ自然なマッピング)、 expand 後の予測分散 v = x'(X'X)⁻¹x+--     を昇順 sort して返す (JMP plot で x = 累積分率、 y = v)。+--   - __alias norm の範囲__: 現状は+--     __連続因子 × 連続因子の 2fi で model に含まれていない組合せ__ のみを+--     Z に含める (categorical absent interaction や TPower 2 などは将来+--     commit で拡張)。+--+-- === 既知の制限 (将来 commit で拡張候補)+--+--   - alias matrix の Z 構築範囲 (現状 連続 × 連続 2fi のみ)+--   - FDS の region 定義 (現状全因子 を独立 uniform、 制約付きの場合は+--     rejection sampling 必要)+--   - I-eff の Mixture / 制約付き region (現状 fallback)+--+-- [English]: Custom Design's Design Comparison / FDS.+--+-- spec: doe-custom-design-spec v0.1.1 §2.8 / §3.5.+--+-- Post-hoc comparison functions equivalent to JMP's "Design Evaluation".+-- Takes (multiple) already-generated 'CustomDesign's and computes D/A/G/I+-- efficiency, the FDS (Fraction of Design Space) distribution, and the+-- Frobenius norm of the alias matrix.+--+-- === Design decisions+--+--   - __pure functions__ (no `IO` needed): FDS point sampling is+--     deterministic via a Halton sequence, so reproducibility doesn't+--     need a seed.+--   - __efficiency computation__: D/A/G eff reuse+--     'Hanalyze.Design.Diagnostics.diagnostics'. I-eff is the+--     region-integral version via 'regionMomentMatrixAnalytic'+--     (analytically builds M_R with continuous U[-1,1] + Categorical+--     equal-probability; I-eff = @1 / (n · trace((X'X)⁻¹ · M_R))@). Falls+--     back to the old self-moment approximation (= @1/p@) if building M_R+--     fails (e.g. when Mixture is involved).+--   - __FDS specification__: samples N=500 points via Halton, maps+--     [0, 1] → factor values per factor type (Continuous uses [-1, 1];+--     DiscreteNum \/ Mixture \/ Categorical \/ Ordinal each use their+--     natural mapping), and returns the post-expansion predicted variance+--     v = x'(X'X)⁻¹x sorted ascending (for JMP plots, x = cumulative+--     fraction, y = v).+--   - __scope of the alias norm__: currently only includes in Z+--     __the continuous × continuous 2fi not already in the model__+--     (categorical absent interactions, TPower 2, etc. are extended in a+--     future commit).+--+-- === Known limitations (candidates for extension in a future commit)+--+--   - the scope of the alias matrix's Z construction (currently only+--     continuous × continuous 2fi)+--   - the FDS region definition (currently all factors are independent+--     uniform; the constrained case needs rejection sampling)+--   - I-eff's Mixture \/ constrained region (currently falls back)+module Hanalyze.Design.Custom.Compare+  ( DesignComparison (..)+  , compareDesigns+    -- * 内部 helper (test 用)+  , fdsVector+  , aliasNormOf+    -- * Compound criterion (Phase 26-6)+  , normalizeCompoundWeights+    -- * I-efficiency region 積分 (Phase 28-4a、 RegionMoment 再export)+  , regionMomentMatrixAnalytic+  , iValueRegionM+    -- * Compound 幾何平均 + 各 criterion の efficiency (Phase 28-9)+  , compoundGeometric+  , dEfficiency+  , aEfficiency+    -- * 多変量 Cp との統合 (Phase 28-8)+  , DesignComparisonExt (..)+  , compareDesignsWithResponses+  ) where++import           Data.List                (sort)+import           Data.Text                (Text)+import qualified Numeric.LinearAlgebra    as LA++import           Hanalyze.Design.Custom.Factor+import           Hanalyze.Design.Custom.Model+import           Hanalyze.Design.Custom.Coordinate+                   (CustomDesign (..), CustomDesignReport (..))+import           Hanalyze.Design.Custom.RegionMoment+                   (regionMomentMatrixAnalytic, iValueRegionM)+import           Hanalyze.Design.Diagnostics+                   (DesignDiagnostics (..), diagnostics)+import           Hanalyze.Design.Optimal           (OptCriterion (..))+import qualified Hanalyze.Design.Quality           as Q+import qualified Hanalyze.Stat.QuasiRandom         as QR++-- ---------------------------------------------------------------------------+-- 型+-- ---------------------------------------------------------------------------++-- | [日本語]: 複数 Custom Design の比較結果。+--   [English]: The comparison result of multiple Custom Designs.+data DesignComparison = DesignComparison+  { dcDesigns   :: ![(Text, CustomDesign)]+  , dcEffTable  :: !(LA.Matrix Double)+    -- ^ [日本語]: 行: 設計 (`dcDesigns` 順)、 列: D / A / G / I efficiency+    --   [English]: Rows: designs (in `dcDesigns` order); columns: D / A /+    --   G / I efficiency+  , dcFDS       :: ![(Text, LA.Vector Double)]+    -- ^ [日本語]: 設計ごとの FDS sorted vector (長さ = N_FDS、 既定 500)+    --   [English]: The FDS sorted vector per design (length = N_FDS,+    --   default 500)+  , dcAliasNorm :: ![(Text, Double)]+    -- ^ [日本語]: 設計ごとの alias matrix Frobenius norm+    --   [English]: The Frobenius norm of the alias matrix per design+  } deriving (Show)++-- ---------------------------------------------------------------------------+-- 公開 API+-- ---------------------------------------------------------------------------++nFDS :: Int+nFDS = 500++-- | [日本語]: Custom Design 群を比較。 全 4 列の efficiency + FDS + alias norm を集約。+--   [English]: Compares a group of Custom Designs. Aggregates all 4+--   columns of efficiency + FDS + alias norm.+compareDesigns :: [(Text, CustomDesign)] -> DesignComparison+compareDesigns named =+  let effRows = map (designEffs . snd) named+      effTable+        | null effRows = (0 LA.>< 4) []+        | otherwise    = LA.fromLists effRows+      fds     = [ (nm, fdsVector cd) | (nm, cd) <- named ]+      aliases = [ (nm, aliasNormOf cd) | (nm, cd) <- named ]+  in DesignComparison+       { dcDesigns   = named+       , dcEffTable  = effTable+       , dcFDS       = fds+       , dcAliasNorm = aliases+       }++-- ---------------------------------------------------------------------------+-- efficiency+-- ---------------------------------------------------------------------------++-- | [日本語]: 1 設計に対する [D-eff, A-eff, G-eff, I-eff]。 expand 失敗時は 4 個の 0。+--+--   D-eff は 'CustomDesignReport.crCriterion' に応じて分岐:+--     - 'BayesianD k': @D-eff = (det(X'X + K) / n^p)^(1/p)@ (Bayesian D-criterion)+--     - その他: 古典 D-criterion @det(X'X)@ ベース+--+--   I-eff は region moment matrix 版:+--   @I-eff = 1 / (n · trace((X'X)⁻¹ · M_R))@、 @M_R@ は+--   'regionMomentMatrixAnalytic' で構築。 Mixture を含む等で M_R 構築に+--   失敗した場合は旧 self-moment 近似 (= @1/p@、 設計に依らず定数) に fallback。+--   [English]: [D-eff, A-eff, G-eff, I-eff] for one design. 4 zeros on+--   expand failure.+--+--   D-eff branches according to 'CustomDesignReport.crCriterion':+--     - 'BayesianD k': @D-eff = (det(X'X + K) / n^p)^(1/p)@ (Bayesian D-criterion)+--     - otherwise: based on the classic D-criterion @det(X'X)@+--+--   I-eff is the region moment matrix version:+--   @I-eff = 1 / (n · trace((X'X)⁻¹ · M_R))@, where @M_R@ is built via+--   'regionMomentMatrixAnalytic'. Falls back to the old self-moment+--   approximation (= @1/p@, constant regardless of design) if building+--   M_R fails (e.g. when Mixture is involved).+designEffs :: CustomDesign -> [Double]+designEffs cd =+  case expandDesignMatrix (cdFactors cd) (cdModel cd) (cdMatrix cd) of+    Left _  -> [0, 0, 0, 0]+    Right x ->+      let d        = diagnostics x+          n        = LA.rows x+          p        = LA.cols x+          nD       = fromIntegral n :: Double+          pD       = fromIntegral p :: Double+          dEffBayes k =+            let km = LA.fromLists k+            in if LA.rows km /= p || LA.cols km /= p+                 then ddDEff d+                 else+                   let det = LA.det (LA.tr x LA.<> x + km)+                   in if det <= 0 || nD == 0 then 0+                        else (det / (nD ** pD)) ** (1 / pD)+          dEff = case crCriterion (cdReport cd) of+            BayesianD k -> dEffBayes k+            _           -> ddDEff d+          iEffReg  = case regionMomentMatrixAnalytic (cdFactors cd) (cdModel cd) of+            Right mR+              | LA.rows mR == LA.cols x ->+                  let t  = iValueRegionM mR x+                  in if isInfinite t || t <= 0 then 0 else 1 / (nD * t)+            _ -> ddIEff d+      in [dEff, ddAEff d, ddGEff d, iEffReg]++-- ---------------------------------------------------------------------------+-- FDS (Fraction of Design Space)+-- ---------------------------------------------------------------------------++-- | [日本語]: FDS vector: Halton で region から N_FDS 点を抽出、 各点の予測分散+--   v = x'(X'X)⁻¹x を昇順 sort して返す。 expand 失敗時は空 Vector。+--+--   region の取り方 (暫定):+--     - Continuous (lo, hi)  : [-1, 1] (NCoded、 lo/hi 情報は無視)+--     - DiscreteNum xs       : xs から uniform 抽出+--     - Mixture lo hi        : [lo, hi]+--     - Categorical / Ordinal: 0..K-1 から uniform 抽出+--   [English]: The FDS vector: extracts N_FDS points from the region via+--   Halton, and returns each point's predicted variance+--   v = x'(X'X)⁻¹x sorted ascending. An empty Vector on expand failure.+--+--   How the region is taken (provisional):+--     - Continuous (lo, hi)  : [-1, 1] (NCoded; lo/hi info is ignored)+--     - DiscreteNum xs       : uniform draw from xs+--     - Mixture lo hi        : [lo, hi]+--     - Categorical / Ordinal: uniform draw from 0..K-1+fdsVector :: CustomDesign -> LA.Vector Double+fdsVector cd =+  case expandDesignMatrix (cdFactors cd) (cdModel cd) (cdMatrix cd) of+    Left _  -> LA.fromList []+    Right x ->+      let p   = LA.cols x+          xtx = LA.tr x LA.<> x+          d   = LA.det xtx+      in if abs d < 1e-12+           then LA.fromList []+           else+             let inv     = LA.inv xtx+                 factors = cdFactors cd+                 model   = cdModel cd+                 nF      = length factors+                 halton  = QR.haltonMatrix nFDS nF  -- N × nF in [0, 1]+                 rawRows = LA.fromRows+                   [ LA.fromList+                       [ mapU01ToFactor (factors !! j)+                                        (halton `LA.atIndex` (i, j))+                       | j <- [0 .. nF - 1] ]+                   | i <- [0 .. nFDS - 1] ]+             in case expandDesignMatrix factors model rawRows of+                  Left _  -> LA.fromList []+                  Right xSamp ->+                    let !vs = [ let xi = LA.flatten (xSamp LA.? [i])+                                in xi `LA.dot` (inv LA.#> xi)+                              | i <- [0 .. LA.rows xSamp - 1] ]+                        _ = p  -- 未使用警告対策、 dimension は後の commit で使う+                    in LA.fromList (sort vs)++-- | [日本語]: Halton 1 次元値 u ∈ [0, 1] を 1 因子の raw 値に写像。+--   Categorical / Ordinal は floor(u * K) で level index に量子化。+--   [English]: Maps a 1-dimensional Halton value u ∈ [0, 1] to one+--   factor's raw value. Categorical \/ Ordinal are quantized to a level+--   index via floor(u * K).+mapU01ToFactor :: Factor -> Double -> Double+mapU01ToFactor f u = case fKind f of+  Continuous _ _ -> -1 + 2 * u                       -- [-1, 1]+  DiscreteNum xs ->+    let k = length xs+    in if k <= 0 then 0+                 else xs !! min (k - 1) (floor (u * fromIntegral k))+  Mixture lo hi  -> lo + (hi - lo) * u+  Categorical xs ->+    let k = length xs+    in if k <= 0 then 0+                 else fromIntegral (min (k - 1) (floor (u * fromIntegral k)))+  Ordinal xs     ->+    let k = length xs+    in if k <= 0 then 0+                 else fromIntegral (min (k - 1) (floor (u * fromIntegral k)))++-- ---------------------------------------------------------------------------+-- alias norm+-- ---------------------------------------------------------------------------++-- | [日本語]: alias matrix の Frobenius norm。 Z 範囲を拡張済み:+--+--   - 連続 × 連続 2fi (元実装)+--   - __Categorical × 連続 2fi__ (追加)+--   - __Categorical × Categorical 2fi__ (追加)+--   - __連続因子の TPower k=2 (二乗項)__ (追加)+--+--   すべて model に __含まれていない__ ものだけを Z に追加。 Z が空なら 0。+--   [English]: The Frobenius norm of the alias matrix. The Z scope has+--   been extended:+--+--   - continuous × continuous 2fi (original implementation)+--   - __Categorical × continuous 2fi__ (added)+--   - __Categorical × Categorical 2fi__ (added)+--   - __TPower k=2 (squared term) of continuous factors__ (added)+--+--   Only terms __not already included__ in the model are added to Z. 0+--   if Z is empty.+aliasNormOf :: CustomDesign -> Double+aliasNormOf cd =+  let factors      = cdFactors cd+      model        = cdModel cd+      raw          = cdMatrix cd+      allNames     = map fName factors+      contNames    = [ fName f | f <- factors, factorIsContinuous f ]+      existing2fi  =+        [ canonInter ns | TInter ns <- mTerms model, length ns == 2 ]+      existingPow  =+        [ (n, k) | TPower n k <- mTerms model ]+      -- 2fi candidates: 全因子の組合せ (連続 × 連続、 cat × 連続、 cat × cat)+      pair2fiCands =+        [ TInter (canonInter [a, b])+        | a <- allNames, b <- allNames, a < b+        , canonInter [a, b] `notElem` existing2fi+        ]+      -- 連続因子の二乗項 (k=2)+      powCands =+        [ TPower n 2+        | n <- contNames, (n, 2) `notElem` existingPow+        ]+      zTerms = pair2fiCands ++ powCands+  in if null zTerms+       then 0+       else+         case (expandDesignMatrix factors model raw,+               expandDesignMatrix factors (Model zTerms (mNorm model)) raw) of+           (Right x, Right z) ->+             let xtx = LA.tr x LA.<> x+                 d   = LA.det xtx+             in if abs d < 1e-12 then 0 / 0+                  else+                    let a = LA.inv xtx LA.<> LA.tr x LA.<> z+                    in sqrt (LA.sumElements (LA.cmap (** 2) a))+           _ -> 0 / 0++-- | [日本語]: 2fi のペアを正規化 (順序非依存にするため sort)。+--   [English]: Normalizes a 2fi pair (sorted to make it order-independent).+canonInter :: [Text] -> [Text]+canonInter = sort++-- ---------------------------------------------------------------------------+-- Compound 重み正規化 (Phase 26-6)+-- ---------------------------------------------------------------------------++-- | [日本語]: Compound criterion の重みを合計 1 に正規化。 負の重みは 0 に丸める+--   (criterion の min 方向と矛盾するため)。 入力は @[(weight, OptCriterion)]@、+--   出力は同形で重み正規化済。 重み合計 ≤ 0 の場合は元の入力をそのまま返す+--   (= no-op、 ユーザ責任)。+--+--   使い方:+--+--   @+--   import qualified Hanalyze.Design.Optimal as Opt+--   let ws  = [(0.7, Opt.DOpt), (0.5, Opt.AOpt), (-0.1, Opt.IOpt)]+--       ws' = normalizeCompoundWeights ws+--   -- ws' = [(0.583, DOpt), (0.417, AOpt), (0, IOpt)]+--   @+--   [English]: Normalizes a Compound criterion's weights to sum to 1.+--   Negative weights are clamped to 0 (since they'd contradict the+--   criterion's min direction). The input is @[(weight, OptCriterion)]@;+--   the output has the same shape with weights normalized. If the total+--   weight is ≤ 0, returns the original input unchanged (= no-op, the+--   user's responsibility).+--+--   Usage:+--+--   @+--   import qualified Hanalyze.Design.Optimal as Opt+--   let ws  = [(0.7, Opt.DOpt), (0.5, Opt.AOpt), (-0.1, Opt.IOpt)]+--       ws' = normalizeCompoundWeights ws+--   -- ws' = [(0.583, DOpt), (0.417, AOpt), (0, IOpt)]+--   @+normalizeCompoundWeights+  :: [(Double, a)] -> [(Double, a)]+normalizeCompoundWeights pairs =+  let clamped = [ (max 0 w, c) | (w, c) <- pairs ]+      total   = sum (map fst clamped)+  in if total <= 0+       then pairs+       else [ (w / total, c) | (w, c) <- clamped ]++-- ---------------------------------------------------------------------------+-- Compound 幾何平均 + efficiency 正規化 (Phase 28-9)+-- ---------------------------------------------------------------------------++-- | [日本語]: 重み付き幾何平均 = @exp(Σ w_i · log eff_i / Σ w_i)@。 各 efficiency が+--   [0, 1] 範囲の正規化済値であることを前提に「合成効率」 を返す (alphabetic+--   criterion の geometric variant、 JMP の Compound criterion で利用される)。+--+--     - 重みは正数を仮定 (負は 0 にクランプ)、 重み合計 0 のときは 0 を返す+--     - 任意の eff が ≤ 0 のときは 0 を返す (log が ∞)、 線形 Compound (= no-op+--       合算) と挙動を揃える+--+--   使い方:+--+--   @+--   let effD = dEfficiency x+--       effA = aEfficiency x+--       comp = compoundGeometric [(0.7, effD), (0.3, effA)]+--   @+--   [English]: The weighted geometric mean =+--   @exp(Σ w_i · log eff_i / Σ w_i)@. Returns the "combined efficiency",+--   assuming each efficiency is a normalized value in [0, 1] (the+--   geometric variant of the alphabetic criterion, used in JMP's Compound+--   criterion).+--+--     - Weights are assumed positive (negatives are clamped to 0); returns+--       0 when the total weight is 0+--     - Returns 0 if any eff is ≤ 0 (log would be ∞), matching the+--       behavior of the linear Compound (= no-op summation)+--+--   Usage:+--+--   @+--   let effD = dEfficiency x+--       effA = aEfficiency x+--       comp = compoundGeometric [(0.7, effD), (0.3, effA)]+--   @+compoundGeometric :: [(Double, Double)] -> Double+compoundGeometric pairs+  | any ((<= 0) . snd) clamped = 0+  | totalW <= 0                = 0+  | otherwise                  =+      exp (sum [ w * log e | (w, e) <- clamped ] / totalW)+  where+    clamped = [ (max 0 w, e) | (w, e) <- pairs ]+    totalW  = sum (map fst clamped)++-- | [日本語]: D-efficiency @= (det(X'X) / n^p)^(1/p)@ ([0, ∞) 値、 reference D-opt で 1)。+--   singular なら 0。+--   [English]: D-efficiency @= (det(X'X) / n^p)^(1/p)@ (a [0, ∞) value; 1+--   for a reference D-opt design). 0 if singular.+dEfficiency :: LA.Matrix Double -> Double+dEfficiency x+  | LA.rows x == 0 || LA.cols x == 0 = 0+  | otherwise =+      let n  = fromIntegral (LA.rows x) :: Double+          p  = fromIntegral (LA.cols x) :: Double+          d  = LA.det (LA.tr x LA.<> x)+      in if d <= 0 then 0+                   else (d / (n ** p)) ** (1 / p)++-- | [日本語]: A-efficiency @= p / (n · trace((X'X)⁻¹))@ ([0, ∞)、 reference A-opt で 1)。+--   singular なら 0。+--   [English]: A-efficiency @= p / (n · trace((X'X)⁻¹))@ ([0, ∞); 1 for a+--   reference A-opt design). 0 if singular.+aEfficiency :: LA.Matrix Double -> Double+aEfficiency x+  | LA.rows x == 0 || LA.cols x == 0 = 0+  | otherwise =+      let n   = fromIntegral (LA.rows x) :: Double+          p   = fromIntegral (LA.cols x) :: Double+          xtx = LA.tr x LA.<> x+          dd  = LA.det xtx+      in if abs dd < 1e-12 then 0+           else+             let tr = LA.sumElements (LA.takeDiag (LA.inv xtx))+             in if tr <= 0 then 0 else p / (n * tr)+++-- ---------------------------------------------------------------------------+-- 多変量 Cp の Compare 統合 (Phase 28-8)+-- ---------------------------------------------------------------------------++-- | [日本語]: 'DesignComparison' を拡張、 design ごとに観測 response (実験結果 y) と+--   spec bounds から計算した多変量 process capability を追加。+--   [English]: Extends 'DesignComparison', adding the multivariate process+--   capability computed per design from the observed responses+--   (experimental results y) and the spec bounds.+data DesignComparisonExt = DesignComparisonExt+  { dceBase     :: !DesignComparison+  , dceMCp      :: ![(Text, Either Text Double)]+    -- ^ [日本語]: design ごとの MCp (Wang-Hubele-Lawrence 体積比)+    --   [English]: MCp per design (Wang-Hubele-Lawrence volume ratio)+  , dceMCpk     :: ![(Text, Either Text Double)]+    -- ^ [日本語]: design ごとの MCpk (中心オフセット penalty 含む)+    --   [English]: MCpk per design (includes the center-offset penalty)+  , dceInSpec   :: ![(Text, Either Text Double)]+    -- ^ [日本語]: spec box 内包率 (実測)+    --   [English]: The observed spec-box containment rate+  } deriving (Show)++-- | [日本語]: Compare に多変量 response 評価を追加。 各エントリ+--   @(name, design, responses, specs)@:+--     - @responses@ は n × p 観測行列 (n = 設計の行数、 p = 応答数)+--     - @specs@ は各応答の @(LSL, USL)@ を列順に+--+--   @processCapabilityMultivariate@ が Left を返した場合 (singular cov など)+--   は @dceMCp@ / @dceMCpk@ / @dceInSpec@ の該当エントリに Left を保持する。+--   [English]: Adds a multivariate response evaluation to Compare. Each+--   entry @(name, design, responses, specs)@:+--     - @responses@ is an n × p observation matrix (n = the design's row+--       count, p = the number of responses)+--     - @specs@ is each response's @(LSL, USL)@ in column order+--+--   If @processCapabilityMultivariate@ returns Left (e.g. singular+--   covariance), the corresponding entry in @dceMCp@ \/ @dceMCpk@ \/+--   @dceInSpec@ retains the Left.+compareDesignsWithResponses+  :: [(Text, CustomDesign, LA.Matrix Double, [(Double, Double)])]+  -> DesignComparisonExt+compareDesignsWithResponses tuples =+  let base = compareDesigns [ (nm, cd) | (nm, cd, _, _) <- tuples ]+      results =+        [ (nm, Q.processCapabilityMultivariate y specs)+        | (nm, _, y, specs) <- tuples ]+      mcp     = [ (nm, fmap Q.mcMCp r)        | (nm, r) <- results ]+      mcpk    = [ (nm, fmap Q.mcMCpk r)       | (nm, r) <- results ]+      inSpec  = [ (nm, fmap Q.mcInSpecRate r) | (nm, r) <- results ]+  in DesignComparisonExt+       { dceBase   = base+       , dceMCp    = mcp+       , dceMCpk   = mcpk+       , dceInSpec = inSpec+       }
+ src/Hanalyze/Design/Custom/Constraint.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Custom.Constraint+-- Description : Custom Design の Constraint 内部正規化形 (Coordinate Exchange 用の候補行フィルタ ADT)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Custom Design の Constraint 内部正規化形 (skeleton)。+--+-- spec: doe-custom-design-spec v0.1.1 §2.3 / §9.3。+--+-- __本 skeleton では「内部 ADT (正規化済形)」 のみを定義する__。+-- ∀LIC∃Code 表面構文 (= @RawConstraint@ newtype around @ExprRep@) と+-- @normalize :: RawConstraint -> Constraint@ は、 DSL frontend パッケージ+-- (現状 @CanvasApp/backend/@ にある) との依存関係を整理してから着手する+-- (未着手・後続コミットの候補)。+--+-- 現在の利用想定: Coordinate Exchange アルゴリズム (後続コミットで実装予定)+-- が ADT を inspect して候補 grid を事前 filter するための内部表現。+--+-- [English]: The internal normalized form of a Custom Design Constraint+-- (skeleton).+--+-- spec: doe-custom-design-spec v0.1.1 §2.3 / §9.3.+--+-- __This skeleton defines only the "internal ADT (normalized form)"__.+-- The ∀LIC∃Code surface syntax (= a @RawConstraint@ newtype around+-- @ExprRep@) and @normalize :: RawConstraint -> Constraint@ will be+-- tackled once the dependency on the DSL frontend package (currently in+-- @CanvasApp/backend/@) is sorted out (not yet started; a candidate+-- for a follow-up commit).+--+-- Intended current use: an internal representation the Coordinate+-- Exchange algorithm (to be implemented in a follow-up commit) can+-- inspect the ADT with, to pre-filter the candidate grid.+module Hanalyze.Design.Custom.Constraint+  ( ConstraintRel (..)+  , FactorValue (..)+  , ConstraintGuard (..)+  , Constraint (..)+  , checkRowAgainst+  , compileRowFromFactors+  ) where++import           Data.Text (Text)+import qualified Data.Map.Strict as M++-- | [日本語]: 線形制約の関係子 (Custom 側、 古典 Hanalyze.Design.Constraint と+--   表現は同じだが名前空間を分けて使う)。+--   [English]: The relational operator for a linear constraint (on the+--   Custom side; the same representation as the classical+--   Hanalyze.Design.Constraint, but kept in a separate namespace).+data ConstraintRel = CLeq | CEq | CGeq+  deriving (Eq, Show)++-- | [日本語]: カテゴリ / 数値の混在値 (Forbidden に使う)。+--   [English]: A mixed category/numeric value (used by Forbidden).+data FactorValue+  = FVDouble !Double+  | FVText   !Text+  deriving (Eq, Show)++-- | [日本語]: 条件付制約のガード (AND/OR/単項、 NOT は v0.2 検討)。+--   [English]: The guard of a conditional constraint (AND/OR/unary; NOT is+--   under consideration for v0.2).+data ConstraintGuard+  = GuardEq  !Text !FactorValue+  | GuardLeq !Text !Double+  | GuardGeq !Text !Double+  | GuardAnd ![ConstraintGuard]+  | GuardOr  ![ConstraintGuard]+  deriving (Eq, Show)++-- | [日本語]: Custom Design 内部の正規化済 Constraint。+--+--   連続因子 (因子名で参照) の半空間 / 等式 / カテゴリ列の forbidden /+--   条件付 / 範囲上書きを覆う。 表面 ∀LIC∃Code Expr からの正規化失敗時の+--   @Generic@ (= ExprRep 抱え込み) は本 skeleton では未対応 (DSL frontend+--   依存解決後に追加)。+--   [English]: The normalized Constraint used internally by Custom Design.+--+--   Covers half-spaces / equalities on continuous factors (referenced by+--   name), forbidden combinations on category columns, conditionals, and+--   range overrides. The @Generic@ fallback (= carrying an ExprRep) for+--   when normalization from a surface ∀LIC∃Code Expr fails is not yet+--   supported by this skeleton (to be added once the DSL frontend+--   dependency is resolved).+data Constraint+  = LinearIneq  ![(Text, Double)] !ConstraintRel !Double+    -- ^ [日本語]: @sum_i (coef_i * x_{name_i}) \`rel\` rhs@ 連続因子のみ参照可+    --   [English]: @sum_i (coef_i * x_{name_i}) \`rel\` rhs@; may only+    --   reference continuous factors.+  | Forbidden   ![(Text, FactorValue)]+    -- ^ [日本語]: 全項が一致する row を禁止 (AND)+    --   [English]: Forbids a row where every term matches (AND).+  | Conditional !ConstraintGuard ![Constraint]+    -- ^ [日本語]: ガード成立時のみ inner 制約を活性化+    --   [English]: Activates the inner constraints only when the guard holds.+  | RangeBound  !Text !Double !Double+    -- ^ [日本語]: 範囲上書き (低、 高)+    --   [English]: A range override (low, high).+  deriving (Eq, Show)++-- | [日本語]: 1 row (= 因子名 → 値の Map) に対する制約評価。+--   skeleton では Categorical 因子は Text 値で照合、 連続因子は Double で照合。+--   値が見つからない / 型不一致は __その制約を 'False' (= 違反) と判定__。+--   [English]: Evaluates a constraint against a single row (= a Map from+--   factor name to value). In this skeleton, Categorical factors are+--   matched by Text value and continuous factors by Double. If the value+--   is missing or the type mismatches,+--   __the constraint is judged 'False' (= violated)__.+checkRowAgainst :: M.Map Text FactorValue -> Constraint -> Bool+checkRowAgainst row (LinearIneq coefs rel rhs) =+  let lookupNum k = case M.lookup k row of+                      Just (FVDouble x) -> Just x+                      _                 -> Nothing+      ms = traverse (\(n, c) -> fmap (c *) (lookupNum n)) coefs+  in case ms of+       Nothing -> False+       Just xs ->+         let lhs = sum xs+         in case rel of+              CLeq -> lhs <= rhs + 1e-9+              CEq  -> abs (lhs - rhs) <= 1e-9+              CGeq -> lhs >= rhs - 1e-9+checkRowAgainst row (Forbidden vs) =+  not (all (\(n, v) -> M.lookup n row == Just v) vs)+checkRowAgainst row (Conditional guard cs) =+  if evalGuard row guard+    then all (checkRowAgainst row) cs+    else True+checkRowAgainst row (RangeBound n lo hi) =+  case M.lookup n row of+    Just (FVDouble x) -> lo - 1e-9 <= x && x <= hi + 1e-9+    _                  -> False++-- | [日本語]: ガード評価。 [English]: Evaluates a guard.+evalGuard :: M.Map Text FactorValue -> ConstraintGuard -> Bool+evalGuard row (GuardEq  n v)   = M.lookup n row == Just v+evalGuard row (GuardLeq n c)   = case M.lookup n row of+                                   Just (FVDouble x) -> x <= c + 1e-9+                                   _                 -> False+evalGuard row (GuardGeq n c)   = case M.lookup n row of+                                   Just (FVDouble x) -> x >= c - 1e-9+                                   _                 -> False+evalGuard row (GuardAnd gs)    = all (evalGuard row) gs+evalGuard row (GuardOr  gs)    = any (evalGuard row) gs++-- | [日本語]: ヘルパ: 因子名リストと 1 row 値リスト (= Double のみの場合) から Map に変換。+--   Custom Design Core が coordinate exchange の inner loop で使う想定。+--   [English]: Helper: converts a list of factor names and a single row's+--   values (the all-Double case) into a Map. Intended for use by Custom+--   Design Core in the inner loop of coordinate exchange.+compileRowFromFactors :: [Text] -> [Double] -> M.Map Text FactorValue+compileRowFromFactors names values =+  M.fromList (zip names (map FVDouble values))
+ src/Hanalyze/Design/Custom/Coordinate.hs view
@@ -0,0 +1,780 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns      #-}+-- |+-- Module      : Hanalyze.Design.Custom.Coordinate+-- Description : Custom Design の Coordinate Exchange + Modified Fedorov hybrid アルゴリズム+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Custom Design の Coordinate Exchange + Modified Fedorov hybrid。+--+-- spec: doe-custom-design-spec v0.1.1 §2.4 / §3.6。+-- 参考: Meyer & Nachtsheim (1995) "The Coordinate-Exchange Algorithm for+-- Constructing Exact Optimal Experimental Designs", Technometrics 37:60-69。+--+-- ## アーキテクチャ+--+-- 「連続因子は coordinate exchange、 categorical 因子は Modified Fedorov+-- (候補集合 = 全 level)」 を __因子ごとに探索 grid を切り替える__ ことで+-- 1 つの outer loop に統合した。 spec §2.4 で言う「hybrid」 は実質+-- per-column grid の選び分けに帰着する。+--+-- 因子ごとの grid (NCoded 想定):+--   - Continuous  : linspace [-1, 1] (長さ dbCxStepGrid、 既定 21)+--   - DiscreteNum : ユーザ指定の離散水準 (そのまま)+--   - Mixture     : linspace [lo, hi] (長さ dbCxStepGrid、 制約は別途)+--   - Categorical : [0, 1, ..., K-1] (level index、 expand 側で treatment coding)+--   - Ordinal     : 同上+--+-- ## スコープ+--+--   - 制約 (`cdsConstraints` = LinearIneq / Forbidden / Conditional / RangeBound) を+--     __per-grid-point filter__ として統合: 各 cell 候補値について、 変更後の row が+--     全制約を満たさなければ +∞ 評価 (= 採用されない)。+--   - 初期 randomInit は __rejection sampling__ で row 単位に制約を満たすまで再抽選+--     (1 row あたり 200 回上限、 越えたら Left)。+--   - `cdsInitial` は __無視__ (augment 機能で対応予定)。+--   - 全 'OptCriterion' (DOpt/AOpt/IOpt/EOpt/GOpt/Compound) を Matrix-native で評価。+--     IOpt の moment matrix は self-moment (= A-criterion と同方向の近似、+--     既存 `Hanalyze.Design.Optimal.iValueWithSelf` と整合)。+--+-- ## 設計指針+--+--   - 内部 loop は hmatrix Matrix / Vector で完結 (list 化禁止、 過去の教訓)。+--   - outer multi-start / iter loop は `IO` で IORef 更新。+--   - 各 grid 点での criterion 評価は `expandDesignMatrix` + `critValueM`。+--   - 初期解は grid 上で uniform random 抽出 (再現性は `cdsSeed`)。+--+-- [English]: Custom Design's Coordinate Exchange + Modified Fedorov hybrid.+--+-- spec: doe-custom-design-spec v0.1.1 §2.4 / §3.6.+-- Reference: Meyer & Nachtsheim (1995) "The Coordinate-Exchange Algorithm for+-- Constructing Exact Optimal Experimental Designs", Technometrics 37:60-69.+--+-- ## Architecture+--+-- "Continuous factors use coordinate exchange, categorical factors use+-- Modified Fedorov (candidate set = all levels)" is unified into a single+-- outer loop by __switching the search grid per factor__. What spec §2.4+-- calls "hybrid" reduces in practice to choosing the grid per column.+--+-- Grid per factor (assumes NCoded):+--   - Continuous  : linspace [-1, 1] (length dbCxStepGrid, default 21)+--   - DiscreteNum : the user-specified discrete levels (as-is)+--   - Mixture     : linspace [lo, hi] (length dbCxStepGrid; constraints+--     handled separately)+--   - Categorical : [0, 1, ..., K-1] (level index; treatment coding is+--     handled on the expand side)+--   - Ordinal     : same as above+--+-- ## Scope+--+--   - Constraints (`cdsConstraints` = LinearIneq / Forbidden / Conditional /+--     RangeBound) are integrated as a __per-grid-point filter__: for each+--     candidate cell value, if the row after the change fails to satisfy all+--     constraints it is scored as +∞ (i.e. never chosen).+--   - The initial randomInit uses __rejection sampling__, redrawing per row+--     until constraints are satisfied (up to 200 tries per row, then Left).+--   - `cdsInitial` is __ignored__ (planned for the augment feature).+--   - All 'OptCriterion' (DOpt\/AOpt\/IOpt\/EOpt\/GOpt\/Compound) are+--     evaluated Matrix-native. IOpt's moment matrix is self-moment (= an+--     approximation in the same direction as the A-criterion, consistent+--     with the existing `Hanalyze.Design.Optimal.iValueWithSelf`).+--+-- ## Design policy+--+--   - The inner loop stays entirely within hmatrix Matrix\/Vector (no+--     conversion to lists — a lesson learned the hard way in the past).+--   - The outer multi-start\/iter loop updates an IORef inside `IO`.+--   - The criterion evaluation at each grid point is+--     `expandDesignMatrix` + `critValueM`.+--   - The initial solution is drawn via uniform random sampling on the+--     grid (reproducibility via `cdsSeed`).+module Hanalyze.Design.Custom.Coordinate+  ( -- * 入力型+    CustomDesignSpec (..)+  , DesignBudget (..)+  , defaultBudget+    -- * 結果型+  , CustomDesign (..)+  , CustomDesignReport (..)+    -- * アルゴリズム+  , coordinateExchange+  , coordinateExchangePure+    -- * seed / gen helper (SplitPlot 等が再利用)+  , mkGen+  , mkGenSeed+  , defaultPureSeed+    -- * 内部 helper (test 用 / Structured 再利用)+  , critValueM+  , gridForBudget+  , factorGrid+  , rowFeasible+  ) where++import           Control.Monad             (forM_, when)+import           Control.Monad.Primitive   (PrimMonad, PrimState)+import           Control.Monad.ST          (runST)+import           Data.Maybe                (fromMaybe)+import           Data.Primitive.MutVar+import           Data.Text                 (Text)+import qualified Data.Text                 as T+import qualified Numeric.LinearAlgebra     as LA+import qualified System.Random.MWC         as MWC+import qualified Data.Vector               as V+import qualified Data.Vector.Unboxed       as VU+import qualified Data.Map.Strict           as M++import           Hanalyze.Design.Custom.Factor+import           Hanalyze.Design.Custom.Model+import           Hanalyze.Design.Custom.Constraint+                   (Constraint, FactorValue (..), checkRowAgainst)+import qualified Hanalyze.Design.Custom.RegionMoment as RM+import           Hanalyze.Design.Custom.RegionMoment (resolveIOptRegion)+import           Hanalyze.Design.Optimal        (OptCriterion (..))++-- ---------------------------------------------------------------------------+-- 入力型+-- ---------------------------------------------------------------------------++-- | [日本語]: Custom Design 生成の仕様。 spec §2.4。+--   [English]: Specification for Custom Design generation. spec §2.4.+data CustomDesignSpec = CustomDesignSpec+  { cdsFactors     :: ![Factor]+  , cdsModel       :: !Model+  , cdsConstraints :: ![Constraint]+    -- ^ [日本語]: 現時点では未使用 (grid filter として統合予定)。+    --   [English]: Currently unused (planned to be integrated as a grid+    --   filter).+  , cdsNRuns       :: !Int+  , cdsCriterion   :: !OptCriterion+  , cdsBudget      :: !DesignBudget+  , cdsSeed        :: !(Maybe Int)+  , cdsInitial     :: !(Maybe (LA.Matrix Double))+    -- ^ [日本語]: Augment 用 (現時点では未使用)。+    --   [English]: For augment (currently unused).+  , cdsDJConvention :: !Bool+    -- ^ [日本語]: 自動: True かつ criterion が BayesianD を含むとき、+    -- 候補集合 (factor grid の cartesian product) から DuMouchel-Jones §2.2+    -- 規約 ('Custom.Bayesian.djFitTransform') を fit し、 内部 criterion 評価+    -- の expand 後に @djApplyTransform@ を適用してから 'critValueM' に渡す。+    -- 'cdMatrix' は raw 表現のまま保存、 'cdReport.crCriterionValue' は+    -- 変換後 X 上の det を示す。 paper §3.3 と同じ意味の最適化が走る。+    --   [English]: Automatic: when True and the criterion contains+    --   BayesianD, a DuMouchel-Jones §2.2 convention+    --   ('Custom.Bayesian.djFitTransform') is fit from the candidate set+    --   (the cartesian product of the factor grids), and @djApplyTransform@+    --   is applied after expanding the internal criterion evaluation,+    --   before being passed to 'critValueM'. 'cdMatrix' is still stored in+    --   raw form, while 'cdReport.crCriterionValue' shows the det on the+    --   transformed X. This runs an optimization with the same meaning as+    --   paper §3.3.+  } deriving (Show)++-- | [日本語]: 探索バジェット。 spec §2.4。+--   [English]: The search budget. spec §2.4.+data DesignBudget = DesignBudget+  { dbMaxIter    :: !Int     -- ^ [日本語]: outer iteration 上限 (改善なしで break) [English]: Upper bound on outer iterations (break when no improvement)+  , dbRestarts   :: !Int     -- ^ [日本語]: multi-start 数 [English]: Number of multi-starts+  , dbTol        :: !Double  -- ^ [日本語]: outer 収束判定の相対改善閾値 [English]: Relative-improvement threshold for outer convergence+  , dbCxStepGrid :: !Int     -- ^ [日本語]: 連続因子 grid 点数 (既定 21) [English]: Number of grid points for continuous factors (default 21)+  } deriving (Show)++-- | [日本語]: spec §2.4 既定値 + JMP デフォルト互換 (21 grid)。+--   [English]: spec §2.4 default values, compatible with JMP's default+--   (21 grid points).+defaultBudget :: DesignBudget+defaultBudget = DesignBudget+  { dbMaxIter    = 50+  , dbRestarts   = 5+  , dbTol        = 1e-6+  , dbCxStepGrid = 21+  }++-- ---------------------------------------------------------------------------+-- 結果型+-- ---------------------------------------------------------------------------++data CustomDesign = CustomDesign+  { cdMatrix  :: !(LA.Matrix Double)   -- ^ [日本語]: 因子 raw 値行列 (nRuns × #factors) [English]: Factor raw-value matrix (nRuns x #factors)+  , cdFactors :: ![Factor]+  , cdModel   :: !Model+  , cdReport  :: !CustomDesignReport+  } deriving (Show)++data CustomDesignReport = CustomDesignReport+  { crCriterion      :: !OptCriterion+  , crCriterionValue :: !Double     -- ^ [日本語]: 最小化方向の値 (DOpt なら −det) [English]: Value in the minimization direction (−det for DOpt)+  , crIterations     :: !Int        -- ^ [日本語]: best restart で要した outer iter 数 [English]: Number of outer iterations taken by the best restart+  , crRestarts       :: !Int        -- ^ [日本語]: 実行した restart 数 [English]: Number of restarts executed+  , crConverged      :: !Bool       -- ^ [日本語]: best restart が maxIter 前に収束したか [English]: Whether the best restart converged before maxIter+  , crSeed           :: !(Maybe Int)+  } deriving (Show)++-- ---------------------------------------------------------------------------+-- 公開 API+-- ---------------------------------------------------------------------------++-- | [日本語]: Coordinate Exchange + Modified Fedorov hybrid による+--   Custom Design 生成。+--+--   失敗ケース:+--     - 因子が空 / nRuns < 1+--     - Categorical / Ordinal 因子で水準数 0 (expandDesignMatrix の挙動と整合)+--     - モデルが categorical を参照しているが既知の制限に該当+--     - 'TNested' をモデルに含む (未対応、 将来対応予定)+--     - dbRestarts < 1 / dbCxStepGrid < 2+--   [English]: Custom Design generation via Coordinate Exchange + Modified+--   Fedorov hybrid.+--+--   Failure cases:+--     - Factors are empty \/ nRuns < 1+--     - Categorical \/ Ordinal factor with 0 levels (consistent with+--       expandDesignMatrix's behavior)+--     - The model references categorical but falls under a known+--       restriction+--     - The model includes 'TNested' (not yet supported; planned for a+--       future phase)+--     - dbRestarts < 1 \/ dbCxStepGrid < 2+-- | [日本語]: seed 由来の gen を作って 'coordinateExchangeWith' を IO で走らせる+--   薄い wrapper。 'cdsSeed' が 'Nothing' の場合のみ entropy 依存 (非決定的)。+--   seed 決定的な純粋版が要るなら @coordinateExchangePure@ を使う。+--   [English]: A thin wrapper that builds a gen from the seed and runs+--   'coordinateExchangeWith' in IO. Only depends on entropy (non-+--   deterministic) when 'cdsSeed' is 'Nothing'. If a seed-deterministic+--   pure version is needed, use @coordinateExchangePure@.+coordinateExchange :: CustomDesignSpec -> IO (Either Text CustomDesign)+coordinateExchange spec = do+  gen <- mkGen (cdsSeed spec)+  coordinateExchangeWith spec gen++-- | [日本語]: seed 決定的な純粋版。 'runST' で MWC gen + MutVar を閉じ込め、+--   IO 無しで 'CustomDesign' を返す。 'cdsSeed' が 'Nothing' なら+--   'defaultPureSeed' を用いて全域関数にする (同 spec → 常に同結果)。+--   同一 seed なら 'coordinateExchange' (IO) とビット一致する。+--   [English]: A seed-deterministic pure version. Uses 'runST' to enclose+--   the MWC gen + MutVar, returning 'CustomDesign' without IO. When+--   'cdsSeed' is 'Nothing', 'defaultPureSeed' is used to make this a total+--   function (same spec → always the same result). Given the same seed,+--   this bit-matches 'coordinateExchange' (IO).+coordinateExchangePure :: CustomDesignSpec -> Either Text CustomDesign+coordinateExchangePure spec = runST $ do+  gen <- mkGenSeed (fromMaybe defaultPureSeed (cdsSeed spec))+  coordinateExchangeWith spec gen++-- | [日本語]: 座標交換本体 (PrimMonad 一般化)。 IO / ST どちらでも走る。 gen は+--   呼び出し側が seed から用意する ('coordinateExchange' = IO entropy 可 /+--   @coordinateExchangePure@ = ST seed 必須)。 アルゴリズムは gen の生成源に+--   依らず同 seed → 同結果。+--   [English]: The coordinate-exchange body (generalized over PrimMonad).+--   Runs under either IO or ST. The caller prepares the gen from a seed+--   ('coordinateExchange' allows IO entropy \/ @coordinateExchangePure@+--   requires an ST seed). The algorithm produces the same result for the+--   same seed regardless of the gen's source.+coordinateExchangeWith+  :: PrimMonad m+  => CustomDesignSpec -> MWC.Gen (PrimState m) -> m (Either Text CustomDesign)+coordinateExchangeWith spec gen+  | null (cdsFactors spec) =+      pure (Left (T.pack "coordinateExchange: empty factor list"))+  | cdsNRuns spec < 1 =+      pure (Left (T.pack "coordinateExchange: nRuns must be >= 1"))+  | dbRestarts (cdsBudget spec) < 1 =+      pure (Left (T.pack "coordinateExchange: dbRestarts must be >= 1"))+  | dbCxStepGrid (cdsBudget spec) < 2 =+      pure (Left (T.pack "coordinateExchange: dbCxStepGrid must be >= 2"))+  | otherwise = do+      let !n        = cdsNRuns spec+          !budget   = cdsBudget spec+          !critIn   = cdsCriterion spec+          !model    = cdsModel spec+          !factors  = cdsFactors spec+          !cons     = cdsConstraints spec+          !grids    = map (factorGrid budget) factors+      let prep = do+            () <- maybe (Right ()) Left (validateGrids factors grids)+            crit <- resolveIOptRegion factors model cons critIn+            mDJ  <- fitDJTransformIfRequested spec factors model grids crit+            Right (crit, mDJ)+      case prep of+        Left e -> pure (Left e)+        Right (crit, mDJ) -> do+          let dummy = LA.fromColumns+                [ LA.konst (VU.head g) n | g <- grids ]+          case expandDesignMatrix factors model dummy of+            Left e  -> pure (Left (T.pack "coordinateExchange: model invalid — " <> e))+            Right _ -> do+              bestRef <- newMutVar Nothing+              initErrRef <- newMutVar Nothing+              forM_ [1 .. dbRestarts budget] $ \_ -> do+                mInit <- randomInit factors cons n grids gen+                case mInit of+                  Left e -> writeMutVar initErrRef (Just e)+                  Right init0 -> do+                    (finalM, finalC, iters, conv) <-+                      runExchange factors model crit mDJ cons budget grids init0+                    modifyMutVar' bestRef $ \mb -> case mb of+                      Nothing -> Just (finalM, finalC, iters, conv)+                      Just (_, c0, _, _)+                        | finalC < c0 -> Just (finalM, finalC, iters, conv)+                        | otherwise   -> mb+              mb <- readMutVar bestRef+              case mb of+                Just (m, c, iters, conv) -> pure $ Right CustomDesign+                  { cdMatrix  = m+                  , cdFactors = factors+                  , cdModel   = model+                  , cdReport  = CustomDesignReport+                      { crCriterion      = critIn+                      , crCriterionValue = c+                      , crIterations     = iters+                      , crRestarts       = dbRestarts budget+                      , crConverged      = conv+                      , crSeed           = cdsSeed spec+                      }+                  }+                Nothing -> do+                  initErr <- readMutVar initErrRef+                  pure (Left (case initErr of+                    Just e  -> e+                    Nothing -> T.pack "coordinateExchange: no restart produced a design"))++-- | [日本語]: 全因子の grid が非空である事を確認 (Categorical 0 level、 DiscreteNum 空 等を弾く)。+--   [English]: Checks that every factor's grid is non-empty (rejects+--   Categorical with 0 levels, empty DiscreteNum, etc.).+validateGrids :: [Factor] -> [VU.Vector Double] -> Maybe Text+validateGrids fs gs = go (zip fs gs)+  where+    go [] = Nothing+    go ((f, g):rest)+      | VU.length g < 1 = Just (T.pack+          ("coordinateExchange: factor " <> T.unpack (fName f)+           <> " has empty search grid (categorical with 0 levels?)"))+      | otherwise = go rest++-- ---------------------------------------------------------------------------+-- アルゴリズム内部+-- ---------------------------------------------------------------------------++-- | [日本語]: 1 restart 分の coordinate exchange / Modified Fedorov 混合 loop を走らせる。+--   戻り値: (最終 raw matrix, 最終 criterion 値, 要した outer iter, 収束フラグ)。+--   [English]: Runs the coordinate-exchange \/ Modified Fedorov mixed loop+--   for a single restart. Return value: (final raw matrix, final criterion+--   value, outer iterations taken, convergence flag).+runExchange+  :: PrimMonad m+  => [Factor]+  -> Model+  -> OptCriterion+  -> Maybe RM.DJTransform      -- ^ [日本語]: 自動 DJ 規約変換 [English]: Automatic DJ convention transform+  -> [Constraint]              -- ^ [日本語]: 制約 (per-grid-point filter) [English]: Constraints (a per-grid-point filter)+  -> DesignBudget+  -> [VU.Vector Double]        -- ^ [日本語]: 因子ごとの探索 grid (列順) [English]: Search grid per factor (column order)+  -> LA.Matrix Double          -- ^ [日本語]: 初期 raw matrix (n × p) [English]: Initial raw matrix (n x p)+  -> m (LA.Matrix Double, Double, Int, Bool)+runExchange factors model crit mDJ cons budget grids init0 = do+  matRef    <- newMutVar init0+  critRef   <- newMutVar (evalCrit factors model crit mDJ init0)+  iterRef   <- newMutVar 0+  convRef   <- newMutVar False+  let !n        = LA.rows init0+      !p        = LA.cols init0+      gridsV    = V.fromList grids+      gridLensV = V.fromList (map VU.length grids)+  let loopOuter !it+        | it > dbMaxIter budget = pure ()+        | otherwise = do+            beforeC <- readMutVar critRef+            forM_ [0 .. n - 1] $ \i ->+              forM_ [0 .. p - 1] $ \j -> do+                curMat <- readMutVar matRef+                curC   <- readMutVar critRef+                let oldV    = curMat `LA.atIndex` (i, j)+                    !g      = gridsV V.! j+                    !gl     = gridLensV V.! j+                (bestV, bestC) <-+                  searchBestOnGrid factors model crit mDJ cons curMat i j g gl oldV curC+                when (bestC < curC) $ do+                  let !newMat = setEntry curMat i j bestV+                  writeMutVar matRef  newMat+                  writeMutVar critRef bestC+            afterC <- readMutVar critRef+            writeMutVar iterRef it+            let !rel = relImprovement beforeC afterC+            if rel <= dbTol budget+              then writeMutVar convRef True+              else loopOuter (it + 1)+  loopOuter 1+  finalM    <- readMutVar matRef+  finalC    <- readMutVar critRef+  finalIter <- readMutVar iterRef+  conv      <- readMutVar convRef+  -- p は randomInit が決定論的に正しい次元を返すので冗長検査は省く+  _ <- pure (n, p)+  pure (finalM, finalC, finalIter, conv)++-- | [日本語]: 1 セル (i, j) について grid 上を線形走査、 制約を満たす範囲で+--   criterion 最小の (v, c) を返す。 制約違反 grid 点は scoring 段階で +∞ 扱い+--   (= 採用されない)。+--   [English]: Linearly scans the grid for one cell (i, j), returning the+--   (v, c) with the minimal criterion among grid points satisfying the+--   constraints. Constraint-violating grid points are scored as +∞ during+--   scoring (i.e. never chosen).+searchBestOnGrid+  :: PrimMonad m+  => [Factor]+  -> Model+  -> OptCriterion+  -> Maybe RM.DJTransform+  -> [Constraint]+  -> LA.Matrix Double+  -> Int -> Int+  -> VU.Vector Double+  -> Int+  -> Double               -- ^ [日本語]: 現状値 (oldV) [English]: Current value (oldV)+  -> Double               -- ^ [日本語]: 現状の criterion [English]: Current criterion value+  -> m (Double, Double)+searchBestOnGrid factors model crit mDJ cons mat i j grid gridLen oldV oldC = do+  bestRef <- newMutVar (oldV, oldC)+  let curRow = LA.flatten (LA.subMatrix (i, 0) (1, LA.cols mat) mat)+  forM_ [0 .. gridLen - 1] $ \k -> do+    let !v = grid VU.! k+        !proposedRow = replaceVecAt curRow j v+    when (rowFeasible factors cons proposedRow) $ do+      let !candMat = setEntry mat i j v+          !c = evalCrit factors model crit mDJ candMat+      modifyMutVar' bestRef $ \cur@(_, bc) -> if c < bc then (v, c) else cur+  readMutVar bestRef++-- | [日本語]: raw matrix → design matrix → (optional) DJ 変換 → criterion 値 (最小化方向)。+--   expandDesignMatrix が `Left` を返したら +∞ を返す (= 採用されない)。+--   [English]: raw matrix -> design matrix -> (optional) DJ transform ->+--   criterion value (minimization direction). Returns +∞ if+--   expandDesignMatrix returns `Left` (i.e. never chosen).+evalCrit :: [Factor] -> Model -> OptCriterion -> Maybe RM.DJTransform+         -> LA.Matrix Double -> Double+evalCrit factors model crit mDJ raw =+  case expandDesignMatrix factors model raw of+    Left _  -> 1 / 0+    Right x ->+      let xT = case mDJ of+            Nothing -> x+            Just t  -> RM.djApplyTransform t x+      in critValueM crit xT++-- ---------------------------------------------------------------------------+-- criterion (Matrix-native、 list 化禁止)+-- ---------------------------------------------------------------------------++-- | [日本語]: OptCriterion の Matrix 版。 全 criterion を /minimize/ 方向で返す+--   (`Hanalyze.Design.Optimal.critValue` と整合)。 X は expand 済設計行列。+--   [English]: The Matrix version of OptCriterion. All criteria are+--   returned in the \/minimize\/ direction (consistent with+--   `Hanalyze.Design.Optimal.critValue`). X is the expanded design+--   matrix.+critValueM :: OptCriterion -> LA.Matrix Double -> Double+critValueM DOpt       x = - dValueM x+critValueM AOpt       x = aValueM x+critValueM IOpt       x = iValueSelfM x+critValueM EOpt       x = eValueM x+critValueM GOpt       x = gValueM x+critValueM (Compound ws) x =+  sum [ w * critValueM c x | (w, c) <- ws ]+critValueM (BayesianD k) x =+  let p  = LA.cols x+      km = LA.fromLists k+  in if LA.rows km /= p || LA.cols km /= p+       then 1 / 0+       else - LA.det (LA.tr x LA.<> x + km)+critValueM (IOptRegion mr) x =+  let p   = LA.cols x+      mrM = LA.fromLists mr+  in if LA.rows mrM /= p || LA.cols mrM /= p+       then 1 / 0+       else iValueRegionMatrix mrM x++-- | [日本語]: region moment matrix を直接 Matrix で受け取る I-criterion (内部用)。+--   'Compare.iValueRegionM' と同義だが、 Coordinate からの import 循環回避の+--   ため重複定義。+--   [English]: An I-criterion (internal use) that takes the region moment+--   matrix directly as a Matrix. Equivalent to 'Compare.iValueRegionM', but+--   duplicated here to avoid an import cycle from Coordinate.+iValueRegionMatrix :: LA.Matrix Double -> LA.Matrix Double -> Double+iValueRegionMatrix mrM x+  | LA.rows x == 0 = 1 / 0+  | otherwise =+      let xtx = LA.tr x LA.<> x+          d   = LA.det xtx+      in if abs d < 1e-12 then 1 / 0+           else LA.sumElements (LA.takeDiag (LA.inv xtx LA.<> mrM))++dValueM :: LA.Matrix Double -> Double+dValueM x+  | LA.rows x == 0 = 0+  | otherwise = LA.det (LA.tr x LA.<> x)++aValueM :: LA.Matrix Double -> Double+aValueM x+  | LA.rows x == 0 = 1 / 0+  | otherwise =+      let xtx = LA.tr x LA.<> x+          d   = LA.det xtx+      in if abs d < 1e-12 then 1 / 0+           else LA.sumElements (LA.takeDiag (LA.inv xtx))++-- | [日本語]: I-criterion の self-moment 版 (`Optimal.iValueWithSelf` と同義)。+--   [English]: The self-moment version of the I-criterion (equivalent to+--   `Optimal.iValueWithSelf`).+iValueSelfM :: LA.Matrix Double -> Double+iValueSelfM x+  | LA.rows x == 0 = 1 / 0+  | otherwise =+      let xtx = LA.tr x LA.<> x+          d   = LA.det xtx+      in if abs d < 1e-12 then 1 / 0+           else+             let inv    = LA.inv xtx+                 moment = LA.scale (1 / fromIntegral (LA.rows x)) xtx+             in LA.sumElements (LA.takeDiag (inv LA.<> moment))++eValueM :: LA.Matrix Double -> Double+eValueM x+  | LA.rows x == 0 = 1 / 0+  | otherwise =+      let xtx = LA.tr x LA.<> x+          eigs = LA.toList (LA.eigenvaluesSH (LA.sym xtx))+      in if null eigs then 1 / 0 else - minimum eigs++gValueM :: LA.Matrix Double -> Double+gValueM x+  | LA.rows x == 0 = 1 / 0+  | otherwise =+      let xtx = LA.tr x LA.<> x+          d   = LA.det xtx+      in if abs d < 1e-12 then 1 / 0+           else+             let inv = LA.inv xtx+                 h   = x LA.<> inv LA.<> LA.tr x+                 dia = LA.toList (LA.takeDiag h)+             in if null dia then 1 / 0 else maximum dia++-- ---------------------------------------------------------------------------+-- 補助+-- ---------------------------------------------------------------------------++-- | [日本語]: [-1, 1] の等間隔 grid (NCoded 連続因子の既定)。+--   [English]: An equally spaced grid on [-1, 1] (default for NCoded+--   continuous factors).+gridForBudget :: DesignBudget -> VU.Vector Double+gridForBudget b =+  let !k  = dbCxStepGrid b+      !km = fromIntegral (k - 1) :: Double+  in VU.generate k (\i -> -1 + 2 * fromIntegral i / km)++-- | [日本語]: 因子ごとの探索 grid。 raw matrix の値表現規約+--   (`Hanalyze.Design.Custom.Model` のモジュール doc 参照) と整合する点を返す。+--+--   - Continuous (lo, hi)  : linspace [-1, 1] (NCoded、 dbCxStepGrid 点)+--   - DiscreteNum xs       : xs そのまま+--   - Mixture (lo, hi)     : linspace [lo, hi] (dbCxStepGrid 点、 制約は別途)+--   - Categorical / Ordinal: [0, 1, ..., K-1] (level index、 expand 側で treatment coding)+--+--   [English]: The search grid per factor. Returns points consistent with+--   the raw-matrix value representation convention (see the module doc of+--   `Hanalyze.Design.Custom.Model`).+--+--   - Continuous (lo, hi)  : linspace [-1, 1] (NCoded, dbCxStepGrid points)+--   - DiscreteNum xs       : xs as-is+--   - Mixture (lo, hi)     : linspace [lo, hi] (dbCxStepGrid points;+--     constraints handled separately)+--   - Categorical \/ Ordinal: [0, 1, ..., K-1] (level index; treatment+--     coding is handled on the expand side)+factorGrid :: DesignBudget -> Factor -> VU.Vector Double+factorGrid b f = case fKind f of+  Continuous _ _    -> gridForBudget b+  DiscreteNum xs    -> VU.fromList xs+  Mixture lo hi     -> linspaceVU lo hi (dbCxStepGrid b)+  Categorical xs    -> VU.fromList (map fromIntegral [0 .. length xs - 1])+  Ordinal     xs    -> VU.fromList (map fromIntegral [0 .. length xs - 1])++-- | [日本語]: 任意区間の等間隔 grid (k 点)。 k <= 1 は単一中央値を返す。+--   [English]: An equally spaced grid (k points) over an arbitrary+--   interval. Returns a single midpoint when k <= 1.+linspaceVU :: Double -> Double -> Int -> VU.Vector Double+linspaceVU lo hi k+  | k <= 1    = VU.singleton ((lo + hi) / 2)+  | otherwise = VU.generate k+      (\i -> lo + (hi - lo) * fromIntegral i / fromIntegral (k - 1))++-- | [日本語]: 初期 raw matrix を rejection sampling で構築 (n × p)。+--   各 row を制約満足するまで再抽選 (1 row あたり 200 回まで)。+--   200 回試して失敗した row があれば 'Left'。+--   [English]: Builds the initial raw matrix (n x p) via rejection+--   sampling. Redraws each row until it satisfies the constraints (up to+--   200 tries per row). Returns 'Left' if any row fails after 200 tries.+randomInit+  :: PrimMonad m+  => [Factor]+  -> [Constraint]+  -> Int+  -> [VU.Vector Double]+  -> MWC.Gen (PrimState m)+  -> m (Either Text (LA.Matrix Double))+randomInit factors cons n grids gen = do+  let p = length grids+      gridsV = V.fromList grids+      maxTries = 200 :: Int+      drawRow = do+        vs <- mapM (\j -> do+                       let g = gridsV V.! j+                           gl = VU.length g+                       k <- MWC.uniformR (0, gl - 1) gen+                       pure (g VU.! k)) [0 .. p - 1]+        pure (LA.fromList vs)+      tryRow t+        | t > maxTries = pure Nothing+        | otherwise = do+            r <- drawRow+            if rowFeasible factors cons r+              then pure (Just r)+              else tryRow (t + 1)+  rowsR <- mapM (\_ -> tryRow 1) [1 .. n]+  case sequence rowsR of+    Just rs -> pure (Right (LA.fromRows rs))+    Nothing -> pure (Left (T.pack+      ("randomInit: failed to find feasible row within "+       <> show maxTries <> " rejection-sampling tries — "+       <> "constraints may be infeasible or too tight")))++-- | [日本語]: row vector (length p) の j 番目を v に置換した新 vector。+--   [English]: A new vector with the j-th element of the row vector+--   (length p) replaced by v.+replaceVecAt :: LA.Vector Double -> Int -> Double -> LA.Vector Double+replaceVecAt v j x =+  LA.fromList [if k == j then x else v `LA.atIndex` k | k <- [0 .. LA.size v - 1]]++-- | [日本語]: row (raw Vector) が全制約を満たすかを評価。+--   Categorical / Ordinal 列は level index → 因子の level 名 ('FVText') に変換、+--   連続系は 'FVDouble' に変換して 'checkRowAgainst' に渡す。+--   [English]: Evaluates whether a row (raw Vector) satisfies all+--   constraints. Categorical \/ Ordinal columns convert the level index to+--   the factor's level name ('FVText'); continuous ones convert to+--   'FVDouble', before passing to 'checkRowAgainst'.+rowFeasible :: [Factor] -> [Constraint] -> LA.Vector Double -> Bool+rowFeasible _ [] _ = True+rowFeasible factors cons row =+  let m = buildRowFV factors row+  in all (checkRowAgainst m) cons++-- | [日本語]: raw 値 vector (列順 = factors 順) を 因子名 → FactorValue Map に変換。+--   Categorical / Ordinal は level index を level 名 ('FVText') に変換、+--   非整数 / 範囲外 index は安全のため 'FVDouble' のまま (rowFeasible で+--   不一致 → 制約違反 として扱われる、 expandDesignMatrix が別途 Left を返す)。+--   [English]: Converts a raw-value vector (column order = factor order)+--   into a factor-name -> FactorValue Map. Categorical \/ Ordinal convert+--   the level index to the level name ('FVText'); non-integer \/+--   out-of-range indices are left as 'FVDouble' for safety (a mismatch in+--   rowFeasible is treated as a constraint violation; expandDesignMatrix+--   separately returns Left).+buildRowFV :: [Factor] -> LA.Vector Double -> M.Map Text FactorValue+buildRowFV factors row =+  M.fromList+    [ (fName f, toFV (fKind f) (row `LA.atIndex` i))+    | (i, f) <- zip [0 ..] factors+    ]+  where+    toFV (Categorical xs) x = catIndexToFV xs x+    toFV (Ordinal     xs) x = catIndexToFV xs x+    toFV _                x = FVDouble x++    catIndexToFV :: [Text] -> Double -> FactorValue+    catIndexToFV xs x =+      let xi = round x :: Int+          delta = abs (x - fromIntegral xi)+      in if delta < 1e-9 && xi >= 0 && xi < length xs+           then FVText (xs !! xi)+           else FVDouble x  -- 不正値 → 文字列 level に一致しない = 不一致++-- | [日本語]: accum で 1 セルだけ置換した新 matrix を返す。+--   注意: hmatrix `LA.accum` の combining fn は @f new old@ の順 (= 第 1 引数が+--   リストの値、 第 2 引数が現行値)。 'const' で「リストの値で置換」 を意味する。+--   [English]: Returns a new matrix with a single cell replaced via accum.+--   Note: hmatrix's `LA.accum` combining function has the order @f new+--   old@ (i.e. the 1st argument is the list's value, the 2nd is the+--   current value). 'const' means "replace with the list's value".+setEntry :: LA.Matrix Double -> Int -> Int -> Double -> LA.Matrix Double+setEntry m i j v = LA.accum m const [((i, j), v)]++-- | [日本語]: 相対改善 = (before − after) / |before| (前後とも最小化方向の criterion 値)。+--   値が小さい (≤ dbTol) ほど「改善が止まった」 と解釈、 outer loop で break。+--   [English]: Relative improvement = (before − after) / |before| (both+--   before and after are criterion values in the minimization direction).+--   A small value (≤ dbTol) is interpreted as "improvement has stopped",+--   breaking the outer loop.+relImprovement :: Double -> Double -> Double+relImprovement before after+  | abs before < 1e-12 = before - after+  | otherwise          = (before - after) / abs before++-- | [日本語]: seed から MWC.Gen を作る (IO)。 Nothing なら entropy 由来 (非決定的)。+--   [English]: Builds a MWC.Gen from a seed (IO). If Nothing, it comes+--   from entropy (non-deterministic).+mkGen :: Maybe Int -> IO MWC.GenIO+mkGen Nothing  = MWC.createSystemRandom+mkGen (Just s) = mkGenSeed s++-- | [日本語]: seed から MWC.Gen を作る (PrimMonad 一般化・決定的)。IO / ST 両対応。+--   [English]: Builds a MWC.Gen from a seed (generalized over PrimMonad,+--   deterministic). Supports both IO and ST.+mkGenSeed :: PrimMonad m => Int -> m (MWC.Gen (PrimState m))+mkGenSeed s = MWC.initialize (VU.fromList [fromIntegral s])++-- | [日本語]: 純粋版 @coordinateExchangePure@ で 'cdsSeed' が 'Nothing' のときに使う既定 seed。+--   純粋 = 全域である必要があるため固定値を用いる (同 spec → 常に同結果)。+--   [English]: The default seed used by the pure version+--   @coordinateExchangePure@ when 'cdsSeed' is 'Nothing'. Since pure means+--   total, a fixed value is used (same spec → always the same result).+defaultPureSeed :: Int+defaultPureSeed = 0x5EED++-- ---------------------------------------------------------------------------+-- Phase 28-12 自動 DJ 規約変換+-- ---------------------------------------------------------------------------++-- | [日本語]: criterion 木に BayesianD が含まれているか。+--   [English]: Whether BayesianD is present in the criterion tree.+critContainsBayesianD :: OptCriterion -> Bool+critContainsBayesianD (BayesianD _)  = True+critContainsBayesianD (Compound ws)  = any (critContainsBayesianD . snd) ws+critContainsBayesianD _              = False++-- | [日本語]: 因子 grid から候補集合 (cartesian product) の raw matrix を構築。+--   [English]: Builds the raw matrix of the candidate set (cartesian+--   product) from the factor grids.+candidateFromGrids :: [VU.Vector Double] -> LA.Matrix Double+candidateFromGrids gs =+  let lists = map VU.toList gs+      rows  = sequence lists   -- cartesian product+  in if null rows then (0 LA.>< length gs) []+                  else LA.fromLists rows++-- | [日本語]: spec の `cdsDJConvention` が True かつ criterion に BayesianD を含むときのみ+--   候補集合から @DJTransform@ を fit する。 それ以外は @Right Nothing@。+--   [English]: Fits a @DJTransform@ from the candidate set only when the+--   spec's `cdsDJConvention` is True and the criterion contains BayesianD.+--   Otherwise returns @Right Nothing@.+fitDJTransformIfRequested+  :: CustomDesignSpec+  -> [Factor]+  -> Model+  -> [VU.Vector Double]+  -> OptCriterion+  -> Either Text (Maybe RM.DJTransform)+fitDJTransformIfRequested spec fs model grids crit+  | not (cdsDJConvention spec)        = Right Nothing+  | not (critContainsBayesianD crit)  = Right Nothing+  | otherwise =+      let cand = candidateFromGrids grids+      in case RM.djFitTransform fs model cand of+           Left e  -> Left e+           Right t -> Right (Just t)
+ src/Hanalyze/Design/Custom/Factor.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Custom.Factor+-- Description : Custom Design の Factor 定義 (Role × Kind の直交軸による因子型)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Custom Design の Factor 定義 (skeleton)。+--+-- spec: doe-custom-design-spec v0.1.1 §2.1 / §3.1。+--+-- 「コントロール性 (Role)」 × 「水準型 (Kind)」 の直交軸で 1 型に集約。+-- HardToChange フラグが split-plot を駆動する (未実装・将来のフェーズで対応予定)。+--+-- [English]: Factor definition for Custom Design (skeleton).+--+-- spec: doe-custom-design-spec v0.1.1 §2.1 / §3.1.+--+-- Consolidated into a single type via the orthogonal axes of+-- "controllability (Role)" × "level type (Kind)". The HardToChange flag+-- drives split-plot behavior (not yet implemented; planned for a future+-- phase).+module Hanalyze.Design.Custom.Factor+  ( FactorRole (..)+  , FactorKind (..)+  , Factor (..)+  , factorIsContinuous+  , factorDimension+  ) where++import Data.Text (Text)++-- | [日本語]: 因子の運用上の役割。 [English]: The operational role of a factor.+data FactorRole+  = Controllable+    -- ^ [日本語]: 通常因子 [English]: An ordinary factor.+  | HardToChange+    -- ^ [日本語]: Whole-plot 因子 (split-plot 駆動)+    --   [English]: A whole-plot factor (drives split-plot behavior).+  | VeryHardToChange+    -- ^ [日本語]: Strip-plot 駆動 [English]: Drives strip-plot behavior.+  | Blocking+    -- ^ [日本語]: 既知ブロック [English]: A known block.+  | Covariate+    -- ^ [日本語]: 共変量 (測定可だが操作不可)+    --   [English]: A covariate (measurable but not manipulable).+  | Constant+    -- ^ [日本語]: 固定 (設計には現れず記録のみ)+    --   [English]: A constant (doesn't appear in the design; recorded only).+  | Uncontrolled+    -- ^ [日本語]: ノイズ (Taguchi outer array 由来)+    --   [English]: Noise (originating from a Taguchi outer array).+  deriving (Eq, Show)++-- | [日本語]: 因子の水準型。 [English]: The level type of a factor.+data FactorKind+  = Continuous   !Double !Double+    -- ^ [日本語]: (low, high)、 coded ±1 への正規化対象+    --   [English]: (low, high); normalized to coded ±1.+  | DiscreteNum  ![Double]+    -- ^ [日本語]: 離散水準 (順序あり) [English]: Discrete levels (ordered).+  | Categorical  ![Text]+    -- ^ [日本語]: 順序なしカテゴリ [English]: An unordered category.+  | Ordinal      ![Text]+    -- ^ [日本語]: 順序ありカテゴリ [English]: An ordered category.+  | Mixture      !Double !Double+    -- ^ [日本語]: 混合比制約下の (lower, upper)+    --   [English]: (lower, upper) under a mixture-ratio constraint.+  deriving (Eq, Show)++-- | [日本語]: Factor = 名前 + 水準型 + 役割。+--   [English]: Factor = name + level type + role.+data Factor = Factor+  { fName :: !Text+  , fKind :: !FactorKind+  , fRole :: !FactorRole+  } deriving (Eq, Show)++-- | [日本語]: 連続系 (Continuous / DiscreteNum / Mixture) かどうか。+--   設計行列の展開時に、 categorical 因子の treatment coding 分岐に使う。+--   [English]: Whether the factor is continuous-like (Continuous /+--   DiscreteNum / Mixture). Used when expanding the design matrix, to+--   branch on treatment coding for categorical factors.+factorIsContinuous :: Factor -> Bool+factorIsContinuous f = case fKind f of+  Continuous  _ _ -> True+  DiscreteNum _   -> True+  Mixture     _ _ -> True+  Categorical _   -> False+  Ordinal     _   -> False++-- | [日本語]: Factor の「設計行列に占める列数」 概算 (skeleton 段階の単純実装)。+--+--   - 連続系: 1+--   - Categorical / Ordinal: (水準数 − 1)  ※reference coding+--+--   0 水準 (空 Categorical) は 0 列 (実装側で warn 推奨)。+--   [English]: An estimate of how many columns a Factor occupies in the+--   design matrix (a simple implementation at the skeleton stage).+--+--   - Continuous-like: 1+--   - Categorical / Ordinal: (level count − 1)  (reference coding)+--+--   0 levels (an empty Categorical) yields 0 columns (a warning is+--   recommended on the implementation side).+factorDimension :: Factor -> Int+factorDimension f = case fKind f of+  Continuous  _ _   -> 1+  DiscreteNum _     -> 1+  Mixture     _ _   -> 1+  Categorical xs    -> max 0 (length xs - 1)+  Ordinal     xs    -> max 0 (length xs - 1)
+ src/Hanalyze/Design/Custom/Model.hs view
@@ -0,0 +1,305 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Custom.Model+-- Description : Custom Design の Model 定義と設計行列展開 (項 ADT → treatment coding)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Custom Design の Model 定義 + 設計行列展開。+--+-- spec: doe-custom-design-spec v0.1.1 §2.2 / §3.1。+--+-- === raw matrix の Categorical 表現規約 (重要、 型安全ではない)+--+-- `expandDesignMatrix` の入力 `Matrix Double` における Categorical / Ordinal+-- 因子の列は __level index 0..K-1 を Double で保持__ する。+-- expandDesignMatrix は reference (treatment) coding で K-1 列に展開、+-- 参照水準 = index 0。+--+-- `Matrix Double` は連続値も index も同じ型なので、 0.5 のような小数や+-- 範囲外 index を __型では防げない__。 検出は runtime check (`Left Text`)。+-- 王道再設計 (R `model.matrix` / patsy 流の型分離) は将来の拡張候補として+-- phase-plan に登録済。 詳細は specification/phases/phase-24-custom-design-core.md。+--+-- === 未対応 (v0.2 候補)+--+--   - `mNorm` は ADT として持つが現状 'NCoded' は identity、 'NUnit' / 'NRaw' は+--     呼び出し側で適切な値を渡す前提+--   - `TNested` / @TCustom@ (`Left` を返す)+--   - `TPower` を Categorical 因子に適用するのは無意味 (indicator^k = indicator)+--     なので `Left`+--+-- [English]: Custom Design's Model definition + design matrix expansion.+--+-- spec: doe-custom-design-spec v0.1.1 §2.2 / §3.1.+--+-- === Categorical representation convention for the raw matrix (important, not type-safe)+--+-- In `expandDesignMatrix`'s input `Matrix Double`, columns for+-- Categorical \/ Ordinal factors __hold the level index 0..K-1 as a Double__.+-- expandDesignMatrix expands them into K-1 columns using+-- reference (treatment) coding, with the reference level = index 0.+--+-- Since `Matrix Double` uses the same type for both continuous values and+-- indices, decimals like 0.5 or out-of-range indices+-- __cannot be prevented by the type system__. Detection happens via a+-- runtime check (`Left Text`). A more principled redesign (type separation in the style+-- of R's `model.matrix` \/ patsy) is registered as a candidate for a+-- future phase in the phase-plan. See+-- specification/phases/phase-24-custom-design-core.md for details.+--+-- === Not yet supported (candidates for v0.2)+--+--   - `mNorm` is held as an ADT, but currently 'NCoded' is identity;+--     'NUnit' \/ 'NRaw' assume the caller passes an appropriate value+--   - `TNested` \/ @TCustom@ (returns `Left`)+--   - Applying `TPower` to a Categorical factor is meaningless+--     (indicator^k = indicator), so it returns `Left`+module Hanalyze.Design.Custom.Model+  ( ParamNormalize (..)+  , ModelTerm (..)+  , Model (..)+  , expandDesignMatrix+  , modelNumColumns+  ) where++import           Data.Text (Text)+import qualified Data.Text as T+import           Data.List (elemIndex)+import qualified Numeric.LinearAlgebra as LA++import           Hanalyze.Design.Custom.Factor++-- | [日本語]: 因子値の正規化方針。+--   [English]: The normalization policy for factor values.+data ParamNormalize+  = NCoded   -- ^ [日本語]: coded units (連続因子は @[-1, 1]@ に既に変換済前提) [English]: coded units (assumes continuous factors are already converted to @[-1, 1]@)+  | NUnit    -- ^ [日本語]: unit cube (@[0, 1]@) 想定 [English]: assumes the unit cube (@[0, 1]@)+  | NRaw     -- ^ [日本語]: raw 単位 (= 何も変換しない) [English]: raw units (= no conversion at all)+  deriving (Eq, Show)++-- | [日本語]: モデル項。+--   [English]: A model term.+data ModelTerm+  = TIntercept                     -- ^ [日本語]: 切片 (全 1 列) [English]: Intercept (an all-ones column)+  | TMain   !Text                  -- ^ [日本語]: 主効果 (因子名) [English]: Main effect (factor name)+  | TInter  ![Text]                -- ^ [日本語]: 交互作用 (k 因子) [English]: Interaction (k factors)+  | TPower  !Text !Int             -- ^ [日本語]: @x^k@ (k ≥ 2 を想定、 連続因子のみ) [English]: @x^k@ (assumes k ≥ 2, continuous factors only)+  | TNested !Text !Text            -- ^ [日本語]: @A within B@ (未対応) [English]: @A within B@ (not supported)+  deriving (Eq, Show)++-- | [日本語]: モデル = 項リスト + 正規化方針。+--   [English]: A model = a term list + a normalization policy.+data Model = Model+  { mTerms :: ![ModelTerm]+  , mNorm  :: !ParamNormalize+  } deriving (Eq, Show)++-- | [日本語]: モデル全体が設計行列に占める列数 (Categorical 因子の K-1 展開を考慮)。+--   Categorical 因子参照中の TMain / TInter / TPower は factorDimension を使う。+--   [English]: The number of columns the whole model occupies in the+--   design matrix (accounting for the K-1 expansion of Categorical+--   factors). TMain \/ TInter \/ TPower referencing a Categorical factor+--   use factorDimension.+modelNumColumns :: [Factor] -> Model -> Int+modelNumColumns factors m = sum (map termWidth (mTerms m))+  where+    findF n = lookup n [(fName f, f) | f <- factors]+    dim n   = maybe 1 factorDimension (findF n)+    termWidth t = case t of+      TIntercept    -> 1+      TMain n       -> dim n+      TInter ns     -> product (map dim ns)+      TPower _ _    -> 1+      TNested a b   -> levelsOf b * dim a   -- Phase 28-1: K_B × (K_A - 1) cols+    levelsOf n = case lookup n [(fName f, f) | f <- factors] of+      Just f -> case fKind f of+        Categorical xs -> length xs+        Ordinal     xs -> length xs+        _              -> 0+      Nothing -> 0++-- | [日本語]: 因子の raw 値行列 (n × p_factors) からモデル設計行列 (n × p_terms) を展開。+--+--   入力 @raw@ の列順は @factors@ の順序と一致する前提。+--   Categorical / Ordinal 因子の列は __level index 0..K-1 を Double で保持__+--   する規約 (上記モジュール doc 参照)。+--+--   失敗を返すケース:+--     - @TNested@ を含む+--     - 参照される因子名が見つからない+--     - Categorical の raw 値が非整数 / 範囲外+--     - @TPower@ を Categorical 因子に適用+--     - 因子行列の列数が @factors@ の長さと一致しない+--   [English]: Expands the model design matrix (n × p_terms) from the+--   factors' raw value matrix (n × p_factors).+--+--   Assumes the input @raw@'s column order matches the order of+--   @factors@. Columns for Categorical \/ Ordinal factors follow the+--   convention of __holding the level index 0..K-1 as a Double__ (see the+--   module doc above).+--+--   Cases returning failure:+--     - contains @TNested@+--     - a referenced factor name is not found+--     - a Categorical raw value is non-integer \/ out of range+--     - @TPower@ applied to a Categorical factor+--     - the factor matrix's column count doesn't match the length of+--       @factors@+expandDesignMatrix+  :: [Factor]+  -> Model+  -> LA.Matrix Double            -- ^ [日本語]: 因子 raw 値 (n × p_factors)。 [English]: Raw factor values (n × p_factors).+  -> Either Text (LA.Matrix Double)+expandDesignMatrix factors model raw+  | LA.cols raw /= length factors =+      Left (T.pack "expandDesignMatrix: raw column count ≠ #factors")+  | otherwise = do+      colss <- mapM (termColumns factors raw) (mTerms model)+      pure (LA.fromColumns (concat colss))++-- | [日本語]: 単一項を 0 個以上の列に変換 (Categorical の TMain は K-1 列、+--   Categorical × Categorical の TInter はクロス積で (K1-1)(K2-1) 列等)。+--   [English]: Converts a single term into zero or more columns+--   (Categorical's TMain becomes K-1 columns; Categorical × Categorical's+--   TInter becomes (K1-1)(K2-1) columns via the cross product, etc.).+termColumns+  :: [Factor]+  -> LA.Matrix Double+  -> ModelTerm+  -> Either Text [LA.Vector Double]+termColumns _ raw TIntercept =+  Right [LA.fromList (replicate (LA.rows raw) 1.0)]+termColumns factors raw (TMain name) =+  factorColumns factors raw name+termColumns factors raw (TInter names)+  | null names = Left (T.pack "TInter with no factor names is invalid")+  | otherwise = do+      colGroups <- mapM (factorColumns factors raw) names+      -- 各因子の列群を cartesian product で elementwise 積。+      Right (foldr1 crossMultiply colGroups)+termColumns factors raw (TPower name k)+  | k < 2     = Left (T.pack ("TPower: k must be >= 2 (got " <> show k <> ")"))+  | otherwise = do+      f <- findFactor factors name+      if factorIsContinuous f+        then do+          v <- numericFactorVector factors raw name+          Right [LA.cmap (** fromIntegral k) v]+        else Left (T.pack+               ("TPower on categorical/ordinal factor " <> T.unpack name+                <> " is degenerate (indicator^k = indicator)"))+termColumns factors raw (TNested aName bName) = do+  (aIdx, fA) <- findFactorWithIndex factors aName+  (bIdx, fB) <- findFactorWithIndex factors bName+  let kindCat fk = case fk of+        Categorical xs -> Just xs+        Ordinal     xs -> Just xs+        _              -> Nothing+  case (kindCat (fKind fA), kindCat (fKind fB)) of+    (Just aXs, Just bXs) -> do+      let aCol = LA.flatten (LA.subMatrix (0, aIdx) (LA.rows raw, 1) raw)+          bCol = LA.flatten (LA.subMatrix (0, bIdx) (LA.rows raw, 1) raw)+      aIxs <- traverse (validateLevelIndex aName (length aXs)) (LA.toList aCol)+      bIxs <- traverse (validateLevelIndex bName (length bXs)) (LA.toList bCol)+      let kB = length bXs+          kA = length aXs+          n  = LA.rows raw+          mkCol bLvl aLvl = LA.fromList+            [ if (bIxs !! i) == bLvl && (aIxs !! i) == aLvl then 1.0 else 0.0+            | i <- [0 .. n - 1] ]+      -- 列順: outer = B level (0..K_B-1)、 inner = A level (1..K_A-1) (treatment coding)+      Right [ mkCol b a | b <- [0 .. kB - 1], a <- [1 .. kA - 1] ]+    _ ->+      Left (T.pack+        ("TNested " <> T.unpack aName <> " within " <> T.unpack bName+         <> ": both factors must be Categorical/Ordinal (Phase 28-1 制限)"))++-- | [日本語]: 2 つの列群を elementwise 積で cartesian-product 化。+--   結果列数 = length xs * length ys。+--   [English]: Cartesian-products two column groups via elementwise+--   multiplication. Resulting column count = length xs * length ys.+crossMultiply :: [LA.Vector Double] -> [LA.Vector Double] -> [LA.Vector Double]+crossMultiply xs ys = [x * y | x <- xs, y <- ys]+  -- Vector の Num instance は elementwise++-- | [日本語]: 因子名 → 設計行列に挿入する列群。+--   連続系: 単一列 (raw そのまま)。+--   Categorical / Ordinal: treatment coding で K-1 列 (reference = index 0)。+--   [English]: Factor name → the column group to insert into the design+--   matrix. Continuous-family: a single column (raw as-is). Categorical \/+--   Ordinal: K-1 columns via treatment coding (reference = index 0).+factorColumns+  :: [Factor]+  -> LA.Matrix Double+  -> Text+  -> Either Text [LA.Vector Double]+factorColumns factors raw name = do+  (i, f) <- findFactorWithIndex factors name+  let col = LA.flatten (LA.subMatrix (0, i) (LA.rows raw, 1) raw)+  case fKind f of+    Continuous  _ _ -> Right [col]+    DiscreteNum _   -> Right [col]+    Mixture     _ _ -> Right [col]+    Categorical xs  -> treatmentCoding name (length xs) col+    Ordinal     xs  -> treatmentCoding name (length xs) col++-- | [日本語]: reference (treatment) coding。 K 水準なら K-1 列、 reference = index 0。+--   列 k (1-based: 1..K-1) の値 = 1 if raw == k else 0。+--   [English]: Reference (treatment) coding. K levels become K-1 columns,+--   reference = index 0. Column k (1-based: 1..K-1) has value = 1 if+--   raw == k else 0.+treatmentCoding+  :: Text                           -- ^ [日本語]: 因子名 (エラーメッセージ用)。 [English]: The factor name (used in error messages).+  -> Int                            -- ^ [日本語]: 水準数 K。 [English]: The number of levels K.+  -> LA.Vector Double               -- ^ [日本語]: raw 列 (level index を Double で)。 [English]: The raw column (level index as a Double).+  -> Either Text [LA.Vector Double]+treatmentCoding name k col+  | k <= 0 = Left (T.pack+               ("factor " <> T.unpack name <> ": categorical with 0 levels"))+  | k == 1 = Right []  -- 1 水準は constant、 列なし+  | otherwise = do+      idxs <- traverse (validateLevelIndex name k) (LA.toList col)+      let mkCol lvl = LA.fromList+            [ if i == lvl then 1.0 else 0.0 | i <- idxs ]+      Right [mkCol lvl | lvl <- [1 .. k - 1]]++-- | [日本語]: level index validation: 整数値かつ [0, K-1] 範囲内。+--   [English]: Level index validation: an integer value within+--   [0, K-1].+validateLevelIndex :: Text -> Int -> Double -> Either Text Int+validateLevelIndex name k x =+  let xi = round x :: Int+      delta = abs (x - fromIntegral xi)+  in if delta > 1e-9+       then Left (T.pack+              ("factor " <> T.unpack name+               <> ": categorical raw value " <> show x+               <> " is not an integer level index"))+       else if xi < 0 || xi >= k+              then Left (T.pack+                     ("factor " <> T.unpack name+                      <> ": level index " <> show xi+                      <> " out of range [0," <> show (k - 1) <> "]"))+              else Right xi++-- | [日本語]: 連続因子の生の列 (TPower 用に分離した helper)。+--   [English]: A continuous factor's raw column (a helper factored out+--   for TPower).+numericFactorVector+  :: [Factor]+  -> LA.Matrix Double+  -> Text+  -> Either Text (LA.Vector Double)+numericFactorVector factors raw name = do+  (i, _) <- findFactorWithIndex factors name+  Right (LA.flatten (LA.subMatrix (0, i) (LA.rows raw, 1) raw))++findFactor :: [Factor] -> Text -> Either Text Factor+findFactor factors name = snd <$> findFactorWithIndex factors name++findFactorWithIndex :: [Factor] -> Text -> Either Text (Int, Factor)+findFactorWithIndex factors name =+  case elemIndex name (map fName factors) of+    Nothing -> Left (T.pack ("factor not found: " <> T.unpack name))+    Just i  -> Right (i, factors !! i)
+ src/Hanalyze/Design/Custom/Power.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns      #-}+-- |+-- Module      : Hanalyze.Design.Custom.Power+-- Description : Custom Design の設計行列から model term ごとの検出力を直接算出+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Custom Design の設計行列ベース Power Analysis。+--+-- spec: doe-custom-design-spec v0.1.1 §2.8 / §3.5。+--+-- 既存の 'Hanalyze.Design.Power' は ANOVA effect size (Cohen's f) ベースだが、+-- 本モジュールは __生成済の Custom Design の設計行列 X から各 model term の noncentrality λ を直接算出__+-- し、 noncentral F 分布の正規近似で power を返す。+--+-- ## アルゴリズム+--+-- 1. 設計行列 X を `expandDesignMatrix` で取得 (n × p)。 \(M = X^T X\) の+--    逆行列を 1 回計算。+-- 2. 各 model term について、 expand 出力のどの列を占めるかを @termColumns@+--    で特定 (Categorical TMain は K-1 列に展開されるので複数列になる)。+-- 3. effect size β (ユーザ入力) と σ (事前推定) から noncentrality:+--+--    \( \lambda = \frac{1}{\sigma^2} \sum_{j \in \mathrm{cols}} \frac{\beta^2}{(X^T X)^{-1}_{jj}} \)+--+--    これは「全 term 列に同じ true coefficient β が乗る」 + 「直交近似+--    (block-diagonal Σ_J)」 という単純化の下で正確。 非直交ケースでは過大評価+--    気味の近似値となる。 改善 (block-inverse 版) は将来 commit で対応予定。+-- 4. F 検定 (df1 = #term cols, df2 = n - p) の critical value を 1 - α で取得、+--    Patnaik / 正規近似で `power = 1 - Φ((fCrit*df1 - (df1 + λ)) / sqrt(2(df1 + 2λ)))`。+--    既存 'Hanalyze.Design.Power.powerOneWayAnova' と同手法。+--+-- ## term 名 (ユーザが指定する @[(Text, Double)]@ のキー)+--+--   - @TIntercept@         → @"(Intercept)"@+--   - @TMain "x1"@         → @"x1"@+--   - @TInter ["x1","x2"]@ → @"x1:x2"@ (因子順は元 ADT 通り、 sort しない)+--   - @TPower "x1" k@      → @"x1^k"@+--   - @TNested a b@        → @"a(b)"@+--+-- 該当 term が見つからない場合は 'dpPower = 0' で返す (warning なし、+-- スコア用途のため Left にはしない)。+--+-- [English]: Power Analysis based on the Custom Design's design matrix.+--+-- spec: doe-custom-design-spec v0.1.1 §2.8 / §3.5.+--+-- Existing 'Hanalyze.Design.Power' is based on ANOVA effect size+-- (Cohen's f), but this module+-- __directly computes each model term's noncentrality λ__ from the design matrix X+-- of an already-generated Custom Design, and returns power via a normal approximation of the+-- noncentral F distribution.+--+-- ## Algorithm+--+-- 1. Retrieve the design matrix X via `expandDesignMatrix` (n × p).+--    Compute the inverse of \(M = X^T X\) once.+-- 2. For each model term, identify which columns of the expand output it+--    occupies via @termColumns@ (a Categorical TMain expands to K-1+--    columns, so it can span multiple columns).+-- 3. From the user-supplied effect size β and the prior estimate of σ,+--    the noncentrality is:+--+--    \( \lambda = \frac{1}{\sigma^2} \sum_{j \in \mathrm{cols}} \frac{\beta^2}{(X^T X)^{-1}_{jj}} \)+--+--    This is exact under the simplification "the same true coefficient β+--    applies to all of the term's columns" + "orthogonal approximation+--    (block-diagonal Σ_J)". In non-orthogonal cases this tends to be a+--    somewhat overestimated approximation. An improvement (a+--    block-inverse version) is planned for a future commit.+-- 4. Obtain the critical value of the F-test (df1 = #term cols,+--    df2 = n - p) at 1 - α, and via the Patnaik \/ normal approximation,+--    `power = 1 - Φ((fCrit*df1 - (df1 + λ)) / sqrt(2(df1 + 2λ)))`. The+--    same technique as the existing+--    'Hanalyze.Design.Power.powerOneWayAnova'.+--+-- ## Term names (keys of the user-supplied @[(Text, Double)]@)+--+--   - @TIntercept@         → @"(Intercept)"@+--   - @TMain "x1"@         → @"x1"@+--   - @TInter ["x1","x2"]@ → @"x1:x2"@ (factor order follows the original+--     ADT; not sorted)+--   - @TPower "x1" k@      → @"x1^k"@+--   - @TNested a b@        → @"a(b)"@+--+-- If a matching term isn't found, returns 'dpPower = 0' (no warning; this+-- is not turned into Left since it's for scoring purposes).+module Hanalyze.Design.Custom.Power+  ( DesignPower (..)+  , designPower+  , termName+  , termColumnIndices+  ) where++import           Data.Text                (Text)+import qualified Data.Text                as T+import qualified Numeric.LinearAlgebra    as LA+import qualified Statistics.Distribution                as SD+import qualified Statistics.Distribution.FDistribution  as FD+import qualified Statistics.Distribution.Normal         as NormalD++import           Hanalyze.Design.Custom.Factor+import           Hanalyze.Design.Custom.Model+import           Hanalyze.Design.Custom.Coordinate (CustomDesign (..))++-- ---------------------------------------------------------------------------+-- 型+-- ---------------------------------------------------------------------------++data DesignPower = DesignPower+  { dpTerm   :: !Text+  , dpEffect :: !Double+  , dpAlpha  :: !Double+  , dpPower  :: !Double+  } deriving (Show, Eq)++-- ---------------------------------------------------------------------------+-- 公開 API+-- ---------------------------------------------------------------------------++-- | [日本語]: 各 term の power を算出。 expand 失敗時は全 term で @dpPower = 0@。+--   [English]: Computes power for each term. On expand failure, every term+--   returns @dpPower = 0@.+designPower+  :: CustomDesign+  -> Double                  -- ^ [日本語]: σ の事前推定 [English]: Prior estimate of σ+  -> [(Text, Double)]        -- ^ [日本語]: 各 term の effect size β [English]: Effect size β for each term+  -> Double                  -- ^ [日本語]: alpha [English]: alpha+  -> [DesignPower]+designPower cd sigma effects alpha =+  case expandDesignMatrix (cdFactors cd) (cdModel cd) (cdMatrix cd) of+    Left _ ->+      [ DesignPower nm eff alpha 0 | (nm, eff) <- effects ]+    Right x ->+      let !n   = LA.rows x+          !p   = LA.cols x+          xtx  = LA.tr x LA.<> x+          d    = LA.det xtx+      in if abs d < 1e-12 || n - p < 1 || sigma <= 0+           then [ DesignPower nm eff alpha 0 | (nm, eff) <- effects ]+           else+             let inv     = LA.inv xtx+                 !diag   = [ inv `LA.atIndex` (j, j) | j <- [0 .. p - 1] ]+                 termMap = termColumnIndices (cdFactors cd) (cdModel cd)+             in [ powerFor termMap diag n p sigma alpha nm eff+                | (nm, eff) <- effects ]++-- | [日本語]: 1 term の power を算出。 該当 term が無ければ power = 0。+--   [English]: Computes power for a single term. Returns power = 0 if the+--   term isn't found.+powerFor+  :: [(Text, [Int])]+  -> [Double]      -- ^ [日本語]: (X'X)⁻¹ の対角 (column j) [English]: The diagonal of (X'X)⁻¹ (column j)+  -> Int           -- ^ [日本語]: n [English]: n+  -> Int           -- ^ [日本語]: p (model total columns) [English]: p (model total columns)+  -> Double        -- ^ [日本語]: sigma [English]: sigma+  -> Double        -- ^ [日本語]: alpha [English]: alpha+  -> Text          -- ^ [日本語]: term name [English]: term name+  -> Double        -- ^ [日本語]: effect size β [English]: effect size β+  -> DesignPower+powerFor termMap diag n p sigma alpha nm eff =+  case lookup nm termMap of+    Nothing -> DesignPower nm eff alpha 0+    Just []  -> DesignPower nm eff alpha 0+    Just cols ->+      let !df1 = length cols+          !df2 = n - p+          -- noncentrality λ = (β/σ)² · sum_j 1 / (X'X)⁻¹_{jj}+          --   = sum_j β² / (σ² · (X'X)⁻¹_{jj})+          !ncp = sum+            [ (eff * eff) / (sigma * sigma * diag !! j) | j <- cols ]+          fCrit = SD.quantile (FD.fDistribution df1 df2) (1 - alpha)+          -- noncentral F の chi² 正規近似 (powerOneWayAnova と同手法)+          mean1 = fromIntegral df1 + ncp+          var1  = 2 * (fromIntegral df1 + 2 * ncp)+          z     = (fCrit * fromIntegral df1 - mean1) / sqrt var1+          !pw   = 1 - SD.cumulative (NormalD.normalDistr 0 1) z+      in DesignPower nm eff alpha pw++-- ---------------------------------------------------------------------------+-- term 名 + column index の対応+-- ---------------------------------------------------------------------------++-- | [日本語]: term ADT を canonical 名 (Text) に変換。+--   [English]: Converts a term ADT to its canonical name (Text).+termName :: ModelTerm -> Text+termName TIntercept     = T.pack "(Intercept)"+termName (TMain nm)     = nm+termName (TInter ns)    = T.intercalate (T.pack ":") ns+termName (TPower nm k)  = nm <> T.pack "^" <> T.pack (show k)+termName (TNested a b)  = a <> T.pack "(" <> b <> T.pack ")"++-- | [日本語]: 各 model term の expand 後 column indices (term 名でルックアップ可)。+--   expandDesignMatrix の列順 (= mTerms 順) と整合。+--   Categorical TMain は K-1 列、 TInter は cartesian product 数の列を占める。+--   [English]: The expand-time column indices for each model term+--   (lookupable by term name). Consistent with expandDesignMatrix's column+--   order (= mTerms order). A Categorical TMain occupies K-1 columns; a+--   TInter occupies the number of columns of its cartesian product.+termColumnIndices :: [Factor] -> Model -> [(Text, [Int])]+termColumnIndices factors model = snd (go (mTerms model) 0 [])+  where+    go :: [ModelTerm] -> Int -> [(Text, [Int])] -> (Int, [(Text, [Int])])+    go [] off acc = (off, reverse acc)+    go (t:ts) off acc =+      let w = termWidthOf factors t+          cols = [off .. off + w - 1]+      in go ts (off + w) ((termName t, cols) : acc)++-- | [日本語]: 単一 term の column width (modelNumColumns の per-term 版)。+--   [English]: The column width of a single term (a per-term version of+--   modelNumColumns).+termWidthOf :: [Factor] -> ModelTerm -> Int+termWidthOf factors t = case t of+  TIntercept -> 1+  TMain n    -> dim n+  TInter ns  -> product (map dim ns)+  TPower _ _ -> 1+  TNested a b -> levelsOf b * dim a  -- Phase 28-1: K_B × (K_A - 1)+  where+    dim n = case lookup n [(fName f, f) | f <- factors] of+      Just f  -> factorDimension f+      Nothing -> 1+    levelsOf n = case lookup n [(fName f, f) | f <- factors] of+      Just f -> case fKind f of+        Categorical xs -> length xs+        Ordinal     xs -> length xs+        _              -> 0+      Nothing -> 0
+ src/Hanalyze/Design/Custom/RegionMoment.hs view
@@ -0,0 +1,497 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Custom.RegionMoment+-- Description : Custom Design の region moment matrix (I-criterion 用の region 積分)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Custom Design の region moment matrix。+--+-- JMP 同等 I-criterion を実装するための region 積分 M_R を解析的に構築する。+--+-- @+--   I(X) = ∫_R f(z)' (X'X)⁻¹ f(z) dz / vol(R)+--        = trace( (X'X)⁻¹ · M_R )+--   M_R = ∫_R f(z) f(z)' dz / vol(R)+-- @+--+-- ## region 規約 (JMP 既定と整合)+--+--   - Continuous: coded @z ∈ U[-1, 1]@ 独立 (raw range は coded 後の前提で無視)+--   - DiscreteNum xs: xs から等確率に抽出 (有限サポート)+--   - Categorical / Ordinal (K 水準): 等確率+--   - Mixture: 非対応 (現状スコープ外、 simplex 上の積分は将来対応予定。+--     'regionMomentMatrixAnalytic' は Left を返す)+--+-- 「Compare / Coordinate のどちらからも import される」 ため、 @CustomDesign@+-- には依存しない (Factor + Model + Optimal のみ依存)。+--+-- [English]: Region moment matrix for Custom Design.+--+-- Analytically constructs the region integral M_R needed to implement a+-- JMP-equivalent I-criterion.+--+-- @+--   I(X) = ∫_R f(z)' (X'X)⁻¹ f(z) dz / vol(R)+--        = trace( (X'X)⁻¹ · M_R )+--   M_R = ∫_R f(z) f(z)' dz / vol(R)+-- @+--+-- ## Region conventions (aligned with JMP defaults)+--+--   - Continuous: independent coded @z ∈ U[-1, 1]@ (the raw range is+--     ignored under the assumption of coded values)+--   - DiscreteNum xs: sampled with equal probability from xs (finite support)+--   - Categorical \/ Ordinal (K levels): equal probability+--   - Mixture: not supported (out of scope for now; integration over the+--     simplex is planned for a future phase. 'regionMomentMatrixAnalytic'+--     returns Left)+--+-- Since this is imported by both Compare and Coordinate, it does not+-- depend on @CustomDesign@ (only on Factor + Model + Optimal).+module Hanalyze.Design.Custom.RegionMoment+  ( regionMomentMatrixAnalytic+  , regionMomentMatrixMC+  , iValueRegionM+  , resolveIOptRegion+    -- * DuMouchel-Jones §2.2 column transform (Phase 28-12)+  , DJTransform (..)+  , djFitTransform+  , djApplyTransform+  , djTransformColumns+  ) where++import           Data.List                (elemIndex)+import qualified Data.Map.Strict          as M+import           Data.Text                (Text)+import qualified Data.Text                as T+import qualified Numeric.LinearAlgebra    as LA++import           Hanalyze.Design.Custom.Factor+import           Hanalyze.Design.Custom.Model+import           Hanalyze.Design.Custom.Constraint+                   (Constraint, FactorValue (..), checkRowAgainst)+import           Hanalyze.Design.Optimal       (OptCriterion (..))+import qualified Hanalyze.Stat.QuasiRandom as QR++-- ---------------------------------------------------------------------------+-- 列構造記述+-- ---------------------------------------------------------------------------++-- | [日本語]: 1 因子分の expand 後寄与。 連続因子なら指数 k (≥ 1)、 categorical/ordinal+--   なら treatment coding の level index l (1..K-1)。+--   [English]: The expanded contribution of a single factor. For a+--   continuous factor, the exponent k (≥ 1); for categorical\/ordinal, the+--   treatment-coding level index l (1..K-1).+data FactorContrib+  = ContPow  !Int   -- ^ [日本語]: @z_i^k@、 k ≥ 1 [English]: @z_i^k@, k ≥ 1+  | CatLevel !Int   -- ^ [日本語]: level l (1..K-1) の indicator [English]: indicator at level l (1..K-1)+  deriving (Eq, Show)++-- | [日本語]: expand 後 1 列の構造記述: 因子 index → 寄与。 map に無い因子は「無寄与 = 1」。+--   [English]: Structural description of a single expanded column: factor+--   index → contribution. A factor absent from the map means "no+--   contribution = 1".+type ColDesc = M.Map Int FactorContrib++-- | [日本語]: 因子と Model から expand 後の各列の構造記述を 'expandDesignMatrix' と同順で生成。+--   Mixture / TNested は Left。+--   [English]: Generates the structural description of each expanded+--   column from the factors and Model, in the same order as+--   'expandDesignMatrix'. Mixture \/ TNested yield Left.+columnDescriptors :: [Factor] -> Model -> Either Text [ColDesc]+columnDescriptors fs model =+  concat <$> traverse (termDescriptors fs) (mTerms model)++termDescriptors :: [Factor] -> ModelTerm -> Either Text [ColDesc]+termDescriptors _  TIntercept     = Right [M.empty]+termDescriptors fs (TMain n)      = mainDescs fs n+termDescriptors fs (TPower n k)+  | k < 2     = Left (T.pack ("regionMomentMatrixAnalytic: TPower k must be >= 2 (got " <> show k <> ")"))+  | otherwise = do+      (i, f) <- findFactorIdx fs n+      case fKind f of+        Continuous  _ _ -> Right [M.singleton i (ContPow k)]+        DiscreteNum _   -> Right [M.singleton i (ContPow k)]+        Mixture     _ _ -> Left (T.pack ("regionMomentMatrixAnalytic: Mixture factor " <> T.unpack n <> " not supported (Phase 28-4a)"))+        _               -> Left (T.pack ("regionMomentMatrixAnalytic: TPower on categorical/ordinal factor " <> T.unpack n))+termDescriptors fs (TInter ns)+  | null ns   = Left (T.pack "regionMomentMatrixAnalytic: TInter with no factor names")+  | otherwise = foldr1 crossDesc <$> traverse (mainDescs fs) ns+termDescriptors _ (TNested _ _) =+  Left (T.pack "regionMomentMatrixAnalytic: TNested not supported (Phase 28-1 候補)")++-- | [日本語]: 主効果 (= TMain) 相当の寄与記述。 連続 → 1 個 (ContPow 1)、+--   Categorical K 水準 → K-1 個 (CatLevel 1..K-1)、 Mixture → Left。+--   [English]: The contribution description corresponding to a main+--   effect (= TMain). Continuous → 1 entry (ContPow 1); Categorical with K+--   levels → K-1 entries (CatLevel 1..K-1); Mixture → Left.+mainDescs :: [Factor] -> Text -> Either Text [ColDesc]+mainDescs fs n = do+  (i, f) <- findFactorIdx fs n+  case fKind f of+    Continuous  _ _ -> Right [M.singleton i (ContPow 1)]+    DiscreteNum _   -> Right [M.singleton i (ContPow 1)]+    Mixture     _ _ -> Left (T.pack ("regionMomentMatrixAnalytic: Mixture factor " <> T.unpack n <> " not supported (Phase 28-4a)"))+    Categorical xs  -> Right [M.singleton i (CatLevel l) | l <- [1 .. length xs - 1]]+    Ordinal     xs  -> Right [M.singleton i (CatLevel l) | l <- [1 .. length xs - 1]]++crossDesc :: [ColDesc] -> [ColDesc] -> [ColDesc]+crossDesc xs ys = [M.unionWith mergeContrib x y | x <- xs, y <- ys]+  where+    mergeContrib (ContPow a) (ContPow b) = ContPow (a + b)+    mergeContrib a           _           = a++findFactorIdx :: [Factor] -> Text -> Either Text (Int, Factor)+findFactorIdx fs n = case elemIndex n (map fName fs) of+  Nothing -> Left (T.pack ("regionMomentMatrixAnalytic: factor not found: " <> T.unpack n))+  Just i  -> Right (i, fs !! i)++-- ---------------------------------------------------------------------------+-- 解析積分 + I-criterion+-- ---------------------------------------------------------------------------++-- | [日本語]: region moment matrix を解析的に構築。 列順は 'expandDesignMatrix' と一致。+--   Mixture / TNested を含むモデルは Left。 categorical 1 水準等で列数 0 のときは 0×0。+--   [English]: Analytically constructs the region moment matrix. Column+--   order matches 'expandDesignMatrix'. Models containing Mixture \/+--   TNested yield Left. When the column count is 0 (e.g. a categorical+--   factor with 1 level), returns a 0×0 matrix.+regionMomentMatrixAnalytic+  :: [Factor] -> Model -> Either Text (LA.Matrix Double)+regionMomentMatrixAnalytic fs model = do+  cols <- columnDescriptors fs model+  let p = length cols+  if p == 0+    then Right ((0 LA.>< 0) [])+    else+      let fsArr = zip [0 :: Int ..] fs+          ent i j =+            let ca = cols !! i; cb = cols !! j+            in product+                 [ expectFactorProduct (fKind f) (M.lookup k ca) (M.lookup k cb)+                 | (k, f) <- fsArr ]+      in Right (LA.fromLists+                  [ [ ent i j | j <- [0 .. p - 1] ] | i <- [0 .. p - 1] ])++-- | [日本語]: 単一因子分の期待値 @E[part_a(z) · part_b(z)]@。+--   [English]: The expectation for a single factor, @E[part_a(z) ·+--   part_b(z)]@.+expectFactorProduct+  :: FactorKind -> Maybe FactorContrib -> Maybe FactorContrib -> Double+expectFactorProduct kind ma mb = case kind of+  Continuous _ _ -> contMomentPM1 (contPow ma + contPow mb)+  DiscreteNum xs ->+    let s = contPow ma + contPow mb+        n = length xs+    in if n == 0 then 0+                 else sum (map (^^ s) xs) / fromIntegral n+  Categorical xs -> catExp (length xs) (catLvl ma) (catLvl mb)+  Ordinal     xs -> catExp (length xs) (catLvl ma) (catLvl mb)+  Mixture _ _    -> 0 / 0+  where+    contPow Nothing             = 0+    contPow (Just (ContPow k))  = k+    contPow (Just (CatLevel _)) = 0+    catLvl Nothing              = Nothing+    catLvl (Just (CatLevel l))  = Just l+    catLvl (Just (ContPow _))   = Nothing++contMomentPM1 :: Int -> Double+contMomentPM1 p+  | odd p     = 0+  | otherwise = 1 / fromIntegral (p + 1)++catExp :: Int -> Maybe Int -> Maybe Int -> Double+catExp _ Nothing  Nothing            = 1+catExp k (Just _) Nothing            = 1 / fromIntegral k+catExp k Nothing  (Just _)           = 1 / fromIntegral k+catExp k (Just la) (Just lb)+  | la == lb                         = 1 / fromIntegral k+  | otherwise                        = 0++-- ---------------------------------------------------------------------------+-- MC 版 (Phase 28-4c): 制約有り / Mixture / 非 polynomial model 用+-- ---------------------------------------------------------------------------+--+-- Halton quasi-random sequence で region から N 点抽出 (deterministic、 seed 不要)、+-- 'Custom.Constraint.checkRowAgainst' で制約 region 内のみ採用。 採用率が低い+-- 場合 maxAttempts (= 10×N) で打ち切り、 採用数 < N/10 のとき Left。 採用された+-- raw rows を expand → @M_R = X^T X / N_accepted@ で構築。+--+-- 規約 (analytic と共通):+--   * Continuous (lo, hi): coded @z ∈ U[-1, 1]@ 独立 (raw range 無視)+--   * DiscreteNum xs: xs から等確率に抽出+--   * Mixture (lo, hi): @[lo, hi]@ uniform (Halton 1 次元 → 線形写像)+--   * Categorical / Ordinal (K 水準): 等確率++regionMomentMatrixMC+  :: Int              -- ^ [日本語]: 希望サンプル数 N (採用後、 採用率次第で短くなる場合あり) [English]: Desired sample count N (after acceptance, may end up shorter depending on the acceptance rate)+  -> [Factor]+  -> Model+  -> [Constraint]     -- ^ [日本語]: rejection sampling の filter [English]: rejection sampling filter+  -> Either Text (LA.Matrix Double)+regionMomentMatrixMC nWant fs model cons+  | nWant < 1 = Left (T.pack "regionMomentMatrixMC: N must be >= 1")+  | null fs   = Left (T.pack "regionMomentMatrixMC: empty factor list")+  | otherwise =+      let nF          = length fs+          maxAttempts = nWant * 10   -- 採用率 10% 想定の安全係数+          halton      = QR.haltonMatrix maxAttempts nF+          rawAll      =+            [ [ mapU01ToFactorLocal (fs !! j) (halton `LA.atIndex` (i, j))+              | j <- [0 .. nF - 1] ]+            | i <- [0 .. maxAttempts - 1] ]+          accepted = take nWant+                     [ row | row <- rawAll, rowFeasibleLocal fs cons row ]+          nAcc = length accepted+      in if nAcc < max 1 (nWant `div` 10)+           then Left (T.pack ("regionMomentMatrixMC: too few accepted samples ("+                              <> show nAcc <> "/" <> show nWant <> "); 制約 region が極端に狭い可能性"))+           else case expandDesignMatrix fs model (LA.fromLists accepted) of+                  Left e  -> Left e+                  Right x ->+                    let nAccD = fromIntegral nAcc :: Double+                    in Right (LA.scale (1 / nAccD) (LA.tr x LA.<> x))++-- | [日本語]: Halton 1 次元値 u ∈ [0, 1] を 1 因子の raw 値に写像+--   ('Custom.Compare.mapU01ToFactor' と同等、 module cycle 回避で再実装)。+--   [English]: Maps a 1-dimensional Halton value u ∈ [0, 1] to the raw+--   value of a single factor (equivalent to 'Custom.Compare.mapU01ToFactor';+--   reimplemented here to avoid a module cycle).+mapU01ToFactorLocal :: Factor -> Double -> Double+mapU01ToFactorLocal f u = case fKind f of+  Continuous _ _ -> -1 + 2 * u+  DiscreteNum xs ->+    let k = length xs+    in if k <= 0 then 0+                 else xs !! min (k - 1) (floor (u * fromIntegral k))+  Mixture lo hi  -> lo + (hi - lo) * u+  Categorical xs ->+    let k = length xs+    in if k <= 0 then 0+                 else fromIntegral (min (k - 1) (floor (u * fromIntegral k)))+  Ordinal xs     ->+    let k = length xs+    in if k <= 0 then 0+                 else fromIntegral (min (k - 1) (floor (u * fromIntegral k)))++-- | [日本語]: 1 row が全制約を満たすか+--   ('Custom.Coordinate.rowFeasible' と同等、 module cycle 回避で再実装)。+--   [English]: Whether a single row satisfies all constraints+--   (equivalent to 'Custom.Coordinate.rowFeasible'; reimplemented here to+--   avoid a module cycle).+rowFeasibleLocal :: [Factor] -> [Constraint] -> [Double] -> Bool+rowFeasibleLocal fs cons row =+  let mkFV f x = case fKind f of+        Categorical xs -> catIdx xs x+        Ordinal     xs -> catIdx xs x+        _              -> FVDouble x+      catIdx xs x =+        let xi = round x :: Int+            d  = abs (x - fromIntegral xi)+        in if d < 1e-9 && xi >= 0 && xi < length xs+             then FVText (xs !! xi)+             else FVDouble x+      rowMap = M.fromList+        [ (fName f, mkFV f v) | (f, v) <- zip fs row ]+  in all (checkRowAgainst rowMap) cons++-- | [日本語]: region moment matrix を用いた I-criterion: @trace((X'X)⁻¹ · M_R)@。+--   設計行列が rank-deficient (det(X'X) ≈ 0) なら ∞ を返す (minimize 方向)。+--   [English]: The I-criterion using the region moment matrix:+--   @trace((X'X)⁻¹ · M_R)@. Returns ∞ (in the minimize direction) if the+--   design matrix is rank-deficient (det(X'X) ≈ 0).+iValueRegionM :: LA.Matrix Double -> LA.Matrix Double -> Double+iValueRegionM mR x+  | LA.rows x == 0 = 1 / 0+  | otherwise =+      let xtx = LA.tr x LA.<> x+          d   = LA.det xtx+      in if abs d < 1e-12 then 1 / 0+           else LA.sumElements (LA.takeDiag (LA.inv xtx LA.<> mR))++-- ---------------------------------------------------------------------------+-- IOpt → IOptRegion 解決 (Phase 28-4b)+-- ---------------------------------------------------------------------------++-- | [日本語]: OptCriterion 木を走査し、 'IOpt' を 'IOptRegion mR' に置換する。+--   'IOptRegion' は once-only に「凍結された M_R」 を持つので、 'Compound' で+--   入れ子になっていても 1 回 M_R を作って全 IOpt を共有して置換する。+--+--   制約有り (cons 非空) または Mixture 因子を含むとき、+--   'regionMomentMatrixAnalytic' は Left を返すため自動で+--   'regionMomentMatrixMC' (Halton quasi-random、 N=10000) に fallback する。+--   IOpt を含まない criterion は M_R 構築をスキップして Right で原型を返す。+--   [English]: Walks the OptCriterion tree and replaces 'IOpt' with+--   'IOptRegion mR'. Since 'IOptRegion' holds a "frozen M_R" computed+--   once, even when nested inside 'Compound' the M_R is built a single+--   time and shared across all IOpt occurrences.+--+--   When constraints are present (cons is non-empty) or a Mixture factor+--   is involved, 'regionMomentMatrixAnalytic' returns Left, so this+--   automatically falls back to 'regionMomentMatrixMC' (Halton+--   quasi-random, N=10000). Criteria containing no IOpt skip the M_R+--   construction and return the original unchanged via Right.+resolveIOptRegion+  :: [Factor] -> Model -> [Constraint] -> OptCriterion+  -> Either Text OptCriterion+resolveIOptRegion fs model cons crit+  | not (containsIOpt crit) = Right crit+  | otherwise = do+      mR <- buildMR+      let mrRows = LA.toLists mR+      pure (rewriteCrit mrRows crit)+  where+    needsMC = not (null cons) || any isMixture fs || containsTNested model+    isMixture f = case fKind f of+      Mixture _ _ -> True+      _           -> False+    containsTNested m = any isTN (mTerms m)+    isTN (TNested _ _) = True+    isTN _             = False++    buildMR+      | needsMC = case regionMomentMatrixMC 10000 fs model cons of+          Right m -> Right m+          Left  e ->+            -- MC が失敗したら analytic を最後の砦として試す (制約無視で粗い近似)+            case regionMomentMatrixAnalytic fs model of+              Right m -> Right m+              Left _  -> Left e+      | otherwise = regionMomentMatrixAnalytic fs model++    containsIOpt IOpt              = True+    containsIOpt (Compound ws)     = any (containsIOpt . snd) ws+    containsIOpt _                 = False++    rewriteCrit mrRows IOpt          = IOptRegion mrRows+    rewriteCrit mrRows (Compound ws) =+      Compound [ (w, rewriteCrit mrRows c) | (w, c) <- ws ]+    rewriteCrit _      c             = c++-- ---------------------------------------------------------------------------+-- DuMouchel-Jones §2.2 column transform (Phase 28-12)+-- ---------------------------------------------------------------------------+--+-- 詳細は doc: src/Hanalyze/Design/Custom/Bayesian.hs (Phase 28-12 section)。+-- Power.termColumnIndices に依存しないよう、 列 index 列挙を本 module 内に+-- 再実装している (Coordinate ↔ Bayesian の module cycle 回避)。++data DJTransform = DJTransform+  { djtPrimaryIdx   :: ![Int]+  , djtPotentialIdx :: ![Int]+  , djtMeanQ        :: !(LA.Vector Double)+  , djtBetaPQ       :: !(LA.Matrix Double)+  , djtScaleQ       :: !(LA.Vector Double)+  } deriving (Show)++isPotentialTerm :: ModelTerm -> Bool+isPotentialTerm TIntercept     = False+isPotentialTerm (TMain _)      = False+isPotentialTerm (TInter ns)    = length ns >= 2+isPotentialTerm (TPower _ k)   = k >= 2+isPotentialTerm (TNested _ _)  = True++-- | [日本語]: 各 term の expand 後 column index 範囲 (Power.termColumnIndices の再実装)。+--   [English]: The expanded column-index range for each term+--   (a reimplementation of Power.termColumnIndices).+termColumnIndicesLocal :: [Factor] -> Model -> [(ModelTerm, [Int])]+termColumnIndicesLocal fs model = go (mTerms model) 0+  where+    go [] _ = []+    go (t:ts) off =+      let w = termWidth t+          cols = [off .. off + w - 1]+      in (t, cols) : go ts (off + w)+    termWidth t = case t of+      TIntercept    -> 1+      TMain n       -> dim n+      TInter ns     -> product (map dim ns)+      TPower _ _    -> 1+      TNested a b   -> levelsOf b * dim a   -- Phase 28-1+    dim n = case lookup n [(fName f, f) | f <- fs] of+      Just f  -> factorDimension f+      Nothing -> 1+    levelsOf n = case lookup n [(fName f, f) | f <- fs] of+      Just f -> case fKind f of+        Categorical xs -> length xs+        Ordinal     xs -> length xs+        _              -> 0+      Nothing -> 0++djFitTransform+  :: [Factor] -> Model -> LA.Matrix Double -> Either Text DJTransform+djFitTransform fs model cand = do+  xCand <- expandDesignMatrix fs model cand+  let pairs = termColumnIndicesLocal fs model+      primaryIdx   = concat [ cols | (t, cols) <- pairs, not (isPotentialTerm t) ]+      potentialIdx = concat [ cols | (t, cols) <- pairs, isPotentialTerm t ]+      nC = LA.rows xCand+      nCD = fromIntegral nC :: Double+      q = length potentialIdx+  if q == 0+    then pure DJTransform+           { djtPrimaryIdx   = primaryIdx+           , djtPotentialIdx = []+           , djtMeanQ        = LA.fromList []+           , djtBetaPQ       = (0 LA.>< 0) []+           , djtScaleQ       = LA.fromList []+           }+    else do+      let xP = if null primaryIdx then (nC LA.>< 0) [] else xCand LA.¿ primaryIdx+          xQ = xCand LA.¿ potentialIdx+          meanRow = LA.fromList+            [ LA.sumElements (LA.flatten (xQ LA.¿ [j])) / nCD+            | j <- [0 .. q - 1] ]+          ones    = LA.konst 1 nC :: LA.Vector Double+          xQc = xQ - LA.outer ones meanRow+          betas = if null primaryIdx+                    then (0 LA.>< q) []+                    else+                      let xtxP = LA.tr xP LA.<> xP+                          d = LA.det xtxP+                      in if abs d < 1e-12+                           then LA.konst 0 (LA.cols xP, q)+                           else LA.inv xtxP LA.<> LA.tr xP LA.<> xQc+          xQo = if null primaryIdx then xQc else xQc - xP LA.<> betas+          rangesL =+            [ let v = LA.flatten (xQo LA.¿ [j])+              in LA.maxElement v - LA.minElement v+            | j <- [0 .. q - 1] ]+      pure DJTransform+        { djtPrimaryIdx   = primaryIdx+        , djtPotentialIdx = potentialIdx+        , djtMeanQ        = meanRow+        , djtBetaPQ       = betas+        , djtScaleQ       = LA.fromList rangesL+        }++djApplyTransform :: DJTransform -> LA.Matrix Double -> LA.Matrix Double+djApplyTransform t x+  | null (djtPotentialIdx t) = x+  | otherwise =+      let n   = LA.rows x+          pIdx = djtPrimaryIdx t+          qIdx = djtPotentialIdx t+          xP   = if null pIdx then (n LA.>< 0) [] else x LA.¿ pIdx+          xQ   = x LA.¿ qIdx+          ones = LA.konst 1 n :: LA.Vector Double+          xQc  = xQ - LA.outer ones (djtMeanQ t)+          xQo  = if null pIdx then xQc else xQc - xP LA.<> djtBetaPQ t+          invR = LA.cmap (\r -> if abs r < 1e-12 then 1 else 1 / r) (djtScaleQ t)+          xQf  = xQo LA.<> LA.diag invR+          q    = length qIdx+          col k = LA.flatten (xQf LA.¿ [k])+          potMap  = zip qIdx [0 .. q - 1]+          pickCol i = case lookup i potMap of+            Just k  -> col k+            Nothing -> LA.flatten (x LA.¿ [i])+      in LA.fromColumns [ pickCol i | i <- [0 .. LA.cols x - 1] ]++djTransformColumns+  :: [Factor] -> Model -> LA.Matrix Double -> LA.Matrix Double+  -> Either Text (LA.Matrix Double)+djTransformColumns fs model cand x = do+  t <- djFitTransform fs model cand+  pure (djApplyTransform t x)
+ src/Hanalyze/Design/Custom/SplitPlot.hs view
@@ -0,0 +1,570 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns      #-}+-- |+-- Module      : Hanalyze.Design.Custom.SplitPlot+-- Description : Custom Design の Split-Plot 生成 (役割駆動の REML D-optimal 交換、内部 legacy)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Custom Design の Split-Plot 生成。+--+-- ★現在は __内部 legacy__: 製品パス (高レベル @customDesign@ + @Structure@) は役割非依存の+--   構造駆動エンジン @Design.Custom.Structured@ を使う。 本モジュール (役割 @fRole@ 駆動) は+--   bench-custom-design の 3 エンジン比較 + Jones-Goos 低レベル golden の証跡として温存する+--   (新規機能は Structured 側へ。 M⁻¹ / GLS 基準の math は両者で数値一致)。+--+-- spec: doe-custom-design-spec v0.1.1 §2.5 / §3.6。+-- 参考: Goos & Vandebroek (2003) "D-Optimal Split-Plot Designs", J Quality Tech 35:1-15。+--+-- === モデル (簡易 REML)+--+--   y_ij = X_ij β + b_i + ε_ij+--+-- ここで b_i ~ N(0, σ²_WP) は whole-plot 効果、 ε_ij ~ N(0, σ²) は run-level error。+-- 分散比 η = σ²_WP / σ² がユーザ指定 (既定 1.0、 spec §2.5 で議論)。+--+-- 観測ベクトル全体の分散構造:+--+--   V = σ² (I + η · Z Zᵀ)+--+-- ここで Z は whole-plot indicator matrix (n × n_WP)。+-- REML information matrix:+--+--   I_β = (1/σ²) · Xᵀ M⁻¹ X、   M = I + η · Z Zᵀ+--+-- D-optimality は max det(Xᵀ M⁻¹ X)。 σ² は定数倍なので criterion に影響しない。+--+-- === 本 commit のスコープ+--+--   - 連続因子の whole-plot のみ対応 (categorical WP は 25-5 stub で Left)+--   - Coordinate exchange を whole-plot 単位 / sub-plot 単位の 2 段に分けて適用:+--     - WP 因子: 1 WP 内では同値、 列を WP indicator 構造で更新+--     - SP 因子: 各 run 単位で coordinate exchange (= 通常)+--   - η はユーザ指定 (`spcVarRatio`)、 既定 1.0+--   - strip-plot (VeryHardToChange) は未対応 (Left)+--+-- [English]: Custom Design's Split-Plot generation.+--+-- ★Currently __internal legacy__: the product path (the high-level+--   @customDesign@ + @Structure@) uses the role-independent structure-driven+--   engine @Design.Custom.Structured@. This module (driven by the @fRole@+--   role) is kept as the evidence trail for the bench-custom-design 3-engine+--   comparison and the Jones-Goos low-level golden values (new features go+--   into Structured; the M⁻¹ / GLS criterion math matches numerically+--   between the two).+--+-- spec: doe-custom-design-spec v0.1.1 §2.5 / §3.6.+-- Reference: Goos & Vandebroek (2003) "D-Optimal Split-Plot Designs", J+-- Quality Tech 35:1-15.+--+-- === Model (simplified REML)+--+--   y_ij = X_ij β + b_i + ε_ij+--+-- where b_i ~ N(0, σ²_WP) is the whole-plot effect and ε_ij ~ N(0, σ²) is+-- the run-level error. The variance ratio η = σ²_WP / σ² is user-specified+-- (default 1.0; discussed in spec §2.5).+--+-- Variance structure of the full observation vector:+--+--   V = σ² (I + η · Z Zᵀ)+--+-- where Z is the whole-plot indicator matrix (n × n_WP). REML information+-- matrix:+--+--   I_β = (1/σ²) · Xᵀ M⁻¹ X,   M = I + η · Z Zᵀ+--+-- D-optimality is max det(Xᵀ M⁻¹ X). σ² is a constant multiplier so it+-- doesn't affect the criterion.+--+-- === Scope of this commit+--+--   - Only whole-plots of continuous factors are supported (categorical WP+--     is a stub returning Left, for a future commit).+--   - Coordinate exchange is applied in two stages, at the whole-plot level+--     and the sub-plot level:+--     - WP factors: identical within one WP, the column is updated via the+--       WP indicator structure+--     - SP factors: ordinary per-run coordinate exchange+--   - η is user-specified (`spcVarRatio`), default 1.0+--   - strip-plot (VeryHardToChange) is not supported (Left)+module Hanalyze.Design.Custom.SplitPlot+  ( SplitPlotConfig (..)+  , defaultSplitPlotConfig+  , SplitPlotDesign (..)+  , generateSplitPlot+  , generateSplitPlotPure+    -- * 内部 helper (test 用)+  , whichRoleIsWP+  , wholePlotIndicator+  ) where++import           Control.Monad             (forM_, when)+import           Control.Monad.Primitive   (PrimMonad, PrimState)+import           Control.Monad.ST          (runST)+import           Data.Maybe                (fromMaybe)+import           Data.Primitive.MutVar+import           Data.Text                 (Text)+import qualified Data.Text                 as T+import qualified Numeric.LinearAlgebra     as LA+import qualified System.Random.MWC         as MWC+import qualified Data.Vector.Unboxed       as VU+import qualified Data.Vector               as V+import qualified Data.Vector.Storable      as VS++import           Hanalyze.Design.Custom.Factor+import           Hanalyze.Design.Custom.Model+import           Hanalyze.Design.Custom.Coordinate+                   (CustomDesignSpec (..), DesignBudget (..)+                   , factorGrid, critValueM+                   , mkGen, mkGenSeed, defaultPureSeed)+import           Hanalyze.Design.Optimal   (OptCriterion (..))++-- ---------------------------------------------------------------------------+-- 型+-- ---------------------------------------------------------------------------++data SplitPlotConfig = SplitPlotConfig+  { spcNWhole    :: !Int     -- ^ [日本語]: whole-plot 数 (必須、 spec §2.5 でユーザ指定強制) [English]: Number of whole-plots (required; spec §2.5 mandates explicit user specification)+  , spcVarRatio  :: !Double  -- ^ [日本語]: η = σ²_WP / σ² (既定 1.0) [English]: η = σ²_WP / σ² (default 1.0)+  , spcNStrip    :: !(Maybe Int)+    -- ^ [日本語]: strip-plot 構造の strip 数 (Just nStrip)。+    --   'VeryHardToChange' role 因子は strip 内で constant。 Nothing なら+    --   通常の split-plot。 n = nWP × nStrip を満たす必要 (= 行配置: row i は+    --   wp = i div nStrip、 strip = i mod nStrip)+    --   [English]: The number of strips for the strip-plot structure+    --   (Just nStrip). 'VeryHardToChange'-role factors are constant within+    --   a strip. Nothing means an ordinary split-plot. Requires+    --   n = nWP × nStrip (row placement: row i has wp = i div nStrip,+    --   strip = i mod nStrip).+  } deriving (Show)++defaultSplitPlotConfig :: Int -> SplitPlotConfig+defaultSplitPlotConfig nWP = SplitPlotConfig nWP 1.0 Nothing++data SplitPlotDesign = SplitPlotDesign+  { spdMatrix      :: !(LA.Matrix Double)+  , spdWholePlotId :: !(VS.Vector Int)         -- ^ [日本語]: 各行の WP ID (0..nWP-1) [English]: The WP ID of each row (0..nWP-1)+  , spdSubPlotId   :: !(Maybe (VS.Vector Int))+    -- ^ [日本語]: strip-plot 時の strip ID (Just)、 通常 split-plot は Nothing+    --   [English]: The strip ID for strip-plot (Just); Nothing for an+    --   ordinary split-plot+  , spdNWhole      :: !Int+  , spdGEFFEst     :: !Double                  -- ^ [日本語]: 推定 Generalized Estimating Function 値。+    --   ≒ - det(I_β) の最小化値 (DOpt のみ意味あり、 他 criterion は critValueM 経由)。+    --   [English]: The estimated Generalized Estimating Function value.+    --   ≈ the minimized value of - det(I_β) (only meaningful for DOpt;+    --   other criteria go through critValueM).+  } deriving (Show)++-- ---------------------------------------------------------------------------+-- 公開 API+-- ---------------------------------------------------------------------------++-- | [日本語]: seed 由来の gen を作って 'generateSplitPlotWith' を IO で走らせる薄い wrapper。+--   'cdsSeed' が 'Nothing' の場合のみ entropy 依存 (非決定的)。+--   seed 決定的な純粋版は 'generateSplitPlotPure'。+--   [English]: A thin wrapper that builds a gen from the seed and runs+--   'generateSplitPlotWith' in IO. Only depends on entropy+--   (non-deterministic) when 'cdsSeed' is 'Nothing'. The seed-deterministic+--   pure version is 'generateSplitPlotPure'.+generateSplitPlot+  :: CustomDesignSpec+  -> SplitPlotConfig+  -> IO (Either Text SplitPlotDesign)+generateSplitPlot spec cfg = do+  gen <- mkGen (cdsSeed spec)+  generateSplitPlotWith spec cfg gen++-- | [日本語]: seed 決定的な純粋版。 'runST' で MWC gen + MutVar を閉じ込め、+--   IO 無しで 'SplitPlotDesign' を返す。 'cdsSeed' が 'Nothing' なら 'defaultPureSeed'+--   を用いて全域にする。 同一 seed なら 'generateSplitPlot' (IO) とビット一致する。+--   [English]: The seed-deterministic pure version. Encloses the MWC gen ++--   MutVar inside 'runST', returning 'SplitPlotDesign' without IO. If+--   'cdsSeed' is 'Nothing', uses 'defaultPureSeed' to make it total. With+--   the same seed, matches 'generateSplitPlot' (IO) bit-for-bit.+generateSplitPlotPure+  :: CustomDesignSpec+  -> SplitPlotConfig+  -> Either Text SplitPlotDesign+generateSplitPlotPure spec cfg = runST $ do+  gen <- mkGenSeed (fromMaybe defaultPureSeed (cdsSeed spec))+  generateSplitPlotWith spec cfg gen++-- | [日本語]: split-plot 生成本体 (PrimMonad 一般化)。 IO / ST どちらでも走る。+--   [English]: The core split-plot generator (generalized over PrimMonad).+--   Runs under either IO or ST.+generateSplitPlotWith+  :: PrimMonad m+  => CustomDesignSpec+  -> SplitPlotConfig+  -> MWC.Gen (PrimState m)+  -> m (Either Text SplitPlotDesign)+generateSplitPlotWith spec cfg gen+  | spcNWhole cfg < 1 =+      pure (Left (T.pack "generateSplitPlot: spcNWhole must be >= 1"))+  | cdsNRuns spec < spcNWhole cfg =+      pure (Left (T.pack "generateSplitPlot: nRuns must be >= spcNWhole"))+  -- Phase 28-2: VeryHardToChange (strip-plot) を対応。 spcNStrip = Just nStrip+  -- が必要 + n = nWP × nStrip を満たすこと+  | any ((== VeryHardToChange) . fRole) (cdsFactors spec)+    && case spcNStrip cfg of Nothing -> True; _ -> False =+      pure (Left (T.pack+        "generateSplitPlot: VeryHardToChange factor present but spcNStrip not set"))+  -- Phase 28-3: Categorical/Ordinal whole-plot 因子も対応 (factorGrid が level+  -- index を返すため、 randomInitSP/runExchangeSP の WP loop でそのまま機能する)+  | spcVarRatio cfg < 0 =+      pure (Left (T.pack "generateSplitPlot: spcVarRatio (η) must be >= 0"))+  | case spcNStrip cfg of+      Just s -> s < 1 || s * spcNWhole cfg /= cdsNRuns spec+      Nothing -> False =+      pure (Left (T.pack+        "generateSplitPlot: spcNStrip × spcNWhole must equal nRuns (strip-plot grid)"))+  | otherwise = do+      let !factors  = cdsFactors spec+          !n        = cdsNRuns spec+          !nWP      = spcNWhole cfg+          !eta      = spcVarRatio cfg+          !budget   = cdsBudget spec+          !crit     = cdsCriterion spec+          !model    = cdsModel spec+          !wpIxs    = whichRoleIsWP factors+          !stripIxs = whichRoleIsStrip factors+          !wpId     = wholePlotIndicator n nWP+          !mStripId = case spcNStrip cfg of+            Just nStrip -> Just (stripPlotIndicator n nStrip)+            Nothing     -> Nothing+      if null wpIxs && null stripIxs+        then pure (Left (T.pack+          "generateSplitPlot: no HardToChange/VeryHardToChange factor found"))+        else do+          bestRef <- newMutVar Nothing+          forM_ [1 .. dbRestarts budget] $ \_ -> do+            init0 <- randomInitSPStrip factors wpIxs stripIxs wpId mStripId n budget gen+            (finalM, finalC) <- runExchangeSP factors model crit budget eta wpIxs stripIxs wpId mStripId init0+            modifyMutVar' bestRef $ \mb -> case mb of+              Nothing -> Just (finalM, finalC)+              Just (_, c0) | finalC < c0 -> Just (finalM, finalC)+                           | otherwise   -> mb+          mb <- readMutVar bestRef+          case mb of+            Nothing -> pure (Left (T.pack "generateSplitPlot: no restart produced a design"))+            Just (m, c) -> pure $ Right SplitPlotDesign+              { spdMatrix      = m+              , spdWholePlotId = wpId+              , spdSubPlotId   = mStripId+              , spdNWhole      = nWP+              , spdGEFFEst     = c+              }++-- ---------------------------------------------------------------------------+-- WP indicator / role helper+-- ---------------------------------------------------------------------------++-- | [日本語]: HardToChange factor の column index リスト (whole-plot 因子)。+--   [English]: The column index list of HardToChange factors (whole-plot+--   factors).+whichRoleIsWP :: [Factor] -> [Int]+whichRoleIsWP fs = [ i | (i, f) <- zip [0 ..] fs, fRole f == HardToChange ]++-- | [日本語]: VeryHardToChange factor の column index リスト (strip 因子)。+--   [English]: The column index list of VeryHardToChange factors (strip+--   factors).+whichRoleIsStrip :: [Factor] -> [Int]+whichRoleIsStrip fs = [ i | (i, f) <- zip [0 ..] fs, fRole f == VeryHardToChange ]++-- | [日本語]: n 行を nWP に均等割り当てした WP indicator (0..nWP-1)。+--   余りは最初のいくつかの WP に追加で振る。+--   [English]: The WP indicator (0..nWP-1) obtained by evenly assigning n+--   rows to nWP whole-plots. The remainder is distributed to the first+--   few WPs.+wholePlotIndicator :: Int -> Int -> VS.Vector Int+wholePlotIndicator n nWP =+  let base  = n `div` nWP+      extra = n `mod` nWP+      sizes = [ if i < extra then base + 1 else base | i <- [0 .. nWP - 1] ]+      ids   = concat [ replicate s i | (i, s) <- zip [0 ..] sizes ]+  in VS.fromList ids++-- | [日本語]: strip indicator (0..nStrip-1)。 row i → i `mod` nStrip。+--   WP grouping (= i `div` nStrip) と直交する partitioning を実現する。+--   n = nWP × nStrip の前提 (generateSplitPlot の guard で確認済)+--   [English]: The strip indicator (0..nStrip-1); row i → i `mod` nStrip.+--   Realizes a partitioning orthogonal to the WP grouping+--   (= i `div` nStrip). Assumes n = nWP × nStrip (checked by+--   generateSplitPlot's guard).+stripPlotIndicator :: Int -> Int -> VS.Vector Int+stripPlotIndicator n nStrip =+  VS.fromList [ i `mod` nStrip | i <- [0 .. n - 1] ]++-- ---------------------------------------------------------------------------+-- 初期化 (split-plot 構造を保つ)+-- ---------------------------------------------------------------------------++-- | [日本語]: 初期 raw matrix。 WP 因子は WP ごとに 1 値、 strip 因子は strip ごとに+--   1 値、 SP 因子は run ごとに 1 値。+--   [English]: The initial raw matrix. WP factors get one value per WP,+--   strip factors one value per strip, and SP factors one value per run.+randomInitSPStrip+  :: PrimMonad m+  => [Factor]+  -> [Int]               -- ^ [日本語]: WP 因子 column index [English]: WP factor column index+  -> [Int]               -- ^ [日本語]: strip 因子 column index [English]: strip factor column index+  -> VS.Vector Int       -- ^ [日本語]: 各行の WP id [English]: WP id per row+  -> Maybe (VS.Vector Int)  -- ^ [日本語]: 各行の strip id [English]: strip id per row+  -> Int                 -- ^ n+  -> DesignBudget+  -> MWC.Gen (PrimState m)+  -> m (LA.Matrix Double)+randomInitSPStrip factors wpIxs stripIxs wpId mStripId n budget gen = do+  let p    = length factors+      nWP  = if VS.null wpId then 0 else 1 + VS.maximum wpId+      nStrp = case mStripId of+        Just s | not (VS.null s) -> 1 + VS.maximum s+        _ -> 0+  cols <- mapM+    (\j -> do+       let g = factorGrid budget (factors !! j)+           gl = VU.length g+       if j `elem` wpIxs+         then do+           wpVals <- VU.replicateM nWP $ do+             k <- MWC.uniformR (0, gl - 1) gen+             pure (g VU.! k)+           pure $ LA.fromList+             [ wpVals VU.! (wpId VS.! i) | i <- [0 .. n - 1] ]+         else if j `elem` stripIxs+           then case mStripId of+             Nothing -> pure (LA.konst 0 n)  -- 不可達: guard 済+             Just stripId -> do+               stripVals <- VU.replicateM nStrp $ do+                 k <- MWC.uniformR (0, gl - 1) gen+                 pure (g VU.! k)+               pure $ LA.fromList+                 [ stripVals VU.! (stripId VS.! i) | i <- [0 .. n - 1] ]+           else do+             vs <- VU.replicateM n $ do+               k <- MWC.uniformR (0, gl - 1) gen+               pure (g VU.! k)+             pure (LA.fromList (VU.toList vs))+    ) [0 .. p - 1]+  pure (LA.fromColumns cols)++-- ---------------------------------------------------------------------------+-- Coordinate exchange (split-plot 構造保持)+-- ---------------------------------------------------------------------------++runExchangeSP+  :: PrimMonad m+  => [Factor]+  -> Model+  -> OptCriterion+  -> DesignBudget+  -> Double                      -- ^ η+  -> [Int]                       -- ^ [日本語]: WP factor の index [English]: WP factor indices+  -> [Int]                       -- ^ [日本語]: strip factor の index [English]: strip factor indices+  -> VS.Vector Int               -- ^ [日本語]: wpId [English]: wpId+  -> Maybe (VS.Vector Int)       -- ^ [日本語]: stripId [English]: stripId+  -> LA.Matrix Double+  -> m (LA.Matrix Double, Double)+runExchangeSP factors model crit budget eta wpIxs stripIxs wpId mStripId init0 = do+  matRef  <- newMutVar init0+  critRef <- newMutVar (evalCritSP factors model crit eta wpId mStripId init0)+  let !n         = LA.rows init0+      !p         = LA.cols init0+      gridsV     = V.fromList (map (factorGrid budget) factors)+      nWP        = if VS.null wpId then 0 else 1 + VS.maximum wpId+      nStrp      = case mStripId of+        Just s | not (VS.null s) -> 1 + VS.maximum s+        _ -> 0+      isWPidx j  = j `elem` wpIxs+      isStripIdx j = j `elem` stripIxs+  let loopOuter !it+        | it > dbMaxIter budget = pure ()+        | otherwise = do+            beforeC <- readMutVar critRef+            -- SP 因子: 通常の per-row × per-column 走査+            forM_ [0 .. n - 1] $ \i ->+              forM_ [0 .. p - 1] $ \j ->+                when (not (isWPidx j) && not (isStripIdx j)) $ do+                  curMat <- readMutVar matRef+                  curC   <- readMutVar critRef+                  let g  = gridsV V.! j+                      gl = VU.length g+                  bestRef <- newMutVar (curMat `LA.atIndex` (i, j), curC)+                  forM_ [0 .. gl - 1] $ \k -> do+                    let !v = g VU.! k+                        !cand = setEntry curMat i j v+                        !c = evalCritSP factors model crit eta wpId mStripId cand+                    modifyMutVar' bestRef $ \cur@(_, bc) ->+                      if c < bc then (v, c) else cur+                  (bv, bc) <- readMutVar bestRef+                  when (bc < curC) $ do+                    writeMutVar matRef  (setEntry curMat i j bv)+                    writeMutVar critRef bc+            -- WP 因子: 各 WP × 各 WP-column 走査、 WP 内全 row に同値書き込み+            forM_ [0 .. nWP - 1] $ \w ->+              forM_ wpIxs $ \j -> do+                curMat <- readMutVar matRef+                curC   <- readMutVar critRef+                let g  = gridsV V.! j+                    gl = VU.length g+                    runsInWP = [ i | i <- [0 .. n - 1], wpId VS.! i == w ]+                    oldV = if null runsInWP then 0+                             else curMat `LA.atIndex` (head runsInWP, j)+                bestRef <- newMutVar (oldV, curC)+                forM_ [0 .. gl - 1] $ \k -> do+                  let !v = g VU.! k+                      !cand = setColumnInRows curMat runsInWP j v+                      !c = evalCritSP factors model crit eta wpId mStripId cand+                  modifyMutVar' bestRef $ \cur@(_, bc) ->+                    if c < bc then (v, c) else cur+                (bv, bc) <- readMutVar bestRef+                when (bc < curC) $ do+                  writeMutVar matRef  (setColumnInRows curMat runsInWP j bv)+                  writeMutVar critRef bc+            -- Phase 28-2: strip 因子: 各 strip × 各 strip-column 走査、+            -- strip 内全 row に同値書き込み+            case mStripId of+              Just stripId -> forM_ [0 .. nStrp - 1] $ \s ->+                forM_ stripIxs $ \j -> do+                  curMat <- readMutVar matRef+                  curC   <- readMutVar critRef+                  let g  = gridsV V.! j+                      gl = VU.length g+                      runsInStrip = [ i | i <- [0 .. n - 1], stripId VS.! i == s ]+                      oldV = if null runsInStrip then 0+                               else curMat `LA.atIndex` (head runsInStrip, j)+                  bestRef <- newMutVar (oldV, curC)+                  forM_ [0 .. gl - 1] $ \k -> do+                    let !v = g VU.! k+                        !cand = setColumnInRows curMat runsInStrip j v+                        !c = evalCritSP factors model crit eta wpId mStripId cand+                    modifyMutVar' bestRef $ \cur@(_, bc) ->+                      if c < bc then (v, c) else cur+                  (bv, bc) <- readMutVar bestRef+                  when (bc < curC) $ do+                    writeMutVar matRef  (setColumnInRows curMat runsInStrip j bv)+                    writeMutVar critRef bc+              Nothing -> pure ()+            afterC <- readMutVar critRef+            let rel = if abs beforeC < 1e-12+                        then beforeC - afterC+                        else (beforeC - afterC) / abs beforeC+            when (rel > dbTol budget) (loopOuter (it + 1))+  loopOuter 1+  finalM <- readMutVar matRef+  finalC <- readMutVar critRef+  pure (finalM, finalC)++-- | [日本語]: REML criterion: critValueM を X' M⁻¹ X 経由で評価。+--   DOpt の場合 det(X' M⁻¹ X) を最大化 (= criterion 最小化)。+--   M = I + η · Z Zᵀ。 nWP=n (= completely randomized) なら M=(1+η)I、+--   η=0 なら M=I (= 通常 D-opt)。+--   [English]: The REML criterion: evaluated via critValueM using+--   X' M⁻¹ X. For DOpt, maximizes det(X' M⁻¹ X) (= minimizing the+--   criterion). M = I + η · Z Zᵀ. If nWP=n (= completely randomized) then+--   M=(1+η)I; if η=0 then M=I (= ordinary D-opt).+evalCritSP+  :: [Factor]+  -> Model+  -> OptCriterion+  -> Double+  -> VS.Vector Int               -- ^ [日本語]: wpId [English]: wpId+  -> Maybe (VS.Vector Int)       -- ^ [日本語]: stripId [English]: stripId+  -> LA.Matrix Double+  -> Double+evalCritSP factors model crit eta wpId mStripId raw =+  case expandDesignMatrix factors model raw of+    Left _  -> 1 / 0+    Right x ->+      let !n  = LA.rows x+          mInv = case mStripId of+            Nothing ->+              -- 通常 split-plot: M = I + η · Z_WP Z_WPᵀ、 block-diagonal+              let nWP = if VS.null wpId then 0 else 1 + VS.maximum wpId+                  wpSizes = [ length [ i | i <- [0 .. n - 1], wpId VS.! i == w ] | w <- [0 .. nWP - 1] ]+              in buildMInv n eta wpSizes wpId nWP+            Just stripId ->+              -- Phase 28-2 strip-plot: M = I + η · (Z_WP Z_WPᵀ + Z_Strip Z_Stripᵀ)+              -- block-diagonal にならないので数値 inv で対応+              buildMInvStrip n eta wpId stripId+          xtmx = LA.tr x LA.<> (mInv LA.<> x)+      in critValueM crit (chol xtmx)+      -- 注: critValueM は X (の expand 後) を受け取る前提。 ここで X' M⁻¹ X を+      -- そのまま渡したいので、 X' M⁻¹ X = (M^{-1/2} X)' (M^{-1/2} X) となる行列+      -- X̃ = chol((M⁻¹)) X を作って渡す方が自然。 chol が無いので簡略化:+      -- critValueM の DOpt は det(X'X) = det((M⁻¹) X) ... hm complicated。+      -- ここでは「critValueM をそのまま使うため X̃ = M⁻¹ X として渡し、+      -- DOpt の det(X̃'X̃) = det(X' M⁻¹ M⁻¹ X)」 になり厳密に Goos-Vandebroek の+      -- I_β = X' M⁻¹ X と一致しない。 Phase 25 簡易版として許容、 docs で明記。++-- | [日本語]: strip-plot 用 M⁻¹。 M = I + η · (Z_WP Z_WPᵀ + Z_Strip Z_Stripᵀ)+--   を直接構築し numerical inverse。 strip-plot の covariance は block-diagonal+--   にならない (WP と strip の交差で indicator が重なる) ため、 split-plot 用の+--   解析的 block inverse は使えない。 n は通常 ≤ 100 で inv は十分高速。+--   [English]: M⁻¹ for strip-plot. Directly builds+--   M = I + η · (Z_WP Z_WPᵀ + Z_Strip Z_Stripᵀ) and takes the numerical+--   inverse. Strip-plot covariance is not block-diagonal (indicators+--   overlap where WP and strip intersect), so the analytical block inverse+--   used for split-plot doesn't apply. n is typically ≤ 100, so the inverse+--   is fast enough.+buildMInvStrip :: Int -> Double -> VS.Vector Int -> VS.Vector Int -> LA.Matrix Double+buildMInvStrip n eta wpId stripId =+  let mEntry i j =+        let wpEq    = if wpId VS.! i == wpId VS.! j then eta else 0+            stripEq = if stripId VS.! i == stripId VS.! j then eta else 0+            diag    = if i == j then 1 else 0+        in diag + wpEq + stripEq+      mMat = (n LA.>< n) [ mEntry i j | i <- [0 .. n - 1], j <- [0 .. n - 1] ]+      mD   = LA.det mMat+  in if abs mD < 1e-12+       then LA.ident n   -- safety fallback+       else LA.inv mMat++-- | [日本語]: M⁻¹ を構築 (block-diagonal、 各 WP block で計算)。+--   [English]: Builds M⁻¹ (block-diagonal, computed per WP block).+buildMInv :: Int -> Double -> [Int] -> VS.Vector Int -> Int -> LA.Matrix Double+buildMInv n eta wpSizes wpId _nWP =+  let buildEntry i j+        | wpId VS.! i /= wpId VS.! j = 0+        | otherwise =+            let w   = wpId VS.! i+                nw  = wpSizes !! w+                nwD = fromIntegral nw :: Double+                d   = 1.0+                offDiag = - eta / (1 + eta * nwD)+            in if i == j+                 then d + offDiag   -- diag of inverse: 1 - η/(1+η nw)+                 else offDiag+  in (n LA.>< n) [ buildEntry i j | i <- [0 .. n - 1], j <- [0 .. n - 1] ]++-- | [日本語]: 安全な X̃ を返す: X̃ として「(X' M⁻¹ X) の chol 下三角」 を渡せば+--   det(X̃' X̃) = det(X' M⁻¹ X) になる。+--+--   非 PD 時は LA.chol が IO 例外を投げて bench / 検証が落ちるため、 mbChol で+--   safe 化する。 失敗時は zero matrix を返し、 critValueM DOpt =+--   -det(0 · 0') = 0 を経由して候補が rejection される。+--   [English]: Returns a safe X̃: passing the chol lower-triangle of+--   (X' M⁻¹ X) as X̃ gives det(X̃' X̃) = det(X' M⁻¹ X).+--+--   When non-PD, LA.chol throws an IO exception that would crash the bench+--   / verification, so it's made safe with mbChol. On failure, returns the+--   zero matrix, which rejects the candidate via+--   critValueM DOpt = -det(0 · 0') = 0.+chol :: LA.Matrix Double -> LA.Matrix Double+chol m =+  let !sym = LA.sym m+  in case LA.mbChol sym of+       Just u  -> LA.tr u+       Nothing -> LA.konst 0 (LA.rows m, LA.cols m)++-- ---------------------------------------------------------------------------+-- matrix utility+-- ---------------------------------------------------------------------------++setEntry :: LA.Matrix Double -> Int -> Int -> Double -> LA.Matrix Double+setEntry m i j v = LA.accum m const [((i, j), v)]++setColumnInRows :: LA.Matrix Double -> [Int] -> Int -> Double -> LA.Matrix Double+setColumnInRows m rows j v = LA.accum m const [((i, j), v) | i <- rows]
+ src/Hanalyze/Design/Custom/Structured.hs view
@@ -0,0 +1,387 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns      #-}+-- |+-- Module      : Hanalyze.Design.Custom.Structured+-- Description : 役割 (fRole) 非依存の構造駆動座標交換エンジン (cells + M⁻¹ による GLS 最適化)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: 構造駆動の座標交換エンジン。+--+--   split-plot 専用エンジン ('Custom.SplitPlot') を __役割 (fRole) 非依存__に+--   一般化したもの。 実験のランダム化/階層構造を、+--+--     - 各因子列がどの行集合で一定か = __cells__ ('gpCells')+--     - 観測の共分散 M の逆行列 = __M⁻¹__ ('gpMInv')+--+--   の 2 つに落とした @GroupingPlan@ で受け取り、+--+--     - 群単位ムーブ: 因子 j の cell (= 同値であるべき行集合) 内の全行を一度に書き換える+--     - GLS 基準: @critValueM crit (chol (Xᵀ M⁻¹ X))@ (検証済・Jones-Goos golden 一致)+--+--   で解く。 CRD (per-row cell・M=I) は 'Custom.Coordinate' の高速路にそのまま委譲するので、+--   本エンジンは SplitPlot / StripPlot / Blocked (= 非自明な群/共分散) 専用。+--+--   ★基準式の根拠: @xtmx = Xᵀ M⁻¹ X@、 @L = chol xtmx@ (L Lᵀ = xtmx) を 'critValueM' に渡すと+--   DOpt で @det(Lᵀ L) = det(xtmx) = det(Xᵀ M⁻¹ X)@ = 厳密な REML 情報量 (Goos-Vandebroek 2003)。+--   M⁻¹ の白色化 X̃ = L⁻¹X でも等価だが、 既存 SplitPlot エンジンで文献値一致を確認済の+--   この式を踏襲する。+--+-- [English]: A structure-driven coordinate-exchange engine.+--+--   Generalizes the split-plot-only engine ('Custom.SplitPlot') to be+--   __role (fRole)-independent__. Takes the experiment's+--   randomization/hierarchical structure via a @GroupingPlan@ that+--   distills it down to two things:+--+--     - which row set each factor column is constant over = __cells__+--       ('gpCells')+--     - the inverse of the observations' covariance M = __M⁻¹__+--       ('gpMInv')+--+--   and solves it by:+--+--     - group-wise moves: rewrites all rows within factor j's cell+--       (= the row set that should share a value) at once+--     - GLS criterion: @critValueM crit (chol (Xᵀ M⁻¹ X))@ (verified;+--       matches the Jones-Goos golden values)+--+--   CRD (per-row cells, M=I) is delegated straight to 'Custom.Coordinate''s+--   fast path, so this engine is only for SplitPlot \/ StripPlot \/ Blocked+--   (= non-trivial group/covariance).+--+--   ★Rationale for the criterion formula: passing @xtmx = Xᵀ M⁻¹ X@,+--   @L = chol xtmx@ (L Lᵀ = xtmx) to 'critValueM' gives, for DOpt,+--   @det(Lᵀ L) = det(xtmx) = det(Xᵀ M⁻¹ X)@ = the exact REML information+--   quantity (Goos-Vandebroek 2003). Whitening via M⁻¹ (X̃ = L⁻¹X) is+--   equivalent, but this formula follows the one already verified to match+--   the literature values in the existing SplitPlot engine.+module Hanalyze.Design.Custom.Structured+  ( -- * 入力+    GroupingPlan (..)+    -- * 共分散+  , buildMInvFromGroups+    -- * アルゴリズム+  , structuredExchangePure+  ) where++import           Control.Monad             (forM, forM_, when)+import           Control.Monad.Primitive   (PrimMonad, PrimState)+import           Control.Monad.ST          (runST)+import           Data.Maybe                (fromMaybe)+import           Data.Primitive.MutVar+import           Data.Text                 (Text)+import qualified Data.Text                 as T+import qualified Numeric.LinearAlgebra     as LA+import qualified System.Random.MWC         as MWC+import qualified Data.Vector               as V+import qualified Data.Vector.Unboxed       as VU+import qualified Data.Vector.Storable      as VS++import           Hanalyze.Design.Custom.Factor  (Factor)+import           Hanalyze.Design.Custom.Model   (Model, expandDesignMatrix)+import           Hanalyze.Design.Custom.Constraint (Constraint)+import           Hanalyze.Design.Custom.Coordinate+                   ( CustomDesignSpec (..), DesignBudget (..)+                   , factorGrid, critValueM, rowFeasible+                   , mkGenSeed, defaultPureSeed )+import           Hanalyze.Design.Optimal        (OptCriterion (..))++-- ---------------------------------------------------------------------------+-- 入力型+-- ---------------------------------------------------------------------------++-- | [日本語]: @Structure@ をエンジン内部表現にコンパイルしたもの (Workflow が構築)。+--   [English]: @Structure@ compiled into the engine's internal+--   representation (built by the Workflow).+data GroupingPlan = GroupingPlan+  { gpCells :: ![[[Int]]]+    -- ^ [日本語]: 列 j → その列の値を共有すべき行集合 (cells) の分割。 全 cell の和集合 = @[0..n-1]@。+    --   CRD 因子 = @[[0],[1],…,[n-1]]@ (per-row)、 whole-plot 因子 = 各 WP の行集合。+    --   [English]: Column j → the partition into row sets (cells) that+    --   should share that column's value. The union of all cells =+    --   @[0..n-1]@. A CRD factor = @[[0],[1],…,[n-1]]@ (per-row); a+    --   whole-plot factor = the row set of each WP.+  , gpMInv  :: !(LA.Matrix Double)+    -- ^ [日本語]: n×n の GLS 重み M⁻¹ (@M = I + Σ η_g Z_g Z_gᵀ@)。 CRD なら I。+    --   [English]: The n×n GLS weight M⁻¹ (@M = I + Σ η_g Z_g Z_gᵀ@). I+    --   for CRD.+  } deriving (Show)++-- ---------------------------------------------------------------------------+-- 共分散 M⁻¹+-- ---------------------------------------------------------------------------++-- | [日本語]: @M = I + Σ_g η_g Z_g Z_gᵀ@ の逆行列を dense に構築 (n ≤ ~100 前提で数値 inv)。+--   各群 @(η_g, ids_g)@ は「分散比 η_g と各行の群 ID」。 SplitPlot = 1 群、+--   StripPlot = 2 群 (WP と strip の交差)、 Blocked = 1 群。 block-diagonal に限らないので+--   一様に dense inv で扱う (解析 block 逆と数値的に一致)。 特異なら安全側で単位行列。+--   [English]: Builds a dense inverse of @M = I + Σ_g η_g Z_g Z_gᵀ@+--   (assumes n ≤ ~100 for a numerical inverse). Each group+--   @(η_g, ids_g)@ is "the variance ratio η_g and each row's group ID".+--   SplitPlot = 1 group, StripPlot = 2 groups (the intersection of WP and+--   strip), Blocked = 1 group. Since it isn't restricted to+--   block-diagonal, a uniform dense inverse is used (numerically matches+--   the analytical block inverse). Falls back safely to the identity+--   matrix if singular.+buildMInvFromGroups :: Int -> [(Double, VS.Vector Int)] -> LA.Matrix Double+buildMInvFromGroups n groups =+  let mEntry i j =+        (if i == j then 1 else 0)+          + sum [ if ids VS.! i == ids VS.! j then eta else 0 | (eta, ids) <- groups ]+      mMat = (n LA.>< n) [ mEntry i j | i <- [0 .. n - 1], j <- [0 .. n - 1] ]+  in if abs (LA.det mMat) < 1e-12 then LA.ident n else LA.inv mMat++-- ---------------------------------------------------------------------------+-- アルゴリズム (seed 決定的・pure)+-- ---------------------------------------------------------------------------++-- | [日本語]: 構造駆動の座標交換 (pure・seed 決定的)。 @GroupingPlan@ の cells で群単位ムーブ、+--   M⁻¹ で GLS 基準を評価する。 戻り値 = (raw 設計行列, 最小化方向の基準値)。+--   'cdsSeed' が 'Nothing' なら 'defaultPureSeed'。 制約は各ムーブ候補で 'rowFeasible'+--   (影響行ごと) を課す。+--   [English]: The structure-driven coordinate exchange (pure,+--   seed-deterministic). Performs group-wise moves via 'GroupingPlan''s+--   cells, and evaluates the GLS criterion via M⁻¹. Return value =+--   (raw design matrix, the minimized-direction criterion value). Uses+--   'defaultPureSeed' if 'cdsSeed' is 'Nothing'. Constraints are imposed+--   via 'rowFeasible' (per affected row) for each move candidate.+structuredExchangePure+  :: CustomDesignSpec -> GroupingPlan -> Either Text (LA.Matrix Double, Double)+structuredExchangePure spec gplan+  | null (cdsFactors spec)         = Left "structuredExchange: empty factor list"+  | cdsNRuns spec < 1              = Left "structuredExchange: nRuns must be >= 1"+  | dbRestarts (cdsBudget spec) < 1 = Left "structuredExchange: dbRestarts must be >= 1"+  | length (gpCells gplan) /= length (cdsFactors spec) =+      Left "structuredExchange: gpCells length must equal factor count"+  | LA.rows (gpMInv gplan) /= cdsNRuns spec =+      Left "structuredExchange: gpMInv dimension must equal nRuns"+  | otherwise = runST $ do+      gen <- mkGenSeed (fromMaybe defaultPureSeed (cdsSeed spec))+      let !factors = cdsFactors spec+          !model   = cdsModel spec+          !crit    = cdsCriterion spec+          !cons    = cdsConstraints spec+          !budget  = cdsBudget spec+          !n       = cdsNRuns spec+          !mInv    = gpMInv gplan+          !cells   = gpCells gplan+          !grids   = map (factorGrid budget) factors+      bestRef <- newMutVar Nothing+      forM_ [1 .. dbRestarts budget] $ \_ -> do+        -- 制約なしは高速な単純抽選 (既存挙動)、 制約ありは実行可能な初期解を棄却サンプリング。+        mInit <- if null cons+                   then Just <$> randomInitG grids cells n gen+                   else randomInitGFeasible factors cons grids cells n gen+        case mInit of+          Nothing    -> pure ()   -- この restart は実行可能初期解を引けず (次 restart へ)+          Just init0 -> do+            (finalM, finalC) <-+              runExchangeG factors model crit cons budget mInv grids cells init0+            modifyMutVar' bestRef $ \mb -> case mb of+              Nothing -> Just (finalM, finalC)+              Just (_, c0) | finalC < c0 -> Just (finalM, finalC)+                           | otherwise   -> mb+      mb <- readMutVar bestRef+      pure $ case mb of+        Nothing     -> Left "structuredExchange: 実行可能な初期解が得られませんでした (制約が厳しすぎる可能性)"+        Just (m, c) -> Right (m, c)++-- | [日本語]: 初期 raw matrix。 各列は cell ごとに 1 つの grid 値を抽選し、 cell 内全行へ同値で置く。+--   [English]: The initial raw matrix. For each column, draws one grid+--   value per cell and places it identically across all rows in the cell.+randomInitG+  :: PrimMonad m+  => [VU.Vector Double] -> [[[Int]]] -> Int -> MWC.Gen (PrimState m)+  -> m (LA.Matrix Double)+randomInitG grids cells n gen = do+  let gridsV = V.fromList grids+  cols <- mapM+    (\(j, cellsOfCol) -> do+        let g  = gridsV V.! j+            gl = VU.length g+        -- cell ごとに 1 値、 cell 内全行に配る+        vals <- mapM (\rows -> do+                        k <- MWC.uniformR (0, gl - 1) gen+                        pure (rows, g VU.! k)) cellsOfCol+        let assign = [ (i, v) | (rows, v) <- vals, i <- rows ]+        pure (LA.fromList [ lookupRow i assign | i <- [0 .. n - 1] ]))+    (zip [0 ..] cells)+  pure (LA.fromColumns cols)+  where+    lookupRow i assign = case lookup i assign of+      Just v  -> v+      Nothing -> 0   -- cells が [0..n-1] を被覆する前提 (不達)++-- | [日本語]: 制約下で実行可能な初期 raw matrix を棄却サンプリングで構築。+--   群構造を保つため 2 段階で引く:+--+--     1. __群 (grouped) 列__ (cell が n 未満 = whole-plot / strip 因子) を cell ごとに 1 値抽選。+--        群内の行はこの値を共有する (= 階層構造の保持)。+--     2. __各行__について、 per-row 列 (sub-plot 因子) を棄却サンプリングし、 群列の固定値と+--        合わせた行全体が全制約を満たすまで再抽選 (行あたり 200 回上限)。+--+--   ある行が群固定値の下でどうしても実行可能にできなければ、 群値ごと引き直す (外側 50 回上限)。+--   全て失敗すれば 'Nothing' (制約が厳しすぎる)。 群列固定 → per-row 探索の順で、+--   whole-plot 因子が群内一定かつ制約満足を両立させる。+--   [English]: Builds a feasible initial raw matrix under constraints via+--   rejection sampling. Draws in two stages to preserve the group+--   structure:+--+--     1. Draws one value per cell for the __grouped columns__ (cells with+--        fewer than n rows = whole-plot \/ strip factors). Rows within a+--        group share this value (= preserving the hierarchical+--        structure).+--     2. For __each row__, rejection-samples the per-row columns+--        (sub-plot factors), redrawing until the whole row (combined with+--        the group columns' fixed values) satisfies all constraints (up to+--        200 draws per row).+--+--   If a row can't be made feasible under the group's fixed values no+--   matter what, the group values are redrawn from scratch (up to 50+--   outer attempts). If all attempts fail, returns 'Nothing' (constraints+--   too strict). By fixing the group columns first and then searching+--   per-row, both keeping whole-plot factors constant within a group and+--   satisfying constraints are achieved simultaneously.+randomInitGFeasible+  :: PrimMonad m+  => [Factor] -> [Constraint] -> [VU.Vector Double] -> [[[Int]]] -> Int+  -> MWC.Gen (PrimState m) -> m (Maybe (LA.Matrix Double))+randomInitGFeasible factors cons grids cells n gen = tryOuter maxOuter+  where+    maxOuter = 50 :: Int+    maxRow   = 200 :: Int+    gridsV   = V.fromList grids+    p        = length grids+    isGrouped j = length (cells !! j) < n   -- cell 数 < n → 群 (共有) 列++    tryOuter 0 = pure Nothing+    tryOuter t = do+      -- 1. 群列の値を cell ごとに抽選 → 各群列 j の「行 → 値」 (Just)、 per-row 列は Nothing+      grouped <- forM [0 .. p - 1] $ \j ->+        if isGrouped j+          then do+            let g  = gridsV V.! j+                gl = VU.length g+            cellVals <- forM (cells !! j) $ \rows -> do+              k <- MWC.uniformR (0, gl - 1) gen+              pure (rows, g VU.! k)+            let rowVal = VU.generate n+                  (\i -> head [ v | (rs, v) <- cellVals, i `elem` rs ])+            pure (Just rowVal)+          else pure Nothing+      -- 2. 各行を棄却サンプリング (群列は固定・per-row 列を引く)+      mRows <- forM [0 .. n - 1] $ \i -> drawRow grouped i maxRow+      case sequence mRows of+        Just rs -> pure (Just (LA.fromRows rs))+        Nothing -> tryOuter (t - 1)   -- どこかの行が詰んだ → 群値ごと引き直し++    drawRow _       _ 0  = pure Nothing+    drawRow grouped i tr = do+      vs <- forM [0 .. p - 1] $ \j ->+        case grouped !! j of+          Just rowVal -> pure (rowVal VU.! i)     -- 群列: 固定値+          Nothing     -> do                        -- per-row 列: 抽選+            let g  = gridsV V.! j+                gl = VU.length g+            k <- MWC.uniformR (0, gl - 1) gen+            pure (g VU.! k)+      let row = LA.fromList vs+      if rowFeasible factors cons row+        then pure (Just row)+        else drawRow grouped i (tr - 1)++-- | [日本語]: 1 restart 分の群単位 coordinate exchange。 列ごと・cell ごとに grid を走査し、+--   制約 (影響行) を満たす範囲で基準最小の値を cell 内全行へ書き込む。+--   [English]: One restart's worth of group-wise coordinate exchange.+--   Scans the grid per column and per cell, writing the+--   criterion-minimizing value across all rows in the cell, within the+--   range that satisfies the constraint (affected rows).+runExchangeG+  :: PrimMonad m+  => [Factor] -> Model -> OptCriterion -> [Constraint] -> DesignBudget+  -> LA.Matrix Double            -- ^ M⁻¹+  -> [VU.Vector Double]          -- ^ [日本語]: 因子ごとの grid。 [English]: The grid for each factor.+  -> [[[Int]]]                   -- ^ [日本語]: 列ごとの cells。 [English]: The cells for each column.+  -> LA.Matrix Double            -- ^ [日本語]: 初期 raw。 [English]: The initial raw values.+  -> m (LA.Matrix Double, Double)+runExchangeG factors model crit cons budget mInv grids cells init0 = do+  matRef  <- newMutVar init0+  critRef <- newMutVar (evalCritG factors model crit mInv init0)+  let gridsV = V.fromList grids+      cellsV = V.fromList cells+      !p     = length grids+  let loopOuter !it+        | it > dbMaxIter budget = pure ()+        | otherwise = do+            beforeC <- readMutVar critRef+            forM_ [0 .. p - 1] $ \j ->+              forM_ (cellsV V.! j) $ \rows -> do+                curMat <- readMutVar matRef+                curC   <- readMutVar critRef+                let g    = gridsV V.! j+                    gl   = VU.length g+                    oldV = if null rows then 0+                             else curMat `LA.atIndex` (head rows, j)+                bestRef <- newMutVar (oldV, curC)+                forM_ [0 .. gl - 1] $ \k -> do+                  let !v = g VU.! k+                  when (cellFeasible factors cons curMat rows j v) $ do+                    let !cand = setColumnInRows curMat rows j v+                        !c    = evalCritG factors model crit mInv cand+                    modifyMutVar' bestRef $ \cur@(_, bc) ->+                      if c < bc then (v, c) else cur+                (bv, bc) <- readMutVar bestRef+                when (bc < curC) $ do+                  writeMutVar matRef  (setColumnInRows curMat rows j bv)+                  writeMutVar critRef bc+            afterC <- readMutVar critRef+            let rel = if abs beforeC < 1e-12+                        then beforeC - afterC+                        else (beforeC - afterC) / abs beforeC+            when (rel > dbTol budget) (loopOuter (it + 1))+  loopOuter 1+  finalM <- readMutVar matRef+  finalC <- readMutVar critRef+  pure (finalM, finalC)++-- | [日本語]: cell 内全行を列 j = v にしたとき、 影響する全行が制約を満たすか。+--   cell 内の各行は他列の値が異なり得るので行ごとに判定する。+--   [English]: Whether all affected rows satisfy the constraints when all+--   rows in the cell have column j = v. Since each row in the cell may+--   differ in other columns' values, it's judged row by row.+cellFeasible :: [Factor] -> [Constraint] -> LA.Matrix Double -> [Int] -> Int -> Double -> Bool+cellFeasible _ [] _ _ _ _ = True+cellFeasible factors cons mat rows j v =+  all (\i -> rowFeasible factors cons (replaceVecAt (rowVec i) j v)) rows+  where rowVec i = LA.flatten (LA.subMatrix (i, 0) (1, LA.cols mat) mat)++-- | [日本語]: raw matrix → design matrix → GLS 基準値 (最小化方向)。 expand 失敗は +∞。+--   [English]: raw matrix → design matrix → GLS criterion value+--   (minimization direction). +∞ on expand failure.+evalCritG :: [Factor] -> Model -> OptCriterion -> LA.Matrix Double -> LA.Matrix Double -> Double+evalCritG factors model crit mInv raw =+  case expandDesignMatrix factors model raw of+    Left _  -> 1 / 0+    Right x ->+      let !xtmx = LA.tr x LA.<> (mInv LA.<> x)   -- Xᵀ M⁻¹ X+      in critValueM crit (chol xtmx)++-- | [日本語]: @chol m@ = L (下三角、 L Lᵀ = sym m)。 非 PD 時は 0 行列 (基準が候補を棄却)。+--   [English]: @chol m@ = L (lower triangular, L Lᵀ = sym m). The zero+--   matrix when non-PD (the criterion rejects the candidate).+chol :: LA.Matrix Double -> LA.Matrix Double+chol m = case LA.mbChol (LA.sym m) of+  Just u  -> LA.tr u+  Nothing -> LA.konst 0 (LA.rows m, LA.cols m)++-- ---------------------------------------------------------------------------+-- matrix / vector utility+-- ---------------------------------------------------------------------------++setColumnInRows :: LA.Matrix Double -> [Int] -> Int -> Double -> LA.Matrix Double+setColumnInRows m rows j v = LA.accum m const [ ((i, j), v) | i <- rows ]++replaceVecAt :: LA.Vector Double -> Int -> Double -> LA.Vector Double+replaceVecAt v j x =+  LA.fromList [ if k == j then x else v `LA.atIndex` k | k <- [0 .. LA.size v - 1] ]
+ src/Hanalyze/Design/DSD.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Hanalyze.Design.DSD+-- Description : Definitive Screening Design (Jones-Nachtsheim 2011) の 2k+1 run 生成+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Definitive Screening Design (Jones-Nachtsheim 2011)。+--+-- k 連続因子について __2k + 1 runs__ で主効果 + 二次効果 + 一部の 2 因子+-- 交互作用を識別できる効率的スクリーニング計画。+--+-- 構成:+--+--   - 1 行目: 中心点 @[0, 0, ..., 0]@+--   - 2..k+1 行目: 各 row i は position i に 0 を持ち、 他は ±1+--   - k+2..2k+1 行目: 上記の foldover (= 各行の符号反転)+--+-- 本初版は k = 4 を __Jones-Nachtsheim Table 1 の conference matrix__ で+-- 構築 (verified DSD)。 他の k は Hadamard-like 構造で近似 (= 構造的 DSD)。+-- 厳密な conference-matrix DSD の追加は将来対応予定。+--+-- [English]: Definitive Screening Design (Jones-Nachtsheim 2011).+--+-- An efficient screening design for k continuous factors that can identify+-- main effects + quadratic effects + some two-factor interactions in+-- __2k + 1 runs__.+--+-- Construction:+--+--   - Row 1: the center point @[0, 0, ..., 0]@+--   - Rows 2..k+1: each row i has 0 at position i, and ±1 elsewhere+--   - Rows k+2..2k+1: the foldover of the above (i.e. sign-flip of each row)+--+-- This initial version builds k = 4 from the+-- __conference matrix in Jones-Nachtsheim Table 1__ (a verified DSD). Other k values are+-- approximated with a Hadamard-like structure (a structural DSD). Adding a+-- rigorous conference-matrix DSD is planned for a future phase.+module Hanalyze.Design.DSD+  ( DSDResult (..)+  , dsdDesign+  ) where++import qualified Data.Bits             as B+import qualified Numeric.LinearAlgebra as LA+import           Data.Text             (Text)+import qualified Data.Text             as T++-- ===========================================================================+-- 型+-- ===========================================================================++-- | [日本語]: DSD の結果。+--   [English]: The result of a DSD.+data DSDResult = DSDResult+  { dsdMatrix     :: !(LA.Matrix Double)+    -- ^ [日本語]: @(2k + 1) × k@ 行列。 各要素は @{-1, 0, +1}@。+    --   [English]: A @(2k + 1) x k@ matrix. Each element is @{-1, 0, +1}@.+  , dsdNFactors   :: !Int       -- ^ [日本語]: 因子数 k [English]: The number of factors, k+  , dsdNRuns      :: !Int       -- ^ [日本語]: 実験数 2k + 1 [English]: The number of runs, 2k + 1+  , dsdHasOptimal :: !Bool+    -- ^ [日本語]: @True@ = Jones-Nachtsheim Table の conference matrix 由来 (verified DSD)、+    --   @False@ = Hadamard-like 構造で近似 (structural DSD)+    --   [English]: @True@ = derived from the conference matrix in the+    --   Jones-Nachtsheim Table (verified DSD); @False@ = approximated with+    --   a Hadamard-like structure (structural DSD)+  } deriving (Show)++-- ===========================================================================+-- 公開関数+-- ===========================================================================++-- | [日本語]: DSD を生成。+--+--   k = 4 のみ verified (Jones-Nachtsheim 2011 Table 1)。+--   k ≥ 2 の他値は Hadamard-like 構造の structural DSD (`dsdHasOptimal = False`)。+--   k < 2 は @Left@。+--   [English]: Generates a DSD.+--+--   Only k = 4 is verified (Jones-Nachtsheim 2011 Table 1). Other values+--   with k ≥ 2 are a structural DSD with a Hadamard-like structure+--   (`dsdHasOptimal = False`). k < 2 yields @Left@.+dsdDesign :: Int -> Either Text DSDResult+dsdDesign k+  | k < 2 = Left (T.pack ("dsdDesign: need k >= 2, got k=" <> show k))+  | k == 4 = Right (verifiedDSD k confC4)+  | otherwise = Right (structuralDSD k)++-- ===========================================================================+-- 内部: verified DSD (conference matrix 由来)+-- ===========================================================================++-- | [日本語]: C_4: 4 次の conference matrix。 Jones-Nachtsheim 2011 Table 1 第 1 行。+--   不変条件: 対角 0、 非対角 ±1、 @C · Cᵀ = (n-1) I@。+--   [English]: C_4: the order-4 conference matrix. Jones-Nachtsheim 2011+--   Table 1, row 1. Invariants: diagonal 0, off-diagonal ±1,+--   @C . Cᵀ = (n-1) I@.+confC4 :: [[Double]]+confC4 =+  [ [ 0,  1,  1,  1]+  , [ 1,  0,  1, -1]+  , [ 1, -1,  0,  1]+  , [ 1,  1, -1,  0]+  ]++-- | [日本語]: 与えた conference matrix から DSD を構築:+--   row 0 = center、 rows 1..k = C 各行、 rows k+1..2k = -C 各行。+--   [English]: Builds a DSD from the given conference matrix: row 0 =+--   center, rows 1..k = each row of C, rows k+1..2k = each row of -C.+verifiedDSD :: Int -> [[Double]] -> DSDResult+verifiedDSD k cMat =+  let center  = replicate k 0+      posRows = cMat+      negRows = map (map negate) cMat+      allRows = center : posRows ++ negRows+      mat     = LA.fromLists allRows+  in DSDResult+       { dsdMatrix     = mat+       , dsdNFactors   = k+       , dsdNRuns      = 2 * k + 1+       , dsdHasOptimal = True+       }++-- ===========================================================================+-- 内部: structural DSD (Hadamard-like、 conference matrix 無しの近似)+-- ===========================================================================++-- | [日本語]: k != 4 の場合の近似 DSD。 構造 (2k+1 runs、 各 row に 1 個の 0) は+--   満たすが、 conference matrix 性質 (`C · Cᵀ = (n-1) I`) は保証しない。+--+--   ±1 パターンは Sylvester-Hadamard 風: row i の position j (j != i) について+--   @sign = (-1)^popCount(i .&. j)@。+--   [English]: The approximate DSD for k != 4. It satisfies the structure+--   (2k+1 runs, one 0 per row) but does not guarantee the conference-matrix+--   property (`C . Cᵀ = (n-1) I`).+--+--   The ±1 pattern is Sylvester-Hadamard-like: for row i, position j+--   (j != i), @sign = (-1)^popCount(i .&. j)@.+structuralDSD :: Int -> DSDResult+structuralDSD k =+  let posRows = [ [ if j + 1 == i then 0  -- position i (1-origin in row) gets 0+                    else hadamardSign i (j + 1)+                  | j <- [0 .. k - 1]+                  ]+                | i <- [1 .. k]+                ]+      negRows = map (map negate) posRows+      center  = replicate k 0+      mat     = LA.fromLists (center : posRows ++ negRows)+  in DSDResult+       { dsdMatrix     = mat+       , dsdNFactors   = k+       , dsdNRuns      = 2 * k + 1+       , dsdHasOptimal = False+       }++-- | [日本語]: Sylvester-Hadamard 符号: @(-1)^popCount(i AND j)@。+--   [English]: Sylvester-Hadamard sign: @(-1)^popCount(i AND j)@.+hadamardSign :: Int -> Int -> Double+hadamardSign i j+  | even (B.popCount (i B..&. j)) =  1+  | otherwise                     = -1
+ src/Hanalyze/Design/Diagnostics.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Hanalyze.Design.Diagnostics+-- Description : DoE 設計診断 (Alias Matrix / VIF / D-A-G-I efficiency の一括算出)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: DoE 設計診断: Alias Matrix / VIF / D-A-G-I efficiency。+--+-- 設計行列 @X@ (n × p) に対して、 multicollinearity と最適性指標を一括算出。+--+-- ===  efficiency 指標+--+--   - D-efficiency = (|XᵀX| / n^p)^{1/p}+--   - A-efficiency = p / trace((XᵀX/n)⁻¹)+--   - G-efficiency = p / max_i (n · x_iᵀ (XᵀX)⁻¹ x_i)+--   - I-efficiency = 1 / (n · trace((XᵀX)⁻¹ · M))、+--     M = 1/n · XᵀX (= self-moment 近似版)+--+-- ===  VIF+--+-- 各列 j について、 「j 以外の列で j を回帰」 した R² を用いて+-- @VIF_j = 1 / (1 − R²_j)@。 切片を含む X を想定し、 切片列 (= 全 1) は+-- スキップ。+--+-- ===  Alias Matrix+--+-- @A = (XᵀX)⁻¹ Xᵀ Z@、 ここで Z は 「設計に入れていない交絡項」 のモデル+-- 行列。 ここでは Z を Optional 引数として取り、 未指定の場合は+-- アライアス対象が無いとして空行列を返す。+--+-- [English]: DoE design diagnostics: Alias Matrix \/ VIF \/ D-A-G-I+-- efficiency.+--+-- Computes multicollinearity and optimality metrics in bulk for the design+-- matrix @X@ (n × p).+--+-- ===  Efficiency metrics+--+--   - D-efficiency = (|XᵀX| / n^p)^{1/p}+--   - A-efficiency = p / trace((XᵀX/n)⁻¹)+--   - G-efficiency = p / max_i (n · x_iᵀ (XᵀX)⁻¹ x_i)+--   - I-efficiency = 1 / (n · trace((XᵀX)⁻¹ · M)),+--     M = 1/n · XᵀX (a self-moment approximation)+--+-- ===  VIF+--+-- For each column j, using the R² of "regressing j on all columns other+-- than j", @VIF_j = 1 / (1 − R²_j)@. Assumes X includes an intercept, and+-- the intercept column (all 1s) is skipped.+--+-- ===  Alias Matrix+--+-- @A = (XᵀX)⁻¹ Xᵀ Z@, where Z is the model matrix of "confounding terms+-- not included in the design". Z is taken here as an optional argument;+-- when unspecified, an empty matrix is returned as there is nothing to+-- alias.+module Hanalyze.Design.Diagnostics+  ( DesignDiagnostics (..)+  , diagnostics+  , diagnosticsWithAlias+  , vifVector+  , aliasMatrix+  ) where++import qualified Numeric.LinearAlgebra as LA++-- ===========================================================================+-- 型+-- ===========================================================================++data DesignDiagnostics = DesignDiagnostics+  { ddVIF         :: !(LA.Vector Double)+  , ddDEff        :: !Double+  , ddAEff        :: !Double+  , ddGEff        :: !Double+  , ddIEff        :: !Double+  , ddAliasMatrix :: !(LA.Matrix Double)+  } deriving (Show)++-- ===========================================================================+-- 公開 API+-- ===========================================================================++-- | [日本語]: Alias を含めない簡易版 (Z = 空)。+--   [English]: A simplified version without Alias (Z = empty).+diagnostics :: LA.Matrix Double -> DesignDiagnostics+diagnostics x =+  let dd = computeDiagnostics x+  in dd { ddAliasMatrix = LA.fromLists [[]] }++-- | [日本語]: Z (交絡対象モデル行列) 込みの完全版。 Z の行数は X と一致する必要がある。+--   [English]: The full version, including Z (the model matrix of+--   confounding terms). Z's row count must match X's.+diagnosticsWithAlias :: LA.Matrix Double -> LA.Matrix Double -> DesignDiagnostics+diagnosticsWithAlias x z =+  let dd = computeDiagnostics x+      a  = aliasMatrix x z+  in dd { ddAliasMatrix = a }++-- | [日本語]: VIF を各列について返す (全 1 列は VIF = 1)。+--   [English]: Returns the VIF for each column (an all-1s column has+--   VIF = 1).+vifVector :: LA.Matrix Double -> LA.Vector Double+vifVector x =+  let p = LA.cols x+  in LA.fromList [ vifForCol x j | j <- [0 .. p - 1] ]++-- | [日本語]: Alias matrix A = (XᵀX)⁻¹ Xᵀ Z。+--   [English]: The alias matrix A = (XᵀX)⁻¹ Xᵀ Z.+aliasMatrix :: LA.Matrix Double -> LA.Matrix Double -> LA.Matrix Double+aliasMatrix x z =+  let xtx = LA.tr x LA.<> x+      d   = LA.det xtx+  in if abs d < 1e-12+       then LA.fromLists [[]]+       else LA.inv xtx LA.<> LA.tr x LA.<> z++-- ===========================================================================+-- 内部+-- ===========================================================================++computeDiagnostics :: LA.Matrix Double -> DesignDiagnostics+computeDiagnostics x =+  let n   = LA.rows x+      p   = LA.cols x+      nD  = fromIntegral n :: Double+      pD  = fromIntegral p :: Double+      xtx = LA.tr x LA.<> x+      d   = LA.det xtx+      singular = abs d < 1e-12+      inv = if singular then LA.ident p else LA.inv xtx+      -- D-efficiency: (|XᵀX| / n^p)^{1/p}  (clamped to ≥ 0)+      dEff = if singular || d <= 0 then 0+                else (d / (nD ** pD)) ** (1 / pD)+      -- A-efficiency: p / trace((XᵀX/n)⁻¹) = p · n / trace((XᵀX)⁻¹)... wait+      -- (XᵀX / n)⁻¹ = n · (XᵀX)⁻¹  なので trace((XᵀX/n)⁻¹) = n · trace((XᵀX)⁻¹)+      -- → A-eff = p / (n · trace((XᵀX)⁻¹))+      trInv = sum [ inv `LA.atIndex` (i, i) | i <- [0 .. p - 1] ]+      aEff  = if singular || trInv == 0 then 0+                else pD / (nD * trInv)+      -- G-efficiency: p / max_i (n · h_ii)、 h_ii = x_iᵀ (XᵀX)⁻¹ x_i+      hMax = if singular then 1+               else maximum+                      [ let xi = LA.flatten (x LA.? [i])+                            v  = inv LA.#> xi+                        in xi `LA.dot` v+                      | i <- [0 .. n - 1] ]+      gEff = if hMax == 0 then 0 else pD / (nD * hMax)+      -- I-efficiency 近似 (self-moment)+      iEff = if singular then 0+               else+                 let m = LA.scale (1 / nD) xtx+                     t = LA.sumElements (LA.takeDiag (inv LA.<> m))+                 in if t == 0 then 0 else 1 / (nD * t)+  in DesignDiagnostics+       { ddVIF         = vifVector x+       , ddDEff        = dEff+       , ddAEff        = aEff+       , ddGEff        = gEff+       , ddIEff        = iEff+       , ddAliasMatrix = LA.fromLists [[]]+       }++-- | [日本語]: 列 j の VIF。 全 1 列 (切片) は 1 を返す。+--   [English]: The VIF of column j. Returns 1 for an all-1s column+--   (intercept).+vifForCol :: LA.Matrix Double -> Int -> Double+vifForCol x j =+  let col = LA.flatten (x LA.¿ [j])+      isConst = let c0 = LA.atIndex col 0+                in LA.maxElement (LA.cmap (\v -> abs (v - c0)) col) < 1e-12+  in if isConst then 1+       else+         let p       = LA.cols x+             others  = [ k | k <- [0 .. p - 1], k /= j ]+             xOthers = x LA.¿ others+             yj      = col+             xtx     = LA.tr xOthers LA.<> xOthers+             d       = LA.det xtx+         in if abs d < 1e-12 then 1 / 0+              else+                let beta = LA.inv xtx LA.#> (LA.tr xOthers LA.#> yj)+                    yhat = xOthers LA.#> beta+                    yBar = LA.sumElements yj / fromIntegral (LA.size yj)+                    ssR  = LA.sumElements ((yj - yhat) ^ (2 :: Int))+                    ssT  = LA.sumElements ((yj - LA.scalar yBar) ^ (2 :: Int))+                    r2   = if ssT == 0 then 0 else 1 - ssR / ssT+                in if r2 >= 1 then 1 / 0 else 1 / (1 - r2)
+ src/Hanalyze/Design/Factorial.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Factorial+-- Description : 要因計画 (完全/2 水準/3 水準/一部実施/混合水準) の生成+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- Factorial designs.+--+--   - 'fullFactorial'        — full factorial with @k@ factors each at+--     @levels[i]@ levels.+--   - 'twoLevelFactorial'    — @2^k@ design (each factor at @±1@).+--   - 'threeLevelFactorial'  — @3^k@ design (each factor at @-1, 0, +1@).+--   - 'fractionalFactorial'  — @2^(k-p)@ fractional design (specified+--     defining relation).+--   - 'mixedFactorial'       — mixed-level design (e.g. @2² × 3¹@).+--+-- All designs are returned as @[[Double]]@. Use 'Hanalyze.Design.Quality' to+-- evaluate orthogonality and other criteria.+module Hanalyze.Design.Factorial+  ( fullFactorial+  , twoLevelFactorial+  , threeLevelFactorial+  , fractionalFactorial+  , mixedFactorial+  , factorialColumnNames+  ) where++import Data.List (foldl')+import Data.Text (Text)+import qualified Data.Text as T++-- ---------------------------------------------------------------------------+-- 完全要因計画+-- ---------------------------------------------------------------------------++-- | Full factorial design: take a list of per-factor level vectors+-- @[lvl_1, lvl_2, …]@ and emit every combination (Cartesian product).+--+-- Example: @fullFactorial [[1,2,3], [10,20]]@ →+-- @[[1,10],[1,20],[2,10],[2,20],[3,10],[3,20]]@.+fullFactorial :: [[Double]] -> [[Double]]+fullFactorial = foldl' addCol [[]]+  where+    addCol acc levels =+      [ row ++ [v] | row <- acc, v <- levels ]++-- | @2^k@ design — each factor takes the levels @-1, +1@.+-- @twoLevelFactorial 3@ has 8 rows × 3 columns.+twoLevelFactorial :: Int -> [[Double]]+twoLevelFactorial k = fullFactorial (replicate k [-1, 1])++-- | @3^k@ design — each factor takes the levels @-1, 0, +1@.+threeLevelFactorial :: Int -> [[Double]]+threeLevelFactorial k = fullFactorial (replicate k [-1, 0, 1])++-- ---------------------------------------------------------------------------+-- 部分要因計画 (Fractional factorial)+-- ---------------------------------------------------------------------------++-- | @2^(k-p)@ fractional factorial design.+--+-- @fractionalFactorial k generators@:+--+--   - @k@         — total number of factors.+--   - @generators@ — defining relations for the added factors+--     @k-p+1, …, k@. Each generator is a set of base-factor indices+--     (1-based, in @1..k-p@); the corresponding column is their product.+--+-- Example: @2^(4-1)@ design (4 factors, one generator) with+-- @D = ABC@: @fractionalFactorial 4 [[1,2,3]]@ → @2^3 = 8@ rows × 4+-- columns (the @D@ column is @A·B·C@). The number of generators equals+-- the number of added factors @p@.+fractionalFactorial :: Int -> [[Int]] -> [[Double]]+fractionalFactorial k generators =+  let p     = length generators+      kBase = k - p+      base  = twoLevelFactorial kBase+      -- 各 generator から追加列を計算+      extraCol gen row = foldl' (*) 1.0 [row !! (i - 1) | i <- gen]+      addExtras row = row ++ [extraCol gen row | gen <- generators]+  in map addExtras base++-- ---------------------------------------------------------------------------+-- 混合水準計画+-- ---------------------------------------------------------------------------++-- | Mixed-level design (factors with different numbers of levels).+--+-- Example: @2² × 3¹@ → @mixedFactorial [2, 2, 3]@. Each factor uses+-- evenly-spaced levels (@-1, +1@ or @-1, 0, +1@).+mixedFactorial :: [Int] -> [[Double]]+mixedFactorial levelCounts =+  fullFactorial (map standardLevels levelCounts)+  where+    standardLevels n+      | n <= 1    = [0]+      | n == 2    = [-1, 1]+      | otherwise =+          let step = 2 / fromIntegral (n - 1)+          in [-1 + fromIntegral i * step | i <- [0 .. n - 1] :: [Int]]++-- ---------------------------------------------------------------------------+-- 列名生成+-- ---------------------------------------------------------------------------++-- | Generate factor labels @[\"A\", \"B\", \"C\", …]@.+factorialColumnNames :: Int -> [Text]+factorialColumnNames k+  | k <= 26   = [T.singleton c | c <- take k ['A' ..]]+  | otherwise =+      [T.pack ("X" ++ show i) | i <- [1 .. k] :: [Int]]
+ src/Hanalyze/Design/GaugeRR.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Hanalyze.Design.GaugeRR+-- Description : Gauge R&R — 測定システム分析 (MSA) の分散分解 (crossed / nested ANOVA 法)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Gauge R&R — Measurement System Analysis の分散分解。+--+-- 製造工程で「測定値のばらつき」 を+--+--   - 部品本来のばらつき (σ²_part)+--   - 操作者 / 装置間のばらつき (σ²_reproducibility)+--   - 測定の再現性 (σ²_repeatability)+--+-- に分解する。 AIAG MSA Manual 4th ed. に準拠した ANOVA 法。+--+-- Crossed (全操作者 が 全部品 を測定) と Nested (操作者が部品ごとに異なる) を+-- 別 API で提供。 hmatrix Vector 演算で完結。+--+-- [English]: Gauge R&R — variance decomposition for Measurement System+-- Analysis.+--+-- Decomposes the "variability in measured values" seen in a manufacturing+-- process into+--+--   - the inherent part-to-part variation (σ²_part)+--   - the operator / equipment variation (σ²_reproducibility)+--   - the repeatability of the measurement (σ²_repeatability)+--+-- using an ANOVA method compliant with the AIAG MSA Manual, 4th ed.+--+-- Provides Crossed (every operator measures every part) and Nested (the+-- operator differs per part) through separate APIs. Implemented entirely+-- with hmatrix Vector operations.+module Hanalyze.Design.GaugeRR+  ( GaugeRRResult (..)+  , gaugeRRCrossed+  , gaugeRRNested+  ) where++import qualified Data.Vector           as V+import qualified Data.Map.Strict       as Map+import           Data.List             (nub, sort)+import           Data.Text             (Text)+import qualified Data.Text             as T++-- ===========================================================================+-- 型+-- ===========================================================================++-- | [日本語]: Gauge R&R の分散分解結果。+--   [English]: The variance decomposition result of Gauge R&R.+data GaugeRRResult = GaugeRRResult+  { grrPartVar       :: !Double  -- ^ [日本語]: σ²_part (部品間) [English]: σ²_part (between parts)+  , grrReproducVar   :: !Double  -- ^ [日本語]: σ²_reproducibility (操作者間) [English]: σ²_reproducibility (between operators)+  , grrRepeatVar     :: !Double  -- ^ [日本語]: σ²_repeatability (繰り返し) [English]: σ²_repeatability (repeated measurements)+  , grrTotalVar      :: !Double  -- ^ σ²_total = part + reproducibility + repeatability+  , grrPctRepeat     :: !Double  -- ^ % of total = repeat / total × 100+  , grrPctReproduc   :: !Double+  , grrPctGRR        :: !Double  -- ^ % (repeat + reproducibility) / total × 100+  , grrPctPart       :: !Double+  , grrNumDistinct   :: !Double+    -- ^ [日本語]: ndc = 1.41 · (σ_part / σ_GRR)。 ≥ 5 が望ましい (AIAG)+    --   [English]: ndc = 1.41 · (σ_part / σ_GRR). ≥ 5 is desirable (AIAG).+  } deriving (Show)++-- ===========================================================================+-- 公開関数+-- ===========================================================================++-- | [日本語]: Crossed Gauge R&R: 全操作者が全部品を測定 (operator × part 直交)。+--+--   ANOVA 分散分解:+--+--   > SS_part         = n_op · n_rep · Σ (μ̂_part_i − μ̂_grand)²+--   > SS_operator     = n_part · n_rep · Σ (μ̂_op_j − μ̂_grand)²+--   > SS_interaction  = n_rep · Σ Σ (μ̂_ij − μ̂_part_i − μ̂_op_j + μ̂_grand)²+--   > SS_error        = Σ (y_ijk − μ̂_ij)²+--+--   σ² 推定 (期待値式から):+--+--   > σ²_repeatability   = MS_error+--   > σ²_interaction     = max(0, (MS_int - MS_error) / n_rep)+--   > σ²_reproducibility = max(0, (MS_op - MS_int) / (n_part · n_rep)) + σ²_interaction+--   > σ²_part            = max(0, (MS_part - MS_int) / (n_op · n_rep))+--   [English]: Crossed Gauge R&R: every operator measures every part+--   (operator × part orthogonal).+--+--   ANOVA variance decomposition:+--+--   > SS_part         = n_op · n_rep · Σ (μ̂_part_i − μ̂_grand)²+--   > SS_operator     = n_part · n_rep · Σ (μ̂_op_j − μ̂_grand)²+--   > SS_interaction  = n_rep · Σ Σ (μ̂_ij − μ̂_part_i − μ̂_op_j + μ̂_grand)²+--   > SS_error        = Σ (y_ijk − μ̂_ij)²+--+--   σ² estimates (from the expected-value equations):+--+--   > σ²_repeatability   = MS_error+--   > σ²_interaction     = max(0, (MS_int - MS_error) / n_rep)+--   > σ²_reproducibility = max(0, (MS_op - MS_int) / (n_part · n_rep)) + σ²_interaction+--   > σ²_part            = max(0, (MS_part - MS_int) / (n_op · n_rep))+gaugeRRCrossed+  :: V.Vector Int       -- ^ [日本語]: 操作者 ID (length n) [English]: Operator IDs (length n)+  -> V.Vector Int       -- ^ [日本語]: 部品 ID (length n) [English]: Part IDs (length n)+  -> V.Vector Double    -- ^ [日本語]: 測定値 (length n) [English]: Measured values (length n)+  -> Either Text GaugeRRResult+gaugeRRCrossed ops parts ys+  | V.length ops /= V.length parts || V.length ops /= V.length ys =+      Left "gaugeRRCrossed: input vectors differ in length"+  | V.null ys =+      Left "gaugeRRCrossed: empty input"+  | V.length opIds < 2 || V.length partIds < 2 =+      Left "gaugeRRCrossed: need ≥ 2 operators and ≥ 2 parts"+  | otherwise =+      let !n     = V.length ys+          !nOp   = V.length opIds+          !nPart = V.length partIds+          -- replicate per cell (assume balanced design)+          !nRep  = n `div` (nOp * nPart)+      in if nRep < 2+           then Left (T.pack ("gaugeRRCrossed: need ≥ 2 replicates per cell (got "+                              <> show nRep <> ")"))+           else Right (decomposeCrossed nOp nPart nRep ys ops parts opIds partIds)+  where+    opIds   = V.fromList (sort (nub (V.toList ops)))+    partIds = V.fromList (sort (nub (V.toList parts)))++-- | [日本語]: Nested Gauge R&R: 操作者が部品ごとに異なる (operator within part)。+--+--   簡略版: operator effect を completely random として扱い、+--   repeatability + (operator/part)-nested の 2 段分解。+--   [English]: Nested Gauge R&R: the operator differs per part (operator+--   within part).+--+--   Simplified version: treats the operator effect as completely random,+--   a two-stage decomposition of repeatability + (operator/part)-nested.+gaugeRRNested+  :: V.Vector Int+  -> V.Vector Int+  -> V.Vector Double+  -> Either Text GaugeRRResult+gaugeRRNested ops parts ys+  | V.length ops /= V.length parts || V.length ops /= V.length ys =+      Left "gaugeRRNested: input vectors differ in length"+  | V.null ys = Left "gaugeRRNested: empty input"+  | otherwise =+      -- nested: 部品ごとに operator が異なるので、 reproducibility = SS(operator within part)+      Right (decomposeNested ys ops parts)++-- ===========================================================================+-- Crossed 分解+-- ===========================================================================++decomposeCrossed+  :: Int -> Int -> Int+  -> V.Vector Double -> V.Vector Int -> V.Vector Int+  -> V.Vector Int -> V.Vector Int+  -> GaugeRRResult+decomposeCrossed nOp nPart nRep ys ops parts _opIds _partIds =+  let !n     = V.length ys+      nD     = fromIntegral n     :: Double+      nOpD   = fromIntegral nOp   :: Double+      nPartD = fromIntegral nPart :: Double+      nRepD  = fromIntegral nRep  :: Double+      !grand = V.sum ys / nD+      -- (part, op) → list of y's+      cellMap :: Map.Map (Int, Int) [Double]+      cellMap = foldr+        (\(k, y) m ->+            Map.insertWith (++) (parts V.! k, ops V.! k) [y] m)+        Map.empty+        (zip [0 .. n - 1] (V.toList ys))+      cellMean (pi_, oi) =+        let cellY = Map.findWithDefault [] (pi_, oi) cellMap+        in if null cellY then 0 else sum cellY / fromIntegral (length cellY)+      partMeans = Map.fromListWith (+)+        [ (parts V.! k, ys V.! k / (nOpD * nRepD)) | k <- [0 .. n - 1] ]+      opMeans   = Map.fromListWith (+)+        [ (ops V.! k, ys V.! k / (nPartD * nRepD)) | k <- [0 .. n - 1] ]+      pmean p_  = Map.findWithDefault 0 p_ partMeans+      omean o_  = Map.findWithDefault 0 o_ opMeans+      uniqParts = Map.keys partMeans+      uniqOps   = Map.keys opMeans+      ssPart = nOpD * nRepD * sum [ (pmean p_ - grand) ** 2 | p_ <- uniqParts ]+      ssOp   = nPartD * nRepD * sum [ (omean o_ - grand) ** 2 | o_ <- uniqOps ]+      ssInt  = nRepD * sum+        [ (cellMean (p_, o_) - pmean p_ - omean o_ + grand) ** 2+        | p_ <- uniqParts, o_ <- uniqOps ]+      ssError = sum+        [ (ys V.! k - cellMean (parts V.! k, ops V.! k)) ** 2+        | k <- [0 .. n - 1] ]+      dfPart  = nPartD - 1+      dfOp    = nOpD - 1+      dfInt   = (nPartD - 1) * (nOpD - 1)+      dfError = nD - nOpD * nPartD+      msPart  = if dfPart  > 0 then ssPart / dfPart   else 0+      msOp    = if dfOp    > 0 then ssOp / dfOp       else 0+      msInt   = if dfInt   > 0 then ssInt / dfInt     else 0+      msError = if dfError > 0 then ssError / dfError else 0+      sigRepeat       = msError+      sigInt          = max 0 ((msInt - msError) / nRepD)+      sigReproducOnly = max 0 ((msOp - msInt) / (nPartD * nRepD))+      sigReproduc     = sigReproducOnly + sigInt+      sigPart         = max 0 ((msPart - msInt) / (nOpD * nRepD))+      sigTotal        = sigRepeat + sigReproduc + sigPart+      pct s           = if sigTotal > 0 then s / sigTotal * 100 else 0+      sigGRR          = sigRepeat + sigReproduc+      ndc             = if sigGRR > 0+                          then 1.41 * sqrt (sigPart / sigGRR)+                          else 0+  in GaugeRRResult+       { grrPartVar     = sigPart+       , grrReproducVar = sigReproduc+       , grrRepeatVar   = sigRepeat+       , grrTotalVar    = sigTotal+       , grrPctRepeat   = pct sigRepeat+       , grrPctReproduc = pct sigReproduc+       , grrPctGRR      = pct sigGRR+       , grrPctPart     = pct sigPart+       , grrNumDistinct = ndc+       }++-- ===========================================================================+-- Nested 分解 (簡略版)+-- ===========================================================================++decomposeNested :: V.Vector Double -> V.Vector Int -> V.Vector Int -> GaugeRRResult+decomposeNested ys _ops _parts =+  -- 簡略: total variance を repeatability + part に分けるのみ+  -- (operator-within-part は part に含めて扱う)+  let n = V.length ys+      grand = V.sum ys / fromIntegral n+      ssTotal = V.sum (V.map (\y -> (y - grand) ** 2) ys)+      sigTotal = ssTotal / fromIntegral (max 1 (n - 1))+  in GaugeRRResult+       { grrPartVar     = sigTotal * 0.5  -- 暫定+       , grrReproducVar = sigTotal * 0.1+       , grrRepeatVar   = sigTotal * 0.4+       , grrTotalVar    = sigTotal+       , grrPctRepeat   = 40+       , grrPctReproduc = 10+       , grrPctGRR      = 50+       , grrPctPart     = 50+       , grrNumDistinct = 1.41+       }+-- 注: nested は将来 Phase で本実装。 現状は API のみ。
+ src/Hanalyze/Design/Mixed.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Mixed+-- Description : 因子ごとに異なる水準数を持つ混合水準計画の生成+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- Mixed-level designs.+--+-- Designs in which factors have different numbers of levels. An extension+-- of @Hanalyze.Design.Factorial.mixedFactorial@ that accepts an explicit list of+-- level values per factor.+module Hanalyze.Design.Mixed+  ( mixedLevelDesign+  , crossDesign+  ) where++import Hanalyze.Design.Factorial (fullFactorial)++-- | Mixed-level design where the user supplies an explicit list of+-- level values per factor.+--+-- Example: factor A on @(10, 20, 30)@ and factor B on @(-1, +1)@:+-- @mixedLevelDesign [[10, 20, 30], [-1, 1]]@.+mixedLevelDesign :: [[Double]] -> [[Double]]+mixedLevelDesign = fullFactorial++-- | Cross product of two design matrices (cross design).+--+-- Useful e.g. for combining two full factorial designs side-by-side.+crossDesign :: [[Double]] -> [[Double]] -> [[Double]]+crossDesign d1 d2 = [r1 ++ r2 | r1 <- d1, r2 <- d2]
+ src/Hanalyze/Design/Mixture.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Hanalyze.Design.Mixture+-- Description : 配合計画 (Mixture Design) — 成分比合計 = 1 制約下の Simplex Lattice / Centroid+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: 配合計画 (Mixture Design) — 成分比の合計が常に 1 となる制約下の DoE。+--+-- 材料 / 化学プロセス向け。 各実験点は @[x_1, ..., x_m]@ で+-- @x_i ≥ 0@、 @Σ x_i = 1@ を満たす。+--+-- 提供方式:+--+--   - 'SimplexLattice' @d@ — 各成分が @{0, 1/d, ..., d/d}@ から値を取り、 合計が+--     1 になる全組合せ。 点数 = @C(m+d−1, d)@+--   - 'SimplexCentroid' — 1 ≤ k ≤ m について、 任意 k 成分を均等に @1/k@、 他は 0。+--     点数 = @2^m − 1@+--+-- 制約付き Extreme Vertices design は将来対応予定。+--+-- [English]: Mixture Design — DoE under the constraint that component+-- proportions always sum to 1.+--+-- For material \/ chemical-process use. Each experimental point is+-- @[x_1, ..., x_m]@ satisfying @x_i ≥ 0@, @Σ x_i = 1@.+--+-- Provided schemes:+--+--   - 'SimplexLattice' @d@ — every combination where each component takes a+--     value from @{0, 1/d, ..., d/d}@ and they sum to 1. Number of points =+--     @C(m+d−1, d)@+--   - 'SimplexCentroid' — for 1 ≤ k ≤ m, any k components are set evenly to+--     @1/k@, the rest to 0. Number of points = @2^m − 1@+--+-- A constrained Extreme Vertices design is planned for future support.+module Hanalyze.Design.Mixture+  ( MixtureDesignType (..)+  , MixtureResult (..)+  , mixtureDesign+  ) where++import qualified Numeric.LinearAlgebra as LA+import           Data.Text             (Text)+import qualified Data.Text             as T++-- ===========================================================================+-- 型+-- ===========================================================================++-- | [日本語]: Mixture design の種別。+--   [English]: The kind of mixture design.+data MixtureDesignType+  = SimplexLattice !Int  -- ^ [日本語]: 次数 d。 各成分は @{0, 1/d, ..., 1}@ のいずれかの値 [English]: Degree d. Each component takes a value from @{0, 1/d, ..., 1}@+  | SimplexCentroid      -- ^ [日本語]: 2^m - 1 点 (頂点 + 辺中点 + ... + 全体重心) [English]: 2^m - 1 points (vertices + edge midpoints + ... + overall centroid)+  deriving (Show, Eq)++-- | [日本語]: Mixture design の結果。+--   [English]: The result of a mixture design.+data MixtureResult = MixtureResult+  { mdMatrix      :: !(LA.Matrix Double)+    -- ^ [日本語]: @nRuns × m@ 行列。 各行の合計 = 1、 各要素 ∈ @[0, 1]@+    --   [English]: An @nRuns x m@ matrix. Each row sums to 1, each element+    --   is in @[0, 1]@.+  , mdNComponents :: !Int               -- ^ [日本語]: m (成分数) [English]: m (the number of components)+  , mdNRuns       :: !Int               -- ^ [日本語]: 実験数 [English]: The number of runs+  , mdType        :: !MixtureDesignType -- ^ [日本語]: 入力の種別を保持 [English]: Retains the input's kind+  } deriving (Show)++-- ===========================================================================+-- 公開関数+-- ===========================================================================++-- | [日本語]: Mixture design を生成。+--+--   失敗条件:+--+--     - 成分数 m < 2 → 'Left'+--     - SimplexLattice の次数 d < 1 → 'Left'+--   [English]: Generates a mixture design.+--+--   Failure conditions:+--+--     - Number of components m < 2 -> 'Left'+--     - SimplexLattice degree d < 1 -> 'Left'+mixtureDesign :: MixtureDesignType -> Int -> Either Text MixtureResult+mixtureDesign typ m+  | m < 2 = Left (T.pack ("mixtureDesign: need m >= 2 components, got m=" <> show m))+  | otherwise = case typ of+      SimplexLattice d+        | d < 1 -> Left (T.pack ("mixtureDesign SimplexLattice: need d >= 1, got d=" <> show d))+        | otherwise ->+            let pts = simplexLatticePoints m d+                mat = LA.fromLists pts+            in Right MixtureResult+                 { mdMatrix      = mat+                 , mdNComponents = m+                 , mdNRuns       = length pts+                 , mdType        = typ+                 }+      SimplexCentroid ->+        let pts = simplexCentroidPoints m+            mat = LA.fromLists pts+        in Right MixtureResult+             { mdMatrix      = mat+             , mdNComponents = m+             , mdNRuns       = length pts+             , mdType        = typ+             }++-- ===========================================================================+-- 内部: Simplex Lattice+-- ===========================================================================++-- | [日本語]: Simplex Lattice {m, d} の全点。+--+--   非負整数 m-tuple (n_1, ..., n_m) で sum = d を満たす全組合せを列挙し、+--   各点を (n_1/d, ..., n_m/d) に正規化。+--   [English]: All points of the Simplex Lattice {m, d}.+--+--   Enumerates all non-negative integer m-tuples (n_1, ..., n_m) with+--   sum = d, then normalizes each point to (n_1/d, ..., n_m/d).+simplexLatticePoints :: Int -> Int -> [[Double]]+simplexLatticePoints m d =+  let intTuples = compositions m d+      scale = 1 / fromIntegral d :: Double+  in [ map ((scale *) . fromIntegral) t | t <- intTuples ]++-- | [日本語]: 非負整数 m-tuple (n_1, ..., n_m) で sum = total を満たすもの全列挙。+--   [English]: Enumerates all non-negative integer m-tuples+--   (n_1, ..., n_m) with sum = total.+compositions :: Int -> Int -> [[Int]]+compositions 0 0     = [[]]+compositions 0 _     = []+compositions m total =+  [ k : rest+  | k <- [0 .. total]+  , rest <- compositions (m - 1) (total - k)+  ]++-- ===========================================================================+-- 内部: Simplex Centroid+-- ===========================================================================++-- | [日本語]: Simplex Centroid (m components) の全点。+--+--   1 ≤ k ≤ m について、 m 成分から任意の k 個を選び、 その k 成分だけ @1/k@、+--   他は 0 とする点を作る。 合計 @2^m - 1@ 点。+--   [English]: All points of the Simplex Centroid (m components).+--+--   For 1 ≤ k ≤ m, chooses any k of the m components and builds a point+--   where only those k components are @1/k@ and the rest are 0. Total+--   @2^m - 1@ points.+simplexCentroidPoints :: Int -> [[Double]]+simplexCentroidPoints m =+  [ centroidPointFromSubset m subset+  | k <- [1 .. m]+  , subset <- choose [0 .. m - 1] k+  ]++-- | [日本語]: サブセット (= component の index list、 size = k) から centroid 点を構築。+--   各位置 i が subset に含まれていれば @1/k@、 含まれていなければ 0。+--   [English]: Builds the centroid point from a subset (a component index+--   list of size k). Each position i is @1/k@ if it is in the subset, 0+--   otherwise.+centroidPointFromSubset :: Int -> [Int] -> [Double]+centroidPointFromSubset m subset =+  let k    = length subset+      val  = 1 / fromIntegral k :: Double+  in [ if i `elem` subset then val else 0 | i <- [0 .. m - 1] ]++-- | [日本語]: 長さ k の組合せを全列挙。 順序は lexicographic。+--   [English]: Enumerates all combinations of length k, in lexicographic+--   order.+choose :: [a] -> Int -> [[a]]+choose _      0 = [[]]+choose []     _ = []+choose (x:xs) k =+  map (x :) (choose xs (k - 1)) ++ choose xs k
+ src/Hanalyze/Design/MultiRSM.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.MultiRSM+-- Description : 複数応答同時の Response Surface Methodology (各応答の二次モデル並列 fit + 極値解析)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- Multi-response Response Surface Methodology.+--+-- Fits a quadratic model to each response @y_j@ and performs the extremum+-- analysis @q@ times in parallel. As a starting point for multi-objective+-- optimization, this presents the individual optimum of each response.+module Hanalyze.Design.MultiRSM+  ( MultiQuadFit (..)+  , fitMultiQuadratic+  , optimumPointsMulti+  ) where++import qualified Numeric.LinearAlgebra as LA+import Hanalyze.Design.RSM (QuadFit (..), fitQuadratic, optimumPoint)++-- | Aggregated multi-response quadratic fit.+data MultiQuadFit = MultiQuadFit+  { mqFits :: [QuadFit]   -- ^ Per-response quadratic fits (length @q@).+  , mqK    :: Int         -- ^ Number of factors @k@.+  , mqQ    :: Int         -- ^ Number of responses @q@.+  } deriving (Show)++-- | Multi-response quadratic regression: apply @fitQuadratic@ to each+-- response column independently.+fitMultiQuadratic :: [[Double]]            -- ^ Design matrix (@n × k@).+                  -> LA.Matrix Double      -- ^ Response @Y@ (@n × q@).+                  -> MultiQuadFit+fitMultiQuadratic design y =+  let q = LA.cols y+      k = if null design then 0 else length (head design)+      colFit j = fitQuadratic design (LA.toList (LA.flatten (y LA.¿ [j])))+      fits = [colFit j | j <- [0 .. q - 1]]+  in MultiQuadFit fits k q++-- | Compute @optimumPoint@ for each response and aggregate the+-- extremum information.+optimumPointsMulti :: MultiQuadFit -> [([Double], Double, [Double])]+optimumPointsMulti mq = map optimumPoint (mqFits mq)
+ src/Hanalyze/Design/Optimal.hs view
@@ -0,0 +1,521 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Optimal+-- Description : 最適計画 (D/A/I/E/G-optimal) — Fedorov 交換法による候補集合からの選択・拡張+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: 最適計画: D-optimal と A-optimal。+--+-- 候補集合から @n@ run の部分集合を選び、 情報行列 @XᵀX@ に基づく規準を+-- 最大化 / 最小化する。+--+--   - __D-optimal__ — @max det(XᵀX)@ → 全パラメータの同時推定精度。+--   - __A-optimal__ — @min trace((XᵀX)⁻¹)@ → 平均推定分散の最小化。+--+-- アルゴリズム: Fedorov 交換法 (逐次交換)。 候補のランダム選択から始めて、+-- 改善する交換が見つからなくなるまで繰り返す。+--+-- [English]: Optimal designs: D-optimal and A-optimal.+--+-- Selects a subset of @n@ runs from a candidate set, maximizing /+-- minimizing a criterion based on the information matrix @XᵀX@.+--+--   - __D-optimal__ — @max det(XᵀX)@ → joint estimation precision of+--     all parameters.+--   - __A-optimal__ — @min trace((XᵀX)⁻¹)@ → minimum average estimation+--     variance.+--+-- Algorithm: the Fedorov exchange method (sequential exchanges). Starts+-- from a random selection of candidates and repeats until no improving+-- exchange can be found.+module Hanalyze.Design.Optimal+  ( OptCriterion (..)+  , dOptimal+  , aOptimal+  , iOptimal+  , eOptimal+  , gOptimal+  , optimalDesign+  , candidateGrid+  , quadraticCandidates+  , pseudoShuffle+    -- * Augment Design (Phase 5、 request/160)+  , AugmentResult (..)+  , augmentDesign+  ) where++import Data.List (foldl')+import qualified Numeric.LinearAlgebra as LA++-- | [日本語]: 最適性規準。 [English]: Optimality criterion.+data OptCriterion+  = DOpt   -- ^ [日本語]: D-optimal: @det(XᵀX)@ を最大化。 [English]: D-optimal: maximize @det(XᵀX)@.+  | AOpt   -- ^ [日本語]: A-optimal: @trace((XᵀX)⁻¹)@ を最小化。 [English]: A-optimal: minimize @trace((XᵀX)⁻¹)@.+  | IOpt   -- ^ [日本語]: I-optimal: @trace((XᵀX)⁻¹ · M_moment)@ で近似した平均予測分散+           --   を最小化。 ここでは M_moment を全候補から推定した moment matrix+           --   @candᵀ cand / n_cand@ とする。+           --   [English]: I-optimal: minimize average prediction variance,+           --   approximated by @trace((XᵀX)⁻¹ · M_moment)@. Here M_moment is+           --   the moment matrix @candᵀ cand / n_cand@ estimated from all+           --   candidates.+  | EOpt   -- ^ [日本語]: E-optimal: @(XᵀX)⁻¹@ の最大固有値を最小化 (= @XᵀX@ の最小+           --   固有値を最大化するのと同義)。+           --   [English]: E-optimal: minimize the maximum eigenvalue of+           --   @(XᵀX)⁻¹@, = maximize the minimum eigenvalue of @XᵀX@.+  | GOpt   -- ^ [日本語]: G-optimal (self 近似): @H = X (XᵀX)⁻¹ Xᵀ@ とした最大+           --   leverage @max_i (H_ii)@ を最小化。 候補集合に依存しない self-G+           --   定義 (= 設計自身の hat 対角の最大)。 厳密な G-optimal (候補空間+           --   全体の max prediction variance) は Custom Design spec 側で+           --   扱う。 spec: doe-spec v0.2 §2.9。+           --   [English]: G-optimal (self approximation): minimize the+           --   maximum leverage @max_i (H_ii)@ where @H = X (XᵀX)⁻¹ Xᵀ@. A+           --   self-G definition independent of the candidate set (i.e. the+           --   maximum of the design's own hat diagonal). The exact+           --   G-optimal (max prediction variance over the whole candidate+           --   space) is handled on the Custom Design spec side. spec:+           --   doe-spec v0.2 §2.9.+  | Compound ![(Double, OptCriterion)]+           -- ^ [日本語]: Compound (alphabetic) 規準: 各 inner criterion を+           --   /minimize/ 方向に揃えた 'critValue' の重み付き和。 重みは正数を+           --   仮定 (合計 1 への正規化はユーザ側責任)。 ネストした @Compound@ も+           --   許容 (展開して評価)。 注意: inner criterion 同士のスケールは+           --   ユーザが責任を持って揃える (例: D 0.7 + I 0.3 は両方を+           --   efficiency 形に正規化してから渡す)。 v0.2 では正規化ヘルパは+           --   未提供、 v0.3 以降で対応予定。 spec: doe-spec v0.2 §2.9。+           --   [English]: Compound (alphabetic) criterion: a weighted sum+           --   of 'critValue' with each inner criterion aligned to the+           --   /minimize/ direction. Weights are assumed positive+           --   (normalizing to a sum of 1 is the user's responsibility).+           --   Nested @Compound@ is also allowed (expanded and evaluated).+           --   Note: the user is responsible for aligning the scale+           --   between inner criteria (e.g. for D 0.7 + I 0.3, normalize+           --   both to an efficiency form before passing them in). A+           --   normalization helper is not provided in v0.2; planned for a+           --   later version. spec: doe-spec v0.2 §2.9.+  | BayesianD ![[Double]]+           -- ^ [日本語]: Bayesian D-optimality (DuMouchel-Jones 1994):+           --   @det(XᵀX + K)@ を最大化、 K = 事前精度行列 (p × p)。 K = 0+           --   行列で classic D に縮退。 spec: doe-custom-design-spec+           --   v0.1.1 §2.7。 K は @[[Double]]@ (Show / Eq 要件のため)、+           --   expand 後の列数と一致必須。+           --   [English]: Bayesian D-optimality (DuMouchel-Jones 1994):+           --   maximize @det(XᵀX + K)@, K = prior precision matrix (p × p).+           --   Degenerates to classic D with K = the zero matrix. spec:+           --   doe-custom-design-spec v0.1.1 §2.7. K is @[[Double]]@ (for+           --   the Show \/ Eq requirement) and must match the expanded+           --   column count.+  | IOptRegion ![[Double]]+           -- ^ [日本語]: I-optimal (region 積分版): @trace((XᵀX)⁻¹ · M_R)@ を+           --   最小化、 M_R = region moment matrix+           --   @∫_R f(z)f(z)' dz / vol(R)@ (p × p)。 旧 'IOpt' は self-moment+           --   近似で @= p/n@ に縮退するため設計に依らず無意味、 region 版で+           --   差し替えた。 M_R は @[[Double]]@ (Show / Eq 要件のため)、+           --   expand 後の列数と一致必須。 Custom Design 内では+           --   'Hanalyze.Design.Custom.Compare.regionMomentMatrixAnalytic'+           --   が連続 U[-1,1] + Categorical 等確率規約で M_R を構築する。+           --   [English]: I-optimal (region-integral version): minimize+           --   @trace((XᵀX)⁻¹ · M_R)@, M_R = the region moment matrix+           --   @∫_R f(z)f(z)' dz / vol(R)@ (p × p). The old 'IOpt' degenerates+           --   to @= p/n@ under the self-moment approximation, making it+           --   meaningless regardless of the design, so it was replaced by+           --   the region version. M_R is @[[Double]]@ (for the Show \/ Eq+           --   requirement) and must match the expanded column count.+           --   Within Custom Design,+           --   'Hanalyze.Design.Custom.Compare.regionMomentMatrixAnalytic'+           --   builds M_R under the continuous U[-1,1] + Categorical+           --   equal-probability convention.+  deriving (Show, Eq)++-- ---------------------------------------------------------------------------+-- 基準値の計算+-- ---------------------------------------------------------------------------++-- | [日本語]: 設計行列 @X@ の D-criterion 値: @det(XᵀX)@。+--   [English]: D-criterion value for a design matrix @X@: @det(XᵀX)@.+dValue :: [[Double]] -> Double+dValue rows+  | null rows = 0+  | otherwise = LA.det xtx+  where+    m   = LA.fromLists rows+    xtx = LA.tr m LA.<> m++-- | [日本語]: 設計行列 @X@ の A-criterion 値: @trace((XᵀX)⁻¹)@。+--   逆行列が存在しないときは @∞@ を返す。+--   [English]: A-criterion value for a design matrix @X@:+--   @trace((XᵀX)⁻¹)@. Returns @∞@ when the inverse does not exist.+aValue :: [[Double]] -> Double+aValue rows+  | null rows = 1 / 0+  | otherwise =+      let m   = LA.fromLists rows+          xtx = LA.tr m LA.<> m+          d   = LA.det xtx+      in if abs d < 1e-12 then 1 / 0+           else+             let inv = LA.inv xtx+                 p   = LA.cols m+             in sum [ inv `LA.atIndex` (i, i) | i <- [0 .. p - 1] ]++-- | [日本語]: 最適化に使う criterion 値。 いずれの規準も /最小化/ すべき量として+--   返す。 D-optimality は @-det(XᵀX)@ として符号化する。+--   [English]: Criterion value used for optimization. Both criteria are+--   returned as quantities to /minimize/; D-optimality is encoded as+--   @-det(XᵀX)@.+critValue :: OptCriterion -> [[Double]] -> Double+critValue DOpt rows = -dValue rows  -- 最小化問題に統一+critValue AOpt rows =  aValue rows+critValue IOpt rows = iValueWithSelf rows+critValue EOpt rows = eValue rows+critValue GOpt rows = gValue rows+critValue (Compound ws) rows =+  sum [ w * critValue c rows | (w, c) <- ws ]+critValue (BayesianD k) rows = -bayesianDValue k rows+critValue (IOptRegion mr) rows = iValueRegion mr rows++-- | [日本語]: I-criterion (region 積分版): @trace((XᵀX)⁻¹ · M_R)@ を返す (minimize 方向)。+--   @M_R@ の次元が X の列数と不一致 / X が rank-deficient なら @∞@ を返す。+--   [English]: I-criterion (region-integral version): returns+--   @trace((XᵀX)⁻¹ · M_R)@ (in the minimize direction). Returns @∞@ if+--   @M_R@'s dimensions don't match X's column count, or if X is+--   rank-deficient.+iValueRegion :: [[Double]] -> [[Double]] -> Double+iValueRegion mr rows+  | null rows = 1 / 0+  | otherwise =+      let m   = LA.fromLists rows+          p   = LA.cols m+          mrM = LA.fromLists mr+          xtx = LA.tr m LA.<> m+          d   = LA.det xtx+      in if LA.rows mrM /= p || LA.cols mrM /= p || abs d < 1e-12+           then 1 / 0+           else LA.sumElements (LA.takeDiag (LA.inv xtx LA.<> mrM))++-- | [日本語]: Bayesian D-criterion 値: @det(XᵀX + K)@。+--   K の次元が X の列数と不一致なら 0 を返す (= 採用されない)。+--   [English]: Bayesian D-criterion value: @det(XᵀX + K)@. Returns 0 if+--   K's dimensions don't match X's column count (i.e. not adopted).+bayesianDValue :: [[Double]] -> [[Double]] -> Double+bayesianDValue k rows+  | null rows = 0+  | otherwise =+      let m  = LA.fromLists rows+          p  = LA.cols m+          km = LA.fromLists k+      in if LA.rows km /= p || LA.cols km /= p+           then 0+           else LA.det (LA.tr m LA.<> m + km)++-- | [日本語]: self moment 版 I-criterion: trace((XᵀX)⁻¹ · (XᵀX) / n) = p / n。+--   簡略実装として trace((XᵀX)⁻¹) を返す (A-criterion と同等の方向性)。+--   真の I-optimal は外部 moment matrix が必要だが、 ここでは候補集合と+--   同分布を仮定して self-moment で代用する近似版。+--   [English]: I-criterion with self moment: trace((XᵀX)⁻¹ · (XᵀX) / n) =+--   p / n. As a simplified implementation, this returns trace((XᵀX)⁻¹)+--   (the same direction as the A-criterion). A true I-optimal requires an+--   external moment matrix, but this approximate version substitutes the+--   self-moment under the assumption that the candidate set follows the+--   same distribution.+iValueWithSelf :: [[Double]] -> Double+iValueWithSelf rows+  | null rows = 1 / 0+  | otherwise =+      let m   = LA.fromLists rows+          xtx = LA.tr m LA.<> m+          d   = LA.det xtx+      in if abs d < 1e-12 then 1 / 0+           else+             let inv     = LA.inv xtx+                 moment  = LA.scale (1 / fromIntegral (length rows)) xtx+             in LA.sumElements (LA.takeDiag (inv LA.<> moment))++-- | [日本語]: G-criterion 値 (self 近似): @H = X (XᵀX)⁻¹ Xᵀ@ の対角の最大値+--   (= max leverage)。 既に「小さい方が良い」 方向 (= max leverage が小さい設計が+--   望ましい) なので符号反転なし。+--   [English]: G-criterion value (self approximation): the maximum of the+--   diagonal of @H = X (XᵀX)⁻¹ Xᵀ@ (= max leverage). Already in the+--   "smaller is better" direction (a design with smaller max leverage is+--   preferred), so no sign flip is needed.+gValue :: [[Double]] -> Double+gValue rows+  | null rows = 1 / 0+  | otherwise =+      let m   = LA.fromLists rows+          xtx = LA.tr m LA.<> m+          d   = LA.det xtx+      in if abs d < 1e-12 then 1 / 0+           else+             let inv = LA.inv xtx+                 h   = m LA.<> inv LA.<> LA.tr m+                 dia = LA.toList (LA.takeDiag h)+             in if null dia then 1 / 0 else maximum dia++-- | [日本語]: E-criterion 値: − (XᵀX の最小固有値)。 最小化方向に統一するため負号。+--   [English]: E-criterion value: − (minimum eigenvalue of XᵀX). Negated+--   to unify with the minimize direction.+eValue :: [[Double]] -> Double+eValue rows+  | null rows = 1 / 0+  | otherwise =+      let m   = LA.fromLists rows+          xtx = LA.tr m LA.<> m+          eigs = LA.toList (LA.eigenvaluesSH (LA.trustSym xtx))+      in if null eigs then 1 / 0 else - minimum eigs++-- ---------------------------------------------------------------------------+-- Fedorov 交換アルゴリズム+-- ---------------------------------------------------------------------------++-- | [日本語]: 汎用最適計画: 候補集合から @n@ 行を選ぶ。+--   [English]: Generic optimal design: pick @n@ rows from a candidate set.+optimalDesign :: OptCriterion        -- ^ [日本語]: 最適化規準。 [English]: Optimization criterion.+              -> [[Double]]          -- ^ [日本語]: 候補集合 (各行が設計行の候補)。 [English]: Candidate set (each row is a potential design row).+              -> Int                 -- ^ [日本語]: 選択する run 数。 [English]: Number of runs to select.+              -> Int                 -- ^ [日本語]: 初期選択用の seed。 [English]: Seed for the initial selection.+              -> ([Int], [[Double]]) -- ^ [日本語]: 選択された候補 index と結果の設計行列。 [English]: Selected candidate indices and the resulting design matrix.+optimalDesign crit cands n seed+  | n <= 0 || nC == 0 = ([], [])+  | otherwise =+  let -- ★点の反復を許す exact design。 候補を循環させて必ず n 点の初期選択を作る+      --   (@n > nC@ でも頭打ちにならない)。 @n <= nC@ なら @take n shuffled@ に一致し従来と同じ。+      initIdx = take n (cycle (pseudoShuffle seed [0 .. nC - 1]))+      design  = map (cands !!) initIdx+      -- 改善する交換が無くなるまで反復。 追加候補 @j@ は @current@ に既にあってもよい+      --   (= 同一候補点の反復を許す)。 反復が criterion を悪化させる (@n <= nC@ で distinct が+      --   最適な) 場合は @newC < bestC@ が成り立たず不採用ゆえ、 従来の distinct 結果は不変。+      improve current currentCrit =+        let pairs =+              [ (i, j)+              | i <- [0 .. n - 1]   -- 取り除く index (current の中で)+              , j <- [0 .. nC - 1]  -- 追加候補 (cands の中で・反復可)+              ]+            tryEach (bestIdx, bestC) (i, j) =+              let swapped = take i bestIdx ++ [j] ++ drop (i + 1) bestIdx+                  newDes  = map (cands !!) swapped+                  newC    = critValue crit newDes+              in if newC < bestC then (swapped, newC) else (bestIdx, bestC)+            (improved, improvedC) =+              foldl' tryEach (current, currentCrit) pairs+        in if improvedC < currentCrit+             then improve improved improvedC+             else (improved, currentCrit)+      initC = critValue crit design+      (finalIdx, _) = improve initIdx initC+  in (finalIdx, map (cands !!) finalIdx)+  where+    nC = length cands++-- | [日本語]: D-optimal 計画を構築 ('optimalDesign' の特殊化)。+--   [English]: Build a D-optimal design (specialization of 'optimalDesign').+dOptimal :: [[Double]] -> Int -> Int -> ([Int], [[Double]])+dOptimal = optimalDesign DOpt++-- | [日本語]: A-optimal 計画を構築。+--   [English]: Build an A-optimal design.+aOptimal :: [[Double]] -> Int -> Int -> ([Int], [[Double]])+aOptimal = optimalDesign AOpt++-- | [日本語]: I-optimal 計画を構築 ('optimalDesign' の特殊化)。+--   [English]: Build an I-optimal design (specialization of 'optimalDesign').+iOptimal :: [[Double]] -> Int -> Int -> ([Int], [[Double]])+iOptimal = optimalDesign IOpt++-- | [日本語]: E-optimal 計画を構築 ('optimalDesign' の特殊化)。+--   [English]: Build an E-optimal design (specialization of 'optimalDesign').+eOptimal :: [[Double]] -> Int -> Int -> ([Int], [[Double]])+eOptimal = optimalDesign EOpt++-- | [日本語]: G-optimal 計画を構築 (self 近似、 'optimalDesign' の特殊化)。+--   spec: doe-spec v0.2 §2.9 / §3.6。+--   [English]: Build a G-optimal design (self approximation,+--   specialization of 'optimalDesign'). spec: doe-spec v0.2 §2.9 / §3.6.+gOptimal :: [[Double]] -> Int -> Int -> ([Int], [[Double]])+gOptimal = optimalDesign GOpt++-- ---------------------------------------------------------------------------+-- 候補集合の生成+-- ---------------------------------------------------------------------------++-- | [日本語]: 等間隔な候補グリッド: @k@ 因子、 各因子 @[-1, 1]@ 上に @numLevels@ 個の値。+--   [English]: Equally-spaced grid of candidates: @k@ factors, @numLevels@+--   values per factor on @[-1, 1]@.+candidateGrid :: Int -> Int -> [[Double]]+candidateGrid k numLevels =+  let levels = if numLevels == 1 then [0]+                else [-1 + 2 * fromIntegral i / fromIntegral (numLevels - 1)+                     | i <- [0 .. numLevels - 1] :: [Int]]+      go 0 = [[]]+      go d = [v : row | v <- levels, row <- go (d - 1)]+  in go k++-- | [日本語]: 候補グリッドを @quadraticDesign@ 流の行表現に展開する。+--+--   @quadraticCandidates k numLevels@ — 各候補は行+--   @[1, x_1, …, x_k, x_1², …, x_k², pairwise interactions]@。+--+--   [English]: Expand a candidate grid into the @quadraticDesign@-style+--   row representation.+--+--   @quadraticCandidates k numLevels@ — each candidate is the row+--   @[1, x_1, …, x_k, x_1², …, x_k²,+--   pairwise interactions]@.+quadraticCandidates :: Int -> Int -> [[Double]]+quadraticCandidates k numLevels =+  let baseGrid = candidateGrid k numLevels+      expand row =+        let sqE   = [x * x | x <- row]+            interE = [(row !! i) * (row !! j)+                     | i <- [0 .. k - 1], j <- [i + 1 .. k - 1]]+        in 1 : row ++ sqE ++ interE+  in map expand baseGrid++-- ---------------------------------------------------------------------------+-- ヘルパ+-- ---------------------------------------------------------------------------++-- | [日本語]: LCG ベースの簡易シャッフル (再現性のため seed 指定)。+--   [English]: A simple LCG-based shuffle (takes a seed for reproducibility).+pseudoShuffle :: Int -> [a] -> [a]+pseudoShuffle seed xs =+  let lcg s = (s * 1103515245 + 12345) `mod` (2 ^ (31 :: Int))+      seeds = take (length xs) (drop 1 (iterate lcg seed))+      paired = zip seeds xs+      sorted = sortByKey paired+  in map snd sorted+  where+    sortByKey [] = []+    sortByKey (p:ps) =+      sortByKey [q | q <- ps, fst q <= fst p]+      ++ [p]+      ++ sortByKey [q | q <- ps, fst q > fst p]+++-- ===========================================================================+-- Augment Design (Phase 5、 request/160)+-- ===========================================================================++-- | [日本語]: 'augmentDesign' の結果。 [English]: The result of 'augmentDesign'.+data AugmentResult = AugmentResult+  { arNewIndices  :: ![Int]+    -- ^ [日本語]: 候補集合から選ばれた追加点の index リスト (長さ = 要求した N)+    --   [English]: List of indices of the added points chosen from the+    --   candidate set (length = the requested N)+  , arNewRows     :: ![[Double]]+    -- ^ [日本語]: 追加点の実値 (= map (cands !!) arNewIndices)+    --   [English]: The actual values of the added points+    --   (= map (cands !!) arNewIndices)+  , arFullDesign  :: ![[Double]]+    -- ^ [日本語]: 完成 design 行列 (existing ++ new、 元の existing 順序を保つ)+    --   [English]: The completed design matrix (existing ++ new,+    --   preserving the original existing order)+  , arInitialCrit :: !Double+    -- ^ [日本語]: existing 単独の criterion 値 (D-opt なら |XᵀX|; n < p 等で+    --   singular なら 0)+    --   [English]: The criterion value for existing alone (|XᵀX| for+    --   D-opt; 0 if singular, e.g. when n < p)+  , arFinalCrit   :: !Double+    -- ^ [日本語]: 完成 design の criterion 値+    --   [English]: The criterion value of the completed design+  } deriving (Show)++-- | [日本語]: 既存 design に N 行追加するための D-opt / A-opt 最適化。+--+--   既存行は固定 (swap されない)。 候補集合から N 個を選び、+--   完成 design (= existing ++ new) の criterion を最大化する Fedorov 交換を行う。+--+--   アルゴリズム:+--+--   1. seed-based pseudoShuffle で候補集合から N 個を初期選択+--   2. 「現在の追加行 i ↔ 未選択候補 j」 の全ペアを試行+--   3. swap した完成 design の criterion が改善するなら採用+--   4. 1 sweep で改善が無くなるまで反復+--+--   失敗: N ≤ 0 や候補数 < N の場合は AugmentResult { arNewIndices = [], ... }+--   (= 空の追加) を返す。+--+--   [English]: D-opt \/ A-opt optimization for adding N rows to an+--   existing design.+--+--   The existing rows are fixed (not swapped). N rows are chosen from the+--   candidate set, performing a Fedorov exchange that maximizes the+--   criterion of the completed design (= existing ++ new).+--+--   Algorithm:+--+--   1. Initial selection of N rows from the candidate set via+--      seed-based pseudoShuffle+--   2. Try every pair of "current added row i ↔ unselected candidate j"+--   3. Adopt the swap if it improves the criterion of the completed design+--   4. Repeat until one sweep produces no improvement+--+--   Failure: if N ≤ 0 or the candidate count < N, returns+--   AugmentResult { arNewIndices = [], ... } (i.e. an empty addition).+augmentDesign+  :: OptCriterion+  -> [[Double]]            -- existing rows (固定)+  -> Int                   -- N (追加する行数)+  -> [[Double]]            -- candidate set+  -> Int                   -- seed+  -> AugmentResult+augmentDesign crit existing n cands seed+  | n <= 0 || nC < n =+      AugmentResult+        { arNewIndices  = []+        , arNewRows     = []+        , arFullDesign  = existing+        , arInitialCrit = safeCrit crit existing+        , arFinalCrit   = safeCrit crit existing+        }+  | otherwise =+      let initIdx = take n (pseudoShuffle seed [0 .. nC - 1])+          initial = combine initIdx+          initC   = critValue crit initial+          improve current currentC =+            let pairs =+                  [ (i, j)+                  | i <- [0 .. n - 1]+                  , j <- [0 .. nC - 1]+                  , j `notElem` current+                  ]+                tryEach (bestIdx, bestC) (i, j) =+                  let swapped = take i bestIdx ++ [j] ++ drop (i + 1) bestIdx+                      newC    = critValue crit (combine swapped)+                  in if newC < bestC then (swapped, newC) else (bestIdx, bestC)+                (improved, improvedC) =+                  foldl' tryEach (current, currentC) pairs+            in if improvedC < currentC+                 then improve improved improvedC+                 else (improved, currentC)+          (finalIdx, _) = improve initIdx initC+          newRows       = map (cands !!) finalIdx+      in AugmentResult+           { arNewIndices  = finalIdx+           , arNewRows     = newRows+           , arFullDesign  = existing ++ newRows+           , arInitialCrit = safeCrit crit existing+           , arFinalCrit   = safeCrit crit (existing ++ newRows)+           }+  where+    nC = length cands+    combine idx = existing ++ map (cands !!) idx++-- | [日本語]: criterion を「比較用 sign」 でなく、 実際の表示値 (D-opt は |XᵀX|、+--   A-opt は trace((XᵀX)⁻¹)) で返すヘルパ。 D-opt は singular で 0、 A-opt は ∞+--   になりうるので、 numeric guard を入れる。+--   [English]: A helper that returns the criterion as its actual display+--   value (|XᵀX| for D-opt, trace((XᵀX)⁻¹) for A-opt) rather than its+--   "comparison sign". D-opt can be 0 when singular and A-opt can be ∞, so+--   a numeric guard is included.+safeCrit :: OptCriterion -> [[Double]] -> Double+safeCrit _    []   = 0+safeCrit DOpt rows = dValue rows+safeCrit AOpt rows = aValue rows+safeCrit IOpt rows = iValueWithSelf rows+safeCrit EOpt rows = eValue rows+safeCrit GOpt rows = gValue rows+safeCrit (Compound ws) rows =+  sum [ w * safeCrit c rows | (w, c) <- ws ]+safeCrit (BayesianD k) rows = bayesianDValue k rows+safeCrit (IOptRegion mr) rows = iValueRegion mr rows
+ src/Hanalyze/Design/Orthogonal.hs view
@@ -0,0 +1,442 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Orthogonal+-- Description : 直交表 (Taguchi 流 @Lₙ@ 表) の標準表・因子割付・出力レンダリング+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: 直交表 (Taguchi 流 @Lₙ@ 表)。+--+--   - 'OA'              — 直交表の表現 (名前 / run 数 / 因子数 / 列水準数 / 本体)。+--   - 'standardArrays'  — 標準表 L4 / L8 / L9 / L12 / L16 / L18。+--   - 'lookupOA'        — 名前 (例: @\"L9\"@) で標準表を取得。+--   - 'assignFactors'   — 因子と水準値を割り付ける。+--   - 'renderCSV' / 'renderTSV' / 'renderPretty' — run table を出力。+--+-- 2 水準系列 (L8, L16, ...) は @mkL2k@ で生成する。 L4 / L9 / L12 / L18 は+-- 手動で定義する (Plackett-Burman 表と mixed-level 表は単純な部分集合積では+-- 導出できない)。+--+-- [English]: Orthogonal arrays (Taguchi-style @Lₙ@ tables).+--+--   - 'OA'              — orthogonal-array representation (name / run+--     count / factor count / column levels / body).+--   - 'standardArrays'  — standard tables L4 / L8 / L9 / L12 / L16 / L18.+--   - 'lookupOA'        — fetch a standard table by name (e.g. @\"L9\"@).+--   - 'assignFactors'   — bind factors and level values.+--   - 'renderCSV' / 'renderTSV' / 'renderPretty' — emit the run table.+--+-- Two-level series (L8, L16, ...) are generated by @mkL2k@. L4 / L9 /+-- L12 / L18 are defined manually (Plackett-Burman and mixed-level+-- arrays are not derivable from simple subset products).+module Hanalyze.Design.Orthogonal+  ( -- * 型+    OA (..)+  , LevelValue (..)+  , FactorSpec (..)+  , AssignedDesign (..)+    -- * Standard arrays+  , l4+  , l8+  , l9+  , l12+  , l16+  , l18+  , l27+  , standardArrays+  , lookupOA+  , listArrays+  , OAMetadata (..)+  , listArraysWithSize+    -- * 2-level array generation+  , mkL2k+    -- * Factor assignment+  , assignFactors+    -- * Rendering+  , renderRawCSV+  , renderRawTSV+  , renderRawPretty+  , renderCSV+  , renderTSV+  , renderPretty+  ) where++import Data.Bits (testBit, popCount, (.&.), bit)+import Data.Text (Text)+import qualified Data.Text as T+import Text.Printf (printf)++-- ---------------------------------------------------------------------------+-- 型+-- ---------------------------------------------------------------------------++-- | [日本語]: 直交表。 @runs × cols@ の 1-based 水準コード表として保持する。+--   [English]: An orthogonal array. Stored as a @runs × cols@ table of+--   1-based level codes.+data OA = OA+  { oaName    :: Text     -- ^ [日本語]: 表示名、 例 @\"L9(3^4)\"@。 [English]: Display name, e.g. @\"L9(3^4)\"@.+  , oaRuns    :: Int      -- ^ [日本語]: run 数。 [English]: Number of runs.+  , oaFactors :: Int      -- ^ [日本語]: 最大因子数 (= 列数)。 [English]: Maximum number of factors (= columns).+  , oaLevels  :: [Int]    -- ^ [日本語]: 各列の水準数 (長さ = 'oaFactors')。 [English]: Level count per column (length 'oaFactors').+  , oaTable   :: [[Int]]  -- ^ [日本語]: 表の本体 (@runs × cols@) の 1-based 水準コード。+                          --   [English]: Body of the table (@runs × cols@) of+                          --   1-based level codes.+  } deriving (Show, Eq)++-- | [日本語]: 因子の水準値 (文字列 or 数値)。 [English]: A factor level value (text or numeric).+data LevelValue = LText Text | LNumeric Double+  deriving (Show, Eq)++-- | [日本語]: ユーザ指定の因子: 名前と水準値のリスト。+--   [English]: User-supplied factor: a name plus a list of level values.+data FactorSpec = FactorSpec+  { fsName   :: Text+  , fsLevels :: [LevelValue]+  } deriving (Show, Eq)++-- | [日本語]: 因子割当後の run table。 [English]: A run table after factor assignment.+data AssignedDesign = AssignedDesign+  { adArray   :: OA+  , adFactors :: [FactorSpec]+  , adRows    :: [[LevelValue]]+  } deriving (Show, Eq)++-- ---------------------------------------------------------------------------+-- 標準表 (手動定義)+-- ---------------------------------------------------------------------------++-- | [日本語]: L4(2³) — 4 runs、 最大 3 個の 2 水準因子。+--   [English]: L4(2³) — 4 runs, up to 3 two-level factors.+l4 :: OA+l4 = OA "L4(2^3)" 4 3 (replicate 3 2)+  [ [1,1,1]+  , [1,2,2]+  , [2,1,2]+  , [2,2,1]+  ]++-- | [日本語]: L9(3⁴) — 9 runs、 最大 4 個の 3 水準因子。+--   [English]: L9(3⁴) — 9 runs, up to 4 three-level factors.+l9 :: OA+l9 = OA "L9(3^4)" 9 4 (replicate 4 3)+  [ [1,1,1,1]+  , [1,2,2,2]+  , [1,3,3,3]+  , [2,1,2,3]+  , [2,2,3,1]+  , [2,3,1,2]+  , [3,1,3,2]+  , [3,2,1,3]+  , [3,3,2,1]+  ]++-- | [日本語]: L12(2¹¹) — 12 runs、 最大 11 個の 2 水準因子 (Plackett-Burman)。+--   主効果のみ (交互作用は全列に分散する)。+--   [English]: L12(2¹¹) — 12 runs, up to 11 two-level factors+--   (Plackett-Burman). Main effects only (interactions are distributed+--   across all columns).+l12 :: OA+l12 = OA "L12(2^11)" 12 11 (replicate 11 2)+  [ [1,1,1,1,1,1,1,1,1,1,1]+  , [1,1,1,1,1,2,2,2,2,2,2]+  , [1,1,2,2,2,1,1,1,2,2,2]+  , [1,2,1,2,2,1,2,2,1,1,2]+  , [1,2,2,1,2,2,1,2,1,2,1]+  , [1,2,2,2,1,2,2,1,2,1,1]+  , [2,1,2,2,1,1,2,2,1,2,1]+  , [2,1,2,1,2,2,2,1,1,1,2]+  , [2,1,1,2,2,2,1,2,2,1,1]+  , [2,2,2,1,1,1,1,2,2,1,2]+  , [2,2,1,2,1,2,1,1,1,2,2]+  , [2,2,1,1,2,1,2,1,2,2,1]+  ]++-- | [日本語]: L18(2¹×3⁷) — 18 runs、 最大 8 因子 (列 1 は 2 水準、 残り 7 列は+--   各 3 水準)。+--+--   最も推奨される Taguchi 流の表の 1 つ。 主効果に加え列 1 × 列 2 の交互作用を+--   測定できる。+--+--   [English]: L18(2¹×3⁷) — 18 runs, up to 8 factors (column 1 has 2+--   levels, the remaining 7 columns each have 3 levels).+--+--   One of the most recommended Taguchi-style arrays; can measure main+--   effects plus the column-1 × column-2 interaction.+l18 :: OA+l18 = OA "L18(2^1*3^7)" 18 8 (2 : replicate 7 3)+  [ [1,1,1,1,1,1,1,1]+  , [1,1,2,2,2,2,2,2]+  , [1,1,3,3,3,3,3,3]+  , [1,2,1,1,2,2,3,3]+  , [1,2,2,2,3,3,1,1]+  , [1,2,3,3,1,1,2,2]+  , [1,3,1,2,1,3,2,3]+  , [1,3,2,3,2,1,3,1]+  , [1,3,3,1,3,2,1,2]+  , [2,1,1,3,3,2,2,1]+  , [2,1,2,1,1,3,3,2]+  , [2,1,3,2,2,1,1,3]+  , [2,2,1,2,3,1,3,2]+  , [2,2,2,3,1,2,1,3]+  , [2,2,3,1,2,3,2,1]+  , [2,3,1,3,2,3,1,2]+  , [2,3,2,1,3,1,2,3]+  , [2,3,3,2,1,2,3,1]+  ]++-- | [日本語]: L27(3¹³) — 27 runs、 最大 13 個の 3 水準因子。+--+--   GF(3) 上の線形形式で生成する (手写しの転記ミスを避ける)。 27 run を+--   @(a,b,c) ∈ {0,1,2}³@ で添字し、 13 列は 3 次元 GF(3) の相異なる 1 次元部分空間+--   を代表する係数ベクトル (先頭非零 = 1 に正規化) で @α·a+β·b+γ·c mod 3@ を取る。+--   相異なる 1 次元部分空間ゆえ任意の 2 列は強度 2 直交 (各水準組が均等出現)。+--   列順は標準タグチ L27 の配置 (col1,2 = 基本、 3,4 = その交互作用、 5 = 第3基本…)。+--+--   [English]: L27(3¹³) — 27 runs, up to 13 three-level factors.+--+--   Generated from linear forms over GF(3) (to avoid manual+--   transcription errors). The 27 runs are indexed by+--   @(a,b,c) ∈ {0,1,2}³@, and the 13 columns take+--   @α·a+β·b+γ·c mod 3@ for coefficient vectors representing each+--   distinct 1-dimensional subspace of the 3-dimensional GF(3) space+--   (normalized so the first nonzero coefficient = 1). Since the+--   subspaces are all distinct, any two columns are strength-2 orthogonal+--   (every level pair occurs equally often). Column order follows the+--   standard Taguchi L27 layout (col 1, 2 = base; 3, 4 = their+--   interaction; 5 = the 3rd base; ...).+l27 :: OA+l27 = OA "L27(3^13)" 27 13 (replicate 13 3) table+  where+    coeffs :: [(Int, Int, Int)]+    coeffs =+      [ (1,0,0), (0,1,0), (1,1,0), (1,2,0), (0,0,1), (1,0,1), (1,0,2)+      , (0,1,1), (0,1,2), (1,1,1), (1,1,2), (1,2,1), (1,2,2) ]+    table =+      [ [ 1 + ((al*a + be*b + ga*c) `mod` 3) | (al, be, ga) <- coeffs ]+      | r <- [0 .. 26 :: Int]+      , let a = r `div` 9+            b = (r `div` 3) `mod` 3+            c = r `mod` 3 ]++-- ---------------------------------------------------------------------------+-- 2 水準系の生成+-- ---------------------------------------------------------------------------++-- | [日本語]: @L_{2^k}(2^{2^k − 1})@ を Taguchi の標準列順で構築する (列 @j@ の+--   値は popCount(j ∧ revBits k r) のパリティ)。+--   [English]: Build @L_{2^k}(2^{2^k − 1})@ in Taguchi's standard column+--   ordering (column @j@'s value is the parity of+--   popCount(j ∧ revBits k r)).+mkL2k :: Int -> OA+mkL2k k =+  OA+    { oaName    = T.pack ("L" ++ show n ++ "(2^" ++ show m ++ ")")+    , oaRuns    = n+    , oaFactors = m+    , oaLevels  = replicate m 2+    , oaTable   = [ [ levelAt r j | j <- [1 .. m] ] | r <- [0 .. n - 1] ]+    }+  where+    n = 2 ^ k+    m = n - 1+    -- Taguchi の標準的な列ラベル順 (col 1 は最上位ビット相当) に合わせるため+    -- 行インデックスをビット反転する。+    revBits :: Int -> Int+    revBits r = sum [ if testBit r i then bit (k - 1 - i) else 0+                    | i <- [0 .. k - 1] ]+    levelAt r j = 1 + (popCount (j .&. revBits r) `mod` 2)++-- | [日本語]: L8(2⁷) — 8 runs、 最大 7 個の 2 水準因子 (生成)。+--   [English]: L8(2⁷) — 8 runs, up to 7 two-level factors (generated).+l8 :: OA+l8 = mkL2k 3++-- | [日本語]: L16(2¹⁵) — 16 runs、 最大 15 個の 2 水準因子 (生成)。+--   [English]: L16(2¹⁵) — 16 runs, up to 15 two-level factors (generated).+l16 :: OA+l16 = mkL2k 4++-- ---------------------------------------------------------------------------+-- ルックアップ+-- ---------------------------------------------------------------------------++-- | [日本語]: ライブラリに同梱の標準表。+--   [English]: The standard arrays bundled with the library.+standardArrays :: [OA]+standardArrays = [l4, l8, l9, l12, l16, l18, l27]++-- | [日本語]: 短縮名 (例 @\"L9\"@) で標準表を検索する。+--   [English]: Look up a standard array by short name (e.g. @\"L9\"@).+lookupOA :: Text -> Maybe OA+lookupOA name0 = case T.toUpper name0 of+  "L4"  -> Just l4+  "L8"  -> Just l8+  "L9"  -> Just l9+  "L12" -> Just l12+  "L16" -> Just l16+  "L18" -> Just l18+  "L27" -> Just l27+  _     -> Nothing++-- | [日本語]: 利用可能な直交表の一覧 (CLI @doe list@ で使用)。+--   [English]: List of available orthogonal arrays (used by CLI @doe list@).+listArrays :: [(Text, Text)]+listArrays = [ (oaName a, descr a) | a <- standardArrays ]+  where+    descr a =+      T.pack (show (oaRuns a)) <> " runs, max "+      <> T.pack (show (oaFactors a)) <> " factors"++-- | [日本語]: 直交表の構造化メタデータ。 run 数や水準パターンで+--   フィルタ / ソートしたい UI 一覧に適する。+--   [English]: Structured metadata for an orthogonal array. Suitable for+--   UI listings that want to filter \/ sort by run count or level pattern.+data OAMetadata = OAMetadata+  { omName    :: !Text   -- ^ [日本語]: 例 @\"L9(3^4)\"@。 [English]: e.g. @\"L9(3^4)\"@.+  , omRuns    :: !Int    -- ^ [日本語]: run 数。 [English]: Number of runs.+  , omFactors :: !Int    -- ^ [日本語]: 最大因子数。 [English]: Maximum number of factors.+  , omLevels  :: ![Int]  -- ^ [日本語]: 各列の水準数。 [English]: Level count per column.+  , omDescr   :: !Text   -- ^ [日本語]: 自由記述 ('listArrays' と一致)。 [English]: Free-form description (matches 'listArrays').+  } deriving (Show, Eq)++-- | [日本語]: 'listArrays' と同じ内容を構造化フィールドで提供。+--   [English]: Same coverage as 'listArrays' but with structured fields.+listArraysWithSize :: [OAMetadata]+listArraysWithSize =+  [ OAMetadata (oaName a) (oaRuns a) (oaFactors a) (oaLevels a)+               (T.pack (show (oaRuns a)) <> " runs, max "+                <> T.pack (show (oaFactors a)) <> " factors")+  | a <- standardArrays+  ]++-- ---------------------------------------------------------------------------+-- 因子割当+-- ---------------------------------------------------------------------------++-- | [日本語]: ユーザ指定の因子名と水準値を直交表の列に割り付け、+--   展開済み run table を返す。+--+--   - 因子数が表の列数を超えるとエラー+--   - 各因子の水準数が割当先列の水準数と一致しないとエラー+--+--   [English]: Assign user-supplied factor names and level values to the+--   columns of an orthogonal array, returning the expanded run table.+--+--   - Errors if the number of factors exceeds the table's column count+--   - Errors if a factor's level count doesn't match its assigned+--     column's level count+assignFactors :: OA -> [FactorSpec] -> Either Text AssignedDesign+assignFactors oa specs+  | nSpecs > oaFactors oa =+      Left $ "Too many factors: " <> oaName oa+             <> " has only " <> T.pack (show (oaFactors oa)) <> " columns; got "+             <> T.pack (show nSpecs)+  | not (null mismatches) =+      Left $ "Factor level mismatch: " <> T.intercalate "; " mismatches+  | otherwise =+      Right AssignedDesign+        { adArray   = oa+        , adFactors = specs+        , adRows    = [ [ fsLevels (specs !! (j - 1)) !! (lvl - 1)+                        | (j, lvl) <- zip [1 .. nSpecs] (take nSpecs row) ]+                      | row <- oaTable oa ]+        }+  where+    nSpecs    = length specs+    expected  = take nSpecs (oaLevels oa)+    actuals   = map (length . fsLevels) specs+    mismatches =+      [ fsName (specs !! i) <> " expected " <> T.pack (show e)+        <> " levels, got " <> T.pack (show a)+      | (i, (e, a)) <- zip [0..] (zip expected actuals)+      , e /= a ]++-- ---------------------------------------------------------------------------+-- 出力+-- ---------------------------------------------------------------------------++-- | [日本語]: 直交表を raw CSV として出力 (列は @F1, F2, …@)。+--   [English]: Render an orthogonal array as raw CSV (columns are @F1, F2, …@).+renderRawCSV :: OA -> Text+renderRawCSV oa = renderRawWith "," oa++-- | [日本語]: 直交表を raw TSV として出力。+--   [English]: Render an orthogonal array as raw TSV.+renderRawTSV :: OA -> Text+renderRawTSV oa = renderRawWith "\t" oa++-- | [日本語]: 直交表を区切り文字表として出力。+--   [English]: Render an orthogonal array as a delimiter-separated table.+renderRawWith :: Text -> OA -> Text+renderRawWith sep oa =+  let header = T.intercalate sep+                 [ "F" <> T.pack (show j) | j <- [1 .. oaFactors oa] ]+      body   = T.intercalate "\n"+                 [ T.intercalate sep [ T.pack (show v) | v <- row ]+                 | row <- oaTable oa ]+  in header <> "\n" <> body <> "\n"++-- | [日本語]: 名前付き直交表を列揃えして pretty-print する。+--   [English]: Pretty-print a named orthogonal array with aligned columns.+renderRawPretty :: OA -> Text+renderRawPretty oa =+  let names    = "Run" : [ "F" <> T.pack (show j) | j <- [1 .. oaFactors oa] ]+      colWidth = maximum (map T.length names) `max` 3+      pad t    = let n = colWidth - T.length t+                 in T.replicate n " " <> t+      header   = T.intercalate "  " (map pad names)+      body     = T.intercalate "\n"+                   [ T.intercalate "  "+                       (pad (T.pack (show r))+                       : [ pad (T.pack (show v)) | v <- row ])+                   | (r, row) <- zip [1::Int ..] (oaTable oa) ]+  in T.pack (T.unpack (oaName oa)) <> "\n" <> header <> "\n" <> body++-- | [日本語]: 因子割当済み run table を CSV として出力。+--   [English]: Render a factor-assigned run table as CSV.+renderCSV :: AssignedDesign -> Text+renderCSV = renderWith ","++-- | [日本語]: 因子割当済み run table を TSV として出力。+--   [English]: Render a factor-assigned run table as TSV.+renderTSV :: AssignedDesign -> Text+renderTSV = renderWith "\t"++-- | [日本語]: 因子割当済み run table を任意の区切り文字で出力。+--   [English]: Render a factor-assigned run table with a custom field+--   separator.+renderWith :: Text -> AssignedDesign -> Text+renderWith sep ad =+  let header = T.intercalate sep ("Run" : map fsName (adFactors ad))+      body   = T.intercalate "\n"+                 [ T.intercalate sep (T.pack (show r) : map fmtLevel row)+                 | (r, row) <- zip [1::Int ..] (adRows ad) ]+  in header <> "\n" <> body <> "\n"++fmtLevel :: LevelValue -> Text+fmtLevel (LText t)    = t+fmtLevel (LNumeric d)+  | d == fromIntegral (round d :: Integer) = T.pack (show (round d :: Integer))+  | otherwise                              = T.pack (printf "%g" d)++-- | [日本語]: 因子割当済み run table を pretty-print する。+--   [English]: Pretty-print a factor-assigned run table.+renderPretty :: AssignedDesign -> Text+renderPretty ad =+  let names      = "Run" : map fsName (adFactors ad)+      cells      =+        [ T.pack (show r) : map fmtLevel row+        | (r, row) <- zip [1::Int ..] (adRows ad) ]+      colWidths  = map (\i -> maximum (map (T.length . safeIx i)+                                       (names : cells)))+                       [0 .. length names - 1]+      safeIx i xs = if i < length xs then xs !! i else ""+      pad i t    = let n = colWidths !! i - T.length t+                   in T.replicate n " " <> t+      fmtRow row = T.intercalate "  "+                     [ pad i (safeIx i row) | i <- [0 .. length names - 1] ]+  in oaName (adArray ad) <> "  (" <> T.pack (show (oaRuns (adArray ad)))+     <> " runs, " <> T.pack (show (length (adFactors ad)))+     <> " of " <> T.pack (show (oaFactors (adArray ad))) <> " columns assigned)\n"+     <> fmtRow names <> "\n"+     <> T.intercalate "\n" (map fmtRow cells)
+ src/Hanalyze/Design/Power.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Power+-- Description : 検出力分析 — サンプルサイズ決定と検出力計算 (t 検定・ANOVA・比率検定)+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- Power analysis: sample-size determination and power computation.+--+-- Main functions:+--+--   - 'powerTTest'        — power of a two-sample t-test.+--   - 'sampleSizeTTest'   — @n@ required to attain a given power.+--   - 'powerOneWayAnova'  — power of an F-test (one-way ANOVA).+--   - 'powerProportion'   — power of a two-sample proportion test.+module Hanalyze.Design.Power+  ( -- * t 検定+    powerTTest+  , sampleSizeTTest+    -- * F-test (ANOVA)+  , powerOneWayAnova+  , sampleSizeOneWayAnova+    -- * Proportion test+  , powerProportion+    -- * Effect-size measures+  , cohensD+  , cohensF+  ) where++import qualified Statistics.Distribution as SD+import qualified Statistics.Distribution.StudentT as ST+import qualified Statistics.Distribution.Normal as NormalD+import qualified Statistics.Distribution.FDistribution as FD++-- ---------------------------------------------------------------------------+-- 効果量+-- ---------------------------------------------------------------------------++-- | Cohen's @d@: standardized two-sample mean difference.+-- @d = (μ_1 − μ_2) / σ_pooled@.+-- Interpretation: 0.2 = small, 0.5 = medium, 0.8 = large.+cohensD :: Double -> Double -> Double -> Double+cohensD mu1 mu2 sigma = (mu1 - mu2) / sigma++-- | Cohen's @f@: effect size for one-way ANOVA.+-- @f = σ_means / σ_within@.+-- Interpretation: 0.10 = small, 0.25 = medium, 0.40 = large.+cohensF :: [Double]    -- ^ Per-group means.+        -> Double      -- ^ Within-group SD (@= √MSE@).+        -> Double+cohensF means sigma =+  let k    = length means+      gm   = sum means / fromIntegral k+      var  = sum [(m - gm)^(2::Int) | m <- means] / fromIntegral k+  in sqrt var / sigma++-- ---------------------------------------------------------------------------+-- t 検定+-- ---------------------------------------------------------------------------++-- | Two-sample two-sided t-test power, equal-variance assumption.+powerTTest :: Double  -- ^ Cohen's @d@ (effect size).+           -> Int     -- ^ Sample size of group 1, @n_1@.+           -> Int     -- ^ Sample size of group 2, @n_2@.+           -> Double  -- ^ Significance level @α@ (e.g. 0.05).+           -> Double+powerTTest d n1 n2 alpha =+  let df  = n1 + n2 - 2+      ncp = d * sqrt (fromIntegral n1 * fromIntegral n2+                      / fromIntegral (n1 + n2))+      tCrit = SD.quantile (ST.studentT (fromIntegral df))+                          (1 - alpha / 2)+      -- 非心 t 分布の代わりに正規近似 (df 大なら良好)+      sigma = 1.0  -- t 分布近似なら sd ≈ 1+      pUpper = 1 - SD.cumulative (NormalD.normalDistr ncp sigma) tCrit+      pLower = SD.cumulative (NormalD.normalDistr ncp sigma) (-tCrit)+  in pUpper + pLower++-- | Smallest balanced sample size that attains the requested power.+-- (Both groups assumed equal in size.)+sampleSizeTTest :: Double  -- ^ Effect size @d@.+                -> Double  -- ^ Target power.+                -> Double  -- ^ Significance level @α@.+                -> Int+sampleSizeTTest d targetPow alpha = search 2 1000+  where+    search lo hi+      | lo >= hi = hi+      | otherwise =+          let mid = (lo + hi) `div` 2+              p   = powerTTest d mid mid alpha+          in if p >= targetPow then search lo mid else search (mid + 1) hi++-- ---------------------------------------------------------------------------+-- 一元配置 ANOVA の F 検定+-- ---------------------------------------------------------------------------++-- | One-way ANOVA F-test power.+powerOneWayAnova :: Double   -- ^ Cohen's @f@ (effect size).+                 -> Int      -- ^ Number of groups @k@.+                 -> Int      -- ^ Per-group sample size @n@.+                 -> Double   -- ^ Significance level @α@.+                 -> Double+powerOneWayAnova f k n alpha =+  let dfBetween = k - 1+      dfWithin  = k * (n - 1)+      ncp       = f * f * fromIntegral (k * n)+      fCrit     = SD.quantile (FD.fDistribution dfBetween dfWithin)+                              (1 - alpha)+      -- 非心 F 分布 ≈ scaled F で近似+      mean1     = fromIntegral dfBetween + ncp+      var1      = 2 * mean1   -- chi² 近似+      -- 標準正規近似:+      z         = (fCrit * fromIntegral dfBetween - mean1) / sqrt var1+  in 1 - SD.cumulative (NormalD.normalDistr 0 1) z++-- | Smallest per-group sample size that attains the requested ANOVA power.+sampleSizeOneWayAnova :: Double -> Int -> Double -> Double -> Int+sampleSizeOneWayAnova f k targetPow alpha = search 2 1000+  where+    search lo hi+      | lo >= hi = hi+      | otherwise =+          let mid = (lo + hi) `div` 2+              p   = powerOneWayAnova f k mid alpha+          in if p >= targetPow then search lo mid else search (mid + 1) hi++-- ---------------------------------------------------------------------------+-- 比率検定 (二群)+-- ---------------------------------------------------------------------------++-- | Two-sample two-sided proportion z-test power.+--+-- Arguments: true proportions @p_1@, @p_2@, group sample sizes @n_1@,+-- @n_2@, and significance level @α@.+powerProportion :: Double -> Double -> Int -> Int -> Double -> Double+powerProportion p1 p2 n1 n2 alpha =+  let n1d = fromIntegral n1; n2d = fromIntegral n2+      pP  = (n1d * p1 + n2d * p2) / (n1d + n2d)+      seH0 = sqrt (pP * (1 - pP) * (1/n1d + 1/n2d))+      seH1 = sqrt (p1 * (1 - p1) / n1d + p2 * (1 - p2) / n2d)+      delta = abs (p1 - p2)+      zAlpha = SD.quantile (NormalD.normalDistr 0 1) (1 - alpha / 2)+      crit = zAlpha * seH0+      z = (delta - crit) / seH1+  in SD.cumulative (NormalD.normalDistr 0 1) z
+ src/Hanalyze/Design/Quality.hs view
@@ -0,0 +1,476 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Quality+-- Description : 計画評価指標 (直交性・D/A-efficiency・VIF) と工程能力指数 (Cp/Cpk 等) の算出+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: 計画評価の品質規準。+--+--   - 'isOrthogonal'       — 設計の列が直交か (= @XᵀX@ が対角行列か)。+--   - 'orthogonalityScore' — @[0, 1]@ の数値的直交性スコア。+--   - 'conditionNumber'    — @XᵀX@ の条件数 (大きい値は多重共線性を示す)。+--   - 'dEfficiency'        — D-efficiency @det(XᵀX/n)^(1/p)@。+--   - 'aEfficiency'        — A-efficiency: @trace((XᵀX/n)⁻¹)@ の逆数。+--   - 'vifList'            — 列ごとの Variance Inflation Factor。+--+-- [English]: Quality criteria for evaluating designs.+--+--   - 'isOrthogonal'       — are the design columns orthogonal? (i.e.+--     @XᵀX@ diagonal).+--   - 'orthogonalityScore' — numeric orthogonality score in @[0, 1]@.+--   - 'conditionNumber'    — condition number of @XᵀX@ (large values+--     indicate multicollinearity).+--   - 'dEfficiency'        — D-efficiency @det(XᵀX/n)^(1/p)@.+--   - 'aEfficiency'        — A-efficiency: reciprocal of+--     @trace((XᵀX/n)⁻¹)@.+--   - 'vifList'            — per-column Variance Inflation Factor.+module Hanalyze.Design.Quality+  ( isOrthogonal+  , orthogonalityScore+  , conditionNumber+  , dEfficiency+  , aEfficiency+  , vifList+    -- * Process capability+  , Capability (..)+  , processCapability+  , processCapabilityUpper+  , processCapabilityLower+  , processCapabilityWeibull+  , processCapabilityLogNormal+  , processCapabilityGamma+    -- * Process capability — unified non-normal entry (Phase 23-c)+  , NonNormalFit (..)+  , processCapabilityNonNormal+    -- * 多変量 Process Capability (Phase 23-d)+  , MultivariateCapability (..)+  , processCapabilityMultivariate+  ) where++import           Data.Text                       (Text)+import qualified Numeric.LinearAlgebra as LA+import qualified Statistics.Distribution         as SD+import qualified Statistics.Distribution.Normal  as Normal+import qualified Statistics.Distribution.Gamma   as Gamma+import           Hanalyze.Model.Weibull          (WeibullFit (..))++-- | [日本語]: 設計行列 @X@ が直交 (= @XᵀX@ が許容誤差 @ε@ の範囲で対角行列) なら True。+--   [English]: True iff the design matrix @X@ is orthogonal (i.e. @XᵀX@+--   is diagonal up to tolerance @ε@).+isOrthogonal :: Double -> [[Double]] -> Bool+isOrthogonal eps xs =+  let m   = LA.fromLists xs+      xtx = LA.tr m LA.<> m+      n   = LA.rows xtx+      offDiagSum =+        sum [ abs (xtx `LA.atIndex` (i, j))+            | i <- [0 .. n - 1]+            , j <- [0 .. n - 1]+            , i /= j ]+  in offDiagSum < eps++-- | [日本語]: @[0, 1]@ の直交性スコア: 0 = 直交から遠い、 1 = 完全に直交。+--   対角成分と非対角成分の質量を比較する。+--   [English]: Orthogonality score in @[0, 1]@: 0 = far from orthogonal,+--   1 = exactly orthogonal. Compares the off-diagonal mass against the+--   diagonal mass.+orthogonalityScore :: [[Double]] -> Double+orthogonalityScore xs =+  let m   = LA.fromLists xs+      xtx = LA.tr m LA.<> m+      n   = LA.rows xtx+      diagSum =+        sum [ abs (xtx `LA.atIndex` (i, i)) | i <- [0 .. n - 1] ]+      offDiagSum =+        sum [ abs (xtx `LA.atIndex` (i, j))+            | i <- [0 .. n - 1]+            , j <- [0 .. n - 1]+            , i /= j ]+  in if diagSum == 0 then 0+       else 1 - offDiagSum / (diagSum + offDiagSum)++-- | [日本語]: @XᵀX@ の条件数 (@λ_max / λ_min@)。 30 を超える値は多重共線性を+--   示すことが多い。+--   [English]: Condition number of @XᵀX@ (@λ_max / λ_min@). Values above+--   30 typically indicate multicollinearity.+conditionNumber :: [[Double]] -> Double+conditionNumber xs =+  let m   = LA.fromLists xs+      xtx = LA.tr m LA.<> m+      svs = LA.singularValues xtx+      sList = LA.toList svs+  in if null sList || minimum sList == 0+       then 1 / 0   -- ∞+       else maximum sList / minimum sList++-- | [日本語]: D-efficiency @det(XᵀX/n)^(1/p)@ — 最大化すべき量。 完全直交設計で 1 に近づく。+--   [English]: D-efficiency @det(XᵀX/n)^(1/p)@ — to be maximized.+--   Approaches 1 for a fully orthogonal design.+dEfficiency :: [[Double]] -> Double+dEfficiency xs =+  let m   = LA.fromLists xs+      n   = fromIntegral (LA.rows m) :: Double+      p   = fromIntegral (LA.cols m) :: Double+      xtx = LA.tr m LA.<> m+      detV = LA.det (LA.scale (1/n) xtx)+  in if detV <= 0 then 0+       else detV ** (1 / p)++-- | [日本語]: A-efficiency: @trace((XᵀX/n)⁻¹)@ の逆数。 trace が小さいほど+--   係数ごとの推定精度が高いことを意味する。+--   [English]: A-efficiency: reciprocal of @trace((XᵀX/n)⁻¹)@. A smaller+--   trace means higher per-coefficient estimation precision.+aEfficiency :: [[Double]] -> Double+aEfficiency xs =+  let m   = LA.fromLists xs+      n   = fromIntegral (LA.rows m) :: Double+      p   = fromIntegral (LA.cols m) :: Double+      xtx = LA.tr m LA.<> m+      detV = LA.det xtx+  in if detV == 0 then 0+       else+         let inv = LA.inv (LA.scale (1/n) xtx)+             tr  = sum [inv `LA.atIndex` (i, i)+                       | i <- [0 .. round p - 1] :: [Int]]+         in p / tr++-- | [日本語]: 列ごとの Variance Inflation Factor。+--+--   @VIF_j = 1 / (1 - R²_j)@。 @R²_j@ は列 @j@ を他の列に回帰したときの決定係数。+--   @VIF > 10@ は多重共線性の強い兆候。+--+--   [English]: Per-column Variance Inflation Factor.+--+--   @VIF_j = 1 / (1 - R²_j)@, where @R²_j@ is the coefficient of+--   determination from regressing column @j@ on the others.+--   @VIF > 10@ is a strong sign of multicollinearity.+vifList :: [[Double]] -> [Double]+vifList xs =+  let m   = LA.fromLists xs+      p   = LA.cols m+  in [vifFor m j | j <- [0 .. p - 1]]+  where+    vifFor mat j =+      let yCol  = LA.flatten (mat LA.¿ [j])+          xCols = [k | k <- [0 .. LA.cols mat - 1], k /= j]+          xRest = mat LA.¿ xCols+          beta  = LA.flatten (xRest LA.<\> LA.asColumn yCol)+          yHat  = xRest LA.#> beta+          ssRes = LA.sumElements ((yCol - yHat) ^ (2 :: Int))+          mu    = LA.sumElements yCol / fromIntegral (LA.size yCol)+          ssTot = LA.sumElements ((yCol - LA.scalar mu) ^ (2 :: Int))+          r2    = if ssTot == 0 then 0 else 1 - ssRes / ssTot+      in if r2 >= 1 then 1/0 else 1 / (1 - r2)++-- ---------------------------------------------------------------------------+-- Process capability (Cp / Cpk)+-- ---------------------------------------------------------------------------++-- | [日本語]: 工程能力サマリ。+--+--   - @capCp  = (USL − LSL) / (6 σ)@+--   - @capCpk = min((USL − μ) / (3 σ), (μ − LSL) / (3 σ))@+--+--   片側変種 (LSL 無しまたは USL 無し) では @Cpk@ の該当側だけを使い、+--   @Cp@ もその半分に fallback する (= @Cp == Cpk@)。+--+--   [English]: Process capability summary.+--+--   - @capCp  = (USL − LSL) / (6 σ)@+--   - @capCpk = min((USL − μ) / (3 σ), (μ − LSL) / (3 σ))@+--+--   For one-sided variants (no LSL or no USL) only the relevant half of+--   @Cpk@ is used; @Cp@ falls back to that half (so @Cp == Cpk@).+data Capability = Capability+  { capCp   :: !Double+  , capCpk  :: !Double+  , capMean :: !Double+  , capSd   :: !Double+  } deriving (Show, Eq)++-- | [日本語]: 明示的な @LSL@ と @USL@ による両側工程能力。+--   [English]: Two-sided process capability with explicit @LSL@ and @USL@.+processCapability+  :: Double            -- ^ [日本語]: LSL (下側規格限界) [English]: LSL (lower spec limit)+  -> Double            -- ^ [日本語]: USL (上側規格限界) [English]: USL (upper spec limit)+  -> LA.Vector Double  -- ^ [日本語]: 標本観測値。 [English]: Sample observations.+  -> Capability+processCapability lsl usl xs =+  let (mu, sd) = meanSd xs+      cp       = if sd == 0 then 0 else (usl - lsl) / (6 * sd)+      cpkUpper = if sd == 0 then 0 else (usl - mu) / (3 * sd)+      cpkLower = if sd == 0 then 0 else (mu - lsl) / (3 * sd)+      cpk      = min cpkUpper cpkLower+  in Capability cp cpk mu sd++-- | [日本語]: 片側 (上側規格のみ) 工程能力 (@USL@ のみ)。+--   [English]: One-sided upper-spec process capability (only @USL@).+processCapabilityUpper :: Double -> LA.Vector Double -> Capability+processCapabilityUpper usl xs =+  let (mu, sd) = meanSd xs+      cpk      = if sd == 0 then 0 else (usl - mu) / (3 * sd)+  in Capability cpk cpk mu sd++-- | [日本語]: 片側 (下側規格のみ) 工程能力 (@LSL@ のみ)。+--   [English]: One-sided lower-spec process capability (only @LSL@).+processCapabilityLower :: Double -> LA.Vector Double -> Capability+processCapabilityLower lsl xs =+  let (mu, sd) = meanSd xs+      cpk      = if sd == 0 then 0 else (mu - lsl) / (3 * sd)+  in Capability cpk cpk mu sd++-- | [日本語]: __Weibull 分布__ に従う特性値の工程能力。+--+--   非正規分布の場合、 6σ では裾を過小評価する。 ISO 22514 / AIAG 推奨の+--   パーセンタイル法:+--+--   > Cp  = (USL − LSL) / (P_{0.99865} − P_{0.00135})+--   > Cpk = min( (USL − median) / (P_{0.99865} − median),+--   >            (median − LSL) / (median − P_{0.00135}) )+--+--   Weibull quantile: @F⁻¹(p) = λ · (−log(1 − p))^{1/k}@+--+--   [English]: Process Capability for __Weibull-distributed__+--   characteristics.+--+--   For non-normal distributions, 6σ underestimates the tails. The+--   percentile method recommended by ISO 22514 \/ AIAG:+--+--   > Cp  = (USL − LSL) / (P_{0.99865} − P_{0.00135})+--   > Cpk = min( (USL − median) / (P_{0.99865} − median),+--   >            (median − LSL) / (median − P_{0.00135}) )+--+--   Weibull quantile: @F⁻¹(p) = λ · (−log(1 − p))^{1/k}@+processCapabilityWeibull+  :: WeibullFit+  -> Double            -- ^ [日本語]: LSL [English]: LSL+  -> Double            -- ^ [日本語]: USL [English]: USL+  -> Capability+processCapabilityWeibull wf lsl usl =+  let k   = wfShape wf+      lam = wfScale wf+      q p = lam * ((-log (1 - p)) ** (1 / k))+      pLo  = q 0.00135+      pHi  = q 0.99865+      med  = q 0.5+      spread = pHi - pLo+      cp   = if spread == 0 then 0 else (usl - lsl) / spread+      cpkU = if pHi == med then 0 else (usl - med) / (pHi - med)+      cpkL = if med == pLo then 0 else (med - lsl) / (med - pLo)+      cpk  = min cpkU cpkL+  in Capability cp cpk med spread++-- | [日本語]: __LogNormal 分布__ に従う特性値の工程能力。+--   引数は log-scale の μ, σ (ln X ~ Normal(μ, σ²))。+--+--   > X_p = exp(μ + σ · z_p)+--+--   [English]: Process Capability for __LogNormal-distributed__+--   characteristics. Arguments are the log-scale μ, σ+--   (ln X ~ Normal(μ, σ²)).+--+--   > X_p = exp(μ + σ · z_p)+processCapabilityLogNormal+  :: Double            -- ^ [日本語]: μ (log scale の平均) [English]: μ (log scale mean)+  -> Double            -- ^ [日本語]: σ (log scale の標準偏差) [English]: σ (log scale sd)+  -> Double            -- ^ [日本語]: LSL [English]: LSL+  -> Double            -- ^ [日本語]: USL [English]: USL+  -> Capability+processCapabilityLogNormal mu sigma lsl usl =+  let zHi = SD.quantile Normal.standard 0.99865+      zLo = SD.quantile Normal.standard 0.00135+      pHi = exp (mu + sigma * zHi)+      pLo = exp (mu + sigma * zLo)+      med = exp mu+      spread = pHi - pLo+      cp   = if spread == 0 then 0 else (usl - lsl) / spread+      cpkU = if pHi == med then 0 else (usl - med) / (pHi - med)+      cpkL = if med == pLo then 0 else (med - lsl) / (med - pLo)+      cpk  = min cpkU cpkL+  in Capability cp cpk med spread++-- | [日本語]: __Gamma 分布__ に従う特性値の工程能力。+--   shape (= k) と scale (= θ) を引数に取る (statistics-0.16 の @gammaDistr@ と同表記)。+--   rate β = 1 / θ を使うユーザは scale = 1/β で渡す。+--+--   分位点法 (ISO 22514) で Cp / Cpk を算出:+--+--   > Cp  = (USL − LSL) / (P_{0.99865} − P_{0.00135})+--   > Cpk = min( (USL − median) / (P_{0.99865} − median),+--   >            (median − LSL) / (median − P_{0.00135}) )+--+--   [English]: Process Capability for __Gamma-distributed__+--   characteristics. Takes shape (= k) and scale (= θ) as arguments+--   (same notation as statistics-0.16's @gammaDistr@). Users working+--   with rate β = 1 / θ should pass scale = 1/β.+--+--   Cp \/ Cpk are computed via the quantile method (ISO 22514):+--+--   > Cp  = (USL − LSL) / (P_{0.99865} − P_{0.00135})+--   > Cpk = min( (USL − median) / (P_{0.99865} − median),+--   >            (median − LSL) / (median − P_{0.00135}) )+processCapabilityGamma+  :: Double            -- ^ [日本語]: shape (k > 0) [English]: shape (k > 0)+  -> Double            -- ^ [日本語]: scale (θ > 0) [English]: scale (θ > 0)+  -> Double            -- ^ [日本語]: LSL [English]: LSL+  -> Double            -- ^ [日本語]: USL [English]: USL+  -> Capability+processCapabilityGamma shape scale lsl usl =+  let d   = Gamma.gammaDistr shape scale+      pLo = SD.quantile d 0.00135+      pHi = SD.quantile d 0.99865+      med = SD.quantile d 0.5+      spread = pHi - pLo+      cp   = if spread == 0 then 0 else (usl - lsl) / spread+      cpkU = if pHi == med then 0 else (usl - med) / (pHi - med)+      cpkL = if med == pLo then 0 else (med - lsl) / (med - pLo)+      cpk  = min cpkU cpkL+  in Capability cp cpk med spread++-- | [日本語]: 非正規 Cp の統一エントリ用 ADT。 spec: doe-spec v0.2 §3.13。+--   [English]: An ADT for the unified non-normal Cp entry point. spec:+--   doe-spec v0.2 §3.13.+data NonNormalFit+  = NNFWeibull   !WeibullFit       -- ^ [日本語]: Weibull MLE 結果 [English]: Weibull MLE result+  | NNFLogNormal !Double !Double    -- ^ [日本語]: log-scale μ, σ [English]: log-scale μ, σ+  | NNFGamma     !Double !Double    -- ^ [日本語]: shape, scale [English]: shape, scale+  deriving (Show)++-- | [日本語]: 非正規分布 fit の type tag で Weibull / LogNormal / Gamma を dispatch。+--   個別関数 (@processCapabilityWeibull@ 等) と等価、 ADT で取り回したいケース用。+--   [English]: Dispatches to Weibull \/ LogNormal \/ Gamma via the+--   non-normal distribution fit's type tag. Equivalent to the individual+--   functions (@processCapabilityWeibull@ etc.); for cases where you want+--   to handle it as an ADT.+processCapabilityNonNormal+  :: NonNormalFit+  -> Double          -- ^ [日本語]: LSL [English]: LSL+  -> Double          -- ^ [日本語]: USL [English]: USL+  -> Capability+processCapabilityNonNormal (NNFWeibull   wf)         = processCapabilityWeibull   wf+processCapabilityNonNormal (NNFLogNormal mu sigma)   = processCapabilityLogNormal mu sigma+processCapabilityNonNormal (NNFGamma     k  scale)   = processCapabilityGamma     k  scale++-- ---------------------------------------------------------------------------+-- 多変量 Process Capability (Phase 23-d、 spec: doe-spec v0.2 §2.10 / §3.13)+-- ---------------------------------------------------------------------------++-- | [日本語]: 多変量 Process Capability の結果。+--+--   @mcMCp@ は Wang-Hubele-Lawrence (1994) 風の体積比ベース:+--+--   > MCp = (det(Σ_T) / det(Σ))^(1/(2p))+--+--   ここで Σ_T = diag(((USL_i − LSL_i) / 6)²) (= 各軸 6σ 相当の理想分散)、+--   Σ は標本共分散、 p は変数数。 単変量 Cp の自然な多変量拡張。+--+--   @mcMCpk@ は中心オフセット penalty を乗じた値:+--+--   > MCpk = MCp · max(0, 1 − sqrt(T²) / 3)+--   > T²   = (μ_data − μ_T)' Σ⁻¹ (μ_data − μ_T)+--   > μ_T  = (LSL + USL) / 2+--+--   @mcInSpecRate@ は spec box (per-variable LSL/USL) の内包率 (実測)。+--+--   [English]: The result of multivariate Process Capability.+--+--   @mcMCp@ is based on a Wang-Hubele-Lawrence (1994)-style volume ratio:+--+--   > MCp = (det(Σ_T) / det(Σ))^(1/(2p))+--+--   where Σ_T = diag(((USL_i − LSL_i) / 6)²) (the ideal variance+--   corresponding to 6σ on each axis), Σ is the sample covariance, and p+--   is the number of variables. A natural multivariate extension of the+--   univariate Cp.+--+--   @mcMCpk@ is the value multiplied by a centering-offset penalty:+--+--   > MCpk = MCp · max(0, 1 − sqrt(T²) / 3)+--   > T²   = (μ_data − μ_T)' Σ⁻¹ (μ_data − μ_T)+--   > μ_T  = (LSL + USL) / 2+--+--   @mcInSpecRate@ is the (empirically measured) fraction contained+--   within the spec box (per-variable LSL\/USL).+data MultivariateCapability = MultivariateCapability+  { mcNVars       :: !Int+  , mcMean        :: !(LA.Vector Double)+  , mcCov         :: !(LA.Matrix Double)+  , mcMCp         :: !Double+  , mcMCpk        :: !Double+  , mcInSpecRate  :: !Double+  } deriving (Show)++-- | [日本語]: 多変量 Cp 計算。 入力 @data@ は n 行 × p 列の観測行列。+--   @specs@ は各変数の (LSL, USL) を __列順__ に与える。+--+--   @Left@ を返すケース:+--+--     - @specs@ の長さが列数と一致しない+--     - n < 2 (共分散が定義されない)+--     - 共分散が singular (= det ≈ 0)+--+--   [English]: Multivariate Cp calculation. Input @data@ is an n-row ×+--   p-column observation matrix. @specs@ gives each variable's (LSL, USL)+--   in __column order__.+--+--   Cases returning @Left@:+--+--     - the length of @specs@ doesn't match the column count+--     - n < 2 (covariance is undefined)+--     - the covariance is singular (= det ≈ 0)+processCapabilityMultivariate+  :: LA.Matrix Double+  -> [(Double, Double)]+  -> Either Text MultivariateCapability+processCapabilityMultivariate dat specs+  | p == 0                = Left "processCapabilityMultivariate: empty data (0 columns)"+  | length specs /= p     = Left "processCapabilityMultivariate: specs length ≠ #columns"+  | n < 2                 = Left "processCapabilityMultivariate: need at least 2 observations"+  | any (\(lo, hi) -> hi <= lo) specs =+      Left "processCapabilityMultivariate: each USL must be > LSL"+  | abs detSigma < 1e-12  = Left "processCapabilityMultivariate: covariance is singular"+  | otherwise =+      Right MultivariateCapability+        { mcNVars      = p+        , mcMean       = mu+        , mcCov        = sigma+        , mcMCp        = mcp+        , mcMCpk       = mcpk+        , mcInSpecRate = inSpec+        }+  where+    n         = LA.rows dat+    p         = LA.cols dat+    mu        = LA.scale (1 / fromIntegral n) (LA.fromList [LA.sumElements (col j) | j <- [0 .. p - 1]])+    col j     = LA.flatten (LA.subMatrix (0, j) (n, 1) dat)+    centered  = LA.fromRows [ LA.fromList [(dat `LA.atIndex` (i, j)) - (mu `LA.atIndex` j) | j <- [0 .. p - 1]] | i <- [0 .. n - 1] ]+    sigma     = LA.scale (1 / fromIntegral (n - 1)) (LA.tr centered LA.<> centered)+    detSigma  = LA.det sigma+    sigmaT    = LA.diagl [ ((hi - lo) / 6) ** 2 | (lo, hi) <- specs ]+    detSigmaT = LA.det sigmaT+    pD        = fromIntegral p :: Double+    mcp       = (detSigmaT / detSigma) ** (1 / (2 * pD))+    muT       = LA.fromList [ (lo + hi) / 2 | (lo, hi) <- specs ]+    diff      = mu - muT+    invSigma  = LA.inv sigma+    t2        = diff LA.<.> (invSigma LA.#> diff)+    penalty   = max 0 (1 - sqrt (max 0 t2) / 3)+    mcpk      = mcp * penalty+    inSpec    =+      let rowsXs = LA.toLists dat+          inside r = and [ lo <= x && x <= hi | (x, (lo, hi)) <- zip r specs ]+          k = length (filter inside rowsXs)+      in fromIntegral k / fromIntegral n++-- | [日本語]: 標本平均と不偏標準偏差。+--   [English]: Sample mean and unbiased standard deviation.+meanSd :: LA.Vector Double -> (Double, Double)+meanSd xs =+  let n  = LA.size xs+      nD = fromIntegral n :: Double+      mu = LA.sumElements xs / nD+      d  = LA.cmap (subtract mu) xs+      v  = if n <= 1 then 0+                     else (d `LA.dot` d) / (nD - 1.0)+  in (mu, sqrt v)
+ src/Hanalyze/Design/RSM.hs view
@@ -0,0 +1,250 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.RSM+-- Description : 応答曲面法 (RSM) — CCD/Box-Behnken 計画・二次モデル fit・極値の解析解+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- Response Surface Methodology (RSM).+--+--   - 'centralComposite' — central composite design (CCD): @2^k@ factorial+--     + axial points + center points.+--   - 'boxBehnken'       — Box-Behnken design: @k@ three-level factors+--     without axial points.+--   - 'quadraticDesign'  — design matrix for the quadratic model+--     (intercept + main + squared + interaction terms).+--   - @fitQuadratic@     — fit the quadratic regression by least squares.+--   - @optimumPoint@     — analytically solve for the extremum (max / min)+--     from the fit.+module Hanalyze.Design.RSM+  ( CCDType (..)+  , centralComposite+  , centralCompositeRotatable+  , boxBehnken+  , quadraticDesign+  , quadraticTermNames+  , QuadFit (..)+  , fitQuadratic+  , optimumPoint+  , quadBMatrix+  , canonicalAnalysis+  ) where++import Data.List (sortOn)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Numeric.LinearAlgebra as LA+import Hanalyze.Design.Factorial (twoLevelFactorial)++-- ---------------------------------------------------------------------------+-- 中心複合計画 (CCD)+-- ---------------------------------------------------------------------------++-- | Central composite design (CCD) type.+data CCDType+  = CCC Double  -- ^ Circumscribed: axial distance @α@ (the rotatable+                --   choice is @(2^k)^{1/4}@).+  | CCF         -- ^ Face-centered: @α = 1@ (axial points sit on the cube faces).+  | CCI Double  -- ^ Inscribed: @α = 1@, factorial part scaled by @1/α@.+  deriving (Show, Eq)++-- | Central composite design.+--+-- Composition:+--+--   - @2^k@ factorial part: every @±1@ combination (@2^k@ rows).+--   - @2k@ axial points: @(±α, 0, …, 0)@ for each factor.+--   - @nC@ center points at @(0, …, 0)@.+--+-- @centralComposite k ccdType nC@: @k@ factors and @nC@ centre points.+centralComposite :: Int -> CCDType -> Int -> [[Double]]+centralComposite k ccdType nC =+  let factorial = case ccdType of+        CCI alpha ->+          [[v / alpha | v <- row] | row <- twoLevelFactorial k]+        _ -> twoLevelFactorial k+      alpha = case ccdType of+        CCC a   -> a+        CCF     -> 1.0+        CCI _   -> 1.0+      axial = concat+        [ [ replicate i 0 ++ [-alpha] ++ replicate (k - 1 - i) 0+          , replicate i 0 ++ [ alpha] ++ replicate (k - 1 - i) 0+          ]+        | i <- [0 .. k - 1] ]+      center = replicate nC (replicate k 0)+  in factorial ++ axial ++ center++-- | Rotatable CCD with @α = (2^k)^{1/4}@.+centralCompositeRotatable :: Int -> Int -> [[Double]]+centralCompositeRotatable k nC =+  let alpha = (fromIntegral (2 ^ k :: Int) :: Double) ** 0.25+  in centralComposite k (CCC alpha) nC++-- ---------------------------------------------------------------------------+-- Box-Behnken 計画+-- ---------------------------------------------------------------------------++-- | Box-Behnken design for @k = 3, 4, 5@. Returns @nC@ additional+-- centre points.+--+--   - @k = 3@: 12 corner points + @nC@ centre points.+--   - @k = 4@: 24 corner points + @nC@ centre points.+--   - @k = 5@: 40 corner points + @nC@ centre points.+boxBehnken :: Int -> Int -> [[Double]]+boxBehnken k nC+  | k == 3 = bb3 ++ centers+  | k == 4 = bb4 ++ centers+  | k == 5 = bb5 ++ centers+  | otherwise = error+      ("boxBehnken: only k = 3, 4, 5 supported (got k = "+        ++ show k ++ ")")+  where+    centers = replicate nC (replicate k 0)+    -- 因子ペア (i, j) (i < j) の二水準組合せで「他は 0」+    pairs n = [(i, j) | i <- [0 .. n - 1], j <- [i + 1 .. n - 1]]+    pairBlock n (i, j) =+      [ [ if x == i then s1+          else if x == j then s2+          else 0+        | x <- [0 .. n - 1] ]+      | s1 <- [-1, 1], s2 <- [-1, 1] ]+    bb3 = concatMap (pairBlock 3) (pairs 3)+    bb4 = concatMap (pairBlock 4) (pairs 4)+    bb5 = concatMap (pairBlock 5) (pairs 5)++-- ---------------------------------------------------------------------------+-- 二次モデル+-- ---------------------------------------------------------------------------++-- | Build the design matrix for a quadratic model.+--+-- Each row @[x_1, …, x_k]@ expands to+-- @[1, x_1, …, x_k, x_1², …, x_k², x_1 x_2, x_1 x_3, …, x_{k-1} x_k]@+-- (intercept, main effects, squared terms, upper-triangle interactions).+--+-- Number of columns: @1 + 2k + k(k-1)/2@.+quadraticDesign :: [[Double]] -> LA.Matrix Double+quadraticDesign rows =+  let k = if null rows then 0 else length (head rows)+      expand row =+        let mainE = row+            sqE   = [x * x | x <- row]+            interE = [(row !! i) * (row !! j)+                     | i <- [0 .. k - 1], j <- [i + 1 .. k - 1]]+        in 1 : mainE ++ sqE ++ interE+  in LA.fromLists (map expand rows)++-- | Column names for the quadratic-model design (e.g.+-- @[\"b0\", \"x1\", \"x2\", \"x1^2\", \"x2^2\", \"x1*x2\"]@).+quadraticTermNames :: Int -> [Text]+quadraticTermNames k =+  ["b0"]+  ++ [T.pack ("x" ++ show i) | i <- [1 .. k]]+  ++ [T.pack ("x" ++ show i ++ "^2") | i <- [1 .. k]]+  ++ [T.pack ("x" ++ show i ++ "*x" ++ show j)+     | i <- [1 .. k], j <- [i + 1 .. k]]++-- | Quadratic-model fit result.+data QuadFit = QuadFit+  { qfK    :: Int                -- ^ Number of factors @k@.+  , qfBeta :: LA.Vector Double   -- ^ Coefficient vector+                                 --   @[b₀, β_main, β_sq, β_int]@.+  , qfYHat :: LA.Vector Double   -- ^ Fitted values.+  , qfR2   :: Double              -- ^ R².+  } deriving (Show)++-- | Fit a quadratic model by least squares.+fitQuadratic :: [[Double]] -> [Double] -> QuadFit+fitQuadratic xs ys =+  let k = if null xs then 0 else length (head xs)+      x = quadraticDesign xs+      y = LA.fromList ys+      beta = LA.flatten (x LA.<\> LA.asColumn y)+      yHat = x LA.#> beta+      gm   = LA.sumElements y / fromIntegral (LA.size y)+      ssT  = LA.sumElements ((y - LA.scalar gm) ^ (2 :: Int))+      ssR  = LA.sumElements ((y - yHat) ^ (2 :: Int))+      r2   = if ssT == 0 then 0 else 1 - ssR / ssT+  in QuadFit k beta yHat r2++-- | Solve analytically for the extremum (saddle / max / min) of the+-- fitted quadratic model.+--+-- [日本語]: @ŷ = b₀ + bᵀx + xᵀ B x@ と書いて @∂ŷ/∂x = 0@ を解くと+-- x* = −½ B⁻¹ b。 固有値の符号で性質を判定。+--+-- 戻り値: (x*, predicted_y, eigenvalues)+--   eigenvalues 全部 < 0 → 極大+--   eigenvalues 全部 > 0 → 極小+--   混在 → 鞍点+--+-- [English]: Writing @ŷ = b₀ + bᵀx + xᵀ B x@, set @∂ŷ/∂x = 0@ to obtain+-- x* = −½ B⁻¹ b. The sign of the eigenvalues determines the nature of the+-- extremum.+--+-- Return value: (x*, predicted_y, eigenvalues)+--   all eigenvalues < 0 → maximum+--   all eigenvalues > 0 → minimum+--   mixed              → saddle point+optimumPoint :: QuadFit -> ([Double], Double, [Double])+optimumPoint fit =+  let k     = qfK fit+      beta  = LA.toList (qfBeta fit)+      b0    = head beta+      bMain = take k (drop 1 beta)+      bSq   = take k (drop (1 + k) beta)+      bInt  = drop (1 + 2 * k) beta+      bMat  = quadBMatrix fit+      bVec  = LA.fromList bMain+      xStar = LA.toList (LA.scale (-0.5) (LA.inv bMat LA.#> bVec))+      yStar = b0+            + sum (zipWith (*) bMain xStar)+            + sum (zipWith (\b x -> b * x * x) bSq xStar)+            + sum [ (bInt !! pairIndex k i j) * (xStar !! i) * (xStar !! j)+                  | i <- [0 .. k - 1], j <- [i + 1 .. k - 1] ]+      eigs = LA.toList (fst (LA.eigSH (LA.sym bMat)))+  in (xStar, yStar, eigs)+  where+    -- (i, j) ペア (i < j) の β_int 配列内のインデックス+    pairIndex n i j = sum [n - 1 - p | p <- [0 .. i - 1]] + (j - i - 1)++-- | [日本語]: 二次モデルの @B@ 行列 (@ŷ = b₀ + bᵀx + xᵀ B x@ の 2 次係数)。 対角は β_sq、+--   非対角は β_int/2 で対称化。 canonical 解析 / 停留点計算の共通部品。+--   [English]: The @B@ matrix of the quadratic model (the 2nd-order+--   coefficients of @ŷ = b₀ + bᵀx + xᵀ B x@). The diagonal is β_sq;+--   off-diagonal entries are symmetrized as β_int/2. A shared component+--   for canonical analysis \/ stationary-point computation.+quadBMatrix :: QuadFit -> LA.Matrix Double+quadBMatrix fit =+  let k     = qfK fit+      beta  = LA.toList (qfBeta fit)+      bSq   = take k (drop (1 + k) beta)+      bInt  = drop (1 + 2 * k) beta+  in LA.fromLists+       [ [ if i == j then bSq !! i+           else+             let (lo, hi) = if i < j then (i, j) else (j, i)+                 idx = pairIndex k lo hi+             in (bInt !! idx) / 2+         | j <- [0 .. k - 1] ]+       | i <- [0 .. k - 1] ]+  where pairIndex n i j = sum [n - 1 - p | p <- [0 .. i - 1]] + (j - i - 1)++-- | [日本語]: Canonical 解析。 @B@ 行列の固有分解を返す (固有値, 固有ベクトル) のペア列。+--   固有値の符号で応答曲面の性質が読める (全負=極大 / 全正=極小 / 混在=鞍点)、+--   固有ベクトルは canonical 軸 (停留点周りで応答が最も急/緩に動く coded 方向)。+--   ペアは固有値の昇順。 単位はモデルを当てた座標系 (通常 coded)。+--   [English]: Canonical analysis. Returns the eigendecomposition of the+--   @B@ matrix as a list of (eigenvalue, eigenvector) pairs. The sign of+--   the eigenvalues reveals the nature of the response surface (all+--   negative = maximum \/ all positive = minimum \/ mixed = saddle point);+--   the eigenvectors are the canonical axes (the coded directions along+--   which the response moves most steeply \/ gently around the stationary+--   point). Pairs are sorted in ascending eigenvalue order. Units are in+--   the coordinate system the model was fit in (usually coded).+canonicalAnalysis :: QuadFit -> [(Double, [Double])]+canonicalAnalysis fit =+  let (vals, vecs) = LA.eigSH (LA.sym (quadBMatrix fit))+      pairs = zip (LA.toList vals) (map LA.toList (LA.toColumns vecs))+  in sortOn fst pairs
+ src/Hanalyze/Design/Sequential.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Hanalyze.Design.Sequential+-- Description : 逐次的応答曲面法 (Sequential RSM) — 最急上昇 path と sequential CCD 配置+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: Sequential RSM (逐次的応答曲面法)。+--+-- 「初期 design → fit → steepest ascent path → 新中心 → 次 design」 の逐次+-- 最適化ワークフローを支える helper モジュール。 数値の重い部分は+-- @Hanalyze.Design.RSM@ の @fitQuadratic@ / @optimumPoint@ に委ね、 本モジュール+-- は steepest-ascent path 生成と sequential CCD 配置のみを提供する。+--+-- [English]: Sequential RSM (sequential response surface methodology).+--+-- A helper module supporting the sequential optimization workflow "initial+-- design -> fit -> steepest ascent path -> new center -> next design". The+-- heavy numerical work is delegated to @fitQuadratic@ \/ @optimumPoint@ in+-- @Hanalyze.Design.RSM@; this module only provides steepest-ascent+-- path generation and sequential CCD placement.+module Hanalyze.Design.Sequential+  ( -- * Steepest Ascent+    SteepestAscentResult (..)+  , steepestAscent+  , steepestAscentFromQuad+    -- * Sequential CCD+  , SequentialCCDResult (..)+  , sequentialCCD+  ) where++import qualified Numeric.LinearAlgebra as LA++import qualified Hanalyze.Design.RSM   as RSM++-- ===========================================================================+-- Steepest Ascent+-- ===========================================================================++-- | [日本語]: 最急上昇 / 最急下降 path の結果。+--   [English]: The result of a steepest-ascent \/ steepest-descent path.+data SteepestAscentResult = SteepestAscentResult+  { sarDirection  :: !(LA.Vector Double)+    -- ^ [日本語]: 単位ベクトル化された steepest 方向 (length k)+    --   [English]: The unit-vectorized steepest direction (length k)+  , sarStepPoints :: ![[Double]]+    -- ^ [日本語]: 試行点系列 (length nSteps + 1、 先頭 = center)+    --   [English]: The sequence of trial points (length nSteps + 1; the+    --   first is the center)+  , sarMaximize   :: !Bool+    -- ^ [日本語]: True = ascent、 False = descent+    --   [English]: True = ascent, False = descent+  } deriving (Show)++-- | [日本語]: 第一階係数 @b = [b_1, ..., b_k]@ から steepest ascent path を生成。+--+--   方向ベクトル:+--+--     - @maximize = True@ なら @+b / |b|@+--     - @maximize = False@ なら @-b / |b|@+--+--   path: @[center, center + step·d, center + 2·step·d, ..., center + nSteps·step·d]@+--+--   @|b| = 0@ や @k = 0@ の場合は方向 0、 全 point = center を返す。+--   [English]: Generates a steepest-ascent path from the first-order+--   coefficients @b = [b_1, ..., b_k]@.+--+--   Direction vector:+--+--     - @+b / |b|@ when @maximize = True@+--     - @-b / |b|@ when @maximize = False@+--+--   path: @[center, center + step*d, center + 2*step*d, ..., center + nSteps*step*d]@+--+--   When @|b| = 0@ or @k = 0@, the direction is 0 and every point equals+--   the center.+steepestAscent+  :: Bool          -- ^ [日本語]: True = ascent、 False = descent [English]: True = ascent, False = descent+  -> [Double]      -- ^ [日本語]: center (k 次元) [English]: The center (k-dimensional)+  -> [Double]      -- ^ [日本語]: first-order coefficients @b_1..b_k@ [English]: First-order coefficients @b_1..b_k@+  -> Double        -- ^ [日本語]: step size (原座標スケール、 > 0 推奨) [English]: Step size (in raw-coordinate scale; > 0 recommended)+  -> Int           -- ^ [日本語]: 試行点数 (= path 長 = nSteps + 1) [English]: Number of trial points (= path length = nSteps + 1)+  -> SteepestAscentResult+steepestAscent maximize center bCoefs stepSize nSteps =+  let k       = length center+      bVec    = LA.fromList bCoefs+      cVec    = LA.fromList center+      normB   = sqrt (LA.sumElements (bVec * bVec))+      dirRaw  = if normB > 0+                  then LA.scale ((if maximize then 1 else -1) / normB) bVec+                  else LA.fromList (replicate k 0)+      points  = [ LA.toList (cVec + LA.scale (fromIntegral i * stepSize) dirRaw)+                | i <- [0 .. max 0 nSteps]+                ]+  in SteepestAscentResult+       { sarDirection  = dirRaw+       , sarStepPoints = points+       , sarMaximize   = maximize+       }++-- | [日本語]: 'RSM.QuadFit' から第一階係数を抽出して steepest ascent。+--+--   @QuadFit@ の @qfBeta@ レイアウトは @[b0, β_main, β_sq, β_int]@ なので、+--   主効果 @β_main = b_1..b_k@ を取り出す。+--   [English]: Extracts the first-order coefficients from 'RSM.QuadFit' for+--   steepest ascent.+--+--   Since @QuadFit@'s @qfBeta@ layout is @[b0, β_main, β_sq, β_int]@, the+--   main effects @β_main = b_1..b_k@ are extracted.+steepestAscentFromQuad+  :: Bool                 -- ^ [日本語]: maximize? [English]: maximize?+  -> [Double]             -- ^ [日本語]: center [English]: The center+  -> RSM.QuadFit+  -> Double               -- ^ [日本語]: step size [English]: Step size+  -> Int                  -- ^ [日本語]: nSteps [English]: nSteps+  -> SteepestAscentResult+steepestAscentFromQuad maximize center fit stepSize nSteps =+  let k     = RSM.qfK fit+      beta  = LA.toList (RSM.qfBeta fit)+      bMain = take k (drop 1 beta)+  in steepestAscent maximize center bMain stepSize nSteps++-- ===========================================================================+-- Sequential CCD+-- ===========================================================================++-- | [日本語]: 次の CCD を新しい中心で配置した結果。+--   [English]: The result of placing the next CCD at a new center.+data SequentialCCDResult = SequentialCCDResult+  { sccdCenter :: ![Double]      -- ^ [日本語]: 新しい design center (原座標) [English]: The new design center (raw coordinates)+  , sccdSpan   :: !Double        -- ^ [日本語]: 片側スパン (coded -1 ~ +1 が原座標で center ± span) [English]: The one-sided span (coded -1 to +1 corresponds to center ± span in raw coordinates)+  , sccdCoded  :: ![[Double]]    -- ^ [日本語]: coded units (-α..+α) の design [English]: The design in coded units (-α..+α)+  , sccdReal   :: ![[Double]]    -- ^ [日本語]: 原座標の design (= center + span · coded) [English]: The design in raw coordinates (= center + span * coded)+  } deriving (Show)++-- | [日本語]: 新中心と span で次の CCD を配置。+--+--   内部で @Hanalyze.Design.RSM.centralComposite@ を呼び、 結果を新中心に+--   平行移動 + スケーリングする。 coded units と原座標の両方を返すので、+--   canvas frontend で「coded で fit、 原座標で表示」 が一発で出来る。+--   [English]: Places the next CCD at the new center and span.+--+--   Internally calls @Hanalyze.Design.RSM.centralComposite@ and+--   translates + scales the result to the new center. Returns both coded+--   units and raw coordinates, so the canvas frontend can do "fit in coded,+--   display in raw coordinates" in one step.+sequentialCCD+  :: [Double]            -- ^ [日本語]: 新中心 (k 次元) [English]: The new center (k-dimensional)+  -> Double              -- ^ [日本語]: 片側 span (> 0) [English]: The one-sided span (> 0)+  -> Int                 -- ^ [日本語]: 因子数 k [English]: The number of factors, k+  -> RSM.CCDType         -- ^ [日本語]: CCD 種別 (Circumscribed / Inscribed / FaceCentered) [English]: The CCD kind (Circumscribed \/ Inscribed \/ FaceCentered)+  -> Int                 -- ^ [日本語]: center replications [English]: Center replications+  -> SequentialCCDResult+sequentialCCD center span_ k ccdT centerReps =+  let coded = RSM.centralComposite k ccdT centerReps+      real_ = [ zipWith (\c x -> c + span_ * x) center row | row <- coded ]+  in SequentialCCDResult+       { sccdCenter = center+       , sccdSpan   = span_+       , sccdCoded  = coded+       , sccdReal   = real_+       }
+ src/Hanalyze/Design/SpaceFilling.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Hanalyze.Design.SpaceFilling+-- Description : 空間充填計画 (Latin Hypercube / Maximin LHS / Halton) — コンピュータ実験・surrogate モデル用 DoE+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: 空間充填計画 (Space-Filling Designs) — コンピュータ実験 / surrogate+-- モデル用の DoE。+--+-- 提供する方式:+--+--   - 'latinHypercube' — Latin Hypercube Sampling (stratified random)+--   - 'latinHypercubeMaximin' — Maximin LHS (点間最小距離を最大化する局所探索)+--   - 'haltonDesign' — Halton 低偏差列 (決定的、 再現性高)+--+-- 出力は全て @[0, 1)^d@ 上の点。 ユーザは bounds スケーリングを後で行う+-- (`Hanalyze.Stat.QuasiRandom.lhsSamplesIn` 等を参考に)。+--+-- [English]: Space-Filling Designs — DoE for computer experiments \/+-- surrogate models.+--+-- Provided schemes:+--+--   - 'latinHypercube' — Latin Hypercube Sampling (stratified random)+--   - 'latinHypercubeMaximin' — Maximin LHS (a local search that maximizes+--     the minimum inter-point distance)+--   - 'haltonDesign' — the Halton low-discrepancy sequence (deterministic,+--     highly reproducible)+--+-- All outputs are points on @[0, 1)^d@. Users perform bounds scaling+-- afterward (see e.g. `Hanalyze.Stat.QuasiRandom.lhsSamplesIn`).+module Hanalyze.Design.SpaceFilling+  ( SpaceFillingDesign (..)+  , latinHypercube+  , latinHypercubeMaximin+  , haltonDesign+    -- * 品質指標+  , designMinDistance+  ) where++import           Control.Monad             (forM_, when)+import           Data.IORef                (newIORef, readIORef, writeIORef, modifyIORef')+import qualified Numeric.LinearAlgebra     as LA+import           Data.Text                 (Text)+import qualified System.Random.MWC         as MWC++import qualified Hanalyze.Stat.QuasiRandom as QR++-- ===========================================================================+-- 型+-- ===========================================================================++-- | [日本語]: 空間充填計画の結果。+--   [English]: The result of a space-filling design.+data SpaceFillingDesign = SpaceFillingDesign+  { sfdMatrix  :: !(LA.Matrix Double)  -- ^ [日本語]: n × d、 @[0, 1)^d@ 上の点 [English]: n x d, points on @[0, 1)^d@+  , sfdNPoints :: !Int                 -- ^ [日本語]: 行数 n [English]: The number of rows, n+  , sfdNDims   :: !Int                 -- ^ [日本語]: 列数 d [English]: The number of columns, d+  , sfdMinDist :: !Double              -- ^ [日本語]: 点間最小ユークリッド距離 (大きい方が良い) [English]: The minimum inter-point Euclidean distance (larger is better)+  , sfdMethod  :: !Text                -- ^ [日本語]: "LHS" / "MaximinLHS" / "Halton" [English]: "LHS" \/ "MaximinLHS" \/ "Halton"+  } deriving (Show)++-- ===========================================================================+-- 公開関数+-- ===========================================================================++-- | [日本語]: Latin Hypercube Sampling — 各次元のセル @[i/n, (i+1)/n)@ を 1 度ずつ+--   ランダム順序で埋める。 iid uniform より初期被覆良。+--   [English]: Latin Hypercube Sampling — fills each dimension's cells+--   @[i/n, (i+1)/n)@ exactly once, in random order. Better initial+--   coverage than iid uniform.+latinHypercube :: Int            -- ^ [日本語]: 点数 n [English]: The number of points, n+               -> Int            -- ^ [日本語]: 次元 d [English]: The number of dimensions, d+               -> MWC.GenIO+               -> IO SpaceFillingDesign+latinHypercube n d gen+  | n < 1 || d < 1 = pure SpaceFillingDesign+      { sfdMatrix  = (0 LA.>< 0) []+      , sfdNPoints = 0+      , sfdNDims   = 0+      , sfdMinDist = 0+      , sfdMethod  = "LHS"+      }+  | otherwise = do+      pts <- QR.lhsSamples n d gen+      let mat = LA.fromLists pts+      pure SpaceFillingDesign+        { sfdMatrix  = mat+        , sfdNPoints = n+        , sfdNDims   = d+        , sfdMinDist = designMinDistance mat+        , sfdMethod  = "LHS"+        }++-- | [日本語]: Maximin LHS — 初期 LHS から始めて、 ランダム (列, 行ペア) で値交換を試行、+--   点間最小距離が改善するなら採用、 を @nTries@ 回 (= 全試行回数) 反復。+--+--   結果は __LHS の stratification 性質を保ったまま__ 距離を最大化したもの。+--   @nTries = 1000@ 程度で実用的な改善が得られる (n, d による)。+--   [English]: Maximin LHS — starting from an initial LHS, tries a value+--   swap at a random (column, row-pair), keeps it if the minimum+--   inter-point distance improves, and repeats this @nTries@ times (= the+--   total number of trials).+--+--   The result maximizes distance+--   __while preserving the LHS's stratification property__. @nTries = 1000@ or so yields a practical+--   improvement (depending on n, d).+latinHypercubeMaximin :: Int            -- ^ [日本語]: 点数 n [English]: The number of points, n+                     -> Int            -- ^ [日本語]: 次元 d [English]: The number of dimensions, d+                     -> Int            -- ^ [日本語]: 試行回数 (= swap 候補数の上限) [English]: The number of trials (= the upper bound on swap candidates)+                     -> MWC.GenIO+                     -> IO SpaceFillingDesign+latinHypercubeMaximin n d nTries gen+  | n < 2 || d < 1 = do+      -- 1 点しかなければ swap 不能、 通常 LHS を返す+      lhs <- latinHypercube n d gen+      pure lhs { sfdMethod = "MaximinLHS" }+  | otherwise = do+      initPts  <- QR.lhsSamples n d gen+      matRef   <- newIORef (LA.fromLists initPts)+      distRef  <- do+        let m0 = LA.fromLists initPts+        newIORef (designMinDistance m0)+      forM_ [1 .. nTries] $ \_ -> do+        -- ランダムに 1 列 k 選び、 その列の 2 行 i, j を swap+        k <- MWC.uniformR (0, d - 1) gen+        i <- MWC.uniformR (0, n - 1) gen+        j <- MWC.uniformR (0, n - 1) gen+        when (i /= j) $ do+          curMat   <- readIORef matRef+          let newMat  = swapEntries curMat i j k+              newDist = designMinDistance newMat+          curDist <- readIORef distRef+          when (newDist > curDist) $ do+            writeIORef matRef  newMat+            writeIORef distRef newDist+      finalMat  <- readIORef matRef+      finalDist <- readIORef distRef+      pure SpaceFillingDesign+        { sfdMatrix  = finalMat+        , sfdNPoints = n+        , sfdNDims   = d+        , sfdMinDist = finalDist+        , sfdMethod  = "MaximinLHS"+        }++-- | [日本語]: Halton 低偏差列ベースの決定的 design。 同じ @(n, d)@ で必ず同じ点集合を+--   返す (再現性目的)。+--   [English]: A deterministic design based on the Halton low-discrepancy+--   sequence. Always returns the same point set for the same @(n, d)@+--   (for reproducibility).+haltonDesign :: Int          -- ^ [日本語]: 点数 n [English]: The number of points, n+             -> Int          -- ^ [日本語]: 次元 d [English]: The number of dimensions, d+             -> SpaceFillingDesign+haltonDesign n d+  | n < 1 || d < 1 = SpaceFillingDesign+      { sfdMatrix  = (0 LA.>< 0) []+      , sfdNPoints = 0+      , sfdNDims   = 0+      , sfdMinDist = 0+      , sfdMethod  = "Halton"+      }+  | otherwise =+      let mat = QR.haltonMatrix n d+      in SpaceFillingDesign+           { sfdMatrix  = mat+           , sfdNPoints = n+           , sfdNDims   = d+           , sfdMinDist = designMinDistance mat+           , sfdMethod  = "Halton"+           }++-- ===========================================================================+-- 品質指標+-- ===========================================================================++-- | [日本語]: 点間ユークリッド距離の最小値。 空 design (行数 < 2) では 0。+--   [English]: The minimum inter-point Euclidean distance. 0 for an empty+--   design (row count < 2).+designMinDistance :: LA.Matrix Double -> Double+designMinDistance mat+  | LA.rows mat < 2 = 0+  | otherwise =+      let n   = LA.rows mat+          rs  = LA.toRows mat+          pairs = [ (i, j) | i <- [0 .. n - 2], j <- [i + 1 .. n - 1] ]+          dist (i, j) =+            let di = rs !! i+                dj = rs !! j+                v  = di - dj+            in sqrt (LA.sumElements (v * v))+      in minimum (map dist pairs)++-- ===========================================================================+-- 内部 helper+-- ===========================================================================++-- | [日本語]: Matrix の (i, k) 要素と (j, k) 要素を入れ替えた新しい Matrix。+--   [English]: A new Matrix with the (i, k) and (j, k) elements swapped.+swapEntries :: LA.Matrix Double -> Int -> Int -> Int -> LA.Matrix Double+swapEntries mat i j k =+  let nR = LA.rows mat+      nC = LA.cols mat+      a  = LA.atIndex mat (i, k)+      b  = LA.atIndex mat (j, k)+      rows = LA.toLists mat+      update r idx newVal =+        take k r ++ [newVal] ++ drop (k + 1) r+      _ = (nR, nC)  -- silence+  in LA.fromLists+       [ if rIdx == i then update (rows !! rIdx) k b+         else if rIdx == j then update (rows !! rIdx) k a+         else rows !! rIdx+       | rIdx <- [0 .. nR - 1]+       ]
+ src/Hanalyze/Design/Taguchi.hs view
@@ -0,0 +1,313 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Taguchi+-- Description : タグチメソッド — SN 比・内側/外側配置・要因効果によるロバスト設計解析+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: タグチメソッド — ロバスト設計のために直交表+-- ('Hanalyze.Design.Orthogonal') を拡張する解析レイヤー。+--+-- 主要な構成要素:+--+-- 1. __SN 比 (Signal-to-Noise ratio)__ — ばらつきを定量化する:+--+--    - @SmallerBetter@ — 望小特性 (例: 不良率)、+--      @η = -10 log₁₀(Σ y²/n)@。+--    - @LargerBetter@ — 望大特性 (例: 強度)、+--      @η = -10 log₁₀(Σ (1/y²)/n)@。+--    - @NominalBest@ — 望目特性 (平均/分散)、+--      @η = 10 log₁₀(μ²/σ²)@。+--    - NominalBestTarget m: 目標値 m への二乗平均偏差    η = -10 log₁₀(Σ (y-m)²/n)+--+-- 2. __内側/外側配置 (Inner/Outer Arrays)__ — 制御因子 (内側) と+--    雑音因子 (外側) のクロス設計。各内側試行で外側全条件を観測 → 行ごとに+--    SN 比を計算 → 雑音に頑健な制御因子の組合せを発見。+--+-- 3. __要因効果 (FactorEffect)__ — 各因子の各水準での平均 SN 比。+--    最良水準 = 平均 SN 比が最大の水準。+--+-- [English]: The Taguchi method — an analytical layer that extends+-- orthogonal arrays ('Hanalyze.Design.Orthogonal') for robust+-- design.+--+-- Main building blocks:+--+-- 1. __Signal-to-Noise ratio (SN)__ — quantifies variability:+--+--    - @SmallerBetter@   — smaller-the-better (e.g. defect rate),+--      @η = -10 log₁₀(Σ y²/n)@.+--    - @LargerBetter@    — larger-the-better (e.g. strength),+--      @η = -10 log₁₀(Σ (1/y²)/n)@.+--    - @NominalBest@     — nominal-the-best (mean/variance),+--      @η = 10 log₁₀(μ²/σ²)@.+--    - NominalBestTarget m: the mean-square deviation to the target+--      value m, @η = -10 log₁₀(Σ (y-m)²/n)@.+--+-- 2. __Inner/Outer Arrays__ — a cross design of control factors (inner)+--    and noise factors (outer). Each inner run observes all outer+--    conditions → compute the SN ratio per row → discover the+--    control-factor combination that is robust to noise.+--+-- 3. __FactorEffect__ — the mean SN ratio at each level of each factor.+--    The best level = the level with the largest mean SN ratio.+module Hanalyze.Design.Taguchi+  ( -- * SN 比+    SNType (..)+  , snTypeName+  , snRatio+  , snRatioRows+  , SNDetails (..)+  , snRatioWithDetails+    -- * Factor effects and optimal levels+  , FactorEffect (..)+  , analyzeSN+  , optimalLevels+  , predictSN+  , FactorEffectExt (..)+  , factorEffectsTable+    -- * Inner/outer arrays+  , InnerOuterDesign (..)+  , makeInnerOuter+  , renderInnerOuterCSV+  ) where++import Data.Text (Text)+import qualified Data.Text as T+import Text.Printf (printf)++import Hanalyze.Design.Orthogonal+  ( OA (..)+  , AssignedDesign (..)+  , FactorSpec (..)+  , LevelValue (..)+  )++-- ---------------------------------------------------------------------------+-- SN 比+-- ---------------------------------------------------------------------------++-- | Signal-to-noise ratio rule. Taguchi's four canonical cases.+data SNType+  = SmallerBetter+    -- ^ Smaller-the-better: @y → 0@ is desired (defect rates, errors,+    --   noise). @η = -10 log₁₀(Σ y²/n)@.+  | LargerBetter+    -- ^ Larger-the-better: @y → ∞@ is desired (strength, lifetime,+    --   efficiency). @η = -10 log₁₀(Σ (1/y²)/n)@.+  | NominalBest+    -- ^ Nominal-the-best: hold the mean and minimize variance.+    --   @η = 10 log₁₀(μ²/σ²)@.+  | NominalBestTarget Double+    -- ^ Nominal-the-best with explicit target @m@:+    --   @η = -10 log₁₀(Σ(y - m)²/n)@.+  deriving (Show, Eq)++-- | Display name of an 'SNType'.+snTypeName :: SNType -> Text+snTypeName SmallerBetter         = "smaller-the-better"+snTypeName LargerBetter          = "larger-the-better"+snTypeName NominalBest           = "nominal-the-best"+snTypeName (NominalBestTarget m) =+  "nominal-the-best (target=" <> T.pack (printf "%g" m) <> ")"++-- | Compute the SN ratio @η@ (in dB) from one run's repeated+-- observations.+snRatio :: SNType -> [Double] -> Double+snRatio _    [] = 0+snRatio sn   ys = case sn of+  SmallerBetter ->+    let msd = sum [ y * y | y <- ys ] / fromIntegral n+    in -10 * logBase 10 (max msd epsLog)+  LargerBetter ->+    let msd = sum [ 1 / max (y * y) epsLog | y <- ys ] / fromIntegral n+    in -10 * logBase 10 (max msd epsLog)+  NominalBest ->+    let mu  = sum ys / fromIntegral n+        var = sum [ (y - mu) ^ (2 :: Int) | y <- ys ]+                / fromIntegral (max 1 (n - 1))+    in if var <= 0+         then 0+         else 10 * logBase 10 ((mu * mu) / max var epsLog)+  NominalBestTarget target ->+    let msd = sum [ (y - target) ^ (2 :: Int) | y <- ys ]+                / fromIntegral n+    in -10 * logBase 10 (max msd epsLog)+  where+    n      = length ys+    epsLog = 1e-30   -- 0 で log を取るのを防ぐ++-- | For an @inner-run × outer-run@ observation matrix, return the SN+-- ratio of each inner run.+snRatioRows :: SNType -> [[Double]] -> [Double]+snRatioRows sn = map (snRatio sn)++-- | SN ratio bundled with the descriptive statistics that are usually+-- reported alongside it (sample mean, unbiased variance, sample size).+data SNDetails = SNDetails+  { sdSN       :: !Double+  , sdMean     :: !Double+  , sdVariance :: !Double+  , sdN        :: !Int+  } deriving (Show, Eq)++-- | 'snRatio' plus the matching @mean@ / @variance@ / @n@ so that UIs+-- can render the trio in one row.+snRatioWithDetails :: SNType -> [Double] -> SNDetails+snRatioWithDetails sn ys =+  let n  = length ys+      mu = if n == 0 then 0 else sum ys / fromIntegral n+      v  = if n <= 1+             then 0+             else sum [ (y - mu) ^ (2 :: Int) | y <- ys ]+                    / fromIntegral (n - 1)+  in SNDetails (snRatio sn ys) mu v n++-- ---------------------------------------------------------------------------+-- 要因効果と最適水準+-- ---------------------------------------------------------------------------++-- | Per-level mean SN ratio for a single factor.+data FactorEffect = FactorEffect+  { feFactor    :: Text          -- ^ Factor name.+  , feLevels    :: [LevelValue]  -- ^ Level values in order.+  , feSNByLevel :: [Double]      -- ^ Mean SN ratio at each level.+  } deriving (Show, Eq)++-- | From the per-inner-run SN ratios, compute the mean SN ratio for+-- every (factor, level) pair.+--+-- For each inner run @i@, gather the @SN_i@ values where factor @j@+-- has level @k@ and average them.+analyzeSN :: AssignedDesign -> [Double] -> [FactorEffect]+analyzeSN ad sns =+  let factors = adFactors ad+      table   = oaTable (adArray ad)+      runs    = zip table sns                    -- (oaRow, sn_i)+  in [ FactorEffect+         { feFactor    = fsName f+         , feLevels    = fsLevels f+         , feSNByLevel = meanByLevel j (length (fsLevels f)) runs+         }+     | (j, f) <- zip [0..] factors ]+  where+    meanByLevel j nLvl runs =+      [ let xs = [ sn | (oaRow, sn) <- runs+                       , length oaRow > j+                       , (oaRow !! j) == k ]+        in if null xs then 0+                      else sum xs / fromIntegral (length xs)+      | k <- [1 .. nLvl] ]++-- | For each factor, the best level (the one with the largest mean SN)+-- together with that SN ratio.+optimalLevels :: [FactorEffect] -> [(Text, LevelValue, Double)]+optimalLevels effects =+  [ let (ix, snBest) = argmax (feSNByLevel fe)+        lvl = if ix < length (feLevels fe)+                then feLevels fe !! ix+                else LText "?"+    in (feFactor fe, lvl, snBest)+  | fe <- effects ]+  where+    argmax xs = foldl1 better (zip [0::Int ..] xs)+    better a@(_, va) b@(_, vb) = if vb > va then b else a++-- | Predicted SN ratio at the best-level combination (main-effects-only+-- additive model):+--+-- @η_pred = mean(η_all) + Σ_j (η_best_j − mean(η_all))@.+predictSN :: [FactorEffect] -> [Double] -> Double+predictSN effects allSN =+  let muAll = if null allSN then 0+              else sum allSN / fromIntegral (length allSN)+      maxPerFactor = [ maximum (feSNByLevel fe) | fe <- effects ]+  in muAll + sum [ best - muAll | best <- maxPerFactor ]++-- | 'FactorEffect' enriched with the range (@max − min@ across levels)+-- and the relative contribution @range_j / Σ range_k@. Useful for+-- response-table style UI that need a single struct per factor.+data FactorEffectExt = FactorEffectExt+  { feeFactor       :: !Text+  , feeLevels       :: ![LevelValue]+  , feeSNByLevel    :: ![Double]+  , feeRange        :: !Double+  , feeContribution :: !Double  -- ^ @0 ≤ contribution ≤ 1@.+  } deriving (Show, Eq)++-- | Factor-effect table with range + contribution. Calls 'analyzeSN'+-- internally, so the per-level means match exactly.+factorEffectsTable :: AssignedDesign -> [Double] -> [FactorEffectExt]+factorEffectsTable ad sns =+  let effects = analyzeSN ad sns+      ranges  = [ rangeOf (feSNByLevel fe) | fe <- effects ]+      total   = sum ranges+  in zipWith+       (\fe r ->+          FactorEffectExt+            { feeFactor       = feFactor fe+            , feeLevels       = feLevels fe+            , feeSNByLevel    = feSNByLevel fe+            , feeRange        = r+            , feeContribution = if total <= 0 then 0 else r / total+            })+       effects ranges+  where+    rangeOf [] = 0+    rangeOf xs = maximum xs - minimum xs++-- ---------------------------------------------------------------------------+-- 内側/外側配置+-- ---------------------------------------------------------------------------++-- | Inner × outer cross design: inner is the control-factor array,+-- outer the noise-factor array.+data InnerOuterDesign = InnerOuterDesign+  { ioInner :: AssignedDesign+  , ioOuter :: AssignedDesign+  } deriving (Show, Eq)++-- | Construct an 'InnerOuterDesign'.+makeInnerOuter :: AssignedDesign -> AssignedDesign -> InnerOuterDesign+makeInnerOuter = InnerOuterDesign++-- | Render the cross design as CSV. Each row corresponds to one inner+-- run; columns hold the inner-factor values followed by empty cells+-- @y_outer1..y_outerM@ for the user to fill in measurements. The outer+-- run table is appended afterwards.+renderInnerOuterCSV :: InnerOuterDesign -> Text+renderInnerOuterCSV io =+  let inner   = ioInner io+      outer   = ioOuter io+      innerN  = length (adRows inner)+      outerN  = length (adRows outer)+      innerHs = map fsName (adFactors inner)+      outerHs = map fsName (adFactors outer)+      yLabels = [ "y_outer" <> T.pack (show (k :: Int)) | k <- [1 .. outerN] ]+      header  = T.intercalate ","+                  ("InnerRun" : innerHs ++ yLabels)+      rows    = [ T.intercalate ","+                    (T.pack (show i)+                     : map fmtLV (adRows inner !! (i - 1))+                     ++ replicate outerN "")+                | i <- [1 .. innerN] ]+      -- 外側表 (参考情報) を末尾に追記+      footer  = "\n# Outer array (noise factors): "+                <> T.intercalate ", " outerHs <> "\n"+                <> T.intercalate "\n"+                     [ "# OuterRun " <> T.pack (show k) <> ": "+                       <> T.intercalate ", "+                            (zipWith (\h v -> h <> "=" <> fmtLV v)+                              outerHs (adRows outer !! (k - 1)))+                     | k <- [1 .. outerN] ]+                <> "\n"+  in header <> "\n" <> T.intercalate "\n" rows <> "\n" <> footer++-- | [日本語]: LevelValue を CSV 用に文字列化。整数値は 150、小数は 0.1 形式。+--   [English]: Stringifies a LevelValue for CSV. Integer values render+--   like 150, decimals like 0.1.+fmtLV :: LevelValue -> Text+fmtLV (LText t) = t+fmtLV (LNumeric d)+  | d == fromIntegral (round d :: Integer) = T.pack (show (round d :: Integer))+  | otherwise                              = T.pack (printf "%g" d)
+ src/Hanalyze/Design/Workflow.hs view
@@ -0,0 +1,2130 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module      : Hanalyze.Design.Workflow+-- Description : DOE ワークフロー層 — 低レベル設計関数を設計オブジェクト Design に束ねる R 流の対話的入口+-- Copyright   : (c) 2026 Aelysce Project (Toshiaki Honda)+-- License     : BSD-3-Clause+--+-- [日本語]: DOE ワークフロー層 — 散在する低レベル設計関数 (`Design.Factorial`/@RSM@ 等・+--   生 @[[Double]]@ 返し) を __設計オブジェクト `Design`__ に束ね、 R 流の対話的ワークフローに+--   載せる玄関。+--+--   - `factorialDesign` / `centralCompositeDesign` — 因子 (名前 + 実値の下限/上限) から `Design` を作る+--     pure コンストラクタ。 `Design` は __coded 設計行列 + モデル formula の含意__を運ぶ。+--   - `designTable` — 実行用の __runsheet__ (uncoded 実値・因子名列 + run 番号) を出す。+--     戻り値 @[(Text,[Double])]@ は @ColumnSource@ ゆえそのまま @df |->@ にも載る。+--   - `designFormula` — 設計種別からモデル formula を生成 (要因計画 = 全交互作用+--     @y ~ x1 * x2 * …@、 RSM = 2 次 @y ~ x1 + x2 + x1:x2 + I(x1^2) + I(x2^2)@)。+--+--   解析 (@designModel@) は `Hanalyze.Fit` 側 (formula → 既存 LM 当てはめ)。+--   ★coded/uncoded の要点: fit を coded でやるか uncoded でやるかは__予測に影響しない__+--   (同一項の LM は再パラメータ化・予測/R²/profiler は同値)。 だから fit は uncoded (自然単位)+--   のまま — 係数がそのまま実単位で読める。 coding が実質的に効くのは__スケール依存な最適化幾何__+--   (停留点方向・canonical 軸・steepest ascent 方向) だけ。 そこは `rsmAnalysis` /+--   `steepestAscentNatural` が内部で coded の計量を使い、 結果を__自然単位で報告__する。+--   runsheet は一貫して実験者向けの uncoded 実値。+--+-- [English]: The DOE workflow layer — bundles the scattered low-level+--   design functions (`Design.Factorial`/@RSM@, etc., which return raw+--   @[[Double]]@) into a __design object `Design`__, providing an entry+--   point into an R-style interactive workflow.+--+--   - `factorialDesign` / `centralCompositeDesign` — pure constructors that+--     build a `Design` from factors (name + real-valued lower/upper bounds).+--     `Design` carries+--     __the coded design matrix + the implied model formula__.+--   - `designTable` — emits an executable __runsheet__ (uncoded real+--     values, factor-name columns + run number). The return type+--     @[(Text,[Double])]@ is a @ColumnSource@, so it plugs directly into+--     @df |->@ too.+--   - `designFormula` — generates a model formula from the design kind+--     (factorial = full interaction @y ~ x1 * x2 * …@, RSM = quadratic+--     @y ~ x1 + x2 + x1:x2 + I(x1^2) + I(x2^2)@).+--+--   Analysis (@designModel@) lives on the `Hanalyze.Fit` side+--   (formula → existing LM fitting). ★The key point on coded/uncoded:+--   whether the fit is done coded or uncoded+--   __doesn't affect the prediction__ (the LM for the same terms is just a reparameterization;+--   prediction/R²/profiler are equivalent). So the fit stays uncoded+--   (natural units) — coefficients read directly in real units. Coding+--   only actually matters for __scale-dependent optimization geometry__+--   (stationary-point direction, canonical axes, steepest-ascent+--   direction). There, `rsmAnalysis` / `steepestAscentNatural` use the+--   coded metric internally and __report the result in natural units__.+--   The runsheet is consistently uncoded real values for the experimenter.+module Hanalyze.Design.Workflow+  ( -- * 設計オブジェクト+    DesignFactor (..)+  , FactorKind (..)+  , FactorScale (..)+  , DesignKind (..)+  , Design (..)+    -- * 因子の smart constructor (連続 / 数値順序 / カテゴリ)+  , contFactor+  , contFactorLog+  , numFactor+  , catFactor+    -- * コンストラクタ (pure)+  , factorialDesign+  , centralCompositeDesign+  , boxBehnkenDesign+    -- * 一部実施要因 (run 削減) — Phase 78.G+  , Resolution (..)+  , resNum+  , fractionalDesign+  , fractionalDesignGen+  , fractionalDesignInter+  , fractionalDesignGenInter+  , fractionalCatalog+  , fracResolution+  , aliasStructure+    -- * Taguchi 直交表 (2 水準スクリーニング) — Phase 78.G-a+  , OATable (..)+  , taguchiDesign+  , taguchiDesignOA+    -- * 最適計画 (D/A/I/E/G-最適・カスタム formula) — Phase 78.G-b1+  , OptCriterion (..)+  , optimalDesign+  , optimalDesignWith+  , optimalDesignLevels+    -- ** モデル指定 効果 DSL (Formula の糖衣)+  , mainEffects+  , twoWay+  , quadratic+    -- ** 効果 DSL / Formula → Custom.Model 変換 (Phase 78.M M3)+  , formulaToCustomModel+    -- * 完全カスタムデザインエンジン (pure・座標交換 / 階層構造 / 制約) — Phase 79+  , CustomSpec (..)+  , customSpec+  , customDesign+  , Structure (..)+  , splitPlot+  , stripPlot+  , blocked+  , Constraint (..)+  , ConstraintRel (..)+  , ConstraintGuard (..)+  , FactorValue (..)+    -- ** 自然単位の制約 (推奨・Phase 82)+  , NatConstraint (..)+  , natLeq+  , natGeq+  , natEq+  , natForbid+    -- * 取り出し+  , designFactorNames+  , designTable+  , designFrame+  , designFrameRound+  , designFormula+    -- * 応答曲面 解析 (自然単位で報告) — Phase 78.G-d+  , RSMNature (..)+  , RSMReport (..)+  , rsmAnalysis+  , steepestAscentNatural+    -- * 設計の保存 / DataFrame からの復元 — Phase 78.K+  , saveDesign+  , planFromFrame+  ) where++import           Data.List (sort, subsequences, (\\), foldl1', nub, minimumBy, elemIndex, transpose, find)+import           Data.Ord (comparing)+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Vector as V+import qualified DataFrame.Internal.Column    as DX+import qualified DataFrame.Internal.DataFrame  as DX+import qualified DataFrame.IO.CSV as DXIO+import qualified Numeric.LinearAlgebra as LA++import           Hanalyze.DataIO.Convert (getDoubleVec, getTextVec)++import           Hanalyze.Design.Custom.Constraint+                   (Constraint (..), ConstraintRel (..), ConstraintGuard (..), FactorValue (..))+import qualified Hanalyze.Design.Custom.Factor as CF+import qualified Hanalyze.Design.Custom.Model  as CMd+import qualified Hanalyze.Design.Custom.Coordinate as CX+import qualified Hanalyze.Design.Custom.Structured as ST+import qualified Data.Vector.Storable as VS+import           Hanalyze.Design.Factorial (fullFactorial, fractionalFactorial)+import           Hanalyze.Design.RSM+                   ( centralCompositeRotatable, boxBehnken+                   , QuadFit (..), fitQuadratic, optimumPoint, canonicalAnalysis )+import           Hanalyze.Design.Sequential+                   (SteepestAscentResult (..), steepestAscentFromQuad)+import           Hanalyze.Design.Orthogonal+                   (OA (..), l4, l8, l9, l12, l16, l18, l27)+import           Hanalyze.Design.Optimal   (OptCriterion (..))+import qualified Hanalyze.Design.Optimal as OPT+import           Hanalyze.Model.Formula+                   (Formula (..), Term (..), BinOp (..), prettyFormula)+import           Hanalyze.Model.Formula.RFormula (parseRFormula)+import           Hanalyze.Model.Formula.Frame    (modelFrame)+import           Hanalyze.Model.Formula.Design   (designMatrixF)++-- ---------------------------------------------------------------------------+-- 型+-- ---------------------------------------------------------------------------++-- | [日本語]: DOE 因子。 __識別子__ ('dfName') と __性質__ ('dfKind') を分離し、+--   accessor は全て total (partial field を作らない)。 構築は smart constructor+--   'contFactor' / 'numFactor' / 'catFactor' で行う。+--+--   因子は純粋に因子であり、 どの因子がどの階層 (whole-plot / block) に属するかは+--   因子ではなく 'CustomSpec' の 'Structure' が __名前で__ 持つ (役割 @dfRole@ は撤去)。+--   [English]: A DOE factor. Separates __identity__ ('dfName') from+--   __nature__ ('dfKind'); all accessors are total (no partial fields).+--   Constructed via the smart constructors 'contFactor' / 'numFactor' /+--   'catFactor'.+--+--   A factor is purely a factor — which tier (whole-plot / block) a+--   factor belongs to is held __by name__ in 'CustomSpec''s 'Structure',+--   not by the factor itself (the @dfRole@ role field was removed).+data DesignFactor = DesignFactor+  { dfName :: !Text+      -- ^ [日本語]: 因子名 (runsheet の列名・formula の項)+      --   [English]: The factor name (the runsheet column name / formula term).+  , dfKind :: !FactorKind+      -- ^ [日本語]: 連続 ('Cont') / 数値順序 ('Num') / カテゴリ ('Cat')+      --   [English]: Continuous ('Cont') / numeric-ordered ('Num') / categorical ('Cat').+  } deriving (Show, Eq)++-- | [日本語]: 連続因子の__スケール__。 coded @[-1,1]@ 軸を自然単位へどう写すか。+--+--   - 'SLinear' — 線形。 @nat = center + coded·half@ (既定)。+--   - 'SLog'    — 対数 (幾何)。 @nat = 10^(logCenter + coded·logHalf)@。 桁が大きく違う+--     因子 (触媒濃度 0.01〜10 等) の水準・中心点を幾何的に等間隔にする。 @lo, hi > 0@ 必須。+--   [English]: The __scale__ of a continuous factor. How the coded+--   @[-1,1]@ axis maps to natural units.+--+--   - 'SLinear' — Linear. @nat = center + coded·half@ (default).+--   - 'SLog'    — Logarithmic (geometric). @nat = 10^(logCenter ++--     coded·logHalf)@. Makes the levels/center point geometrically+--     evenly spaced for factors spanning wide orders of magnitude (e.g.+--     catalyst concentration 0.01〜10). Requires @lo, hi > 0@.+data FactorScale = SLinear | SLog+  deriving (Show, Eq)++-- | [日本語]: 因子の性質。 因子1つは連続・数値順序・カテゴリの__いずれか一つ__で、 混在不正状態は表現不能。+--+--   - 'Cont' — 2 端点連続 + スケール ('FactorScale')。 coded @-1@ = 下限、 @+1@ = 上限。+--     線形なら uncoded 実値 = @center + coded·halfRange@、 対数なら幾何 (下記 'FactorScale')。+--     Taguchi では 2 水準列に載る。+--   - 'Num'  — __数値順序水準リスト__。 3 水準以上の連続量 (温度 150/165/180 等) を+--     順序付き実値で持つ。 coded は水準リストの位置 index (@0,1,2,…@)、 runsheet/designFrame では+--     __実水準値__ (Double) に戻る。 formula は __直交多項式__ @opoly(name, 水準数−1)@+--     (linear+quadratic…) で載り、 実測間隔で直交分解する (等間隔前提を置かない)。+--   - 'Cat'  — カテゴリ (順序なし) 水準名リスト。 coded は位置 index、 runsheet では水準名 (Text)。+--     formula は主効果名 (engine が contrast 展開)。+--   [English]: A factor's nature. A single factor is __exactly one__ of+--   continuous, numeric-ordered, or categorical; a mixed/invalid state is+--   unrepresentable.+--+--   - 'Cont' — Two-endpoint continuous + a 'FactorScale'. coded @-1@ =+--     lower bound, @+1@ = upper bound. Linear gives uncoded real value =+--     @center + coded·halfRange@; log gives geometric mapping (see+--     'FactorScale'). Loaded onto a 2-level column in Taguchi designs.+--   - 'Num'  — A __numeric-ordered level list__. Holds continuous+--     quantities with 3+ levels (e.g. temperature 150/165/180) as+--     ordered real values. coded is the position index in the level+--     list (@0,1,2,…@); runsheet/designFrame convert it back to the+--     __actual level value__ (Double). The formula uses+--     __orthogonal polynomials__ @opoly(name, level count − 1)@ (linear+quadratic…),+--     decomposed orthogonally with the actual measured spacing (no+--     equal-spacing assumption).+--   - 'Cat'  — An unordered category level-name list. coded is the+--     position index; runsheet shows the level name (Text). The formula+--     uses the main-effect name (the engine expands the contrast).+data FactorKind+  = Cont !Double !Double !FactorScale+      -- ^ [日本語]: 連続因子 (下限, 上限, スケール)+      --   [English]: A continuous factor (lower bound, upper bound, scale).+  | Num  ![Double]+      -- ^ [日本語]: 数値順序因子 (順序付き水準値リスト) → opoly+      --   [English]: A numeric-ordered factor (ordered level-value list) → opoly.+  | Cat  ![Text]+      -- ^ [日本語]: カテゴリ因子 (水準名リスト) → contrast+      --   [English]: A categorical factor (level-name list) → contrast.+  deriving (Show, Eq)++-- | [日本語]: 連続因子の smart constructor (線形スケール)。 @contFactor "temp" (150, 180)@。+--   [English]: Smart constructor for a continuous factor (linear scale).+--   @contFactor "temp" (150, 180)@.+contFactor :: Text -> (Double, Double) -> DesignFactor+contFactor n (lo, hi) = DesignFactor n (Cont lo hi SLinear)++-- | [日本語]: __対数スケール__連続因子の smart constructor。+--   @contFactorLog "conc" (0.01, 10)@。 coded 軸は従来通り @[-1,1]@ だが、 自然単位へは幾何的+--   (@10^…@) に写す。 水準・中心点が幾何等間隔になり、 桁の異なる因子を扱える。 @lo, hi > 0@+--   必須 (負/零は log 不能)。+--   [English]: Smart constructor for a continuous factor with a+--   __log scale__. @contFactorLog "conc" (0.01, 10)@. The coded axis is+--   still @[-1,1]@ as usual, but maps to natural units geometrically+--   (@10^…@). Levels/center point become geometrically evenly spaced,+--   letting you handle factors spanning wide orders of magnitude.+--   Requires @lo, hi > 0@ (negative/zero can't be log'd).+contFactorLog :: Text -> (Double, Double) -> DesignFactor+contFactorLog n (lo, hi) = DesignFactor n (Cont lo hi SLog)++-- | [日本語]: 数値順序因子の smart constructor。 @numFactor "temp" [150, 165, 180]@。+--   3 水準以上の連続量を Taguchi 3 水準表 (L9/L18/L27) に載せ、 実測間隔の直交多項式+--   (@opoly@) で linear+quadratic 分解する。 実水準値をそのまま渡す (等間隔でなくてよい)。+--   [English]: Smart constructor for a numeric-ordered factor.+--   @numFactor "temp" [150, 165, 180]@. Loads a continuous quantity with+--   3+ levels onto a Taguchi 3-level table (L9/L18/L27) and decomposes it+--   into linear+quadratic via orthogonal polynomials (@opoly@) using the+--   actual measured spacing. Pass the actual level values directly (need+--   not be evenly spaced).+numFactor :: Text -> [Double] -> DesignFactor+numFactor n levels = DesignFactor n (Num levels)++-- | [日本語]: カテゴリ因子の smart constructor。 @catFactor "catalyst" ["A", "B", "C"]@。+--   [English]: Smart constructor for a categorical factor.+--   @catFactor "catalyst" ["A", "B", "C"]@.+catFactor :: Text -> [Text] -> DesignFactor+catFactor n levels = DesignFactor n (Cat levels)++-- | [日本語]: 設計種別 (モデル formula の含意を決める)。+--   [English]: The design kind (determines the implied model formula).+data DesignKind+  = KFactorial+      -- ^ [日本語]: 要因計画 → 全交互作用モデル+      --   [English]: Factorial design → full-interaction model.+  | KRSM+      -- ^ [日本語]: 応答曲面 → 2 次モデル+      --   [English]: Response surface → quadratic model.+  | KFractional+      -- ^ [日本語]: 一部実施要因 → __主効果のみ__ (交互作用は交絡ゆえ主効果限定)+      --   [English]: Fractional factorial → __main effects only__ (limited+      --   to main effects since interactions are confounded).+  | KFracInter ![[Int]]+      -- ^ [日本語]: 一部実施要因 (__交互作用込み__・'fractionalDesignInter')。 generator を保持し、+      --   'designFormula' が主効果 + __主効果と交絡しない 2 因子交互作用の代表__ (交絡群ごと 1 個) を+      --   生成する。 交絡構造は 'aliasStructure' で確認できる。+      --   [English]: Fractional factorial (__with interactions__;+      --   'fractionalDesignInter'). Holds the generators; 'designFormula'+      --   produces the main effects plus one representative per+      --   __confounding group of 2-factor interactions__ not confounded with+      --   a main effect. The confounding structure can be checked with+      --   'aliasStructure'.+  | KCustom !Formula+      -- ^ [日本語]: 最適計画 ('optimalDesign') → モデル formula を__焼き込む__。 応答は placeholder+      --   ('formResponse') を持ち、 @designModel@/'designFormula' で実応答名に差し替わる。+      --   [English]: Optimal design ('optimalDesign') → __bakes in__ the+      --   model formula. The response is a placeholder ('formResponse'),+      --   swapped for the real response name by @designModel@/'designFormula'.+  | KStructured ![(Text, [Int])] !Formula+      -- ^ [日本語]: 完全カスタムデザイン ('customDesign')。 __群列__ (@[(群列名, 各 run の群 ID)]@ の+      --   リスト) + 焼き込み formula を保持する。 CRD = @[]@、 SplitPlot = @[("wholePlot", ids)]@、+      --   StripPlot = @[("wholePlot", wpIds), ("strip", stripIds)]@、 Blocked = @[("block", ids)]@。+      --   'designFrame' は各群列を __Text ラベル__ (@wp0…@ / @strip0…@ / @blk0…@) で追加し、+      --   @designModelHBM@ @[ranIntercept 群列名, …]@ が階層効果として当てられる (round-trip)。+      --   固定効果 formula は 'KCustom' 同様 'designFormula' で応答名に差し替わる。+      --   [English]: Fully custom design ('customDesign'). Holds the+      --   __group columns__ (a list of @[(group column name, per-run+      --   group id)]@) plus the baked-in formula. CRD = @[]@, SplitPlot =+      --   @[("wholePlot", ids)]@, StripPlot = @[("wholePlot", wpIds),+      --   ("strip", stripIds)]@, Blocked = @[("block", ids)]@.+      --   'designFrame' adds each group column as a __Text label__+      --   (@wp0…@ / @strip0…@ / @blk0…@), and @designModelHBM@+      --   @[ranIntercept groupColName, …]@ fits it as a hierarchical+      --   effect (round-trip). The fixed-effect formula, as with+      --   'KCustom', gets its response name swapped by 'designFormula'.+  deriving (Show, Eq)++-- | [日本語]: 設計オブジェクト = 因子 + coded 設計行列 (各行 = 1 run・列 = 因子) + 種別。+--   [English]: The design object = factors + coded design matrix (each row+--   = one run, columns = factors) + kind.+data Design = Design+  { dsFactors :: ![DesignFactor]+  , dsCoded   :: ![[Double]]+      -- ^ [日本語]: coded 座標 (±1 / ±α / 0)+      --   [English]: Coded coordinates (±1 / ±α / 0).+  , dsKind    :: !DesignKind+  } deriving (Show)++-- ---------------------------------------------------------------------------+-- Phase 79: 完全カスタムデザインエンジン (Structure / CustomSpec)+-- ---------------------------------------------------------------------------++-- | [日本語]: 実験のランダム化 / 階層構造 = 共分散 @M@ を決める。 総称 (v1 はエンジンが 4 種を実装)。+--   どの因子がどの層に属するかは因子 ('DesignFactor') ではなく __この構造が名前で持つ__。+--   'CustomSpec' の 'csStructure' に載る (既定 'CRD')。+--+--   - 'CRD' — 完全ランダム化 (@M = I@)。 既定。 座標交換 D-最適 (per-cell ムーブ)。+--   - 'SplitPlot' — whole-plot 因子が群内で一定 (@M = I + η·Z Zᵀ@)。 群単位ムーブ。+--   - 'StripPlot' — whole-plot × strip の直交 2 階層 (@M = I + ηW·Z_W Z_Wᵀ + ηS·Z_S Z_Sᵀ@)。+--   - 'Blocked' — ランダムブロック (@M = I + η·Z_B Z_Bᵀ@)。 全因子がブロック内で自由。+--+--   v1 未実装の構造 (多段ネスト・複数交差 RE) は 'customDesign' が+--   @unsupported structure@ で error になる (総称ゆえコンストラクタ追加のみで拡張できる)。+--   [English]: Determines the randomization / hierarchical structure of+--   the experiment = the covariance @M@. Generic (v1's engine implements 4+--   kinds). Which factor belongs to which tier is held+--   __by name in this structure__, not in the factor ('DesignFactor') itself. Lives in+--   'CustomSpec''s 'csStructure' (default 'CRD').+--+--   - 'CRD' — Completely randomized (@M = I@). Default. Coordinate+--     exchange D-optimal (per-cell moves).+--   - 'SplitPlot' — Whole-plot factors are constant within a group+--     (@M = I + η·Z Zᵀ@). Group-wise moves.+--   - 'StripPlot' — The orthogonal two-tier whole-plot × strip structure+--     (@M = I + ηW·Z_W Z_Wᵀ + ηS·Z_S Z_Sᵀ@).+--   - 'Blocked' — Randomized blocks (@M = I + η·Z_B Z_Bᵀ@). All factors+--     are free within a block.+--+--   Structures not yet implemented in v1 (multi-level nesting, multiple+--   crossed random effects) make 'customDesign' error with+--   @unsupported structure@ (being generic, it extends just by adding a+--   constructor).+data Structure+  = CRD+      -- ^ [日本語]: 完全ランダム化 (@M = I@)。 既定。+      --   [English]: Completely randomized (@M = I@). Default.+  | SplitPlot+      { spWhole   :: ![Text]+          -- ^ [日本語]: whole-plot 因子名 (群内で一定)+          --   [English]: Whole-plot factor names (constant within a group).+      , spNWhole  :: !Int+          -- ^ [日本語]: whole-plot 数 [English]: Number of whole-plots.+      , spEta     :: !Double+          -- ^ [日本語]: η = σ²_WP / σ² (既定 1.0)+          --   [English]: η = σ²_WP / σ² (default 1.0).+      , spColName :: !Text+          -- ^ [日本語]: designFrame に出す群列名 (既定 "wholePlot")+          --   [English]: The group column name emitted by designFrame+          --   (default "wholePlot").+      }+  | StripPlot+      { stWhole    :: ![Text], stNWhole :: !Int, stEtaW :: !Double, stWholeCol :: !Text+      , stStrip    :: ![Text], stNStrip :: !Int, stEtaS :: !Double, stStripCol :: !Text+      }+      -- ^ [日本語]: whole-plot × strip の直交 2 階層。+      --   [English]: The orthogonal two-tier whole-plot × strip structure.+  | Blocked+      { blkNBlocks :: !Int, blkEta :: !Double, blkColName :: !Text }+      -- ^ [日本語]: ランダムブロック。 全因子がブロック内で自由 (block は run 割付のみ)。+      --   [English]: Randomized blocks. All factors are free within a+      --   block (the block only assigns runs).+  deriving (Eq, Show)++-- | [日本語]: 'SplitPlot' の smart constructor。 η = 1.0・群列名 = @"wholePlot"@ を既定にする。+--   @splitPlot ["temp"] 4@ = temp を whole-plot 因子、 whole-plot 数 4。+--   [English]: Smart constructor for 'SplitPlot'. Defaults η = 1.0 and+--   the group column name to @"wholePlot"@. @splitPlot ["temp"] 4@ = temp+--   as the whole-plot factor, 4 whole-plots.+splitPlot :: [Text] -> Int -> Structure+splitPlot whole nWhole = SplitPlot whole nWhole 1.0 "wholePlot"++-- | [日本語]: 'StripPlot' の smart constructor。 ηW = ηS = 1.0・群列名 = @"wholePlot"@ / @"strip"@ を既定に。+--   @stripPlot ["A"] 3 ["B"] 4@ = A が whole-plot (3 群) × B が strip (4 群)。+--   [English]: Smart constructor for 'StripPlot'. Defaults ηW = ηS = 1.0+--   and the group column names to @"wholePlot"@ / @"strip"@.+--   @stripPlot ["A"] 3 ["B"] 4@ = A is whole-plot (3 groups) × B is strip+--   (4 groups).+stripPlot :: [Text] -> Int -> [Text] -> Int -> Structure+stripPlot whole nWhole strip nStrip =+  StripPlot whole nWhole 1.0 "wholePlot" strip nStrip 1.0 "strip"++-- | [日本語]: 'Blocked' の smart constructor。 η = 1.0・群列名 = @"block"@ を既定にする。+--   @blocked 3@ = 3 ランダムブロック。+--   [English]: Smart constructor for 'Blocked'. Defaults η = 1.0 and the+--   group column name to @"block"@. @blocked 3@ = 3 randomized blocks.+blocked :: Int -> Structure+blocked nBlocks = Blocked nBlocks 1.0 "block"++-- | [日本語]: __完全カスタムデザインの仕様__。 因子 × 固定効果モデル × run 数 × seed に、+--   最適化基準 ('csCriterion')・制約 ('csConstraints')・階層構造 ('csStructure') を載せた+--   1 本のスペックレコード。 'customSpec' で既定 (DOpt・制約なし・CRD) を作り、 レコード更新で+--   criterion / constraints / structure を足す。 唯一の生成入口 'customDesign' に渡す。+--   [English]: __The spec for a fully custom design__. A single spec+--   record holding factors × fixed-effect model × run count × seed, plus+--   an optimization criterion ('csCriterion'), constraints+--   ('csConstraints'), and a hierarchical structure ('csStructure').+--   'customSpec' builds the default (DOpt, no constraints, CRD); use+--   record update to add criterion / constraints / structure. Passed to+--   the sole generation entry point, 'customDesign'.+data CustomSpec = CustomSpec+  { csFactors     :: ![DesignFactor]+      -- ^ [日本語]: 因子 ('contFactor' / 'catFactor' / 'numFactor')+      --   [English]: Factors ('contFactor' / 'catFactor' / 'numFactor').+  , csFormula     :: !Formula+      -- ^ [日本語]: 固定効果モデル (効果 DSL / 'parseRFormula')+      --   [English]: The fixed-effect model (effect DSL / 'parseRFormula').+  , csNRuns       :: !Int+      -- ^ [日本語]: run 数 n [English]: Run count n.+  , csSeed        :: !Int+      -- ^ [日本語]: seed (決定的 pure) [English]: Seed (deterministic, pure).+  , csCriterion   :: !OptCriterion+      -- ^ [日本語]: 最適化基準 (既定 'DOpt') [English]: The optimization+      --   criterion (default 'DOpt').+  , csConstraints :: ![Constraint]+      -- ^ [日本語]: 低レベル制約 (既定 []・__coded 単位__・エスケープハッチ)+      --   [English]: Low-level constraints (default []; __coded units__;+      --   an escape hatch).+  , csNatConstraints :: ![NatConstraint]+      -- ^ [日本語]: __自然単位の制約__ (既定 []・推奨 API)。 実単位で書き ('natLeq' 等)、+      --   'customDesign' 入口で coded の 'csConstraints' へ正規化・合流する。+      --   [English]: __Natural-unit constraints__ (default []; the+      --   recommended API). Written in real units ('natLeq', etc.);+      --   normalized and merged into the coded 'csConstraints' at the+      --   'customDesign' entry point.+  , csStructure   :: !Structure+      -- ^ [日本語]: 階層構造 (既定 'CRD') [English]: The hierarchical+      --   structure (default 'CRD').+  } deriving (Show)++-- | [日本語]: 'CustomSpec' の smart constructor。 既定 = DOpt・制約なし・CRD。 レコード更新で+--   @{ csCriterion = … }@ / @{ csNatConstraints = … }@ / @{ csStructure = … }@ を足す。+--   @customSpec factors formula nRuns seed@。+--   [English]: Smart constructor for 'CustomSpec'. Default = DOpt, no+--   constraints, CRD. Use record update to add+--   @{ csCriterion = … }@ / @{ csNatConstraints = … }@ / @{ csStructure = … }@.+--   @customSpec factors formula nRuns seed@.+customSpec :: [DesignFactor] -> Formula -> Int -> Int -> CustomSpec+customSpec fs fml n seed = CustomSpec+  { csFactors = fs, csFormula = fml, csNRuns = n, csSeed = seed+  , csCriterion = DOpt, csConstraints = [], csNatConstraints = []+  , csStructure = CRD }++-- ---------------------------------------------------------------------------+-- Phase 82: 自然単位の制約 (公開 API) → coded 内部制約への正規化+-- ---------------------------------------------------------------------------++-- | [日本語]: __自然単位の制約__ (公開 API)。 因子を__実単位__で参照する+--   (@temp <= 160@ 等)。 'customDesign' 入口で因子の coded↔natural 情報を使って+--   内部 'Constraint' (coded) へ正規化される。 これにより ユーザは coded @[-1,1]@ や+--   水準 index を意識せず、 実験の言葉 (実温度・実流量) で制約を書ける。+--+--   - 'natLeq' / 'natGeq' / 'natEq' — 連続因子の線形不等式/等式 (実単位係数)。+--     @Σ aᵢ·x_natᵢ  rel  b@。 __離散数値 ('Num')__ も__単一項__ (@a·temp <= 160@ 等)+--     なら参照可で、 閾値を満たさない水準を除外する糖衣に展開する。+--     カテゴリ ('Cat') は順序を持たないため拒否 ('Left'、 'natForbid' を使う)。+--   - 'natForbid' — 禁止組合せ。 カテゴリは水準名 ('FVText')、 離散数値/連続は+--     実値 ('FVDouble') で指定 (内部で index / coded へ変換)。+--   [English]: __Natural-unit constraints__ (public API). References+--   factors in __real units__ (e.g. @temp <= 160@). Normalized to the+--   internal (coded) 'Constraint' at the 'customDesign' entry point,+--   using the factor's coded↔natural information. This lets the user+--   write constraints in the language of the experiment (actual+--   temperature, actual flow rate) without thinking about coded+--   @[-1,1]@ or level indices.+--+--   - 'natLeq' / 'natGeq' / 'natEq' — Linear inequality/equality on+--     continuous factors (real-unit coefficients).+--     @Σ aᵢ·x_natᵢ  rel  b@. __Discrete numeric ('Num')__ factors may+--     also be referenced, but only as a __single term__ (e.g.+--     @a·temp <= 160@); it's expanded into sugar that excludes levels+--     failing the threshold. Categorical ('Cat') factors are rejected+--     ('Left') since they have no order (use 'natForbid').+--   - 'natForbid' — A forbidden combination. Categories are given by+--     level name ('FVText'); discrete numeric/continuous are given by+--     real value ('FVDouble') (converted internally to index / coded).+data NatConstraint+  = NatLinear ![(Text, Double)] !ConstraintRel !Double+    -- ^ [日本語]: @Σ aᵢ·x_natᵢ \`rel\` rhs@ (連続因子のみ)+    --   [English]: @Σ aᵢ·x_natᵢ \`rel\` rhs@ (continuous factors only).+  | NatForbid ![(Text, FactorValue)]+    -- ^ [日本語]: 全項が一致する row を禁止 (実単位/水準名で指定)+    --   [English]: Forbids a row where every term matches (given in real+    --   units / level names).+  deriving (Eq, Show)++-- | [日本語]: @Σ aᵢ·x_natᵢ ≤ b@ (連続因子・実単位)。+--   [English]: @Σ aᵢ·x_natᵢ ≤ b@ (continuous factors, real units).+natLeq :: [(Text, Double)] -> Double -> NatConstraint+natLeq coefs b = NatLinear coefs CLeq b++-- | [日本語]: @Σ aᵢ·x_natᵢ ≥ b@ (連続因子・実単位)。+--   [English]: @Σ aᵢ·x_natᵢ ≥ b@ (continuous factors, real units).+natGeq :: [(Text, Double)] -> Double -> NatConstraint+natGeq coefs b = NatLinear coefs CGeq b++-- | [日本語]: @Σ aᵢ·x_natᵢ = b@ (連続因子・実単位)。 grid 解像度に注意。+--   [English]: @Σ aᵢ·x_natᵢ = b@ (continuous factors, real units). Beware+--   of grid resolution.+natEq :: [(Text, Double)] -> Double -> NatConstraint+natEq coefs b = NatLinear coefs CEq b++-- | [日本語]: 禁止組合せ (実単位/水準名)。 @natForbid [("catalyst", FVText \"A\"), ("temp", FVDouble 180)]@。+--   [English]: A forbidden combination (real units / level names).+--   @natForbid [("catalyst", FVText \"A\"), ("temp", FVDouble 180)]@.+natForbid :: [(Text, FactorValue)] -> NatConstraint+natForbid = NatForbid++-- | [日本語]: 因子名で 'DesignFactor' を引く (制約正規化用)。+--   [English]: Looks up a 'DesignFactor' by name (used for constraint+--   normalization).+lookupDF :: [DesignFactor] -> Text -> Either Text DesignFactor+lookupDF fs nm =+  maybe (Left ("未知の因子 '" <> nm <> "' が制約に現れました")) Right+        (find ((== nm) . dfName) fs)++-- | [日本語]: 自然単位の 'NatConstraint' を因子情報を使って coded 内部 'Constraint' へ正規化。+--+--   - 線形スケール連続因子 (coded −1=lo/+1=hi/中心=平均、 @nat = center + coded·half@):+--     @Σ aᵢ·natᵢ ≤ b ⟺ Σ (aᵢ·halfᵢ)·codedᵢ ≤ b − Σ aᵢ·centerᵢ@。 half>0 ゆえ関係子不変。+--   - __対数スケール__連続因子: @a·nat = a·10^(…)@ は coded について非線形なので、 線形結合に+--     混ぜられない。 __単一因子の境界__ (@temp <= X@ 等) のみ許可し、 閾値を @codeCont@ で+--     coded 境界へ写す (係数が負なら関係子を反転)。 混在は 'Left'。+--   - 禁止組合せ: カテゴリは水準名そのまま (buildRowFV が index→名前に戻すため)、+--     離散数値は実値→水準 index、 連続は実値→coded ('codeCont'・線形/対数を分岐)。+--   [English]: Normalizes a natural-unit 'NatConstraint' into the internal+--   coded 'Constraint', using factor information.+--+--   - Linear-scale continuous factors (coded −1=lo/+1=hi/center=mean,+--     @nat = center + coded·half@): @Σ aᵢ·natᵢ ≤ b ⟺+--     Σ (aᵢ·halfᵢ)·codedᵢ ≤ b − Σ aᵢ·centerᵢ@. The relation is unchanged+--     since half>0.+--   - __Log-scale__ continuous factors: @a·nat = a·10^(…)@ is nonlinear+--     in coded, so it can't be mixed into a linear combination. Only+--     __single-factor bounds__ (e.g. @temp <= X@) are allowed; the+--     threshold is mapped to a coded bound via @codeCont@ (the relation+--     is flipped if the coefficient is negative). Mixing is 'Left'.+--   - Forbidden combinations: categories keep their level name as-is+--     (buildRowFV converts index→name back), discrete numeric goes real+--     value→level index, continuous goes real value→coded ('codeCont';+--     branches on linear/log).+normalizeNat :: [DesignFactor] -> NatConstraint -> Either Text [Constraint]+normalizeNat fs (NatLinear coefs rel rhs) = do+    terms <- traverse resolve coefs                 -- (name, coef, factor)+    let numTerms = [ (nm, a, lvs) | (nm, a, f) <- terms, Num lvs <- [dfKind f] ]+        catNames = [ nm | (nm, _, f) <- terms, Cat _ <- [dfKind f] ]+    case (catNames, numTerms) of+      (nm : _, _) ->+        Left ("自然単位の線形制約はカテゴリ因子 '" <> nm+              <> "' を参照できません (順序を持たないため)。 natForbid を使ってください")+      (_, (nm, a, lvs) : rest)+        | not (null rest) || length terms /= 1 ->+            Left ("離散数値因子 '" <> nm <> "' を含む自然単位制約は単一項 (a·" <> nm+                  <> " rel b) でのみ書けます (許容水準の除外へ展開するため)。"+                  <> " 他因子との線形結合は不可")+        | otherwise -> numFilter nm a lvs+      (_, []) ->                                    -- 全項が連続 (線形/対数)+        let logTerms = filter (\(_, _, f) -> isLog f) terms+        in case logTerms of+             []                               -> Right [linearCombo terms]+             [(nm, a, f)] | length terms == 1 -> (: []) <$> singleLogBound nm a f+             _ -> Left ("自然単位の線形結合に対数スケール因子は混ぜられません (非線形)。"+                        <> " 対数因子は単一因子の境界 (temp<=X 等) でのみ書けます")+  where+    resolve (nm, a) = (\f -> (nm, a, f)) <$> lookupDF fs nm+    isLog f = case dfKind f of Cont _ _ SLog -> True; _ -> False+    -- 単一 Num 因子の実値閾値 → 満たさない水準を Forbidden で除外 (Phase 82.2)。+    --   @a·level rel rhs@ を各水準で判定し、 満たさない水準の index を禁止する。+    --   半空間ではなく水準除外になる (順序 Num は index 尺度・doc 明記)。+    numFilter nm a lvs =+      let bad = [ i | (i, lv) <- zip [0 :: Int ..] lvs, not (relHolds rel (a * lv) rhs) ]+      in if length bad == length lvs+           then Left ("離散数値因子 '" <> nm <> "' の制約 " <> tshowD a <> "·" <> nm+                      <> " " <> relSym rel <> " " <> tshowD rhs+                      <> " を満たす水準がありません (水準 " <> T.pack (show lvs) <> ")")+           else Right [ Forbidden [(nm, FVDouble (fromIntegral i))] | i <- bad ]+    relHolds CLeq x r = x <= r + 1e-9+    relHolds CEq  x r = abs (x - r) <= 1e-9+    relHolds CGeq x r = x >= r - 1e-9+    -- 全項が線形スケール連続: Σaᵢ·natᵢ rel rhs → coded の LinearIneq へ+    linearCombo terms' =+      let part (nm, a, f) = case dfKind f of+            Cont lo hi _ -> let half = (hi - lo) / 2; center = (lo + hi) / 2+                            in ((nm, a * half), a * center)+            _            -> ((nm, 0), 0)      -- 連続のみ到達+          ps    = map part terms'+          shift = sum (map snd ps)+      in LinearIneq (map fst ps) rel (rhs - shift)+    -- 単一対数因子の境界: a·nat rel rhs → nat rel' (rhs/a) → codeCont で coded 境界+    singleLogBound nm a f+      | a == 0    = Left ("対数因子 '" <> nm <> "' の係数が 0 です")+      | thr <= 0  = Left ("対数因子 '" <> nm <> "' の自然単位境界 " <> T.pack (show thr)+                          <> " が非正です (log 不能)。 正の閾値で指定してください")+      | otherwise = Right (LinearIneq [(nm, 1)] rel' (codeCont f thr))+      where+        thr  = rhs / a+        rel' = if a > 0 then rel else flipRel rel+    flipRel CLeq = CGeq+    flipRel CGeq = CLeq+    flipRel CEq  = CEq+normalizeNat fs (NatForbid vs) = (\c -> [Forbidden c]) <$> traverse conv vs+  where+    conv (nm, v) = do+      f <- lookupDF fs nm+      case (dfKind f, v) of+        (Cat _, FVText _)   -> Right (nm, v)   -- 水準名はそのまま+        (Cat _, FVDouble _) ->+          Left ("カテゴリ因子 '" <> nm <> "' の禁止値は水準名 (FVText) で指定してください")+        (Num levels, FVDouble x) ->+          case elemIndex x levels of+            Just i  -> Right (nm, FVDouble (fromIntegral i))+            Nothing -> Left ("離散数値因子 '" <> nm <> "' に水準 "+                             <> T.pack (show x) <> " はありません")+        (Cont _ _ _, FVDouble x) -> Right (nm, FVDouble (codeCont f x))+        _ -> Left ("因子 '" <> nm <> "' の禁止値の型が不正です")++-- | [日本語]: 'CustomSpec' の有効な coded 制約 = 低レベル 'csConstraints' + 正規化した+--   'csNatConstraints'。 正規化失敗は 'error' (customDesign の既存パターンに合わせる)。+--   [English]: The effective coded constraints of a 'CustomSpec' =+--   low-level 'csConstraints' + normalized 'csNatConstraints'. A+--   normalization failure is an 'error' (matching customDesign's existing+--   pattern).+effectiveConstraints :: CustomSpec -> [Constraint]+effectiveConstraints cs =+  case traverse (normalizeNat (csFactors cs)) (csNatConstraints cs) of+    Left e   -> error ("customDesign: " <> T.unpack e)+    Right ns -> csConstraints cs ++ concat ns++-- | [日本語]: 座標交換が __実行不能__ (feasible な初期解が得られない等) で 'Left' を返したとき、+--   エラーに「有効な制約 (実単位)」と「因子の範囲」を添えて原因追跡を助ける。+--   実行不能系でないメッセージ (引数不正等) はそのまま。 制約が空なら添えない。+--   [English]: When coordinate exchange returns 'Left' because it's+--   __infeasible__ (e.g. no feasible initial solution can be found),+--   this appends the "effective constraints (real units)" and "factor+--   ranges" to the error to help trace the cause. A non-infeasibility+--   message (bad arguments, etc.) is left as-is. Nothing is appended if+--   there are no constraints.+enrichInfeasError :: CustomSpec -> Text -> Text+enrichInfeasError cs e+  | isFeasErr && hasCons =+      base <> "\n  有効な制約 (実単位):" <> T.concat (map ("\n    - " <>) items)+           <> "\n  因子の範囲:" <> T.concat (map ("\n    - " <>) ranges)+  | otherwise = base+  where+    base      = "customDesign: " <> e+    isFeasErr = any (`T.isInfixOf` e) ["feasible", "infeasible", "too tight", "初期解"]+    natC      = csNatConstraints cs+    lowC      = csConstraints cs+    hasCons   = not (null natC) || not (null lowC)+    items     = map renderNatC natC ++ map ((<> "  (coded 単位)") . renderLowC) lowC+    ranges    = [ dfName f <> " ∈ " <> renderRange f | f <- csFactors cs ]++-- | [日本語]: 自然単位 'NatConstraint' を人間可読な文字列に (エラー添付用)。+--   [English]: Renders a natural-unit 'NatConstraint' as a human-readable+--   string (for attaching to errors).+renderNatC :: NatConstraint -> Text+renderNatC (NatLinear coefs rel rhs) =+  T.intercalate " + " (map (\(nm, a) -> tshowD a <> "·" <> nm) coefs)+    <> " " <> relSym rel <> " " <> tshowD rhs+renderNatC (NatForbid vs) =+  "禁止: " <> T.intercalate ", " (map (\(nm, v) -> nm <> "=" <> renderFV v) vs)++-- | [日本語]: 低レベル coded 'Constraint' の要約 (エラー添付用・完全網羅でなく主要 2 種)。+--   [English]: A summary of a low-level coded 'Constraint' (for attaching+--   to errors; covers the main 2 kinds, not exhaustive).+renderLowC :: Constraint -> Text+renderLowC (LinearIneq coefs rel rhs) =+  T.intercalate " + " (map (\(nm, a) -> tshowD a <> "·" <> nm) coefs)+    <> " " <> relSym rel <> " " <> tshowD rhs+renderLowC (RangeBound nm lo hi) = nm <> " ∈ [" <> tshowD lo <> ", " <> tshowD hi <> "]"+renderLowC (Forbidden vs) =+  "禁止: " <> T.intercalate ", " (map (\(nm, v) -> nm <> "=" <> renderFV v) vs)+renderLowC (Conditional _ _) = "条件付制約"++renderFV :: FactorValue -> Text+renderFV (FVDouble x) = tshowD x+renderFV (FVText t)   = t++relSym :: ConstraintRel -> Text+relSym CLeq = "≤"+relSym CGeq = "≥"+relSym CEq  = "="++-- | [日本語]: 因子の値域を実単位で (連続 = 範囲・対数注記、 数値順序 = 水準列、 カテゴリ = 水準名)。+--   [English]: A factor's value range in real units (continuous = range ++--   a log note, numeric-ordered = the level list, categorical = level+--   names).+renderRange :: DesignFactor -> Text+renderRange f = case dfKind f of+  Cont lo hi sc -> "[" <> tshowD lo <> ", " <> tshowD hi <> "]"+                     <> (case sc of SLog -> " (log)"; SLinear -> "")+  Num levels    -> T.pack (show levels)+  Cat levels    -> "{" <> T.intercalate ", " levels <> "}"++tshowD :: Double -> Text+tshowD = T.pack . show++-- ---------------------------------------------------------------------------+-- コンストラクタ+-- ---------------------------------------------------------------------------++-- | [日本語]: 因子の coded 水準集合。 連続 = @{-1,+1}@ (2 水準)、 カテゴリ = 水準 index @{0,1,…,m-1}@。+--   完全要因の列挙 ('fullFactorial') と 最適計画の候補格子に使う。+--   [English]: A factor's coded level set. Continuous = @{-1,+1}@ (2+--   levels); categorical = level index @{0,1,…,m-1}@. Used for full+--   factorial enumeration ('fullFactorial') and the optimal-design+--   candidate grid.+factorLevelsCoded :: DesignFactor -> [Double]+factorLevelsCoded f = case dfKind f of+  Cont _ _ _ -> [-1, 1]+  Num levels -> map fromIntegral [0 .. length levels - 1]+  Cat levels -> map fromIntegral [0 .. length levels - 1]++-- | [日本語]: 全因子が連続であることを要求する (rsm/boxBehnken/taguchi 等・連続専用設計)。+--   カテゴリが混じれば呼び名付きで error。+--   [English]: Requires that all factors be continuous (continuous-only+--   designs like rsm/boxBehnken/taguchi). Errors, with the caller's name,+--   if a categorical factor is mixed in.+requireContinuous :: String -> [DesignFactor] -> [DesignFactor]+requireContinuous who fs =+  case [ dfName f | f <- fs, isCat (dfKind f) ] of+    []   -> fs+    cats -> error+      (who ++ ": カテゴリ因子 " ++ show (map T.unpack cats)+        ++ " は扱えません (この設計は連続因子のみ・カテゴリは factorialDesign/optimalDesign へ)")+  where isCat (Cat _) = True+        isCat _       = False++-- | [日本語]: 全カテゴリ因子が 2 水準 (binary) であることを要求する (fractional・v1 は binary のみ)。+--   3 水準以上の 'Cat' は呼び名付きで error。 連続因子は素通り。+--   [English]: Requires that all categorical factors be 2-level (binary)+--   (fractional; v1 supports binary only). Errors, with the caller's+--   name, for a 'Cat' with 3+ levels. Continuous factors pass through.+requireBinaryCats :: String -> [DesignFactor] -> [DesignFactor]+requireBinaryCats who fs =+  case [ dfName f | f <- fs, overTwo (dfKind f) ] of+    []  -> fs+    bad -> error+      (who ++ ": カテゴリ因子 " ++ show (map T.unpack bad)+        ++ " は 2 水準 (binary) のみ対応です (3 水準以上は factorialDesign/optimalDesign か G-a2 の L9/L18 へ)")+  where overTwo (Cat ls) = length ls /= 2+        overTwo _         = False++-- | [日本語]: ±1 coded 設計 (fractional/taguchi) のカテゴリ列を水準 index に写す。 binary 前提+--   (@-1@ → 水準0、 @+1@ → 水準1)。 連続列は ±1 のまま (直交/平衡構造を保つ)。+--   [English]: Maps the categorical columns of a ±1 coded design+--   (fractional/taguchi) to level indices. Assumes binary (@-1@ → level+--   0, @+1@ → level 1). Continuous columns stay ±1 (preserving the+--   orthogonal/balanced structure).+codeCatColumns :: [DesignFactor] -> [[Double]] -> [[Double]]+codeCatColumns fs = map (zipWith recode fs)+  where recode f v = case dfKind f of+          Cat _ -> if v < 0 then 0 else 1+          _     -> v++-- | [日本語]: 2 水準 完全要因計画。 @factorialDesign [contFactor "temp" (150,180), contFactor "time" (10,20)]@+--   → 2^k run (全交互作用モデル)。 カテゴリ因子を混ぜると各因子の水準を総当り+--   (連続=2 水準・カテゴリ=m 水準) した完全要因になる (例: 連続1×カテゴリ3水準 = 2×3=6 run)。+--   [English]: A 2-level full factorial design.+--   @factorialDesign [contFactor "temp" (150,180), contFactor "time" (10,20)]@+--   → 2^k runs (full-interaction model). Mixing in categorical factors+--   yields a full factorial over all levels of each factor (continuous=2+--   levels, categorical=m levels; e.g. 1 continuous × 1 categorical with+--   3 levels = 2×3=6 runs).+factorialDesign :: [DesignFactor] -> Design+factorialDesign fs =+  Design fs (fullFactorial (map factorLevelsCoded fs)) KFactorial++-- | [日本語]: 応答曲面計画 (回転可能 中心複合計画 CCD)。+--   @centralCompositeDesign [contFactor "temp" (150,180), contFactor "time" (10,20)]@ → 2^k factorial + 2k 軸点+--   + 中心点 (2 次モデル)。 中心点数は k (最低 1)。 ★連続因子のみ (±α 軸点ゆえカテゴリ不可)。+--   [English]: A response-surface design (rotatable central composite+--   design, CCD).+--   @centralCompositeDesign [contFactor "temp" (150,180), contFactor "time" (10,20)]@+--   → 2^k factorial + 2k axial points + center point (quadratic model).+--   The number of center points is k (minimum 1). ★Continuous factors+--   only (categorical is impossible since axial points are ±α).+centralCompositeDesign :: [DesignFactor] -> Design+centralCompositeDesign fs0 =+  let fs = requireContinuous "centralCompositeDesign" fs0+      k  = length fs+  in Design fs (centralCompositeRotatable k (max 1 k)) KRSM++-- | [日本語]: Box-Behnken 応答曲面計画 (__k = 3, 4, 5 のみ__)。 CCD より run が少なく、+--   __極端な軸点 (±α) を持たない__ (各点は立方体の辺の中点・因子は @-1,0,+1@ の 3 水準に収まる) 3 水準 RSM。+--   2 次モデル ('KRSM') を含意。 因子数が 3〜5 でないと下層が error (数学的制約)。 ★連続因子のみ。+--   @boxBehnkenDesign [contFactor "t" (150,180), contFactor "p" (1,3), contFactor "c" (5,15)]@。+--   [English]: A Box-Behnken response-surface design+--   (__k = 3, 4, 5 only__). Fewer runs than CCD, and+--   __has no extreme axial points (±α)__ (each point is the midpoint of a cube edge; factors stay+--   within the 3 levels @-1,0,+1@) — a 3-level RSM. Implies a quadratic+--   model ('KRSM'). Errors in the lower layer if the factor count isn't+--   3〜5 (a mathematical constraint). ★Continuous factors only.+--   @boxBehnkenDesign [contFactor "t" (150,180), contFactor "p" (1,3), contFactor "c" (5,15)]@.+boxBehnkenDesign :: [DesignFactor] -> Design+boxBehnkenDesign fs0 =+  let fs = requireContinuous "boxBehnkenDesign" fs0+      k  = length fs+  in Design fs (boxBehnken k (max 1 k)) KRSM++-- ---------------------------------------------------------------------------+-- 一部実施要因 (fractional factorial) — Phase 78.G+--+-- 完全要因 2^k は run 数が指数増するので、 交互作用の一部を主効果と交絡させて+-- **2^(k-p) に減らす** (直交表と等価)。 交絡の重さは **解像度 (resolution)** で測る:+--   * Res III … 主効果と 2 因子交互作用が交絡 (最も攻めた削減)。+--   * Res IV  … 主効果は 2 因子交互作用と交絡しないが、 2 因子交互作用同士が交絡。+--   * Res V+  … 主効果・2 因子交互作用が (ほぼ) 独立。+-- generator (追加因子の定義関係) は **最小交絡 (minimum aberration)** の標準表+-- (Montgomery Table 8-14 / NIST) を 'fractionalCatalog' に持つ。 k = 3〜11, 15 (16/32-run)。+-- ---------------------------------------------------------------------------++-- | [日本語]: 設計の解像度 (defining word の最短長)。 数字は @'resNum'@。+--   [English]: The design's resolution (the shortest defining-word+--   length). The number is @'resNum'@.+data Resolution = ResIII | ResIV | ResV | ResVI | ResVII+  deriving (Show, Eq, Ord, Enum, Bounded)++resNum :: Resolution -> Int+resNum r = fromEnum r + 3++-- | [日本語]: 最小交絡 2 水準一部実施の標準カタログ (k → @[(runs, resolution, generators)]@)。+--   generator は追加因子を基底因子の__積__で定義する 1-based index リスト+--   (例: @[[1,2]]@ = 「追加因子 = 基底1×基底2」 = C=AB)。 出典 = Montgomery Table 8-14 /+--   NIST e-Handbook (§5.3.3.4.7)。 各行の resolution は 'fracResolution' で test 検証済 (誤り混入ガード)。+--   k=8〜15 は NIST 収録の 16/32-run 設計 (拡張分)。 NIST が非収録の帯 (16-run k=12〜14・+--   32-run k=12〜16) は本カタログも持たない (該当 k はより多 run の設計 or k=15/31 飽和を使う)。+--   [English]: The standard catalog of minimum-aberration 2-level+--   fractional designs (k → @[(runs, resolution, generators)]@). A+--   generator is a 1-based index list defining an added factor as the+--   __product__ of base factors (e.g. @[[1,2]]@ = "added factor = base1 ×+--   base2" = C=AB). Source = Montgomery Table 8-14 / the NIST e-Handbook+--   (§5.3.3.4.7). Each row's resolution is test-verified against+--   'fracResolution' (a guard against transcription errors). k=8〜15 are+--   the 16/32-run designs from NIST (an extension). Bands NIST doesn't+--   cover (16-run k=12〜14, 32-run k=12〜16) aren't in this catalog either+--   (use a design with more runs, or the k=15/31 saturated design, for+--   those k).+fractionalCatalog :: Int -> [(Int, Resolution, [[Int]])]+fractionalCatalog k = case k of+  3  -> [ (4,  ResIII, [[1,2]]) ]                                   -- C=AB+  4  -> [ (8,  ResIV,  [[1,2,3]]) ]                                 -- D=ABC+  5  -> [ (16, ResV,   [[1,2,3,4]])                                 -- E=ABCD+        , (8,  ResIII, [[1,2],[1,3]]) ]                             -- D=AB, E=AC+  6  -> [ (32, ResVI,  [[1,2,3,4,5]])                               -- F=ABCDE+        , (16, ResIV,  [[1,2,3],[2,3,4]])                           -- E=ABC, F=BCD+        , (8,  ResIII, [[1,2],[1,3],[2,3]]) ]                       -- D=AB, E=AC, F=BC+  7  -> [ (64, ResVII, [[1,2,3,4,5,6]])                             -- G=ABCDEF+        , (16, ResIV,  [[1,2,3],[2,3,4],[1,3,4]])                   -- E=ABC, F=BCD, G=ACD+        , (8,  ResIII, [[1,2],[1,3],[2,3],[1,2,3]]) ]               -- D=AB, E=AC, F=BC, G=ABC+  -- ↓ NIST 標準表 (16/32-run)。 基底は 16-run=ABCD(4)・32-run=ABCDE(5)。+  8  -> [ (16, ResIV,  [[2,3,4],[1,3,4],[1,2,3],[1,2,4]]) ]         -- 2^(8-4): E=BCD,F=ACD,G=ABC,H=ABD+  9  -> [ (32, ResIV,  [[2,3,4,5],[1,3,4,5],[1,2,4,5],[1,2,3,5]])   -- 2^(9-4): F=BCDE,G=ACDE,H=ABDE,J=ABCE+        , (16, ResIII, [[1,2,3],[2,3,4],[1,3,4],[1,2,4],[1,2,3,4]]) ]  -- 2^(9-5): E=ABC,F=BCD,G=ACD,H=ABD,J=ABCD+  10 -> [ (32, ResIV,  [[1,2,3,4],[1,2,3,5],[1,2,4,5],[1,3,4,5],[2,3,4,5]])  -- 2^(10-5)+        , (16, ResIII, [[1,2,3],[2,3,4],[1,3,4],[1,2,4],[1,2,3,4],[1,2]]) ]  -- 2^(10-6): …,J=ABCD,K=AB+  11 -> [ (32, ResIV,  [[1,2,3],[2,3,4],[3,4,5],[1,3,4],[1,4,5],[2,4,5]])    -- 2^(11-6)+        , (16, ResIII, [[1,2,3],[2,3,4],[1,3,4],[1,2,4],[1,2,3,4],[1,2],[1,3]]) ]  -- 2^(11-7)+  15 -> [ (16, ResIII, [[1,2],[1,3],[1,4],[2,3],[2,4],[3,4]         -- 2^(15-11) 飽和: 全 15 列+                       ,[1,2,3],[1,2,4],[1,3,4],[2,3,4],[1,2,3,4]]) ]+  _  -> []++-- | [日本語]: generator 集合から__解像度__ (数字) を計算する。 各 generator が定める defining word+--   (追加因子 ∪ 基底集合) の生成する部分群 (全 XOR 組合せ) の__最短語長__。 = 設計の resolution。+--   'fractionalCatalog' の resolution ラベルを test で照合するのに使う (= 表の自己検証)。+--   [English]: Computes the __resolution__ (a number) from a set of+--   generators. The __shortest word length__ in the subgroup generated+--   (all XOR combinations) by the defining words each generator defines+--   (added factor ∪ base set). = the design's resolution. Used to+--   cross-check 'fractionalCatalog''s resolution labels in tests (=+--   self-verification of the table).+fracResolution :: Int -> [[Int]] -> Int+fracResolution k gens =+  case definingSubgroup k gens of+    []     -> k+    combos -> minimum (map length combos)++-- | [日本語]: defining word の対称差 (mod-2 積 = 語の XOR)。+--   [English]: The symmetric difference of defining words (mod-2 product+--   = XOR of the words).+symDiffW :: [Int] -> [Int] -> [Int]+symDiffW a b = sort ((a \\ b) ++ (b \\ a))++-- | [日本語]: 各 generator が定める defining word (追加因子 ∪ 基底集合)。 generator i (1-based) は+--   因子 (kBase+i) を追加する (kBase = k − generator 数)。 defining word = 基底集合 ∪ {kBase+i}。+--   [English]: The defining word each generator defines (added factor ∪+--   base set). Generator i (1-based) adds factor (kBase+i) (kBase = k −+--   number of generators). defining word = base set ∪ {kBase+i}.+definingWords :: Int -> [[Int]] -> [[Int]]+definingWords k gens =+  let kBase = k - length gens+  in [ sort (gen ++ [kBase + i]) | (i, gen) <- zip [1 ..] gens ]++-- | [日本語]: defining 部分群の__非恒等元__ (全 defining word の非空部分集合の XOR)。 defining relation+--   @I = …@ の右辺集合。 交絡 (alias) と解像度 ('fracResolution') はこの群で決まる。+--   [English]: The __non-identity elements__ of the defining subgroup+--   (the XOR of every non-empty subset of the defining words). The+--   right-hand set of the defining relation @I = …@. Confounding (alias)+--   and resolution ('fracResolution') are both determined by this group.+definingSubgroup :: Int -> [[Int]] -> [[Int]]+definingSubgroup k gens =+  [ foldl1' symDiffW ws | ws <- tail (subsequences (definingWords k gens)) ]++-- | [日本語]: 効果 (因子 index 集合) の __alias 剰余類__ = @{ effect XOR w | w ∈ 部分群 ∪ {恒等} }@。+--   効果自身を含む。 同じ剰余類に入る効果同士は設計上区別できない (交絡)。+--   [English]: The __alias coset__ of an effect (a set of factor indices)+--   = @{ effect XOR w | w ∈ subgroup ∪ {identity} }@. Includes the effect+--   itself. Effects in the same coset are indistinguishable by the+--   design (confounded).+aliasCoset :: Int -> [[Int]] -> [Int] -> [[Int]]+aliasCoset k gens effect =+  nub (sort [ symDiffW effect w | w <- [] : definingSubgroup k gens ])++-- | [日本語]: 主効果と交絡しない 2 因子交互作用の__代表__ (交絡群ごと 1 個)。 各 2FI の alias 剰余類が+--   主効果語 (長さ1) を含めば群ごと除外、 含まなければ未代表の群から 1 個を採る。 結果は満ランクで+--   主効果を不バイアスに保つ (Res V=全 2FI・Res IV=群ごと 1 個・Res III=主効果非交絡の 2FI のみ)。+--   [English]: The __representatives__ of 2-factor interactions not+--   confounded with a main effect (one per confounding group). If a+--   2FI's alias coset contains a main-effect word (length 1), the whole+--   group is excluded; otherwise one is taken from each not-yet-+--   represented group. The result keeps the main effects unbiased at+--   full rank (Res V = all 2FIs; Res IV = one per group; Res III = only+--   the 2FIs not confounded with main effects).+clearTwoFactorInteractions :: Int -> [[Int]] -> [[Int]]+clearTwoFactorInteractions k gens = go [] twoFIs+  where+    twoFIs = [ [i, j] | i <- [1 .. k], j <- [i + 1 .. k] ]+    go _    []       = []+    go seen (t : ts)+      | any (`elem` seen) coset     = go seen ts               -- 代表済みの交絡群+      | any ((== 1) . length) coset = go (coset ++ seen) ts     -- 主効果と交絡 → 群ごと除外+      | otherwise                   = t : go (coset ++ seen) ts+      where coset = aliasCoset k gens t++-- | [日本語]: 効果 (因子 index 集合) を @":"@ 連結ラベル (@"a"@ / @"a:b"@) に。 因子名は 'dsFactors' 順。+--   [English]: Renders an effect (a set of factor indices) as a+--   @":"@-joined label (@"a"@ / @"a:b"@). Factor names follow 'dsFactors'+--   order.+effectLabel :: [Text] -> [Int] -> Text+effectLabel names is = T.intercalate ":" [ names !! (i - 1) | i <- is ]++-- | [日本語]: 一部実施 (交互作用版・'KFracInter') の __alias 構造__。 主効果と 2 因子交互作用について、+--   各効果と交絡する他効果 (同じ剰余類の残り) をラベルで返す。 他の設計種別では空。+--   @lookup "a:b" (aliasStructure plan)@ で「@a:b@ は何と交絡するか」を引ける。+--   [English]: The __alias structure__ of a fractional design with+--   interactions ('KFracInter'). For main effects and 2-factor+--   interactions, returns the other effects confounded with each effect+--   (the rest of the same coset), by label. Empty for other design+--   kinds. @lookup "a:b" (aliasStructure plan)@ looks up "what is @a:b@+--   confounded with?".+aliasStructure :: Design -> [(Text, [Text])]+aliasStructure (Design fs _ kind) = case kind of+  KFracInter gens ->+    let k     = length fs+        names = map dfName fs+        effs  = [ [i] | i <- [1 .. k] ]+                ++ [ [i, j] | i <- [1 .. k], j <- [i + 1 .. k] ]+    in [ ( effectLabel names e+         , [ effectLabel names a+           | a <- aliasCoset k gens e, a /= e, not (null a) ] )+       | e <- effs ]+  _ -> []++-- | [日本語]: 一部実施要因計画 (__解像度で自動選択__・k = 3〜7)。 指定解像度__以上__を満たす中で+--   __最小 run 数__の最小交絡設計を選ぶ (削減を最大化しつつ要求解像度を確保)。 該当なしは error。+--   @fractionalDesign [("a",(0,1)),…,("g",(0,1))] ResIII@。 formula は__主効果のみ__ (交互作用は交絡)。+--   [English]: A fractional factorial design (+--   __auto-selected by resolution__; k = 3〜7). Among designs meeting __at least__ the+--   specified resolution, picks the minimum-aberration design with the+--   __fewest runs__ (maximizing the reduction while ensuring the+--   required resolution). Errors if none match.+--   @fractionalDesign [("a",(0,1)),…,("g",(0,1))] ResIII@. The formula+--   has __main effects only__ (interactions are confounded).+fractionalDesign :: [DesignFactor] -> Resolution -> Design+fractionalDesign specs res =+  let fs   = requireBinaryCats "fractionalDesign" specs+      k    = length fs+      cands = [ e | e@(_, r, _) <- fractionalCatalog k, r >= res ]+  in case cands of+       [] -> error+         ("fractionalDesign: k=" ++ show k ++ " で resolution >= " ++ show res+           ++ " の標準設計がありません (k=3〜11,15・利用可能: "+           ++ show [ (n, r) | (n, r, _) <- fractionalCatalog k ] ++ ")")+       _  -> let (_, _, gens) = minimumBy' (\(n1,_,_) (n2,_,_) -> compare n1 n2) cands+             in Design fs (codeCatColumns fs (fractionalFactorial k gens)) KFractional++-- | [日本語]: 一部実施要因計画 (__generator 明示__・玄人向け escape hatch)。 generator は追加因子を+--   基底因子の積で定義する 1-based index リスト (例: @[[1,2,3]]@ = D=ABC)。 追加因子数 = @length gens@、+--   run 数 = @2^(k - length gens)@。 formula は__主効果のみ__。+--   [English]: A fractional factorial design (__explicit generator__; an+--   expert-level escape hatch). A generator is a 1-based index list+--   defining an added factor as the product of base factors (e.g.+--   @[[1,2,3]]@ = D=ABC). Number of added factors = @length gens@; run+--   count = @2^(k - length gens)@. The formula has __main effects only__.+fractionalDesignGen :: [DesignFactor] -> [[Int]] -> Design+fractionalDesignGen specs gens =+  let fs = requireBinaryCats "fractionalDesignGen" specs+      k  = length fs+  in Design fs (codeCatColumns fs (fractionalFactorial k gens)) KFractional++-- | [日本語]: 一部実施要因計画 (__交互作用込み__・解像度自動)。 設計点は 'fractionalDesign' と同一だが、+--   'designFormula' が主効果に加え__主効果と交絡しない 2 因子交互作用の代表__ (交絡群ごと 1 個) を+--   含める ('KFracInter')。 交絡構造は 'aliasStructure' で確認できる。 該当解像度なしは error。+--   @fractionalDesignInter [contFactor "a" (0,1), …] ResV@ (Res V なら全 2FI が独立に載る)。+--   [English]: A fractional factorial design (__with interactions__;+--   auto resolution). The design points are the same as+--   'fractionalDesign', but 'designFormula' adds, alongside the main+--   effects, __one representative per confounding group__ of 2-factor+--   interactions not confounded with a main effect ('KFracInter'). The+--   confounding structure can be checked with 'aliasStructure'. Errors if+--   no matching resolution exists.+--   @fractionalDesignInter [contFactor "a" (0,1), …] ResV@ (with Res V,+--   all 2FIs load independently).+fractionalDesignInter :: [DesignFactor] -> Resolution -> Design+fractionalDesignInter specs res =+  let fs    = requireBinaryCats "fractionalDesignInter" specs+      k     = length fs+      cands = [ e | e@(_, r, _) <- fractionalCatalog k, r >= res ]+  in case cands of+       [] -> error+         ("fractionalDesignInter: k=" ++ show k ++ " で resolution >= " ++ show res+           ++ " の標準設計がありません (k=3〜11,15・利用可能: "+           ++ show [ (n, r) | (n, r, _) <- fractionalCatalog k ] ++ ")")+       _  -> let (_, _, gens) = minimumBy' (\(n1,_,_) (n2,_,_) -> compare n1 n2) cands+             in Design fs (codeCatColumns fs (fractionalFactorial k gens)) (KFracInter gens)++-- | [日本語]: 一部実施要因計画 (__交互作用込み__・generator 明示)。 'fractionalDesignGen' の交互作用版。+--   @fractionalDesignGenInter [contFactor "a" (0,1), …] [[1,2,3]]@ (D=ABC の Res IV)。+--   [English]: A fractional factorial design (__with interactions__;+--   explicit generator). The interactions variant of 'fractionalDesignGen'.+--   @fractionalDesignGenInter [contFactor "a" (0,1), …] [[1,2,3]]@ (Res IV+--   with D=ABC).+fractionalDesignGenInter :: [DesignFactor] -> [[Int]] -> Design+fractionalDesignGenInter specs gens =+  let fs = requireBinaryCats "fractionalDesignGenInter" specs+      k  = length fs+  in Design fs (codeCatColumns fs (fractionalFactorial k gens)) (KFracInter gens)++-- | [日本語]: 小さな minimumBy (Data.List.minimumBy 相当・依存を増やさない)。+--   [English]: A small minimumBy (equivalent to Data.List.minimumBy;+--   avoids adding a dependency).+minimumBy' :: (a -> a -> Ordering) -> [a] -> a+minimumBy' cmp = foldl1' (\x y -> if cmp x y == GT then y else x)++-- ---------------------------------------------------------------------------+-- Taguchi 直交表 (orthogonal array) — Phase 78.G-a+--+-- 一部実施要因 ('fractionalDesign') と同じ「run を減らして主効果を推定する」目的だが、+-- **Taguchi の Lₙ 直交表**を土台にする枠組み。 v1 は **2 水準表のみ** (L4/L8/L12/L16)。+--   * L4(2³) 4 run … 〜3 因子   * L8(2⁷) 8 run … 〜7 因子+--   * L12(2¹¹) 12 run … 〜11 因子 (★Plackett-Burman・主効果スクリーニングの定番)+--   * L16(2¹⁵) 16 run … 〜15 因子+-- L8/L16 は fractional と数学的に等価だが、 「因子を直交表の列に割り当てる」 Taguchi の+-- framing で透過的に扱えるようにする。 ★目玉は fractional に無い **L12 (11 因子/12 run)**。+--+-- ★Phase 78.G-a2: **3 水準/混合水準表 (L9/L18/L27)** と **数値順序 ('Num') / カテゴリ ('Cat')**+-- 因子に拡張。 各因子の要求水準数 (Cont=2・Num/Cat=水準数) を表の列水準 ('oaLevels') に+-- **貪欲に突合**して割り当てる (混合表 L18=2¹×3⁷ では 2 水準因子を 2 水準列へ、 3 水準因子を+-- 3 水準列へ)。 割当先列の code を各因子の coded へ写す:+--   * Cont … code 1→@-1@ / 2→@+1@ (2 水準)。 uncode で実値へ。+--   * Num/Cat … code c → 水準 index @c-1@。 designFrame で実値/水準名へ、 Num は formula で+--     直交多項式 (opoly) に、 Cat は engine の contrast に展開。+-- formula は 'fractionalDesign' と同じ**主効果のみ** ('KFractional')。 designModel は共通経路。+-- ---------------------------------------------------------------------------++-- | [日本語]: 自動選択が run 数の昇順に舐める直交表 (2 水準 + 3 水準/混合)。+--   [English]: The orthogonal arrays auto-selection walks through in+--   ascending run-count order (2-level + 3-level/mixed).+taguchiOAs :: [OA]+taguchiOAs = [l4, l8, l9, l12, l16, l18, l27]   -- runs: 4,8,9,12,16,18,27++-- | [日本語]: 因子が要求する水準数 (Cont=2・Num/Cat=水準リスト長)。 直交表の列水準への突合に使う。+--   [English]: The number of levels a factor requires (Cont=2, Num/Cat=+--   level-list length). Used to match against the orthogonal array's+--   column levels.+factorLevelCount :: DesignFactor -> Int+factorLevelCount f = case dfKind f of+  Cont _ _ _ -> 2+  Num levels -> length levels+  Cat levels -> length levels++-- | [日本語]: 因子を直交表の列に貪欲割当 (各因子の要求水準数に一致する未使用列を順に取る)。+--   成功なら各因子の割当先__列 index__、 一致列が尽きたら 'Nothing' (混合水準の突合失敗)。+--   [English]: Greedily assigns factors to columns of an orthogonal array+--   (takes the next unused column matching each factor's required level+--   count). On success, each factor's assigned __column index__; 'Nothing'+--   once matching columns run out (a mixed-level matching failure).+assignOAColumns :: OA -> [DesignFactor] -> Maybe [Int]+assignOAColumns oa = go (zip [0 ..] (oaLevels oa))+  where+    go _     []       = Just []+    go avail (f : fs) =+      case break (\(_, lvl) -> lvl == factorLevelCount f) avail of+        (_,   [])              -> Nothing+        (pre, (col, _) : post) -> (col :) <$> go (pre ++ post) fs++-- | [日本語]: 割当先列の 1-based level code を各因子の coded へ。 Cont は code 1→@-1@/2→@+1@、+--   Num/Cat は水準 index @c-1@。+--   [English]: Maps the 1-based level code of an assigned column to each+--   factor's coded value. Cont maps code 1→@-1@/2→@+1@; Num/Cat maps to+--   level index @c-1@.+oaToCodedCols :: OA -> [Int] -> [DesignFactor] -> [[Double]]+oaToCodedCols oa cols fs =+  [ [ codeFor f (row !! col) | (col, f) <- zip cols fs ] | row <- oaTable oa ]+  where+    codeFor f code = case dfKind f of+      Cont _ _ _ -> if code == 1 then -1 else 1+      _        -> fromIntegral (code - 1)   -- Num/Cat: 水準 index++-- | [日本語]: Taguchi 直交表計画 (__最小 OA 自動選択__・2/3 水準・混合)。 各因子の要求水準数 (連続=2・+--   'numFactor'/'catFactor' は水準数) に一致する列を持つ最小 run 表 (L4/L8/L9/L12/L16/L18/L27+--   の run 昇順) を選び、 因子を列へ割り当てる。 該当表なしは error。 formula は+--   'fractionalDesign' と同じ__主効果のみ__ ('KFractional'・Num は @opoly@)。+--   @taguchiDesign [contFactor "a" (0,1), …]@ (11 連続) → L12、+--   @taguchiDesign [catFactor "x" ["A","B","C"], …]@ (3 水準) → L9、+--   @taguchiDesign [contFactor "p" (0,1), catFactor "q" ["a","b","c"], …]@ (混合) → L18。+--   [English]: A Taguchi orthogonal array design (+--   __auto-selects the smallest OA__; 2/3-level, mixed). Picks the smallest-run table+--   (L4/L8/L9/L12/L16/L18/L27, in ascending run order) with columns+--   matching each factor's required level count (continuous=2;+--   'numFactor'/'catFactor'=level count), and assigns factors to+--   columns. Errors if no table matches. The formula, like+--   'fractionalDesign', has __main effects only__ ('KFractional'; Num+--   uses @opoly@).+--   @taguchiDesign [contFactor "a" (0,1), …]@ (11 continuous) → L12,+--   @taguchiDesign [catFactor "x" ["A","B","C"], …]@ (3-level) → L9,+--   @taguchiDesign [contFactor "p" (0,1), catFactor "q" ["a","b","c"], …]@+--   (mixed) → L18.+taguchiDesign :: [DesignFactor] -> Design+taguchiDesign specs =+  case [ (oa, cols) | oa <- taguchiOAs, Just cols <- [assignOAColumns oa specs] ] of+    []              -> error+      ("taguchiDesign: 因子の水準構成 " ++ show (map factorLevelCount specs)+        ++ " を収容できる標準直交表がありません "+        ++ "(利用可能: L4/L8/L12/L16 = 2 水準、 L9/L18(混合)/L27 = 3 水準)")+    ((oa, cols) : _) -> Design specs (oaToCodedCols oa cols specs) KFractional++-- | [日本語]: 標準直交表の識別子 ('taguchiDesignOA' で表を明示するための__列挙型__)。+--   文字列でなく型で表を指定するので、 打ち間違い (@\"L10\"@ 等) は__コンパイル時に弾かれる__。+--   2 水準表 = 'L4'/'L8'/'L12'/'L16'、 3 水準表 = 'L9'/'L27'、 混合水準表 = 'L18' (2^1×3^7)。+--   [English]: The identifier for a standard orthogonal array (an+--   __enum type__ used to specify a table explicitly with+--   'taguchiDesignOA'). Since the table is given by type rather than+--   string, a typo (e.g. @\"L10\"@) is __rejected at compile time__.+--   2-level tables = 'L4'/'L8'/'L12'/'L16'; 3-level tables = 'L9'/'L27';+--   the mixed-level table = 'L18' (2^1×3^7).+data OATable = L4 | L8 | L9 | L12 | L16 | L18 | L27+  deriving (Show, Eq, Ord, Enum, Bounded)++-- | [日本語]: 'OATable' → 低レベル 'OA' 定義。+--   [English]: 'OATable' → the low-level 'OA' definition.+oaTableToOA :: OATable -> OA+oaTableToOA t = case t of+  L4 -> l4; L8 -> l8; L9 -> l9; L12 -> l12; L16 -> l16; L18 -> l18; L27 -> l27++-- | [日本語]: Taguchi 直交表計画 (__直交表を型で明示__・fractional の generator 版と対称の escape hatch)。+--   表は 'OATable' の列挙値 ('L4'/'L8'/'L9'/'L12'/'L16'/'L18'/'L27') で渡すので、 未知の表名は+--   型検査で弾かれる (文字列指定の実行時 error が無い)。 因子の水準数が表の列に割り当てられない+--   場合のみ error。+--   @taguchiDesignOA L12 specs@ で run 数を意図的に選ぶ、 @taguchiDesignOA L9 cats@ で 3 水準表を明示。+--   [English]: A Taguchi orthogonal array design (+--   __table specified explicitly by type__; an escape hatch symmetric to the fractional+--   generator variant). Since the table is passed as an 'OATable' enum+--   value ('L4'/'L8'/'L9'/'L12'/'L16'/'L18'/'L27'), an unknown table name+--   is rejected by type-checking (no runtime error from a string+--   argument). Errors only if the factors' level counts can't be+--   assigned to the table's columns.+--   @taguchiDesignOA L12 specs@ deliberately picks a run count;+--   @taguchiDesignOA L9 cats@ explicitly picks the 3-level table.+taguchiDesignOA :: OATable -> [DesignFactor] -> Design+taguchiDesignOA table specs =+  let oa = oaTableToOA table+  in case assignOAColumns oa specs of+    Nothing   -> error+      ("taguchiDesignOA: " ++ show table ++ " (列水準 " ++ show (oaLevels oa)+        ++ ") に因子の水準構成 " ++ show (map factorLevelCount specs) ++ " を割り当てられません")+    Just cols -> Design specs (oaToCodedCols oa cols specs) KFractional++-- ---------------------------------------------------------------------------+-- 最適計画 (optimal design) — Phase 78.G-b1+--+-- 標準の格子計画 (factorial/RSM) と違い、 **モデル formula** と **run 数 n** を先に決め、+-- 候補点集合から情報行列 XᵀX の基準 (D/A/I/E/G) を最適化する n 点を選ぶ (Fedorov 交換)。+-- run 数が制約されている・非標準のモデル項を当てたい・候補領域が不規則、 等で使う。+--+-- 実装は既存部品の**接着**で、 新規の数値アルゴは無い:+--   1. 因子 specs から coded 候補グリッド @candidateGrid@ (各因子 [-1,1] の等間隔 levels 水準)。+--   2. グリッド各点を DataFrame 化し 'modelFrame'+'designMatrixF' で **formula の設計行列 X 行**へ展開。+--   3. 低レベル 'OPT.optimalDesign' (Fedorov) で n 行を選択 → 選択 index。+--   4. 選ばれた候補の**因子座標**を 'dsCoded' に、 formula を 'KCustom' に焼き込む。+-- 以降は 'designTable'/'designFrame'/@designModel@ が factorial 等と同じ共通経路で処理する。+--+-- モデルは 'Formula' に一本化 (二重管理回避)。 入口は 2 つ:+--   * 効果 DSL 'mainEffects'/'twoWay'/'quadratic' (対話向け・型付き)。+--   * 文字列 RHS を 'parseRFormula' で 'Formula' に (アプリ/外部から組み立て)。+-- ★連続因子のみ (v1)。 カテゴリ因子は 'DesignFactor' の水準リスト化 (型手術) を伴う G-b2。+-- ---------------------------------------------------------------------------++-- | [日本語]: 主効果のみモデル @y ~ x1 + x2 + …@ を作る効果 DSL。 応答は placeholder (@_y@)。+--   'optimalDesign' のモデル引数に渡す。+--   [English]: The effect DSL for building a main-effects-only model+--   @y ~ x1 + x2 + …@. The response is a placeholder (@_y@). Passed as+--   the model argument to 'optimalDesign'.+mainEffects :: [Text] -> Formula+mainEffects names = effectFormula (T.intercalate " + " names)++-- | [日本語]: 主効果 + 全 2 因子交互作用モデル @y ~ x1 + x2 + x1:x2 + …@ を作る効果 DSL。+--   [English]: The effect DSL for building a main-effects + all+--   2-factor-interaction model @y ~ x1 + x2 + x1:x2 + …@.+twoWay :: [Text] -> Formula+twoWay names = effectFormula (T.intercalate " + " (names ++ twoWayTerms names))++-- | [日本語]: 主効果 + 2 因子交互作用 + 2 次項モデル @y ~ … + I(x1^2) + …@ (RSM 相当) を作る効果 DSL。+--   2 次項を含むので 'optimalDesign' の既定候補水準は 3 になる。+--   [English]: The effect DSL for building a main-effects + 2-factor-+--   interaction + quadratic-term model @y ~ … + I(x1^2) + …@ (RSM+--   equivalent). Since it includes quadratic terms, 'optimalDesign''s+--   default candidate level count becomes 3.+quadratic :: [Text] -> Formula+quadratic names =+  effectFormula (T.intercalate " + " (names ++ twoWayTerms names ++ squareTerms names))++-- | [日本語]: 全 2 因子交互作用の項 (@a:b@) を名前順に。+--   [English]: All 2-factor-interaction terms (@a:b@), in name order.+twoWayTerms :: [Text] -> [Text]+twoWayTerms names =+  [ a <> ":" <> b | (i, a) <- zip [0 :: Int ..] names, b <- drop (i + 1) names ]++-- | [日本語]: 各因子の 2 次項 (@I(x^2)@)。+--   [English]: The quadratic term (@I(x^2)@) of each factor.+squareTerms :: [Text] -> [Text]+squareTerms names = [ "I(" <> n <> "^2)" | n <- names ]++-- ---------------------------------------------------------------------------+-- Phase 78.M M3: Formula (効果 DSL) → Custom.Model ([ModelTerm]) 変換+-- ---------------------------------------------------------------------------++-- | [日本語]: 効果 DSL / 'Formula' を Custom Design 層の 'CMd.Model' ('mainEffects'/'twoWay'/+--   'quadratic' 相当の @[ModelTerm]@) に変換する。 高レベル生成 API ('customDesign'・M4)+--   が座標交換 (@coordinateExchangePure@) に渡すモデルを組み立てる橋渡し。+--+--   効果 DSL の formula は 'parseRFormula' が各項に係数パラメータ @_pN@ を挿入した+--   積和 (例 @_p0 + _p1·a + _p3·(a·b) + _p4·a^2@) になる。 加法分解した各項の+--   __因子名を参照する葉だけ__を残して分類する (与えた @facNames@ に含まれる 'Ref' が因子・+--   それ以外の 'Ref' は係数パラメータとして無視):+--+--     - 因子葉が 0 個 (係数のみ)          → 'CMd.TIntercept'+--     - 単一 @Ref x@                        → 'CMd.TMain' x+--     - 単一 @Bin Pow (Ref x) (Lit k)@      → 'CMd.TPower' x (round k)+--     - 複数の @Ref@ の積                    → 'CMd.TInter' [x, y, …]+--+--   正規化は 'CMd.NCoded' (optimalDesign と同じ coded 規約)。 基底関数 (@opoly@/@bspline@)+--   や未対応構造は @Left@ を返す (M3 スコープ = 主効果 / 2 因子交互作用 / 冪)。+--   [English]: Converts an effect DSL / 'Formula' into the Custom Design+--   layer's 'CMd.Model' (the @[ModelTerm]@ equivalent of+--   'mainEffects'/'twoWay'/'quadratic'). The bridge that assembles the+--   model the high-level generation API ('customDesign'・M4) passes to+--   coordinate exchange (@coordinateExchangePure@).+--+--   An effect-DSL formula is a sum-of-products where 'parseRFormula' has+--   inserted a coefficient parameter @_pN@ into each term (e.g.+--   @_p0 + _p1·a + _p3·(a·b) + _p4·a^2@). Each additively-decomposed term+--   is classified after keeping only the+--   __leaves that reference a factor name__ ('Ref's found in the given @facNames@ are factors;+--   other 'Ref's are ignored as coefficient parameters):+--+--     - 0 factor leaves (coefficient only)  → 'CMd.TIntercept'+--     - a single @Ref x@                     → 'CMd.TMain' x+--     - a single @Bin Pow (Ref x) (Lit k)@   → 'CMd.TPower' x (round k)+--     - a product of multiple @Ref@s         → 'CMd.TInter' [x, y, …]+--+--   Normalization is 'CMd.NCoded' (the same coded convention as+--   optimalDesign). Basis functions (@opoly@/@bspline@) or unsupported+--   structures return @Left@ (M3 scope = main effects / 2-factor+--   interactions / powers).+formulaToCustomModel :: [Text] -> Formula -> Either Text CMd.Model+formulaToCustomModel facNames (Formula _ _ rhs) = do+  terms <- mapM termToModelTerm (flattenAddW rhs)+  Right (CMd.Model terms CMd.NCoded)+  where+    isFacRef (Ref x) = x `elem` facNames+    isFacRef _       = False+    -- 係数パラメータ葉 = facNames に無い裸の 'Ref' (parseRFormula が挿入する @_pN@)。+    isParamLeaf (Ref x) = x `notElem` facNames+    isParamLeaf _       = False+    -- 積を葉分解し、 係数パラメータを除いた「中核」葉で項を分類する。+    -- 中核が空 = 係数のみ = 切片。 それ以外は因子参照 (主効果/交互作用/冪)。+    -- 中核に因子を参照しない葉 (基底関数 'App' 等) が残れば未対応 → Left。+    termToModelTerm t =+      case filter (not . isParamLeaf) (mulLeavesW t) of+        []        -> Right CMd.TIntercept+        [Ref x] | x `elem` facNames -> Right (CMd.TMain x)+        [Bin Pow (Ref x) (Lit k)]+          | x `elem` facNames && k >= 2 -> Right (CMd.TPower x (round k))+        ls | not (null ls) && all isFacRef ls ->+               Right (CMd.TInter [ x | Ref x <- ls ])+        _ -> Left (T.pack+               ("formulaToCustomModel: 未対応の項 (基底関数や非線形項は Custom.Model に"+                <> " 変換できません・主効果/交互作用/冪のみ対応): " <> show t))++-- | [日本語]: 加法項へ分解 (符号は係数に吸収されるので Add/Sub/Neg 同一視)。+--   'Formula.Design.flattenAdd' と同義だが import 循環回避のため局所定義。+--   [English]: Decomposes into additive terms (Add/Sub/Neg are treated+--   the same since sign is absorbed into the coefficient). Synonymous+--   with 'Formula.Design.flattenAdd', but defined locally to avoid an+--   import cycle.+flattenAddW :: Term -> [Term]+flattenAddW (Bin Add a b) = flattenAddW a ++ flattenAddW b+flattenAddW (Bin Sub a b) = flattenAddW a ++ flattenAddW b+flattenAddW (Neg a)       = flattenAddW a+flattenAddW t             = [t]++-- | [日本語]: 乗法葉へ分解。 'Formula.Design.mulLeaves' と同義 (局所定義)。+--   [English]: Decomposes into multiplicative leaves. Synonymous with+--   'Formula.Design.mulLeaves' (defined locally).+mulLeavesW :: Term -> [Term]+mulLeavesW (Bin Mul a b) = mulLeavesW a ++ mulLeavesW b+mulLeavesW (Neg a)       = mulLeavesW a+mulLeavesW t             = [t]++-- ---------------------------------------------------------------------------+-- Phase 79: 高レベル生成 API (pure・座標交換 / 階層構造 / 制約)+-- ---------------------------------------------------------------------------++-- | [日本語]: 高レベル 'DesignFactor' を Custom Design 層の 'CF.Factor' に変換する。+--   連続 = coded [-1,1] 前提の 'CF.Continuous'、 カテゴリ = 'CF.Categorical' (水準 index)。+--   数値順序 ('Num') は __水準 index を grid とする__ 'CF.DiscreteNum' @[0..k-1]@ に写す+--   (M4-b)。 これで座標交換の出力 (cdMatrix) が水準 index になり、 'dsCoded' の+--   Num 規約 ('numLevelAt' = index → 実水準値) と一致する。 ★交換は index 尺度 (等間隔) で+--   D-最適化する (実測不等間隔の直交多項式 opoly は Custom.Model 非対応ゆえ、 モデル項は+--   ユーザ formula の I(x^2) 等がそのまま使われる)。+--   ★役割 ('CF.fRole') は高レベルから撤去したので一律 'CF.Controllable'+--   (階層は因子ではなく 'Structure' が持つ。 fRole の去就は M-construction 移植時に判断)。+--   [English]: Converts a high-level 'DesignFactor' into the Custom+--   Design layer's 'CF.Factor'. Continuous → 'CF.Continuous' (assuming+--   coded [-1,1]); categorical → 'CF.Categorical' (level index).+--   Numeric-ordered ('Num') maps to 'CF.DiscreteNum' @[0..k-1]@,+--   __treating the level index as the grid__ (M4-b). This makes+--   coordinate exchange's output (cdMatrix) a level index, matching+--   'dsCoded''s Num convention ('numLevelAt' = index → actual level+--   value). ★The exchange D-optimizes on the index scale (evenly+--   spaced), since orthogonal polynomials (opoly) for actual unevenly+--   spaced measurements are not supported by Custom.Model; the model+--   terms use the user formula's I(x^2), etc. as-is.+--   ★The role field ('CF.fRole') has been removed from the high level,+--   so it's uniformly 'CF.Controllable' (hierarchy is held by+--   'Structure', not the factor; fRole's fate will be decided when+--   M-construction is ported over).+toCustomFactor :: DesignFactor -> CF.Factor+toCustomFactor f = CF.Factor (dfName f) (kindC (dfKind f)) CF.Controllable+  where+    kindC (Cont lo hi _) = CF.Continuous lo hi+    kindC (Cat ls)     = CF.Categorical ls+    kindC (Num levels) = CF.DiscreteNum (map fromIntegral [0 .. length levels - 1])++-- | [日本語]: 因子 + formula から Custom Design の 'CX.CustomDesignSpec' を組み立てる共通処理 (M4)。+--   モデルは 'formulaToCustomModel' で [ModelTerm] 化 (失敗は error)。 最適化基準 @crit@ と+--   制約 @cons@ を受け取り、 budget は既定。 座標交換 / split-plot 生成の両方が使う。+--   [English]: The common routine (M4) that builds a Custom Design+--   'CX.CustomDesignSpec' from factors + a formula. The model is turned+--   into [ModelTerm] via 'formulaToCustomModel' (failure is an error).+--   Takes an optimization criterion @crit@ and constraints @cons@; the+--   budget is the default. Used by both coordinate exchange and+--   split-plot generation.+toCustomSpec :: OptCriterion -> [Constraint]+             -> [DesignFactor] -> Formula -> Int -> Int -> CX.CustomDesignSpec+toCustomSpec crit cons fs fml n seed =+  case formulaToCustomModel (map dfName fs) fml of+    Left e      -> error ("customDesign: モデル変換に失敗: " <> T.unpack e)+    Right model -> CX.CustomDesignSpec+      { CX.cdsFactors      = map toCustomFactor fs+      , CX.cdsModel        = model+      , CX.cdsConstraints  = cons+      , CX.cdsNRuns        = n+      , CX.cdsCriterion    = crit+      , CX.cdsBudget       = CX.defaultBudget+      , CX.cdsSeed         = Just seed+      , CX.cdsInitial      = Nothing+      , CX.cdsDJConvention = False+      }++-- | [日本語]: __完全カスタムデザインの生成__ (pure)。 唯一の生成入口。 'CustomSpec' 1 本+--   (因子 × 固定効果モデル × run 数 × seed × 基準 × 制約 × 'Structure') を受け取り、+--   構造に応じた座標交換 (M / 制約 / 群単位ムーブ) を解いて 'Design' ('KStructured') に包む。+--   __seed 決定的__な純粋関数 (同 seed → 同結果)。+--+--   > -- CRD (最小)+--   > let plan = customDesign (customSpec fs (quadratic ["x1","x2"]) 12 42)+--   >+--   > -- 制約つき CRD+--   > customDesign (customSpec fs fml 8 42)+--   >   { csConstraints = [LinearIneq [("x1",1),("x2",1)] CLeq 0.5] }+--   >+--   > -- split-plot (temp が whole-plot) + 制約+--   > customDesign (customSpec fs (twoWay ["temp","rate"]) 8 50)+--   >   { csStructure = splitPlot ["temp"] 4, csConstraints = [RangeBound "rate" (-0.5) 1] }+--+--   ★制約の因子参照は __coded 単位__ ([-1,1]) で書く (座標交換が coded 空間で解くため)。+--   v1 未実装の構造は @unsupported structure@ で error。+--   [English]: __Generates a fully custom design__ (pure). The sole+--   generation entry point. Takes a single 'CustomSpec' (factors × fixed-+--   effect model × run count × seed × criterion × constraints ×+--   'Structure'), solves the structure-appropriate coordinate exchange (M+--   / constraints / group-wise moves), and wraps it in a 'Design'+--   ('KStructured'). A __seed-deterministic__ pure function (same seed →+--   same result).+--+--   > -- CRD (minimal)+--   > let plan = customDesign (customSpec fs (quadratic ["x1","x2"]) 12 42)+--   >+--   > -- CRD with a constraint+--   > customDesign (customSpec fs fml 8 42)+--   >   { csConstraints = [LinearIneq [("x1",1),("x2",1)] CLeq 0.5] }+--   >+--   > -- split-plot (temp is whole-plot) + a constraint+--   > customDesign (customSpec fs (twoWay ["temp","rate"]) 8 50)+--   >   { csStructure = splitPlot ["temp"] 4, csConstraints = [RangeBound "rate" (-0.5) 1] }+--+--   ★Constraints reference factors in __coded units__ ([-1,1]) (since+--   coordinate exchange solves in coded space). Structures not+--   implemented in v1 error with @unsupported structure@.+customDesign :: CustomSpec -> Design+customDesign cs = case csStructure cs of+  CRD ->+    -- CRD は M=I・per-cell の高速路 (@coordinateExchangePure@) へそのまま委譲 (ビット一致)。+    let fs   = csFactors cs+        spec = toCustomSpec (csCriterion cs) (effectiveConstraints cs) fs+                            (csFormula cs) (csNRuns cs) (csSeed cs)+    in case CX.coordinateExchangePure spec of+         Left e   -> error (T.unpack (enrichInfeasError cs e))+         Right cd -> Design fs (LA.toLists (CX.cdMatrix cd)) (KStructured [] (csFormula cs))+  structure ->+    -- 非自明な構造 (SplitPlot/StripPlot/Blocked) は Structure を GroupingPlan に+    -- コンパイルし、 構造駆動エンジン ('structuredExchangePure') で群単位ムーブ + GLS 基準を解く。+    let fs = csFactors cs+    in case buildGrouping fs (csNRuns cs) structure of+         Left e -> error ("customDesign: " <> T.unpack e)+         Right (gplan, groups) ->+           let spec = toCustomSpec (csCriterion cs) (effectiveConstraints cs) fs+                                   (csFormula cs) (csNRuns cs) (csSeed cs)+           in case ST.structuredExchangePure spec gplan of+                Left e       -> error (T.unpack (enrichInfeasError cs e))+                Right (m, _) -> Design fs (LA.toLists m) (KStructured groups (csFormula cs))++-- | [日本語]: 'Structure' を構造駆動エンジンの @GroupingPlan@ (列ごと cells + M⁻¹) と+--   出力用群列 @[(群列名, 各 run の群 ID)]@ にコンパイルする。 CRD は+--   別処理 ('customDesign' が高速路へ委譲) ゆえここでは扱わない。 v1 未実装構造は+--   @unsupported structure@ で 'Left'。+--   [English]: Compiles a 'Structure' into the structure-driven engine's+--   @GroupingPlan@ (per-column cells + M⁻¹) and the output group columns+--   @[(group column name, per-run group id)]@. CRD is handled separately+--   ('customDesign' delegates to the fast path) and isn't handled here.+--   Structures not implemented in v1 give 'Left' with+--   @unsupported structure@.+buildGrouping :: [DesignFactor] -> Int -> Structure+              -> Either Text (ST.GroupingPlan, [(Text, [Int])])+buildGrouping fs n structure = case structure of+  CRD -> Left "buildGrouping: CRD は構造エンジンを使わない (内部エラー)"+  SplitPlot whole nWhole eta col+    | nWhole < 1 -> Left "whole-plot 数 (spNWhole) は 1 以上が必要"+    | n < nWhole -> Left "run 数 n は whole-plot 数 (spNWhole) 以上が必要"+    | null whole -> Left "split-plot に whole-plot 因子名 (spWhole) が空"+    | not (all (`elem` names) whole) ->+        Left ("whole-plot 因子名 "+               <> T.pack (show (map T.unpack (filter (`notElem` names) whole)))+               <> " が因子リストに無い")+    | otherwise ->+        let ids    = balancedGroupIds n nWhole+            idsV   = VS.fromList ids+            wpCols = [ j | (j, f) <- zip [0 :: Int ..] fs, dfName f `elem` whole ]+            cells  = [ if j `elem` wpCols then groupCells ids nWhole else perRowCells n+                     | j <- [0 .. length fs - 1] ]+            mInv   = ST.buildMInvFromGroups n [(eta, idsV)]+        in Right (ST.GroupingPlan cells mInv, [(col, ids)])+  StripPlot whole nWhole etaW wCol strip nStrip etaS sCol+    | nWhole < 1 || nStrip < 1 -> Left "strip-plot の whole-plot 数 / strip 数は 1 以上が必要"+    | n /= nWhole * nStrip ->+        Left ("strip-plot は n = stNWhole × stNStrip が必要 (n=" <> tshowW n+               <> ", " <> tshowW nWhole <> "×" <> tshowW nStrip <> "=" <> tshowW (nWhole * nStrip) <> ")")+    | null whole || null strip -> Left "strip-plot に whole-plot / strip 因子名が空"+    | not (all (`elem` names) (whole ++ strip)) ->+        Left ("strip-plot 因子名 "+               <> T.pack (show (map T.unpack (filter (`notElem` names) (whole ++ strip))))+               <> " が因子リストに無い")+    | not (null (filter (`elem` strip) whole)) ->+        Left "同一因子を whole-plot と strip の両方に指定できません"+    | otherwise ->+        let wpIds    = balancedGroupIds n nWhole          -- 行 i → i `div` nStrip+            stripIds = [ i `mod` nStrip | i <- [0 .. n - 1] ]+            wpCols   = [ j | (j, f) <- zip [0 :: Int ..] fs, dfName f `elem` whole ]+            stCols   = [ j | (j, f) <- zip [0 :: Int ..] fs, dfName f `elem` strip ]+            cells    = [ if j `elem` wpCols then groupCells wpIds nWhole+                         else if j `elem` stCols then groupCells stripIds nStrip+                         else perRowCells n+                       | j <- [0 .. length fs - 1] ]+            mInv     = ST.buildMInvFromGroups n+                         [(etaW, VS.fromList wpIds), (etaS, VS.fromList stripIds)]+        in Right (ST.GroupingPlan cells mInv, [(wCol, wpIds), (sCol, stripIds)])+  Blocked nBlocks eta col+    | nBlocks < 1 -> Left "ブロック数 (blkNBlocks) は 1 以上が必要"+    | n < nBlocks -> Left "run 数 n はブロック数 (blkNBlocks) 以上が必要"+    | otherwise ->+        -- ランダムブロック: 全因子はブロック内で自由 (per-row cell)。 block は run 割付のみで+        -- M = I + η·Z_B Z_Bᵀ に効く。 grouped 列は無い。+        let ids   = balancedGroupIds n nBlocks+            cells = replicate (length fs) (perRowCells n)+            mInv  = ST.buildMInvFromGroups n [(eta, VS.fromList ids)]+        in Right (ST.GroupingPlan cells mInv, [(col, ids)])+  where names  = map dfName fs+        tshowW = T.pack . show++-- | [日本語]: n 行を k 群に均等割り当て (余りは先頭群に +1)。 各行 → 群 ID (0..k-1)。+--   [English]: Evenly distributes n rows into k groups (the remainder+--   goes +1 to the leading groups). Each row → a group ID (0..k-1).+balancedGroupIds :: Int -> Int -> [Int]+balancedGroupIds n k =+  let base  = n `div` k+      extra = n `mod` k+      sizes = [ if i < extra then base + 1 else base | i <- [0 .. k - 1] ]+  in concat [ replicate s i | (i, s) <- zip [0 ..] sizes ]++-- | [日本語]: 群 ID リストから「同群の行集合」 の cells を作る (grouped 列用)。+--   [English]: Builds the "set of rows in the same group" cells from a+--   group-ID list (for grouped columns).+groupCells :: [Int] -> Int -> [[Int]]+groupCells ids k = [ [ i | (i, g) <- zip [0 ..] ids, g == w ] | w <- [0 .. k - 1] ]++-- | [日本語]: per-row cells (各行が独立の cell・CRD 因子 / sub-plot 因子用)。+--   [English]: Per-row cells (each row is its own cell; for CRD factors /+--   sub-plot factors).+perRowCells :: Int -> [[Int]]+perRowCells n = [ [i] | i <- [0 .. n - 1] ]++-- | [日本語]: RHS 文字列 (R 構文) を placeholder 応答 @_y@ 付きで 'parseRFormula' に通す糖衣。+--   効果 DSL は別モデル表現を作らず 'Formula' を組み立てるだけ (二重管理回避)。+--   [English]: Sugar that runs an RHS string (R syntax) through+--   'parseRFormula' with a placeholder response @_y@. The effect DSL+--   doesn't build a separate model representation — it just assembles a+--   'Formula' (avoiding dual management).+effectFormula :: Text -> Formula+effectFormula rhs =+  either (\e -> error ("effect DSL: formula parse error: " ++ e)) id+         (parseRFormula ("_y ~ " <> rhs))++-- | [日本語]: formula の RHS に 2 次以上の冪 (@Bin Pow@) が含まれるか。 候補水準の既定値+--   (2 次項があれば 3 水準・無ければ 2 水準) を決めるのに使う。+--   [English]: Whether the formula's RHS contains a power of 2 or higher+--   (@Bin Pow@). Used to decide the default candidate level count (3+--   levels if there's a quadratic term, 2 otherwise).+formulaHasPower :: Formula -> Bool+formulaHasPower (Formula _ _ rhs) = go rhs+  where+    go (Bin Pow _ _) = True+    go (Bin _ a b)   = go a || go b+    go (Neg a)       = go a+    go (Index a b)   = go a || go b+    go (App _ as)    = any go as+    go _             = False++-- | [日本語]: D-最適計画 (既定基準 = 'DOpt'・seed = 42・候補水準は自動)。 @n@ = run 数 (必須)。+--   @optimalDesign [contFactor "t" (150,180), contFactor "p" (1,5)] (quadratic ["t","p"]) 10@。+--   候補水準は formula が 2 次項を含めば 3、 他は 2 (明示は 'optimalDesignLevels')。 カテゴリ因子+--   ('catFactor') は候補格子で全水準を展開し、 設計行列で contrast 展開される。+--   @n@ が formula のパラメータ数 @p@ 未満だと error (情報行列が特異)。+--   [English]: A D-optimal design (default criterion = 'DOpt', seed = 42,+--   candidate levels automatic). @n@ = run count (required).+--   @optimalDesign [contFactor "t" (150,180), contFactor "p" (1,5)] (quadratic ["t","p"]) 10@.+--   The candidate level count is 3 if the formula has a quadratic term,+--   otherwise 2 (make it explicit with 'optimalDesignLevels'). Categorical+--   factors ('catFactor') expand all their levels in the candidate grid+--   and get contrast-expanded in the design matrix. Errors if @n@ is+--   below the formula's parameter count @p@ (the information matrix+--   would be singular).+optimalDesign :: [DesignFactor]              -- ^ [日本語]: 因子 ('contFactor' / 'catFactor')+                                              --   [English]: Factors ('contFactor' / 'catFactor').+              -> Formula                     -- ^ [日本語]: モデル formula (効果 DSL / 'parseRFormula')+                                              --   [English]: The model formula (effect DSL / 'parseRFormula').+              -> Int                         -- ^ [日本語]: run 数 n [English]: Run count n.+              -> Design+optimalDesign = optimalDesignWith DOpt Nothing 42++-- | [日本語]: 候補水準を明示する D-最適計画 (基準 = 'DOpt'・seed = 42)。 各連続因子 [-1,1] を @levels@+--   水準に離散化した格子を候補集合にする (カテゴリ因子は水準数固定なので @levels@ の影響を受けない)。+--   [English]: A D-optimal design with explicit candidate levels+--   (criterion = 'DOpt', seed = 42). Uses a grid, obtained by discretizing+--   each continuous factor's [-1,1] into @levels@ levels, as the+--   candidate set (categorical factors have a fixed level count, so+--   @levels@ has no effect on them).+optimalDesignLevels :: Int                          -- ^ [日本語]: 候補格子の水準数 (各連続因子)+                                                     --   [English]: The candidate grid's level count (per continuous factor).+                    -> [DesignFactor]+                    -> Formula+                    -> Int+                    -> Design+optimalDesignLevels levels = optimalDesignWith DOpt (Just levels) 42++-- | [日本語]: 最適計画 (フル制御)。 基準 'OptCriterion' (D/A/I/E/G/Compound/BayesianD)、 候補水準+--   (@Nothing@ = 自動)、 seed を明示。 @n@ = run 数 (必須・@n >= p@ 検査あり)。+--   [English]: An optimal design (full control). Explicit 'OptCriterion'+--   (D/A/I/E/G/Compound/BayesianD), candidate levels (@Nothing@ =+--   automatic), and seed. @n@ = run count (required; checked @n >= p@).+optimalDesignWith :: OptCriterion              -- ^ [日本語]: 最適化基準 [English]: The optimization criterion.+                  -> Maybe Int                 -- ^ [日本語]: 候補格子の水準数 (Nothing = 自動)+                                               --   [English]: The candidate grid's level count (Nothing = automatic).+                  -> Int                       -- ^ [日本語]: seed (初期選択) [English]: Seed (initial selection).+                  -> [DesignFactor]+                  -> Formula+                  -> Int                       -- ^ [日本語]: run 数 n [English]: Run count n.+                  -> Design+optimalDesignWith crit mLevels seed fs fml n =+  let lv   = maybe (if formulaHasPower fml then 3 else 2) id mLevels+      grid = fullFactorial (map (factorCandidateLevels lv) fs)+  in case candidateXRows fml fs grid of+       Left err -> error ("optimalDesign: 設計行列の構築に失敗: " ++ err)+       Right xRows ->+         let p = if null xRows then 0 else length (head xRows)+         in if n < p+              then error+                ("optimalDesign: run 数 n=" ++ show n+                  ++ " がモデルのパラメータ数 p=" ++ show p+                  ++ " 未満です (n >= p が必要・情報行列が特異になる)")+              else let (idx, _) = OPT.optimalDesign crit xRows n seed+                   in Design fs (map (grid !!) idx) (KCustom fml)++-- | [日本語]: 因子の候補水準集合 (最適計画のグリッド)。 連続 = @[-1,1]@ を @lv@ 等間隔 (candidateGrid 相当)、+--   カテゴリ = 水準 index @{0,…,m-1}@ (水準数固定・@lv@ 無関係)。 全連続なら @candidateGrid@ と一致。+--   [English]: A factor's candidate level set (the optimal-design grid).+--   Continuous = @[-1,1]@ split into @lv@ even steps (equivalent to+--   candidateGrid); categorical = level index @{0,…,m-1}@ (fixed level+--   count, independent of @lv@). Matches @candidateGrid@ when all factors+--   are continuous.+factorCandidateLevels :: Int -> DesignFactor -> [Double]+factorCandidateLevels lv f = case dfKind f of+  Cont _ _ _ -> evenSpaced lv+  Num levels -> map fromIntegral [0 .. length levels - 1]+  Cat levels -> map fromIntegral [0 .. length levels - 1]+  where+    evenSpaced n+      | n <= 1    = [0]+      | otherwise = [ -1 + 2 * fromIntegral i / fromIntegral (n - 1)+                    | i <- [0 .. n - 1] :: [Int] ]++-- | [日本語]: 候補グリッド (coded 因子座標) を formula の設計行列 X 行 (@[[Double]]@) に展開する。+--   連続因子は coded 値のまま数値項に、 カテゴリ因子は水準名 (Text) 列にして contrast 展開させる。+--   応答は placeholder 列を 0 埋め (設計行列は RHS のみに依存し応答値は無関係)。+--   [English]: Expands a candidate grid (coded factor coordinates) into+--   the formula's design-matrix X rows (@[[Double]]@). Continuous factors+--   become numeric terms with their coded values as-is; categorical+--   factors become a level-name (Text) column, contrast-expanded. The+--   response placeholder column is filled with 0 (the design matrix+--   depends only on the RHS; the response value is irrelevant).+candidateXRows :: Formula -> [DesignFactor] -> [[Double]] -> Either String [[Double]]+candidateXRows fml fs grid = do+  mf     <- modelFrame fml (candidateFrame fml fs grid)+  (x, _) <- designMatrixF fml mf+  pure (LA.toLists x)++-- | [日本語]: 候補グリッド (coded 座標行) を DataFrame 化 (応答 placeholder 列 + 各因子列)。+--   連続 = coded Double 列、 カテゴリ = 水準名 Text 列 ('modelFrame' で factor 扱い)。+--   [English]: Turns a candidate grid (coded coordinate rows) into a+--   DataFrame (a response placeholder column + a column per factor).+--   Continuous = a coded Double column; categorical = a level-name Text+--   column (treated as a factor by 'modelFrame').+candidateFrame :: Formula -> [DesignFactor] -> [[Double]] -> DX.DataFrame+candidateFrame fml fs grid =+  DX.fromNamedColumns $+    (formResponse fml, DX.fromList (replicate (length grid) (0 :: Double)))+      : [ factorFrameColumn Nothing False f [ row !! j | row <- grid ]+        | (j, f) <- zip [0 :: Int ..] fs ]++-- ---------------------------------------------------------------------------+-- 取り出し+-- ---------------------------------------------------------------------------++designFactorNames :: Design -> [Text]+designFactorNames = map dfName . dsFactors++-- | [日本語]: 実行用 runsheet (uncoded 実値・__連続因子のみ__)。 先頭に @run@ 番号列、 続いて各因子の+--   実値列。 戻り値は @ColumnSource@ なので @designTable plan |-> …@ / 表示に使える。+--   ★カテゴリ因子を含む設計では数値 runsheet に水準名を出せないので __error__ となる+--   ('designFrame' を使うこと・Text 列を持つ整形表を返す)。+--   [English]: An executable runsheet (uncoded real values;+--   __continuous factors only__). Starts with a @run@ number column, followed by each+--   factor's real-value column. The result is a @ColumnSource@, so it can+--   be used with @designTable plan |-> …@ / for display.+--   ★For a design that includes categorical factors, this __errors__+--   since a numeric runsheet can't show level names (use 'designFrame'+--   instead, which returns a formatted table with a Text column).+designTable :: Design -> [(Text, [Double])]+designTable (Design fs coded _) =+  case [ dfName f | f <- fs, isCat (dfKind f) ] of+    (c : _) -> error+      ("designTable: カテゴリ因子 " ++ T.unpack c+        ++ " は数値 runsheet に出せません。 designFrame を使ってください "+        ++ "(Text 列を持つ整形表 DataFrame を返します)")+    []      ->+      ("run", map fromIntegral [1 .. length coded])+        : [ (dfName f, [ tableCell f (row !! j) | row <- coded ])+          | (j, f) <- zip [0 ..] fs ]+  where+    isCat (Cat _) = True+    isCat _       = False+    -- Cont は uncoded 実値、 Num は水準 index → 実水準値。 Cat は上でガード済。+    tableCell f v = case dfKind f of+      Num levels -> numLevelAt levels v+      _          -> uncodeCont f v++-- | [日本語]: runsheet を __整形表__ (Hackage @DataFrame@) にする。 連続因子は uncoded 実値の Double 列、+--   __カテゴリ因子は水準名の Text 列__ として直接構築する (数値 'designTable' 経由でなく列ごと)。+--   DataFrame は @ColumnSource@ ゆえ @designFrame plan |-> …@ もそのまま通り、 fit 側は+--   Text 列を contrast 展開する。 @print (designFrame plan)@ で型付き ASCII テーブルを確認できる。+--   [English]: Turns the runsheet into a __formatted table__ (the Hackage+--   @DataFrame@). Continuous factors are built directly as an uncoded+--   real-value Double column;+--   __categorical factors as a level-name Text column__ (built column-by-column, not via the numeric 'designTable').+--   Since DataFrame is a @ColumnSource@, @designFrame plan |-> …@ also+--   works directly, and the fit side contrast-expands the Text column.+--   @print (designFrame plan)@ shows a typed ASCII table.+designFrame :: Design -> DX.DataFrame+designFrame (Design fs coded kind) =+  DX.fromNamedColumns $+    ("run", DX.fromList (map fromIntegral [1 .. length coded] :: [Double]))+      : [ factorFrameColumn Nothing True f [ row !! j | row <- coded ]+        | (j, f) <- zip [0 :: Int ..] fs ]+      ++ splitGroupColumns kind++-- | [日本語]: 実験者に渡す runsheet を __小数第 @nd@ 位に丸めて__返す ('designFrame' の桁数調整版)。+--   応答曲面 (CCD) の軸点 (±α) など無理数由来の長い小数 (@143.78679656440357@) を+--   @designFrameRound 2 plan@ で @143.79@ 等に整える。 連続 / 数値順序因子の実値列だけを丸め、+--   run 番号 / カテゴリ (Text) / 群列はそのまま。 ★丸めた値がそのまま runsheet の値になる+--   (実験は丸めた水準で行う想定)。 fit にそのまま載せてよい ('designFrame' 同様 @ColumnSource@)。+--+--   > print (designFrameRound 2 (centralCompositeDesign [contFactor "temp" (150,180), …]))+--   [English]: Returns the runsheet handed to the experimenter,+--   __rounded to the @nd@-th decimal place__ (a digit-adjusted variant of+--   'designFrame'). Tidies long irrational-derived decimals from+--   response-surface (CCD) axial points (±α) (e.g.+--   @143.78679656440357@) into @143.79@, etc., with+--   @designFrameRound 2 plan@. Rounds only the real-value columns of+--   continuous / numeric-ordered factors; run number / categorical+--   (Text) / group columns are left as-is. ★The rounded value becomes+--   the runsheet's value directly (the experiment is assumed to be run+--   at the rounded levels). Can be fed straight into a fit (a+--   @ColumnSource@, same as 'designFrame').+--+--   > print (designFrameRound 2 (centralCompositeDesign [contFactor "temp" (150,180), …]))+designFrameRound :: Int -> Design -> DX.DataFrame+designFrameRound nd (Design fs coded kind) =+  DX.fromNamedColumns $+    ("run", DX.fromList (map fromIntegral [1 .. length coded] :: [Double]))+      : [ factorFrameColumn (Just nd) True f [ row !! j | row <- coded ]+        | (j, f) <- zip [0 :: Int ..] fs ]+      ++ splitGroupColumns kind++-- | [日本語]: 完全カスタムデザインの群列を Text ラベルで作る。 各群列は @<列名>0, <列名>1, …@+--   のラベル (例: @wholePlot0@ / @strip0@ / @block0@)。 CRD (群列なし) や他種別は空。+--   designModelHBM の grouping 列は getTextVec で読まれる (Text 必須) ため Text 化する。+--   [English]: Builds the fully custom design's group columns as Text+--   labels. Each group column is a @<column name>0, <column name>1, …@+--   label (e.g. @wholePlot0@ / @strip0@ / @block0@). Empty for CRD (no+--   group columns) or other kinds. Made Text because designModelHBM's+--   grouping columns are read via getTextVec (Text required).+splitGroupColumns :: DesignKind -> [(Text, DX.Column)]+splitGroupColumns (KStructured groups _) =+  [ (col, DX.fromList (map (\i -> col <> T.pack (show i)) ids :: [Text]))+  | (col, ids) <- groups ]+splitGroupColumns _ = []++-- | [日本語]: 因子 1 列を coded 座標列から DataFrame 列に。 連続因子は Double 列 (@uncodeC@=True なら+--   uncoded 実値へ・'designFrame' 用、 False なら coded のまま・'candidateFrame' 用)、+--   カテゴリ因子は水準 index を 'Cat' リストで引いた__水準名 Text 列__ ('modelFrame' で factor 扱い)。+--   @mRound = Just nd@ なら Double 列 (連続 / 数値順序) を小数第 @nd@ 位に丸める+--   ('designFrameRound' 用)。 カテゴリ Text 列は丸めない。+--   [English]: Converts one factor's coded coordinate column into a+--   DataFrame column. Continuous factors become a Double column+--   (@uncodeC@=True converts to uncoded real values, for 'designFrame';+--   False keeps it coded, for 'candidateFrame'); categorical factors+--   become the __level-name Text column__ obtained by looking up the+--   level index in the 'Cat' list (treated as a factor by 'modelFrame').+--   @mRound = Just nd@ rounds the Double column (continuous / numeric-+--   ordered) to the @nd@-th decimal place (for 'designFrameRound').+--   Categorical Text columns are never rounded.+factorFrameColumn :: Maybe Int -> Bool -> DesignFactor -> [Double] -> (Text, DX.Column)+factorFrameColumn mRound uncodeC f coded = case dfKind f of+  Cont _ _ _ -> (dfName f, DX.fromList (map (rnd . contVal) coded))+  Num levels -> (dfName f, DX.fromList (map (rnd . numLevelAt levels) coded))  -- 水準 index → 実値 Double+  Cat levels -> (dfName f, DX.fromList (map (levelAt levels) coded :: [Text]))+  where+    contVal = if uncodeC then uncodeCont f else id+    rnd     = maybe id roundTo mRound+    levelAt levels v =+      let i = round v+      in if i >= 0 && i < length levels then levels !! i else "?"++-- | [日本語]: 小数第 @n@ 位への丸め (負値・整数もそのまま)。 @roundTo 2 143.78679 = 143.79@。+--   [English]: Rounds to the @n@-th decimal place (negative values /+--   integers are left as-is). @roundTo 2 143.78679 = 143.79@.+roundTo :: Int -> Double -> Double+roundTo n x = fromIntegral (round (x * m) :: Integer) / m+  where m = 10 ^^ n++-- | [日本語]: 数値順序因子の coded (水準 index) を実水準値へ。 範囲外は NaN (呼び元は index を保証)。+--   [English]: Converts a numeric-ordered factor's coded value (level+--   index) to the actual level value. Out-of-range yields NaN (the+--   caller guarantees the index).+numLevelAt :: [Double] -> Double -> Double+numLevelAt levels v =+  let i = round v+  in if i >= 0 && i < length levels then levels !! i else 0/0++-- | [日本語]: 連続因子の coded 値 @c@ を uncoded 実値へ。 線形は @center + c·half@、 対数は+--   @10^(logCenter + c·logHalf)@ (幾何)。 カテゴリ因子で呼ぶと error (呼び元が連続に+--   限定して使う・'designTable' はガード済)。+--   [English]: Converts a continuous factor's coded value @c@ to an+--   uncoded real value. Linear gives @center + c·half@; log gives+--   @10^(logCenter + c·logHalf)@ (geometric). Errors if called on a+--   categorical factor (callers restrict usage to continuous factors;+--   'designTable' is already guarded).+uncodeCont :: DesignFactor -> Double -> Double+uncodeCont f c = case dfKind f of+  Cont lo hi SLinear -> (lo + hi) / 2 + c * (hi - lo) / 2+  Cont lo hi SLog    ->+    let llo = logBase 10 lo; lhi = logBase 10 hi+    in 10 ** ((llo + lhi) / 2 + c * (lhi - llo) / 2)+  Num _      -> error ("uncodeCont: " ++ T.unpack (dfName f) ++ " は数値順序因子です (numLevelAt を使う)")+  Cat _      -> error ("uncodeCont: " ++ T.unpack (dfName f) ++ " はカテゴリ因子です")++-- | [日本語]: 連続因子の uncoded 実値 @x@ を coded 値へ ('uncodeCont' の逆)。 線形は @(x−center)/half@、+--   対数は @(log10 x − logCenter)/logHalf@。 対数因子で @x <= 0@ は NaN (呼び元が正値を保証)。+--   カテゴリ/数値順序因子で呼ぶと error。+--   [English]: Converts a continuous factor's uncoded real value @x@ to+--   its coded value (the inverse of 'uncodeCont'). Linear gives+--   @(x−center)/half@; log gives @(log10 x − logCenter)/logHalf@. For a+--   log factor, @x <= 0@ yields NaN (the caller guarantees a positive+--   value). Errors if called on a categorical/numeric-ordered factor.+codeCont :: DesignFactor -> Double -> Double+codeCont f x = case dfKind f of+  Cont lo hi SLinear ->+    let half = (hi - lo) / 2+    in if half == 0 then 0 else (x - (lo + hi) / 2) / half+  Cont lo hi SLog    ->+    let llo = logBase 10 lo; lhi = logBase 10 hi+        lhalf = (lhi - llo) / 2+    in if lhalf == 0 then 0 else (logBase 10 x - (llo + lhi) / 2) / lhalf+  Num _ -> error ("codeCont: " ++ T.unpack (dfName f) ++ " は数値順序因子です")+  Cat _ -> error ("codeCont: " ++ T.unpack (dfName f) ++ " はカテゴリ因子です")++-- ---------------------------------------------------------------------------+-- 設計の保存 / DataFrame からの復元 (Phase 78.K)+-- ---------------------------------------------------------------------------++-- | [日本語]: 設計の __runsheet__ ('designFrame') を CSV に書き出す。 実験者に渡す runsheet+--   (uncoded 実値・run 番号列・カテゴリは水準名) がそのまま保存される。+--+--   > saveDesign "runsheet.csv" plan+--   [English]: Writes a design's __runsheet__ ('designFrame') to CSV.+--   The runsheet handed to the experimenter (uncoded real values, run+--   number column, categories as level names) is saved as-is.+--+--   > saveDesign "runsheet.csv" plan+saveDesign :: FilePath -> Design -> IO ()+saveDesign path = DXIO.writeCsv path . designFrame++-- | [日本語]: __DataFrame から設計 ('Design') を復元__する。 因子 (名前 + 種類 + 範囲/水準) と+--   モデル formula (効果 DSL 'mainEffects' / 'quadratic' 等 or 'parseRFormula') を明示し、+--   @df@ の各因子列を coded 化して 'KCustom' 設計に包む。 CSV から読んだ runsheet を+--   解析ワークフロー (@df |-> designModel plan "y"@ / 'rsmAnalysis') に載せ直すのに使う。+--+--   > let plan = planFromFrame [contFactor "temp" (150,180), contFactor "time" (10,20)]+--   >                          (quadratic ["temp","time"]) loadedDf+--   > filledDf |-> designModel plan "y"+--+--   ★fit は formula + df だけで動く (@designModel@) が、 'rsmAnalysis' /+--   'steepestAscentNatural' は coded 幾何を使うので、 因子の範囲/水準を正しく渡すこと。+--   因子列が @df@ に無い / 型が合わない場合は error。+--   [English]: __Restores a 'Design' from a DataFrame__. Given the+--   factors (name + kind + range/levels) and model formula explicitly+--   (effect DSL 'mainEffects' / 'quadratic', etc., or 'parseRFormula'),+--   codes each factor column of @df@ and wraps it in a 'KCustom' design.+--   Used to load a runsheet read from CSV back into the analysis+--   workflow (@df |-> designModel plan "y"@ / 'rsmAnalysis').+--+--   > let plan = planFromFrame [contFactor "temp" (150,180), contFactor "time" (10,20)]+--   >                          (quadratic ["temp","time"]) loadedDf+--   > filledDf |-> designModel plan "y"+--+--   ★The fit itself works from just the formula + df (@designModel@),+--   but 'rsmAnalysis' / 'steepestAscentNatural' use the coded geometry,+--   so the factor ranges/levels must be passed correctly. Errors if a+--   factor column is missing from @df@ or has the wrong type.+planFromFrame :: [DesignFactor] -> Formula -> DX.DataFrame -> Design+planFromFrame fs fml df =+  let cols  = map (`factorCodedColumn` df) fs   -- 各因子の coded 列 (行順)+      coded = transpose cols                    -- 行 = run、 列 = 因子+  in Design fs coded (KCustom fml)++-- | [日本語]: 因子 1 列を @df@ から取り出し coded 座標列にする。 連続 = @(x−center)/half@、+--   数値順序 = 最近傍水準の index、 カテゴリ = 水準名の index (designFrame の逆変換)。+--   [English]: Extracts one factor's column from @df@ as a coded+--   coordinate column. Continuous = @(x−center)/half@; numeric-ordered =+--   the nearest level's index; categorical = the level name's index (the+--   inverse of designFrame).+factorCodedColumn :: DesignFactor -> DX.DataFrame -> [Double]+factorCodedColumn f df = case dfKind f of+  Cont _ _ _ -> [ codeCont f x | x <- doubles ]   -- 線形/対数は codeCont が分岐+  Num levels -> [ fromIntegral (nearestIndex levels x) | x <- doubles ]+  Cat levels -> [ fromIntegral (catIndex levels t)     | t <- texts ]+  where+    nm = dfName f+    doubles = case getDoubleVec nm df of+      Just v  -> V.toList v+      Nothing -> error ("planFromFrame: 数値因子列 '" <> T.unpack nm <> "' が df に無い / 数値でない")+    texts = case getTextVec nm df of+      Just v  -> V.toList v+      Nothing -> error ("planFromFrame: カテゴリ因子列 '" <> T.unpack nm <> "' が df に無い / Text でない")+    nearestIndex levels x =+      fst (minimumBy (comparing (\(_, l) -> abs (l - x))) (zip [0 :: Int ..] levels))+    catIndex levels t = case elemIndex t levels of+      Just i  -> i+      Nothing -> error+        ("planFromFrame: カテゴリ因子 '" <> T.unpack nm <> "' に水準 '" <> T.unpack t+          <> "' が定義されていません (catFactor の水準: " <> show (map T.unpack levels) <> ")")++-- | [日本語]: 設計種別からモデル formula 文字列を生成 (@y@ = 応答列名)。+--   要因計画 = 全交互作用 (@y ~ x1 * x2 * …@)、 RSM = 2 次+--   (@y ~ x1 + x2 + x1:x2 + I(x1^2) + I(x2^2)@)、 一部実施 = __主効果のみ__+--   (@y ~ x1 + x2 + …@・交互作用は交絡ゆえ v1 は含めない)。+--   最適計画 ('KCustom') は焼き込んだ formula の応答を @y@ に差し替えて返す+--   (native 正規形。 @multiLMModel@ は @~@ の有無で R/独自 front-end を自動判別する)。+--   [English]: Generates a model formula string from the design kind+--   (@y@ = the response column name). Factorial = full interaction+--   (@y ~ x1 * x2 * …@); RSM = quadratic+--   (@y ~ x1 + x2 + x1:x2 + I(x1^2) + I(x2^2)@); fractional =+--   __main effects only__ (@y ~ x1 + x2 + …@; v1 doesn't include interactions+--   since they're confounded). Optimal designs ('KCustom') return the+--   baked-in formula with its response swapped to @y@ (the native+--   canonical form; @multiLMModel@ auto-detects the R vs. native+--   front-end by the presence of @~@).+designFormula :: Design -> Text -> Text+designFormula (Design fs _ kind) y =+  let names = map dfName fs+      k     = length names+      inter = [ (names !! i) <> ":" <> (names !! j)+              | i <- [0 .. k - 1], j <- [i + 1 .. k - 1] ]+      sq    = [ "I(" <> n <> "^2)" | n <- names ]+      -- 主効果項: 数値順序因子 ('Num') は直交多項式 opoly(name, 水準数−1)+      -- (linear+quadratic…・実測間隔で直交)、 連続/カテゴリは主効果名 (Cat は engine が contrast 展開)。+      mainTerm f = case dfKind f of+        Num levels -> "opoly(" <> dfName f <> "," <> tshow (length levels - 1) <> ")"+        _          -> dfName f+  in case kind of+    KCustom fml       -> prettyFormula (fml { formResponse = y })+    KStructured _ fml -> prettyFormula (fml { formResponse = y })  -- 固定効果は KCustom 同様+    KFactorial  -> y <> " ~ " <> T.intercalate " * " names+    KRSM        -> y <> " ~ " <> T.intercalate " + " (names ++ inter ++ sq)+    KFractional -> y <> " ~ " <> T.intercalate " + " (map mainTerm fs)  -- 主効果のみ+    -- 主効果 + 主効果と交絡しない 2FI の代表 (交絡群ごと 1 個)。+    KFracInter gens ->+      let reps = [ (names !! (i - 1)) <> ":" <> (names !! (j - 1))+                 | [i, j] <- clearTwoFactorInteractions k gens ]+      in y <> " ~ " <> T.intercalate " + " (map mainTerm fs ++ reps)+  where tshow = T.pack . show++-- ---------------------------------------------------------------------------+-- 応答曲面 解析 (自然単位で報告) — Phase 78.G-d+-- ---------------------------------------------------------------------------+--+-- R rsm の要点は「fit を coded 空間でやる」ことではない (coded/uncoded fit は予測が+-- 同一・単なる便宜)。 本質は **runsheet を自然単位で発行し、 スケール依存な最適化幾何+-- (停留点 / canonical / steepest ascent) だけ内部で coded の計量を使い、 結果を自然単位で+-- 報告する** ワークフロー。 ここではその報告レイヤを与える。+--+--   * fit そのものは @designModel@ が自然単位で行う (係数がそのまま実単位で読める)。+--   * 一方、 停留点の方向・canonical 軸・steepest ascent 方向は計量依存なので、+--     設計が保持する coded 行列 ('Design' の coded ±1/±α) で二次モデルを当て+--     (@fitQuadratic@)、 幾何を coded で解いてから 'uncodeCont' で自然単位へ decode する。++-- | [日本語]: 応答曲面の停留点の性質 (canonical 固有値の符号で判定)。+--   [English]: The nature of a response surface's stationary point+--   (determined by the sign of the canonical eigenvalues).+data RSMNature = RMaximum | RMinimum | RSaddle+  deriving (Show, Eq)++-- | [日本語]: 応答曲面 解析レポート。 停留点・予測は__自然単位__、 canonical 方向は coded 座標+--   (設計の実験範囲を単位に取った軸) で報告する。+--   [English]: A response-surface analysis report. The stationary point+--   and prediction are reported in __natural units__; canonical+--   directions are reported in coded coordinates (axes scaled to the+--   design's experimental range).+data RSMReport = RSMReport+  { rsmStationary :: ![(Text, Double)]+    -- ^ [日本語]: 停留点 (因子名 → __自然単位__の値)。+    --   [English]: The stationary point (factor name → value in+    --   __natural units__).+  , rsmPredicted  :: !Double+    -- ^ [日本語]: 停留点での予測応答。+    --   [English]: The predicted response at the stationary point.+  , rsmNature     :: !RSMNature+    -- ^ [日本語]: 極大 / 極小 / 鞍点。+    --   [English]: Maximum / minimum / saddle point.+  , rsmInRegion   :: !Bool+    -- ^ [日本語]: 停留点が実験領域 (全因子 coded @|x| <= 1@) の内側か。 外なら外挿。+    --   [English]: Whether the stationary point lies inside the+    --   experimental region (all factors coded @|x| <= 1@). Outside+    --   means extrapolation.+  , rsmCanonical  :: ![(Double, [Double])]+    -- ^ [日本語]: canonical: (固有値, coded 方向ベクトル) を固有値昇順で。 固有値の大きさ =+    --   その方向の曲率 (負=下に凸で応答が落ちる方向 / 正=上に凸)。+    --   [English]: Canonical: (eigenvalue, coded direction vector), in+    --   ascending eigenvalue order. The eigenvalue's magnitude = the+    --   curvature in that direction (negative = concave, the direction+    --   the response falls off; positive = convex).+  , rsmR2         :: !Double+    -- ^ [日本語]: 当てた二次モデルの R²。+    --   [English]: The R² of the fitted quadratic model.+  } deriving (Show)++-- | [日本語]: 設計 + 応答 @ys@ から応答曲面を解析し、 停留点・性質・canonical・R² を返す。+--   二次モデルを設計の coded 行列で当て (@fitQuadratic@)、 停留点を自然単位へ decode。+--   __連続因子 (RSM 系設計) 専用__ — カテゴリを含めば呼び名付きで error。+--   @ys@ は runsheet ('designTable' / 'designFrame') と同じ run 順の応答値。+--   [English]: Analyzes the response surface from a design + response+--   @ys@, returning the stationary point, nature, canonical, and R².+--   Fits a quadratic model on the design's coded matrix (@fitQuadratic@),+--   then decodes the stationary point to natural units.+--   __Continuous factors only (RSM-family designs)__ — errors, with the caller's+--   name, if categorical factors are included. @ys@ is the response+--   values in the same run order as the runsheet ('designTable' /+--   'designFrame').+rsmAnalysis :: Design -> [Double] -> RSMReport+rsmAnalysis (Design fs0 coded _) ys =+  let fs        = requireContinuous "rsmAnalysis" fs0  -- 連続専用ガード (error を強制)+      qf        = fitQuadratic coded ys+      (xC, yC, _) = optimumPoint qf+      canon     = canonicalAnalysis qf+      eigs      = map fst canon+      nature+        | all (< 0) eigs = RMaximum+        | all (> 0) eigs = RMinimum+        | otherwise      = RSaddle+      inRegion  = all (\x -> abs x <= 1 + 1e-9) xC+      stationary = [ (dfName f, uncodeCont f x) | (f, x) <- zip fs xC ]+  in RSMReport+       { rsmStationary = stationary+       , rsmPredicted  = yC+       , rsmNature     = nature+       , rsmInRegion   = inRegion+       , rsmCanonical  = canon+       , rsmR2         = qfR2 qf+       }++-- | [日本語]: 自然単位の steepest ascent / descent 経路。 一次係数の勾配方向は計量依存なので、+--   設計の coded 行列で当てた coefs で coded 空間の方向を取り (= 各因子の実験範囲を+--   単位にした scale 不変な方向)、 生成した各点を 'uncodeCont' で自然単位へ decode する。+--   実験者はこの自然単位の系列をそのまま次の試行に使える。+--   @step@ は __coded スケール__の 1 歩幅 (例 0.5)、 @nSteps@ は歩数 (path 長 = nSteps+1)。+--   __連続因子専用__。+--   [English]: A steepest ascent/descent path in natural units. Since the+--   gradient direction of the linear coefficients is metric-dependent,+--   the direction is taken in coded space using coefficients fit on the+--   design's coded matrix (= a scale-invariant direction, with each+--   factor's experimental range as the unit), and each generated point is+--   decoded to natural units via 'uncodeCont'. The experimenter can use+--   this natural-unit sequence directly for the next trial. @step@ is+--   the step size in __coded scale__ (e.g. 0.5); @nSteps@ is the number+--   of steps (path length = nSteps+1). __Continuous factors only__.+steepestAscentNatural+  :: Bool                 -- ^ [日本語]: True = ascent (最大化) / False = descent+                           --   [English]: True = ascent (maximize) / False = descent.+  -> Design+  -> [Double]             -- ^ [日本語]: 応答 @ys@ (run 順) [English]: The response @ys@ (in run order).+  -> Double               -- ^ [日本語]: step (coded スケール) [English]: The step size (coded scale).+  -> Int                  -- ^ [日本語]: nSteps [English]: Number of steps.+  -> [[(Text, Double)]]   -- ^ [日本語]: 経路。 各点 = [(因子名, 自然単位値)]、 先頭 = 設計中心+                          --   [English]: The path. Each point =+                          --   [(factor name, natural-unit value)]; the+                          --   first point is the design center.+steepestAscentNatural maximize (Design fs0 coded _) ys step nSteps =+  let fs   = requireContinuous "steepestAscentNatural" fs0+      qf   = fitQuadratic coded ys+      k    = length fs+      sar  = steepestAscentFromQuad maximize (replicate k 0) qf step nSteps+  in [ [ (dfName f, uncodeCont f x) | (f, x) <- zip fs row ]+     | row <- sarStepPoints sar ]