計算機科学のブログ

関数型プログラミングの基礎 ファーストクラス関数 引数としての関数 例:カスタムソート Data.Listモジュール、sortBy関数

入門Haskellプログラミング (Will Kurt(著)、株式会社クイープ(監修、翻訳)、翔泳社)のUNIT1(関数型プログラミングの基礎)、LESSON 4(ファーストクラス関数)、4.1(引数としての関数)、例:カスタムソート、クイックチェック 4-2の解答を求めてみる。

コード

lesson/app/Main.hs

module Main where

import Data.List (sortBy)

-- import Lib ()

compareLastName :: (Ord a1, Ord a2) => (a2, a1) -> (a2, a1) -> Ordering
compareLastName name1 name2 =
  let lastName1 = snd name1
      lastName2 = snd name2
   in if lastName1 > lastName2
        then GT
        else
          if lastName1 < lastName2
            then LT
            else
              let firstName1 = fst name1
                  firstName2 = fst name2
               in if firstName1 > firstName2
                    then GT
                    else
                      if firstName1 < firstName2
                        then LT
                        else EQ

-- まだ出てきてない構文を利用してよりlet句(where句)簡潔に関数を記述
compareLastName1 :: (Ord a1, Ord a2) => (a2, a1) -> (a2, a1) -> Ordering
compareLastName1 (firstName1, lastName1) (firstName2, lastName2) =
  if lastName1 > lastName2
    then GT
    else
      if lastName1 < lastName2
        then LT
        else
          if firstName1 > firstName2
            then GT
            else
              if firstName1 < firstName2
                then LT
                else EQ

-- if/then/elseを省略したらさらに簡潔な記述
compareLastName2 :: (Ord a1, Ord a2) => (a2, a1) -> (a2, a1) -> Ordering
compareLastName2 (firstName1, lastName1) (firstName2, lastName2)
  | lastName1 > lastName2 = GT
  | lastName1 < lastName2 = LT
  | firstName1 > firstName2 = GT
  | firstName2 < firstName2 = LT
  | otherwise = EQ

names :: [(String, String)]
names =
  [ ("Ian", "Curtis"),
    ("Bernard", "Sumner"),
    ("Peter", "Hook"),
    ("Stephen", "Morris"),
    ("Ian", "Sumner"),
    ("Bernard", "Sumner")
  ]

main :: IO ()
main = do
  mapM_ print names
  mapM_
    ( \(fname, f) -> do
        print fname
        mapM_ print $ sortBy f names
    )
    [ ("compareLastName", compareLastName),
      ("compareLastName1", compareLastName1),
      ("compareLastName2", compareLastName2)
    ]

入出力結果(Terminal, Zsh)

% stack runghc app/Main.hs
("Ian","Curtis")
("Bernard","Sumner")
("Peter","Hook")
("Stephen","Morris")
("Ian","Sumner")
("Bernard","Sumner")
"compareLastName"
("Ian","Curtis")
("Peter","Hook")
("Stephen","Morris")
("Bernard","Sumner")
("Bernard","Sumner")
("Ian","Sumner")
"compareLastName1"
("Ian","Curtis")
("Peter","Hook")
("Stephen","Morris")
("Bernard","Sumner")
("Bernard","Sumner")
("Ian","Sumner")
"compareLastName2"
("Ian","Curtis")
("Peter","Hook")
("Stephen","Morris")
("Bernard","Sumner")
("Bernard","Sumner")
("Ian","Sumner")
%