昔読めなかった Haskell のコードを解読してみた

968 デフォルトの名無しさん [sage] 2011/03/02(水) 20:59:11.07 ID: Be:
先生宿題のクイックソートができました

 q[]=[] 
 q(x:xs)=arr (List.partition(<x))>>>first q >>> second q>>>arr((((((((((((((app .).).(&&&))(((app .).).(&&&)) (const id)).).).).)((flip.).) ((.).((.).))) .).).).) (((.).(.)).)flip(++)(:) x snd fst ) $ xs 

ときどきの雑記帖

昔これ見て無理げーと思ってたのですが、今なら読めそうなので頑張りました。

まずでかい部分を f 関数へ移動。

q[]=[] 
q(x:xs)=
  arr (List.partition(<x)) >>> first q >>> second q >>>
  arr f $ xs 
  where
    f = ((((((((((((((app .).).(&&&)) (((app .).).(&&&)) (const id)).).).).) ((flip.).) ((.).((.).))).).).).) (((.).(.)).) flip (++) (:) x snd fst)

f の中の適当に分解できそうなところを関数に移して、ポイントフリーなのをポイントありー（ここ笑うところ）にしていく。

q[]=[] 
q(x:xs)=
  arr (List.partition(<x)) >>> first q >>> second q >>>
  arr f $ xs 
  where
    f = ((((((((((f1 f1 (const id)).).).).) f2 f3) .).).).) f4 flip (++) (:) x snd fst
    f1 f g x = f x (g x)
    f2 f x y z = f2' (f x) y z
      where f2' g y z = flip (g y) z
    f3 f g x h z= f3' f (g x) h z
      where f3' f x h z = f x (h z)
    f4 f x h y z = f4' (f x) h y z
      where f4' g h y z = f4'' g (h y) z
            f4'' g hh z = g (hh z)

f の左側にあるでかいのを別関数に移動。ついでに f1 も展開。

q[]=[] 
q(x:xs)=
  arr (List.partition(<x)) >>> first q >>> second q >>>
  arr f $ xs 
  where
    f = f' f4 flip (++) (:) x snd fst
    f' a b c d e f g h = f'' f2 f3 (a b c d e) f g h
    f'' a b c d e f = a b c d e f f
    f2 f x y z = f2' (f x) y z
      where f2' g y z = flip (g y) z
    f3 f g x h z= f3' f (g x) h z
      where f3' f x h z = f x (h z)
    f4 f x h y z = f4' (f x) h y z
      where f4' g h y z = f4'' g (h y) z
            f4'' g hh z = g (hh z)

で、f' と f'' は実際は大した関数じゃないということが分かったので、実際に f4 とか flip とか (++) とかを適用して展開する。

q[]=[] 
q(x:xs)=
  arr (List.partition(<x)) >>> first q >>> second q >>>
  arr f $ xs 
  where
    f xs = f2 f3 (f4 flip (++) (:) x) snd fst xs xs
    f2 f x y z = f2' (f x) y z
      where f2' g y z = flip (g y) z
    f3 f g x h z= f3' f (g x) h z
      where f3' f x h z = f x (h z)
    f4 f x h y z = f4' (f x) h y z
      where f4' g h y z = f4'' g (h y) z
            f4'' g hh z = g (hh z)

f4 を展開。

q[]=[] 
q(x:xs)=
  arr (List.partition(<x)) >>> first q >>> second q >>>
  arr f $ xs 
  where
    f xs = f2 f3 (g x) snd fst xs xs
    g x xs ys = ys ++ (x:xs)
    f2 f x y z = f2' (f x) y z
      where f2' g y z = flip (g y) z
    f3 f g x h z= f3' f (g x) h z
      where f3' f x h z = f x (h z)

この時点で g 関数が何かクイックソートの一部っぽくなってる。
で、f2 を展開

q[]=[] 
q(x:xs)=
  arr (List.partition(<x)) >>> first q >>> second q >>>
  arr f $ xs 
  where
    f xs = f3 (g x) snd xs fst xs
    g x xs ys = ys ++ (x:xs)
    f3 f g x h z= f3' f (g x) h z
      where f3' f x h z = f x (h z)

f3 を展開

q[]=[] 
q(x:xs)=
  arr (List.partition(<x)) >>> first q >>> second q >>>
  arr f $ xs 
  where
    f xs = g x (snd xs) (fst xs)
    g x xs ys = ys ++ (x:xs)

snd xs とか fst xs とかから xs はペアだということが分かるので、それでパターンマッチさせて、g を展開。

q[]=[] 
q(x:xs)=
  arr (List.partition(<x)) >>> first q >>> second q >>>
  arr f $ xs 
  where
    f (a,b) = a ++ (x:b)

最初の方にある Arrow に対して xs を適用。

q[]=[] 
q(x:xs)= f $ first q $ second q $ List.partition (<x) xs
  where f (a,b) = a ++ (x:b)

最後に first q $ second q というのは要するに \(a,b)->(q a,q b) のことで、ペアの両方に q を適用してるだけなので、これを f 関数に一緒に混ぜてやって完成。

q[]=[] 
q(x:xs)= f $ List.partition (<x) xs
  where f (a,b) = q a ++ (x:q b)

よくそこら辺で書かれている qsort が

qsort [] = []
qsort (x:xs) = qsort less ++ (x : qsort greater)
  where less    = [y | y <- xs, y <= x]
        greater = [y | y <- xs, y > x]

こんな感じの実装らしいので、List.partition が less と greater に分ける関数と考えれば、ほぼ同様の処理になっていることが分かります。