[1,2,3,4,5] が与えられたとき [[1,2][2,3][3,4][4,5]] を返すような関数を定義せよ

追記あり

---

リスト処理の問題。

1. (1 2 3 4 5) が与えられたとき ((1 2)(2 3)(3 4)(4 5)) を返すような関数を定義せよ
2. 1 の関数を拡張して、(0 1 2 3 4 5 6 7 8 9) と 2 が与えられたとき ((0 1)(1 2)(2 3)(3 4)(4 5)(5 6)(6 7)(7 8)(8 9)) を、(0 1 2 3 4 5 6 7 8 9) と 3 が与えられたとき ((0 1 2) (2 3 4) (4 5 6) (6 7 8) (8 9)) を、(0 1 2 3 4 5 6 7 8 9) と 4 が与えられたとき ((0 1 2 3) (3 4 5 6) (6 7 8 9)) を返すような関数を定義せよ

1

英語が弱いと関数の名前付けに苦労しますね。。適当英語でｽﾏｿ。

;; example 1
;; (0 1 2 3 4 5 6 7 8 9)
;; -> ((0 1) (1 2) (2 3) (3 4) (4 5) (5 6) (6 7) (7 8) (8 9))
;; example 2
;; (a b c d e f g h i j k l m n o p q r s t u v w x y z)
;; -> ((a b) (b c) (c d) (d e) (e f) (f g) (g h) (h i) (i j) (j k) (k l) (l m) (m n) (n o) (o p) (p q) (q r) (r s) (s t) (t u) (u v) (v w) (w x) (x y) (y z))

(use util.list :only (slices))
(use srfi-1)

