?

Log in

group - Жить не можем без проблем! [entries|archive|friends|userinfo]
Жить не можем без проблем!

[ userinfo | livejournal userinfo ]
[ archive | journal archive ]

group [Feb. 17th, 2012|09:22 am]
Жить не можем без проблем!

ru_lisp

[incogn1too]
Доброго времени суток. Нужна была функция, которая группирует список группами по несколько элементов. Получился не совсем красивый велосипед. Никто из сообщества не поделиться более элегантным решением?

(define (group lst n)
  (define (group2 n2 lst2 group grouped)
    (cond ((<= (length lst2) n2) (append grouped (list lst2)))
             ((= n2 0) (group2 n lst2 '() (append grouped (list (reverse group)))))
             (else (group2 (- n2 1) (mcdr lst2) (cons (car lst2) group) grouped))))
  (group2 n lst '() '() ))

[UPD] Спасибо всем за ответы. В комментариях подали идею сделать более функциональную реализацию. Получилось что-то такое:

(define (split n lst)
  (map (lambda(x)(take n x))
    (append (list lst) (reverse (cdr
      (unfold (lambda(x)(drop n x)) lst empty?) )))))

(define (unfold func init pred)
  (define (unfold2 func init pred res)
    (let ((x (func init)))
      (if (pred init)
      res
  (unfold2 func x pred (cons x res) ))))
  (unfold2 func init pred '()))

 (define (drop n lst)
  (if (or (= n 0) (empty? lst))
    lst
    (drop (- n 1) (cdr lst))))

(define (take n lst)
  (define (take2 lst n res)
    (if (or (empty? lst) (= n 0)) (reverse res)
      (take2 (cdr lst) (- n 1) (cons (car lst) res))))
      (take2 lst n '()))
linkReply

Comments:
[User Picture]From: francis_drake
2012-02-17 09:28 am (UTC)
Можно по-пионерски.

(define (take-i lst i)
  (if (or (= i 0) (equal? lst '()))
    '()
    (cons (car lst) (take-i (cdr lst) (- i 1)))))

(define (drop-i lst i)
  (if (or (= i 0) (equal? lst '()))
    lst
    (drop-i (cdr lst) (- i 1))))

(define (group lst n)
  (if (or (= n 0) (equal? lst '()))
    lst
    (cons (take-i lst n)
              (group (drop-i lst n) n))))

Edited at 2012-02-17 09:29 am (UTC)
(Reply) (Thread)
[User Picture]From: francis_drake
2012-02-17 09:33 am (UTC)
А можно по-пионерски же допилить.

(define (bad-input? lst i)
  (or (equal? lst '()) (= i 0)))

(define (take-i lst i)
  (if (bad-input? lst i)
    '()
    (cons (car lst) (take-i (cdr lst) (- i 1)))))

(define (drop-i lst i)
  (if (bad-input? lst i)
    lst
    (drop-i (cdr lst) (- i 1))))

(define (group lst n)
  (if (bad-input? lst n)
    lst
    (cons (take-i lst n)
              (group (drop-i lst n) n))))
(Reply) (Parent) (Thread)
[User Picture]From: yuridichesky
2012-02-17 09:55 am (UTC)
В принципе, френсис более-менее верно идею излагает.
Вот аналогичный вариант на итерациях:
(define (head s n)
  (let loop ((s s) (n n) (res '()))
    (if (or (null? s) (zero? n)) (reverse res)
      (loop (cdr s) (1- n) (cons (car s) res)))))

(define (tail s n)
  (if (or (null? s) (zero? n)) s
    (tail (cdr s) (1- n))))

(define (group-by s n)
  (let loop ((s s) (res '()))
    (if (null? s) (reverse res)
      (loop (tail s n) (cons (head s n) res)))))

Насчет элегантности можно дискутировать, но сложность алгоритма получается линейная (vs квадратичная в вашем варианте).
(Reply) (Thread)
[User Picture]From: yuridichesky
2012-02-17 01:57 pm (UTC)
О, нашел в междуящечном пространстве:
(define (group-by s count)
  (let loop ((s s) (len (length s)) (res '()))
    (if (null? s) (reverse res)
      (let ((n (min len count)))
        (loop (drop s n) (- len n) (cons (take s n) res))))))
(Reply) (Thread)
[User Picture]From: smilga
2012-02-17 10:22 pm (UTC)
Только take и drop — нестандартные функции.
Мой вариант:

(define (group-by n l)
  (let ((gcons (lambda (g groups)
                 (if (null? g) groups (cons (reverse g) groups)))))
    (let group ((m n) (l l) (g '()) (groups '()))
      (cond ((null? l) (reverse (gcons g groups)))
            ((zero? m) (group n l '() (gcons g groups)))
            (else (group (- m 1) (cdr l) (cons (car l) g) groups))))))



Edited at 2012-02-17 10:22 pm (UTC)
(Reply) (Parent) (Thread)
[User Picture]From: yuridichesky
2012-02-18 07:54 am (UTC)
подписываюсь
(Reply) (Parent) (Thread)
[User Picture]From: smilga
2012-02-17 10:54 pm (UTC)
Да, и если входной список одноразовый, а Схема используется с мутабельными парами, то можно сделать совсем линейную версию:

(define (group-destructively-by n l)
  (let ((groups '(-)) (n- (- n 1)))
    (let dismember! ((m n-) (l l) (g l) (gg groups))
      (cond ((null? l) (and (pair? g) (set-cdr! gg (list g)))
                       (cdr groups))
            ((zero? m) (let ((l+ (cdr l)) (gg+ (list g)))
                         (set-cdr! l '())
                         (set-cdr! gg gg+)
                         (dismember! n- l+ l+ gg+)))
            (else (dismember! (- m 1) (cdr l) g gg))))))
(Reply) (Thread)
[User Picture]From: yoschi
2012-02-19 08:32 am (UTC)
Не сказал бы, что прям элегантней. По сути, твоё же, но оптимизированное решение. Не бегает каждый раз по списку, проверяя его длину, добавляя что-то к нему в конец и не делает лишних телодвижений с запаковыванием, распаковыванием списков.

(define (group lst n)
  (define (gr tail pack count accum)
    (cond
      [(null? tail) (reverse (cons (reverse pack) accum))]
      [(= count 0) (gr tail '() n (cons (reverse pack) accum))]
      [else (gr (cdr tail) (cons (car tail) pack) (sub1 count) accum)]))
  (gr lst '() n '()))

Edited at 2012-02-19 08:33 am (UTC)
(Reply) (Thread)