【元日】Haskellで線形合同法おみくじ作って運試し

明けましておめでとうございます！
本年もよろしくお願いいたします

新年の運試しということで、Haskellでおみくじを作って運試ししました

方針

乱数アルゴリズムはシンプルな線形合同法を使うことにしました
ライブラリは使わずに手で実装します
線形合同法のパラメータですが、乱数としての品質は少し落ちても、2026年にちなんだ数字を使います

実装

import Control.Monad.State (State, StateT, evalStateT, get, put, runState, state)
import Control.Monad.Trans.Class (lift)
import Data.Bits (shiftR)
import Text.Read (readMaybe)

m, a, c :: Integer
m = 2^31 -- 法
a = 20260101 -- 乗数
c = 2026 -- 増分

-- 線形合同法
lcgStep :: Integer -> Integer
lcgStep x = (a * x + c) `mod` m

-- 次の乱数を生成し、Stateのシードを更新する
nextLCG :: State Integer Integer
nextLCG = do
    x <- get
    let x' = lcgStep x
    put x'
    pure x'

-- 1回分のおみくじを引く
omikuji :: State Integer String
omikuji = do
    x1 <- nextLCG
    let r = (x1 `shiftR` 16) `mod` 7
        kuji = ["大吉","中吉","小吉","吉","末吉","凶","大凶"]
    pure (kuji !! fromIntegral r)

-- Stateの計算をIOの中で動かせるように包む
drawOnce :: StateT Integer IO String
drawOnce = state (runState omikuji)

-- Enterで引き続け、qで終了するループ
drawLoop :: StateT Integer IO ()
drawLoop = do
    lift (putStrLn "Enterでおみくじを回す、qで終了:")
    line <- lift getLine
    if line == "q"
        then pure ()
        else do
            result <- drawOnce
            lift (putStrLn result)
            drawLoop

-- シード入力後におみくじループを開始する
main :: IO ()
main = do
    putStrLn "シード値を設定します。好きな数字(整数)を入力してください:"
    line <- getLine
    case readMaybe line of
        Just seed -> evalStateT drawLoop seed
        Nothing -> putStrLn "整数ではないようです"

ポイント

-- 次の乱数を生成し、Stateのシードを更新する
nextLCG :: State Integer Integer

乱数器にStateモナドを使うことで、シード値という状態の更新を副作用を伴わずに記述できます

let r = (x1 `shiftR` 16) `mod` 7

線形合同法は下位ビットが弱いので、右シフトして上位ビットを使います

まとめ

これでガチャガチャおみくじを回して、今年の運試しができますね！