············@gmail.com wrote:
> The code is not pretty(and/or efficient I think)because it's still a
> bit hard for me to write a pretty and efficient code.
>
>
> (defun list-combination (total-list collect-number)
> "Usage : (list-combination '(1 2 3) 0) -> nil
> (list-combination '(1 2 3) 1) -> ((1) (2) (3))
> (list-combination '(1 2 3) 2) -> ((1 2) (1 3) (2 3))
> (list-combination '(1 2 3) 3) -> ((1 2 3))
> (list-combination '(1 2 3) 4) -> nil"
> (let ((length_ (length total-list))
> (car_ (car total-list))
> (cdr_ (cdr total-list)))
> (cond ((< length_ collect-number) nil)
> ((zerop collect-number) nil)
> ((null car_) nil)
> ((null cdr_) (list (list car_)))
> (t (append
> (or (loop for i in (list-combination cdr_ (1-
> collect-number))
> collect (cons car_ i))
> (list (list car_)))
> (and (> length_ collect-number)
> (list-combination cdr_ collect-number)))))))
>
> (defun number-combination (total-number collect-number)
> "Usage : Create a number list from 1 to total-number
> for list-combination to use"
> (let ((list_ (loop for i from 1 to total-number
> collect i)))
> (list-combination list_ collect-number)))
the presence of too many special cases is an indication that there
might be something wrong with what you want your code to do...
in your case.. you want (list-combination '(1 2 3) 0) to return nil...
but if you think about it, the *right* answer should be (nil)...
because there /is/ one combination of zero elements, which is nil...
and since your function returns a list of combinations, it should
return (nil).
with this change.. the function can be written a little more compactly
as:
(defun list-combination (a r)
(let ((len (length a))
(head (first a)))
(cond ((< len r) nil)
((zerop r) (list nil))
(t (nconc
(loop :for x :in (list-combination (rest a) (1- r))
:collect (cons head x))
(list-combination (rest a) r))))))
cheers
[sreeram;]
·············@gmail.com" <············@gmail.com> writes:
> The code is not pretty(and/or efficient I think)because it's still a
> bit hard for me to write a pretty and efficient code.
>
>
> (defun list-combination (total-list collect-number)
> "Usage : (list-combination '(1 2 3) 0) -> nil
> (list-combination '(1 2 3) 1) -> ((1) (2) (3))
> (list-combination '(1 2 3) 2) -> ((1 2) (1 3) (2 3))
> (list-combination '(1 2 3) 3) -> ((1 2 3))
> (list-combination '(1 2 3) 4) -> nil"
> (let ((length_ (length total-list))
> (car_ (car total-list))
> (cdr_ (cdr total-list)))
> (cond ((< length_ collect-number) nil)
> ((zerop collect-number) nil)
> ((null car_) nil)
> ((null cdr_) (list (list car_)))
> (t (append
> (or (loop for i in (list-combination cdr_ (1-
> collect-number))
> collect (cons car_ i))
> (list (list car_)))
> (and (> length_ collect-number)
> (list-combination cdr_ collect-number)))))))
The only think in this that seems (on the surface) to be immediately
inefficient is the use of APPEND in a recursive manner. That ends up
causing a lot of list copying, since it always has to copy the head of
the list. This can be minorly improved using NCONC instead, to avoid
the copy phase -- this is safe because the first argument always
generates new list structure.
But the way that you can improve the collection more majorly is to avoid
having to traverse the head of the list N^2 times in the first place.
This requires the use of an additional parameter, often referred to in
lisp texts as an "accumulator" parameter. This works very well in
situations where you don't really care about the order of the results,
since you can just cons onto the front.
For example, using an optional parameter for the accumulator. Another
option would be to use an auxiliary function, perhaps inside a labels
form.
(defun list-combination2 (total-list collect-number &optional (accumulator nil))
"Usage : (list-combination '(1 2 3) 0) -> nil
(list-combination '(1 2 3) 1) -> ((1) (2) (3))
(list-combination '(1 2 3) 2) -> ((1 2) (1 3) (2 3))
(list-combination '(1 2 3) 3) -> ((1 2 3))
(list-combination '(1 2 3) 4) -> nil"
(let ((length_ (length total-list))
(car_ (car total-list))
(cdr_ (cdr total-list)))
(cond ((< length_ collect-number) nil)
((zerop collect-number) nil)
((null car_) nil)
((null cdr_) (cons (list car_) accumulator))
(t (let ((sub-result (list-combination2 cdr_ (1- collect-number) nil)))
(if sub-result
(loop for i in sub-result do (push (cons car_ i) accumulator))
(push (list car_) accumulator)))
(when (> length_ collect-number)
(setq accumulator
(list-combination2 cdr_ collect-number accumulator)))
accumulator))))
Testing this for running, you will note that it is a bit faster and
generates much less garbage. In the TIME function, I use the PROGN
returning NIL so that I don't have to time the printing of the result.
USER> (setq list100 (loop for i from 1 to 100 collect i))
(1 2 3 4 5 6 7 8 9 10 ...)
USER> (time (progn (list-combination list100 2) nil))
; cpu time (non-gc) 30 msec user, 0 msec system
; cpu time (gc) 0 msec user, 0 msec system
; cpu time (total) 30 msec user, 0 msec system
; real time 32 msec
; space allocation:
; 34,553 cons cells, 0 symbols, 0 other bytes, 0 static bytes
NIL
USER> (time (progn (list-combination2 list100 2) nil))
; cpu time (non-gc) 20 msec user, 0 msec system
; cpu time (gc) 0 msec user, 0 msec system
; cpu time (total) 20 msec user, 0 msec system
; real time 21 msec
; space allocation:
; 19,802 cons cells, 0 symbols, 0 other bytes, 0 static bytes
NIL
USER> (time (progn (list-combination list100 3) nil))
; cpu time (non-gc) 870 msec user, 0 msec system
; cpu time (gc) 670 msec user, 0 msec system
; cpu time (total) 1,540 msec user, 0 msec system
; real time 1,547 msec
; space allocation:
; 1,612,249 cons cells, 0 symbols, 0 other bytes, 0 static bytes
NIL
USER> (time (progn (list-combination2 list100 3) nil))
; cpu time (non-gc) 570 msec user, 0 msec system
; cpu time (gc) 590 msec user, 0 msec system
; cpu time (total) 1,160 msec user, 0 msec system
; real time 1,174 msec
; space allocation:
; 970,202 cons cells, 0 symbols, 0 other bytes, 0 static bytes
NIL
USER> (time (progn (list-combination list100 4) nil))
; cpu time (non-gc) 22,590 msec user, 0 msec system
; cpu time (gc) 69,470 msec (00:01:09.470) user, 1,370 msec system
; cpu time (total) 92,060 msec (00:01:32.060) user, 1,370 msec system
; real time 93,931 msec (00:01:33.931)
; space allocation:
; 50,823,928 cons cells, 0 symbols, 0 other bytes, 0 static bytes
NIL
USER> (time (progn (list-combination2 list100 4) nil))
; cpu time (non-gc) 14,920 msec user, 10 msec system
; cpu time (gc) 58,410 msec user, 2,690 msec system
; cpu time (total) 73,330 msec (00:01:13.330) user, 2,700 msec system
; real time 76,267 msec (00:01:16.267)
; space allocation:
; 31,370,108 cons cells, 0 symbols, 0 other bytes, 0 static bytes
NIL
--
Thomas A. Russ, USC/Information Sciences Institute
+ ·············@gmail.com" <············@gmail.com>:
| The code is not pretty(and/or efficient I think)because it's still a
| bit hard for me to write a pretty and efficient code.
Just a couple quick comments:
There is no need for the underscore in variable names like car_, cdr_,
list_, length_. Common Lisp has separate namespaces for functions and
variables, so naming variables car, cdr, list, length is perfectly
okay, and more readable.
Also, it's considered good style to use first and rest instead of car
and cdr when you are working with lists. (Use car and cdr when
working with conses that are not part of lists.)
| (t (append
| (or (loop for i in (list-combination cdr_ (1- collect-number))
| collect (cons car_ i))
| (list (list car_)))
| (and (> length_ collect-number)
| (list-combination cdr_ collect-number)))))))
You could replace append by nconc and save a bit of consing. Nconc is
safe here because the list is is not used elsewhere.
You could save even more consing by replacing the above with code that
mutates the return value of the first call to list-combination,
replacing each element i by (cons first i), but that might be a
classic example of premature optimization and thus better avoided
unless profiling shows it to be necessary.
--
* Harald Hanche-Olsen <URL:http://www.math.ntnu.no/~hanche/>
- It is undesirable to believe a proposition
when there is no ground whatsoever for supposing it is true.
-- Bertrand Russell