日記

_ lethevert is a programmer より、マージソート。文字列ソートで文字列長 m のときに O(mn log n) になるのがいやという話。初めに思いうかべたのは百万件くらいの住所のソートで、自分には縁のない話かなあと思ったけど、N-gram とか suffix array みたいに大きな文字列の部分文字列を考えるときに結構出てくることに気づいた。

先頭の一致する文字を括りだしてこればいいんではないかな。

data L a = L [(a, L a)] deriving Show
type Lis a = [(a, L a)]
 
merge :: Ord a => Lis a -> Lis a -> Lis a
merge [] y = y
merge x [] = x
merge lx@((x, L xl):xs) ly@((y, L yl):ys)
    | x == y = (x, L $ merge xl yl):merge xs ys
    | x < y = (x, L xl):merge xs ly
    | x > y = (y, L yl):merge lx ys

_ これを低級言語で効率よくなるように実装するのは面倒そうだ。

_ [Anarchy Golf] 最短でないコードたち

_ Fibonacci

main=mapM print$take 46f
f=1:scanl(+)1f

_ swap lines

main=g>>=(g>>=p>>).p>>main
p=putStrLn
g=getLine

_ AAでグラフを書く

(use srfi-1)
 
(define (f i p q)
  (let ((x1 (car p))
        (y1 (cdr p))
        (x2 (car q))
        (y2 (cdr q)))
    (let ((h (if (or (= i y1) (= i 0)) #\- #\ ))
          (v (cond ((or (= i y1) (= i y2)) "+")
                   ((and (< y1 i) (< i y2)) "|")
                   ((and (< y2 i) (< i y1)) "|")
                   ((= i 0) "-")
                   (else " "))))
      (string-append (make-string (- x2 x1) h) v))))
 
(define (g ps)
  (let1 mx (apply max (map cdr ps))
     (map (lambda (i)
            (apply string-append (map (cut f i <> <>) (cons '(0 . 0) ps) ps)))
          (iota (+ mx 1) mx -1))))
 
(map print (g (read (standard-input-port))))

_ Haskell で書くとき、こういうリストの一歩手前を参照する処理に zipWith を使うか mapAccumL を使うか迷う。どっちが自然かな。

_ nub を Haskell98 の範囲内の関数合成だけで書いてみよう。 (ポイントフリー nubより)

まず、if を消すのは簡単。 [(True, then), (False, else)] なリストを作って、条件節で filter して snd . head すればよし。

s の方が少し手こずったが、repeat (or replicate) で複製して、関数適用し易いタプルにするかわりに第一引数を uncurry しておけばいい。

s = (. (. splitAt 1 . repeat) . (uncurry . ((. (,) . head) . (flip (.) . (. head))))) . ((.) . uncurry)
 
nub' :: Eq a => [a] -> [a]
nub' = snd . head . s (filter . ((. fst) . ((==) . null)))
                      (s ((:) . (,) True)
                         ((:[]) . (,) False . s ((:) . head)
                                                (nub' . s (filter . (/=) . head) tail)))

_ 追記 こちらの方が短い。(http://d.hatena.ne.jp/m-a-o/より)

s = (((. head . uncurry zip . splitAt 1 . repeat) . uncurry) .) . (.) . flip

_ 昨日の続き。木を一度しか走査せずに目的を達成するには、リストの左から右に acc を動かして、帰りに蓄積結果を使って map すればいい?

mapAccumLRT f g a (Node x []) = (f a x, Node (g a x) [])
mapAccumLRT f g a (Node x ts)
    = let (a', ts') = mapAccumLR ((fst .) . h) ((snd .) . h) (f a x) ts
          h = mapAccumLRT f g
      in (a', Node (g a' x) ts')
 
mapAccumLR f g a [] = (a, [])
mapAccumLR f g a (x:xs) = let (a', ys) = mapAccumLR f g (f a x) xs
                          in (a', (g a' x):ys)
 
normalize t@(Node x _) = snd $ mapAccumLRT min (flip (/)) x t

_ 実際に木を構成しているポインタを辿るのをカウントすると考えるといいか、と思ったけど、それじゃあ木をコピーしてからアクセスし放題だしなあ…

_ 参: Haskellのある暮らし

_

_ 今日の一行 から [quiz] リスト要素の正規化

_ Scheme でツリー構造に対する fold とか map を書いてみる。 foldT1 はツリーの最左末端が () だと死亡する。末端には要素があることが前提。

(use srfi-1)
 
(define (foldT f a t)
  (if (pair? t)
      (receive (x y) (car+cdr t)
               (foldT f (foldT f a x) y))
      (if (null? t) a (f a t))))
 
(define (foldT1 f t)
  (if (pair? t)
      (receive (x y) (car+cdr t)
               (foldT f (foldT1 f x) y))
      (if (null? t) #f t)))
 
(define (mapT f t)
  (if (pair? t)
      (receive (x y) (car+cdr t)
               (cons (mapT f x) (mapT f y)))
      (if (null? t) t (f t))))

(define (norm t)
  (let1 m (foldT1 min t)
        (mapT (lambda (x) (/ x m)) t)))
 
(display (norm '(9 (3 12 (3 15)) 27 (6 (18 15)))))
(newline)

_ Haskell だとこう。

import Data.Tree
import Data.Foldable as F
 
normalize t = fmap (/ F.minimum t) t

_ CYCLE MODE 2006 に行って以来、ロードレーサーが欲しくなりました。