group

[incogn1too]

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

(define (group lst n)
  (define (group2 n2 lst2 group grouped)
    (cond ((<= (length lst2) n2) (append grouped (list lst2

Comments

[francis_drake]

Можно по-пионерски.

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

[francis_drake]

А можно по-пионерски же допилить.

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

[yuridichesky]

В принципе, френсис более-менее верно идею излагает.
Вот аналогичный вариант на итерациях:

(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 квадратичная в вашем варианте).

[yuridichesky]

О, нашел в междуящечном пространстве:

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

[smilga]

Только 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))))))

[yuridichesky]

подписываюсь

[smilga]

Да, и если входной список одноразовый, а Схема используется с мутабельными парами, то можно сделать совсем линейную версию:

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

[yoschi]

Не сказал бы, что прям элегантней. По сути, твоё же, но оптимизированное решение. Не бегает каждый раз по списку, проверяя его длину, добавляя что-то к нему в конец и не делает лишних телодвижений с запаковыванием, распаковыванием списков.

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