hanalyze-design-0.2.0.1: src/Hanalyze/Design/Orthogonal.hs
{-# 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)