Scheme どう書く?的

整列済みの number のリストがある。

'(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)))))

g:cadr:id:g000001さんによる

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))
            (2nd (cadr 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さん

Python!

#!/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];;