Created
May 31, 2016 12:37
-
-
Save tokiwoousaka/015f0800b3bfe5c4049b6a7afdc3e5ff to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main where | |
import Control.Monad | |
data Sex = Man | Woman deriving (Show, Eq) | |
data Student = Student | |
{ getName :: String | |
, getSex :: Sex | |
} deriving (Show, Eq) | |
list :: [Student] | |
list = | |
[ Student "あきら" Man | |
, Student "かける" Man | |
, Student "つばさ" Man | |
, Student "じゅん" Man | |
, Student "あみ" Woman | |
, Student "さら" Woman | |
, Student "なな" Woman | |
, Student "えり" Woman | |
, Student "りさ" Woman | |
] | |
-- リストモナドの例、フラットな手続きで組み合わせの計算を書ける | |
cp :: Sex -> [(String, String)] | |
cp sex = do | |
x <- list | |
y <- list | |
-- 同じ人同士はカップリング出来ない | |
guard $ x /= y | |
-- 同じ性別同士をカップリングしたい | |
guard $ getSex x == getSex y | |
-- 引数の性別で絞り込む | |
guard $ getSex x == sex | |
-- 残ったCPを返却 | |
return (getName x, getName y) | |
-------- | |
printCp :: [(String, String)] -> IO () | |
printCp cpList = do | |
forM_ cpList $ \(x, y) -> do | |
putStrLn $ x ++ " ✕ " ++ y | |
main :: IO () | |
main = do | |
putStrLn "……ほもぉ……" | |
printCp $ cp Man | |
putStrLn "" | |
putStrLn "……ゆりぃ……" | |
printCp $ cp Woman | |
{- | |
実行結果: | |
……ほもぉ…… | |
あきら ✕ かける | |
あきら ✕ つばさ | |
あきら ✕ じゅん | |
かける ✕ あきら | |
かける ✕ つばさ | |
かける ✕ じゅん | |
つばさ ✕ あきら | |
つばさ ✕ かける | |
つばさ ✕ じゅん | |
じゅん ✕ あきら | |
じゅん ✕ かける | |
じゅん ✕ つばさ | |
……ゆりぃ…… | |
あみ ✕ さら | |
あみ ✕ なな | |
あみ ✕ えり | |
あみ ✕ りさ | |
さら ✕ あみ | |
さら ✕ なな | |
さら ✕ えり | |
さら ✕ りさ | |
なな ✕ あみ | |
なな ✕ さら | |
なな ✕ えり | |
なな ✕ りさ | |
えり ✕ あみ | |
えり ✕ さら | |
えり ✕ なな | |
えり ✕ りさ | |
りさ ✕ あみ | |
りさ ✕ さら | |
りさ ✕ なな | |
りさ ✕ えり | |
-} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
FSharp
で僕のできる範囲で書いてみました〜 (^_^)/