(define (duplicate-without-edge ls)
  (define tail? (cut equal? <> (last-pair ls)))
  (if (or (null? ls)(tail? ls))
      ls
      (cons (car ls)
            (pair-fold-right
             (^ (pr acc)
                (cons (car pr)
                      (if (tail? pr)
                          acc
                          (cons (car pr) acc))))
             '() (cdr ls)))))

(define (overlap-slices ls)
  (slices (duplicate-without-edge ls) 2))

実行結果。

(overlap-slices (iota 5))
;; -> ((0 1) (1 2) (2 3) (3 4))
(overlap-slices (iota 10))
;; -> ((0 1) (1 2) (2 3) (3 4) (4 5) (5 6) (6 7) (7 8) (8 9))

(use srfi-14)
(define alphabet (map (compose string->symbol (pa$ x->string))
                      (reverse (string->list (char-set->string #[a-z])))))
(overlap-slices alphabet)
;; -> ((a b) (b c) (c d) (d e) (e f) (f g) (g h) (h i) (i j) (j k) (k l) (l m) (m n) (n o) (o p) (p q) (q r) (r s) (s t) (t u) (u v) (v w) (w x) (x y) (y z))

2

初めは、1 の定義を基に考えていましたが、named let の方が簡単でスッキリしました。効率とかは考えてません。

;; example 1
;; (0 1 2 3 4 5 6 7 8 9) 2
;; -> ((0 1) (1 2) (2 3) (3 4) (4 5) (5 6) (6 7) (7 8) (8 9))
;; example 2
;; (0 1 2 3 4 5 6 7 8 9) 3
;; -> ((0 1 2) (2 3 4) (4 5 6) (6 7 8) (8 9))
;; example 3
;; (0 1 2 3 4 5 6 7 8 9) 4
;; -> ((0 1 2 3) (3 4 5 6) (6 7 8 9))
;; example 4
;; (0 1 2 3 4 5 6 7 8 9) 5
;; -> ((0 1 2 3 4) (4 5 6 7 8) (8 9))
;; example 5
;; (0 1 2 3 4 5 6 7 8 9) 6
;; -> ((0 1 2 3 4 5) (5 6 7 8 9))
;; example 6
;; (a b c d e f g h i j k l m n o p q r s t u v w x y z)
;; -> ((a b c d e f g h i j) (j k l m n o p q r s) (s t u v w x y z))

(define (overlap-slices ls n)
  (let rec ((ls ls)(acc '()))
    (if (<= n (length ls))
        (receive (head tail)
            (split-at ls n)
          (rec (cons (last head) tail)(append acc head)))
        (slices (if (equal? ls (last-pair ls))
                    acc
                    (append acc ls)) n))))

実行結果。

(overlap-slices (iota 10) 2)
;; -> ((0 1) (1 2) (2 3) (3 4) (4 5) (5 6) (6 7) (7 8) (8 9))
(overlap-slices (iota 10) 3)
;; -> ((0 1 2) (2 3 4) (4 5 6) (6 7 8) (8 9))
(overlap-slices (iota 10) 4)
;; -> ((0 1 2 3) (3 4 5 6) (6 7 8 9))
(overlap-slices (iota 10) 5)
;; -> ((0 1 2 3 4) (4 5 6 7 8) (8 9))
(overlap-slices (iota 10) 6)
;; -> ((0 1 2 3 4 5) (5 6 7 8 9))
(use srfi-14)
(define alphabet (map (compose string->symbol (pa$ x->string))
                      (reverse (string->list (char-set->string #[a-z])))))
(overlap-slices alphabet 10)
;; -> ((a b c d e f g h i j) (j k l m n o p q r s) (s t u v w x y z))

そういえば、L-99 もやりかけでしたな。。

• vallog: L-99

追記

1 についていろいろ反応が。

• Twitter / いわた: @valvallow (define (x l) ( ...

(define (x l)
  (map list (drop-right l 1) (cdr l)))

• Twitter / 初音ミク: 拡張考えなきゃこの程度でイイとは思うんだけどね。 ...

(define (hoge ls)
　(let loop ((ls0 ls) (ls1 (cdr ls)) (acc '()))
　　(if (null? ls1)
　　　　(reverse acc)
　　　　(loop (cdr ls0) (cdr ls1) (cons `(,(car ls0) ,(car ls1)) acc)))))

• Twitter / わさびず: とりあえず1だけ。 (define (func x) ...

(define (func x)
  (if (>= (length x) 2)
      (cons (take x 2)
            (func (drop x 1))) ()))

• Twitter / わさびず: @valvallow (define (f x a) ...

(define (f x a)
  (if (>= (length x) 2)
      (f (drop x 1) (cons (take x 2) a))
      (reverse a)))

• Twitter / SaitoAtsushi: @valvallow srfi-1 の map であ ...

(define(overlap-slices ls)
  (map list ls(cdr ls)))

• Twitter / SaitoAtsushi: @valvallow srfi-1 がアリなら zi ...

(define(overlap-slices ls)
  (zip ls(cdr ls)))

• Twitter / podhmo: @valvallow 今更だけれど、こんなんどうです ...
• Twitter / podhmo: @valvallow あ、そっか。(define ( ...
• 某所での問題の回答 - podhmoの日記

(define (overlaps xs n)
  (unfold null? (cut take* <> n)
          (cute drop* <> (- n 1)) xs))

• Re: [1,2,3,4,5] が与えられたとき 1,2][2,3][3,4][4,5? を返すような関数を定義せよ - Life is very short
• (1 2 3 4 5)が与えられたとき( (1 2) (2 3) (3 4) (4 5) )を返すような関数の定義 - tmurataの日記
• やってみた: (1 2 3 4 5)が与えられたとき( (1 2) (2 3) (3 4) (4 5) )を返すような関数の定義 - ボクは算数以外しか出来なかった
• k16's note: drop して take すればリストに窓が開く
• Twitter / cranebird KT: 多分既出 (1 2 3 4 5) から ((1 2) ...

2 についてのこの解答、すごくエレガント！というか美しい。

• 某所での問題の回答 - podhmoの日記

(それぞれ srfi-1 や util.list などが必要になったりしますね)

いやー勉強になりました。
私の解答が残念過ぎて恥ずかしい。

追記2

かっけぇー！

• Twitter / くだだだだー: @valvallow zip といえば、僕は転置行列 ...

(define (transpose m)
  (apply map list m))

(transpose '((0 1 2 3)(4 5 6 7)(8 9 10 11)(12 13 14 15)))
;; -> ((0 4 8 12) (1 5 9 13) (2 6 10 14) (3 7 11 15))