# Scheme どう書く？的

```'(1 3 4 5 6 12 13 15)
```

このようなリストで数が連続している部分は '(1 2 3) -> '(1 . 3) のように両端のみを書くような記法を導入する。

```'(1 (3 . 6) (12 . 13) 15)
```

このようなリストの変換をするコードを書きたい。

```(define (compact-number-list lst)
(define (exact-next-number? a b)
(cond
[(and (number? a) (number? b))
(= (- b a) 1)]
[(and (pair? a) (number? b))
(exact-next-number? (cdr a) b)]))
(define (make-range a b)
(cond
[(and (number? a) (number? b))
(cons a b)]
[(and (pair? a) (number? b))
(cons (car a) b)]))
(let loop ([numbers lst]
[ret '()])
(cond
[(null? numbers) (reverse ret)]
[(and (pair? ret) (exact-next-number? (car ret) (car numbers)))
(loop (cdr numbers)
(cons (make-range (car ret) (car numbers)) (cdr ret)))]
[else
(loop (cdr numbers) (cons (car numbers) ret))])))

(compact-number-list '(1 3 4 5 6 12 13 15))
```

#### shiro さんによる

```(define (compact-number-list lis)
(define (scan xs prev head r)
(cond [(null? xs) (reverse (push prev head r))]
[(not prev) (scan (cdr xs) (car xs) (car xs) r)]
[(= (car xs) (+ prev 1)) (scan (cdr xs) (car xs) head r)]
[else (scan (cdr xs) (car xs) (car xs) (push prev head r))]))
(define (push prev head r)
(if (= prev head) `(,head ,@r) `((,head . ,prev) ,@r)))
(scan lis #f #f ’()))
```

#### id:reiroさんによる Scala 版

```  case class R(s: Int,e: Int)
case class N(n: Int) extends R(n,n)

def f( input: List[R] ): List[R] = input match {
case R(c1,c2)::N(c3)::cdr if(c2+1==c3) => f(R(c1,c3)::cdr)
case car::cdr => car::f(cdr)
case r => r
}

println(f((1::3::4::5::6::12::13::15::Nil)map(N(_))))```

#### id:athosさんによる

すっきりですね。

```(define (compact-number-list ls)
(define (loop start n ls ns)
(cond [(or (null? ls) (not (= (+ n 1) (car ls))))
(rec ls (acons start n ns))]
[else (loop start (+ n 1) (cdr ls) ns)]))
(define (rec ls ns)
(cond [(or (null? ls) (null? (cdr ls)))
(reverse (append ls ns))]
[(= (cadr ls) (+ (car ls) 1))
(loop (car ls) (cadr ls) (cddr ls) ns)]
[else (rec (cdr ls) (cons (car ls) ns))]))
(rec ls '()))
```

#### id:fujita-y さんによる

syntax-case のパターンマッチをうまく利用しています。
そういえば '[] という書き方は初めて見た気がする。合法ですが新鮮。

```; datum definition from Chez Scheme User's Guide
(define-syntax datum (syntax-rules () [(_ t) (syntax->datum (syntax t))]))

(define (compact-number-list x)
(let loop ((x (cons '[] x)))
(syntax-case x ()
(([(lo . hi) r ...] new more ...)
(if (= (datum new) (+ (datum hi) 1))
(loop (datum ([(lo . new) r ...] more ...)))
(loop (datum ([(new . new) (lo . hi) r ...] more ...)))))
(([] new more ...) (loop (datum ([(new . new)] more ... ))))
((ans) (reverse (map (lambda (e) (if (= (car e) (cdr e)) (car e) e))
(datum ans)))))))

(compact-number-list '(1 3 4 5 6 12 13 15))
=> (1 (3 . 6) (12 . 13) 15)
```

#### id:Gemmaさんによる

Gauche の group-sequence を利用した例。
なるほど delta1 のものは同じグループですよと。

```(use srfi-1)
(use gauche.sequence)

(define (group-number-list l)
(define (delta1? knil)
(let ((prev knil))
(lambda (a _)
(begin0
(= (+ prev 1) a)
(set! prev a)))))

(map (lambda (x)
(if (and (pair? x) (null? (cdr x)))
(car x)
(cons (car x) (last x))))
(group-sequence l :test (delta1? (car l)))))
```

Clojure 版。
assert を書いていて偉い。

