リスト処理の問題。
- (1 2 3 4 5) が与えられたとき ((1 2)(2 3)(3 4)(4 5)) を返すような関数を定義せよ
- 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 もやりかけでしたな。。
追記
1 についていろいろ反応が。(define (x l) (map list (drop-right l 1) (cdr l)))
(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)))))
(define (func x) (if (>= (length x) 2) (cons (take x 2) (func (drop x 1))) ()))
(define (f x a) (if (>= (length x) 2) (f (drop x 1) (cons (take x 2) a)) (reverse a)))
(define(overlap-slices ls) (map list ls(cdr ls)))
(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 についてのこの解答、すごくエレガント！というか美しい。
(それぞれ srfi-1 や util.list などが必要になったりしますね)
いやー勉強になりました。
私の解答が残念過ぎて恥ずかしい。
追記2
かっけぇー！(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))
