スマートかどうかは置いといて
http://d.hatena.ne.jp/higepon/20080925/1222326246
とりあえずCLで書いてみよう。
(defun compact (nums) (let (result) (labels ((cpush (from end) (push (if (= from end) end (cons from end)) result)) (rec (from end l) (cond ((null l) (reverse (cpush from end))) ((< (1+ end) #1=(car l)) (cpush from end) (rec #1# #1# (cdr l))) (t (rec from #1# (cdr l)))))) (rec #2=(car nums) #2# (cdr nums))))) (defun expand (l) (mapcan #'(lambda (n) (if (consp n) (loop for i from (car n) to (cdr n) collect i) (list n))) l)) (expand (print (compact '(1 3 4 5 6 12 13 15))))
結果
(1 (3 . 6) (12 . 13) 15) (1 3 4 5 6 12 13 15)
折角なのでloopマクロでもやってみる。
(defun compact2 (nums) (flet ((con (a b) (if (= a b) a (cons a b)))) (loop with a = (car nums) with b = a for n in (cdr nums) when (< (1+ b) n) collect (con a b) into result and do (setf a n) do (setf b n) finally (return `(,@result ,(con a b)))))) (compact2 '(1 2 3 5 6 12 14 15 16))
地味なコードになった。
into resultとfinally以下をなくしてfletも消せないかと考えてみたけど、
(defun compact3 (nums) (loop with a = (car nums) with b = a for n in `(,@(cdr nums) ,(+ 2 (car (last nums)))) when (< (1+ b) n) collect (if (= a b) a (cons a b)) and do (setf a n) do (setf b n)))
このforはないよな…
詰め込んでみる
;recursive (defun c1(x)(labels((f(a b l r)(cond((not a)r)((>(1-(or #1=(car l)(+ b 2)))b) (f #1# #1#(cdr l)(push(if(= a b)b(cons a b))r)))(t(f a #1#(cdr l)r)))))(reverse (f #2=(car x)#2#(cdr x)nil)))) ;loop (defun c2(x)(reverse(do*((l x(cdr l))(n(car l)(car l))(a n)(b n)(r))((not a)r) (when(>(1-(or n(+ b 2)))b)(push(if(= a b)b(cons a b))r)(setf a n))(setf b n)))) ;expand (defun x(l) (mapcan(lambda(n)(if(atom n)`(,n)(loop for i from(car n)to(cdr n)collect i)))l)) (print(c2(x(print(c1(print(x'(1 (3 . 6) (12 . 13) 15))))))))
再帰版はshiroさんのコードと殆ど同じになった?
ループ版はもっと違うやり方がありそう。
for on
quekさんの回答が色々参考になった。
mapconとか使ってみようかと考えてみたが短くならない。