```(defn
#^{:doc "整列済みの number のリストで、'(1 3 4 5 6 12 13 15)
リスト内で数が連続している部分は '(1 2 3) -> '(1 . 3) のように両端のみのリストに纏める。

'(1 (3  6) (12  13) 15)"
:test (do (test= (group-number-list '(1 3 4 5 6 12 13 15))
'(1 (3 6) (12 13) 15))
(test= (group-number-list []) [] )
(test= (group-number-list [1 1 1 1 1 1 1]) [1 1 1 1 1 1 1]))}
; -----------------
group-number-list [coll]
; -----------------
(assert (every? number? coll))
(loop [coll (reverse (cons (gensym) coll)), tem [], acc [] ]
(let [[car & cdr] coll, [temcar & temcdr] tem]
(cond (empty? coll)
acc
;;
(or (empty? tem)
(= car (- temcar 1)))
(recur cdr (cons car tem) acc)
;;
:else
(recur cdr
(list car)
(cons (if temcdr (list temcar (last tem)) temcar)
acc))))))

(defmacro test= [expr val]
`(do (assert (= ~expr ~val))))
```

#### id:chanmanaさんによる

```(define (compact-number-list lst)
(define (skip-to-end l)
(if (null? (cdr l))
l
(if (= (+ 1 (car l)) (cadr l))
(skip-to-end (cdr l))
l)))
(if (null? lst)
'()
(let ([beg (car lst)]
[r   (skip-to-end lst)])
(cond [(null? r)       lst]
[(= beg (car r)) (cons beg (compact-number-list (cdr r))) ]
[else            (cons (cons beg (car r)) (compact-number-list (cdr r)))]))))
```

#### id:nobsun による

```compactNumberList :: (Enum a, Eq a) => [a] -> [[a]]
compactNumberList [] = []
compactNumberList (x:xs) = reverse \$ foldl f [[x]] xs
where f a@(b:bs) y = case (head b,last b) of
(p,q) | succ q == y -> [p,y]:bs
_                   -> [y]:a
```

#### id:katona さん

```(use util.match)
(define f (match-lambda
(() ())
((x . xs) (let1 p (lambda (y) (and (number? y) (= (- y x) 1)))
(match (f xs) ((((? p y) . z) . r) (cons (cons x z) r))
(((? p y) . r)       (cons (cons x y) r))
(r                   (cons x r)))))))
```

#### hasukerudesuさん

```compactNumberList = map (￥(x,y) -> x:[y|x/=y]) . foldr c []
where
c x ((a,b):ls) | succ x == a = (x,b):ls
c x ls = (x,x):ls```

#### irieさんによる

Emacs Lisp
nil が false ってのは意外と良いかもしれない。

```(defun compact-number-list (seq)
(if seq
(let ((1st (car seq))
(if (eq (1+ (or (cdr-safe 1st) 1st)) 2nd)
(compact-number-list
(cons (cons (or (car-safe 1st) 1st) 2nd) (cddr seq)))
(cons 1st (compact-number-list (cdr seq)))))))
```

#### shinhさんによる

さすがゴルファー。

```o = [1, 3, 4, 5, 6, 12, 13, 15]

\$_=o*','
o.map{|v|sub(/#{v-1}(.)?,(#{v})|.*\d\$/){\$1?\$2+\$1:"[#\$&]"}}
p eval\$_
```

#### id:quekさん

これが噂のループマクロ？

```(defun compact-number-list (lst)
(loop for (a b) on lst
with s = (car lst)
unless (eql (1+ a) b)
collect (prog1 (if (= s a)
a
(cons s a))
(setf s b))))
```

#### naoya_tさんによる

```(use srfi-1)
(define (compact-number-list lst)
(define (span p)
(if (pair? p)
(let ((from (car p)) (to (cdr p)))
(iota (+ (- to from) 1) from))
(list p)))
(let loop ((rest lst) (result '()))
(if (null? rest)
result
(loop (cdr rest) (append result (span (car rest)))))))
```

#### id:scinfaxi さんによる

```(use gauche.sequence)
;; or (use complex-iterator)

(define (compact-number-list r)
(reverse
(fold2
(lambda (c r p)
(values
(if (= c (+ p 1))
r
(list* c (if (= #0=(car r) p) p (cons p #0#)) #1=(cdr r)))
c))
`(,#0#) #0# #1#)))

#?=(compact-number-list '(1 3 4 5 6 12 13 15))
;; => (1 (6 . 3) (13 . 12) 15)
```

#### id:CortYumingさん

```#!/usr/bin/env python
# *-# -*- coding: utf-8 -*-

def division_num_list(lst):
div_lst = []
previouns_num = lst[0]
tmp_lst = [lst[0]]
for num in lst[1:]:
if num == previouns_num + 1:
tmp_lst.append(num)
else:
div_lst.append(tmp_lst)
tmp_lst = [num]
previouns_num = num
else:
if tmp_lst:
div_lst.append(tmp_lst)
return div_lst

def number_range_list(lst):
result_lst = []
for seq in lst:
if len(seq) == 1:
result_lst.append(seq[0])
if len(seq) > 1:
result_lst.append([seq[0],seq[-1]])
return result_lst

def compact_number_list(lst):
div_lst = division_num_list(lst)
return number_range_list(div_lst)

if __name__ == '__main__':
lst = [1, 3, 4, 5, 6, 12, 13, 15]
print compact_number_list(lst)
```

#### id:nihaさんによる

ゴルファー

```o = [1,3,4,5,6,12,13,15]
r=[];(o+[nil]).inject{|a,b|s,t=a;b==1+(t||s)?[s,b]:(r<<a;b)}
```

#### id:KeisukeNakanoさんによる

```a=[1,3,4,5,6,12,13,15]
a.map{|e|x,y=\$*[-1];e-1==(y||x)?\$*[-1]=[x,e]:\$*<<e};p\$*
```

#### id:iRiEさんによる

OCaml

```let compact_number_list list =
List.fold_right
(fun n -> function
(x :: y) :: p when x = n + 1 ->
(n :: if y = [] then [x] else y) :: p
| r ->  [n] :: r)
list [];;

compact_number_list [1; 3; 4; 5; 6; 12; 13; 15];;
```