hanalyze-0.1.0.0: demo/doe-optim/MaterialsMOODemo.hs
{-# LANGUAGE OverloadedStrings #-}
-- | Phase W: 統合デモ — 材料科学シナリオ。
--
-- シナリオ: 合金組成 (x ∈ [0, 1] が銅含有率) を最適化。
-- - 強度 (高いほうが良い): strength(x) = 100 * sin(3x) + 50x + 20
-- - コスト (低いほうが良い): cost(x) = 50 + 100*x
-- - 重量 (低いほうが良い): weight(x) = 10 + 5*x
--
-- 全 3 目的を NSGA-II で同時最適化、Pareto front を可視化。
module Main where
import Text.Printf (printf)
import System.Random.MWC (createSystemRandom)
import Hanalyze.Optim.NSGA (Solution (..), NSGAConfig (..), defaultNSGAConfig,
nsga2)
import Hanalyze.Optim.Pareto (hypervolume)
import Hanalyze.Viz.Pareto (parallelCoordinatesFile, paretoPairFile,
solutionsToPlotData)
import Hanalyze.Viz.Core (defaultConfig, OutputFormat (..), PlotConfig (..))
-- 材料科学シナリオ: x ∈ [0, 1] (合金中の銅含有率)
-- すべて最小化問題に統一 (強度は -strength)
materialsObjective :: [Double] -> [Double]
materialsObjective [x] =
let strength = 100 * sin (3 * x) + 50 * x + 20 -- 最大化 → 最小化のため -符号
cost = 50 + 100 * x
weight = 10 + 5 * x
in [-strength, cost, weight]
materialsObjective _ = error "1D"
main :: IO ()
main = do
putStrLn "═══════════════════════════════════════════════════════════════"
putStrLn " Phase W: 材料科学 統合デモ"
putStrLn "═══════════════════════════════════════════════════════════════"
putStrLn ""
putStrLn "シナリオ: 合金の銅含有率 x ∈ [0, 1] を最適化"
putStrLn " 目的 1 (-strength): 100·sin(3x) + 50x + 20 を最大化"
putStrLn " 目的 2 (cost): 50 + 100x を最小化"
putStrLn " 目的 3 (weight): 10 + 5x を最小化"
putStrLn " 全 3 目的を最小化に統一して NSGA-II"
putStrLn ""
gen <- createSystemRandom
-- NSGA-II で 3 目的最適化
let cfg = defaultNSGAConfig
{ nsgaPopSize = 80
, nsgaGenerations = 150
}
front <- nsga2 cfg materialsObjective [(0, 1)] gen
printf "Pareto front サイズ: %d\n" (length front)
putStrLn ""
putStrLn "[1] Pareto front の代表点 (5 個)"
let sortedFront = sortByObj 0 front
idxs = [0, length sortedFront `div` 4
, length sortedFront `div` 2
, 3 * length sortedFront `div` 4
, length sortedFront - 1]
reps = [sortedFront !! i | i <- idxs, i < length sortedFront]
printf " %-15s %-15s %-15s %-15s\n"
("x (Cu 比率)" :: String) ("strength" :: String)
("cost" :: String) ("weight" :: String)
mapM_ (\s -> do
let [x] = solDecision s
[neg_str, c, w] = solObjectives s
printf " %14.4f %14.2f %14.2f %14.2f\n"
x (-neg_str) c w)
reps
putStrLn ""
-- HV 評価
let allObjs = map solObjectives front
refPt = [-(-50.0), 200.0, 16.0] -- 各目的の悪い値
printf "[2] HV (ref = %s) = %.3f\n" (show refPt) (hypervolume refPt allObjs)
putStrLn ""
-- 可視化
putStrLn "[3] 可視化"
let vCfg t = (defaultConfig t)
{ plotWidth = 700, plotHeight = 350 }
-- 130 規約: Solution → PlotData に変換してから Viz に渡す
let labels = ["-strength", "cost", "weight"]
pdFront = solutionsToPlotData labels front
parallelCoordinatesFile HTML "materials-parallel.html"
(vCfg "材料 Pareto front — 並行座標 (-strength / cost / weight)")
labels pdFront
paretoPairFile HTML "materials-pair.html"
(vCfg "材料 Pareto front — ペア散布")
labels pdFront
putStrLn " → materials-parallel.html / materials-pair.html"
putStrLn ""
putStrLn "═══════════════════════════════════════════════════════════════"
putStrLn " ✓ 材料 3 目的最適化が完了"
putStrLn " Pareto front から要件に応じて 1 点を選ぶ:"
putStrLn " - 強度重視: 銅含有率 高、コスト・重量増 (右端)"
putStrLn " - コスト重視: 銅含有率 低、強度低 (左端)"
putStrLn " - バランス: 中央付近"
putStrLn "═══════════════════════════════════════════════════════════════"
where
sortByObj :: Int -> [Solution] -> [Solution]
sortByObj j = qs
where qs [] = []
qs (p:xs) = qs [x | x <- xs, solObjectives x !! j <= solObjectives p !! j]
++ [p]
++ qs [x | x <- xs, solObjectives x !! j > solObjectives p !! j]