Avatar

Tested on MzScheme

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
;; Turns a flat-list into a list of n-sized lists
;; Examples:
;;   (group-by '(1 2 3 4) 2) => ((1 2) (3 4))
;;   (group-by '(a b c d) 3) => ((a b c) (d))
;;   (group-by '(a b c d) 1) => ((a) (b) (c) (d))
;;   (group-by '(a b c d) 4) => ((a b c d))
;;   (group-by '(a b c d e f 1 2 3 4 5 6) 7) => (a b c d e f 1) (2 3 4 5 6))

(define (group-by x n)
  (let loop ((x x) (grouped '()) (current '()) (i 0))
    (if (null? x)
	(reverse (cons (reverse current) grouped))
	(if (= i n)
	    (loop x (cons (reverse current) grouped) '() 0)
	    (loop (cdr x) grouped (cons (car x) current) (+ i 1))))))

Refactorings

No refactoring yet !

5a00a3a98dcf6f9cd717440fd2b606e5

Eineki

December 22, 2007, December 22, 2007 01:38, permalink

No rating. Login to rate!

What do you think of this refactoring?
No "let and loop", just use of ambients and recursion as functional programming should do.
I don't use tail recursion to optimize memory usage

Sorry if you find the code scholastic but my last scheme program
dates several eons ago :)

I just tested in drscheme, I think it is

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
;; get the firt n element from a list
;; parameter:
;;     l -> list to split
;;     n -> elements to put in the first list
;;     acc -> memory for the forward recursion. It have to starts '()
;; return a list splitted in two:
;;     car -> a list o first n elements
;;     cdr -> a list contaings the remainder

(define (split-aux l n acc)
  (cond
    ((empty? l) (list acc '()))
    ((= n 1)    (cons (append acc (list (first l))) (list (rest l))))
    (else (split-aux (rest l) (- n 1) (append acc (list (first l)))))
    )
  )

;; auxiliary function of group, split a flat list into n-sized lists

(define (group-aux l n lacc)
  (local 
      ((define temp (split-aux l n '())))
      (cond
        ((empty? (first (rest temp))) (append lacc (list (first temp))))
        (else (group-aux (first (rest temp)) n (append lacc (list (first temp)))))
        )
   )
)
;; group-by frontend, check the parameters (poorly) and 
;; if they are ok pass them on group-aux

(define (group-by l n) 
  (cond 
    ((< n 1) "error n > 0") 
    (else (group-aux l n '()))
  )
)
;;  **** TESTS ****    
;; (group-by '(1 2 3 4 5 6) 0)
;; (group-by '(a b c d e f 1 2 3 4 5 6) 7)
;;
;;   (group-by '(1 2 3 4) 2) => ((1 2) (3 4))
;;   (group-by '(a b c d) 3) => ((a b c) (d))
;;   (group-by '(a b c d) 1) => ((a) (b) (c) (d))
;;   (group-by '(a b c d) 4) => ((a b c d))
;;   (group-by '(a b c d e f 1 2 3 4 5 6) 7) => (a b c d e f 1) (2 3 4 5 6))
Avatar

jsmcgd

May 24, 2008, May 24, 2008 13:30, permalink

No rating. Login to rate!

It isn't tail recursive and not sure how robust it is but it works.

1
2
3
4
5
6
7
8
9
10
(defun group-by (lst n)
  (cond ((null lst) nil)
	(t (cons (first-n n lst)
	   (group-by (nthcdr n lst) n)))))
       
(defun first-n (n x)
  (if (or (= n 0)(null x))
      nil
      (cons (car x)
	    (first-n (1- n) (cdr x)))))
729442eea8d8548842a6e0947e333c7b

Chris Jester-Young

June 23, 2008, June 23, 2008 10:59, permalink

No rating. Login to rate!

Here's a very cheap answer that uses SRFI 1. :-P

About the predicate ensuring that the list has more than n elements left:

1. The "take"/"drop" functions fail if there aren't at least n elements in the list being processed. Unfortunately, all the "length" calls do not make the code particularly fast, especially if the list is long.

2. It's safe to change the (<= (length l) n) into (< (length l) n), so that the loop continues one last time when (length l) is n. However, the tail-generator code would then append an empty list, which is outside the spec. Solving it in that case would require complicating the tail generator, and I was going for simplest answer here.

I'll see if I can code up a faster version. But meanwhile, here's a very concise version. :-)

SRFI 1-based implementation

1
2
3
4
5
6
7
8
9
10
11
12
;; To activate SRFI 1:
;; MzScheme 372: (require (lib "1.ss" "srfi"))
;; MzScheme 4.0: (require srfi/1)
;; Guile: (use-modules (srfi srfi-1))

(define (group-by x n)
  (unfold
    (lambda (l) (<= (length l) n))
    (lambda (l) (take l n))
    (lambda (l) (drop l n))
    x
    list))
729442eea8d8548842a6e0947e333c7b

Chris Jester-Young

June 25, 2008, June 25, 2008 17:36, permalink

No rating. Login to rate!

Here is a demonstration of the kinds of madness one can get up to in the name of "performance". Of course, I personally prefer the shorter, simpler, and clearer code listed in my previous submission.

This implementation uses a variant of "split-at!" (returning the results as a dotted pair instead of multiple values, as well as allowing the list to be shorter than the split point). It's faster in two ways: for long lists, because there are no calls to "length"; and for large group size, because the use of "split-at!" (or variant) means only one traversal, rather than one for each of "take" and "drop". Oh, and it also mutates the incoming list, to avoid making any copies.

This way lies madness

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
(define (split-at-or-earlier! x i)
  (let 
      ((dummy (cons #f x)))
    (let loop
        ((cur dummy) (rem i))
      (if
        (or (zero? rem) (null? (cdr cur)))
        (let 
            ((tail (cdr cur)))
          (set-cdr! cur '())
          (cons (cdr dummy) tail))
        (loop (cdr cur) (- rem 1))))))

(define (group-by x n)
  (let
      ((split! 
        (lambda (l) 
          (split-at-or-earlier! l n))))
    (unfold
      (lambda (p) (null? (car p)))
      car
      (lambda (p) (split! (cdr p)))
      (split! x))))
729442eea8d8548842a6e0947e333c7b

Chris Jester-Young

June 29, 2008, June 29, 2008 09:33, permalink

No rating. Login to rate!

The function can be made even shorter by using the cut functionality in SRFI 26. :-)

Even more succinct, with SRFI 1 and SRFI 26

1
2
3
4
5
6
7
(define (group-by x n)
  (unfold
    (lambda (l) (<= (length l) n))
    (cut take <> n)
    (cut drop <> n) 
    x
    list))

Your refactoring





Format Copy from initial code

or Cancel