リスト（配列）の中で隣り合う同じ値をグループ化する(2)

こないだのやつを Scheme と Haskell でやってみた。

まずは Scheme 版。

(define adjacent-group
  (lambda (lis)
    (let loop ((l (cdr lis)) (c (car lis)) (r (cons (list (car lis)) '())))
      (if (null? l)
          (reverse (map reverse r))
          (if (= (car l) c)
              (loop (cdr l) c (cons (cons (car l) (car r)) (cdr r)))
              (loop (cdr l) (car l) (cons (list (car l)) r)))))))

(print (adjacent-group '(1 1 2 2 3 1 1)))

^o^ >gosh adjacent-group.scm
((1 1) (2 2) (3) (1 1))

基本的な考え方は、Ruby や Python のと同じ。ちょっと工夫したのは、先頭の要素を最初から結果のリストに入れたこと。これで分岐条件が１つ減った。
……のはいいんだけど、これって引数に空リストが来た時のことが考えられてないじゃないか。まあ、グループ化しようというんだから空リストは考えなくてもいいか……ホントか？

さて、Haskell 版。こっちはちゃんと空リストが来ても大丈夫（実行例は示さないけど）。

adjacentGroup :: [Int] -> [[Int]]
adjacentGroup [] = []
adjacentGroup (x:xs) = reverse $ map reverse $ foldl f [[x]] xs
  where
    f (y:ys) z = if head y == z
                 then (z:y):ys
                 else (z:[]):y:ys

main :: IO()
main = print $ adjacentGroup [1, 1, 2, 2, 3, 1, 1]

^o^ >runhaskell adjacentGroup.hs
[[1,1],[2,2],[3],[1,1]]

[追記](9/27)

Scheme 版を空リスト対応にした。分岐条件が１つ増えた。

(define adjacent-group
  (lambda (lis)
    (let loop ((l lis) (c (undefined)) (r '()))
      (if (null? l)
          (reverse (map reverse r))
          (cond
            ((undefined? c) (loop (cdr l) (car l) (cons (list (car l)) r)))
            ((= (car l) c) (loop (cdr l) c (cons (cons (car l) (car r)) (cdr r))))
            (else (loop (cdr l) (car l) (cons (list (car l)) r))))))))

(print (adjacent-group '(1 1 2 2 3 1 1)))
(print (adjacent-group '()))

^o^ >gosh adjacent-group2.scm
((1 1) (2 2) (3) (1 1))
()

[さらに追記](9/28)

分岐条件を工夫して2つに減らせた。cond じゃなく if になった。

(define adjacent-group
  (lambda (lis)
    (let loop ((l lis) (c (undefined)) (r '()))
      (if (null? l)
          (reverse (map reverse r))
          (if (and (not (undefined? c)) (= (car l) c))
              (loop (cdr l) c (cons (cons (car l) (car r)) (cdr r)))
              (loop (cdr l) (car l) (cons (list (car l)) r)))))))

(print (adjacent-group '(1 1 2 2 3 1 1)))
(print (adjacent-group '()))

^o^ > gosh adjacent-group3.scm
((1 1) (2 2) (3) (1 1))
()