I've implemented a lottery number generation (there are 49 balls,
numbered from 1 to 49 and you take 6) like I could do it in Java, with a
destructive remove-at (I didn't found something like this function in
Common Lisp). How can I write it more Lisp-like?
(defmacro remove-at (index list)
(let ((element (gensym)))
`(let ((,element (nth ,index ,list)))
(setf ,list
(remove-if (constantly t) ,list :start ,index :count 1))
,element)))
(defmacro remove-random (list)
(let ((random (gensym)))
`(let ((,random (random (length ,list))))
(remove-at ,random ,list))))
(defun 6-out-49 ()
(let ((numbers (loop for i from 1 to 49 collect i)))
(loop repeat 6 collect (remove-random numbers))))
(6-out-49) => (3 47 15 5 26 11)
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Frank Buss wrote:
> I've implemented a lottery number generation (there are 49 balls,
> numbered from 1 to 49 and you take 6) like I could do it in Java,
with a
> destructive remove-at (I didn't found something like this function in
> Common Lisp). How can I write it more Lisp-like?
>
> (defmacro remove-at (index list)
> (let ((element (gensym)))
> `(let ((,element (nth ,index ,list)))
> (setf ,list
> (remove-if (constantly t) ,list :start ,index :count 1))
> ,element)))
>
> (defmacro remove-random (list)
> (let ((random (gensym)))
> `(let ((,random (random (length ,list))))
> (remove-at ,random ,list))))
>
> (defun 6-out-49 ()
> (let ((numbers (loop for i from 1 to 49 collect i)))
> (loop repeat 6 collect (remove-random numbers))))
>
> (6-out-49) => (3 47 15 5 26 11)
If this is for buzzword bingo...
http://c2.com/cgi/wiki?GenerateBingoCardsInManyProgrammingLanguages
MfG,
Tayssir
Frank Buss <··@frank-buss.de> wrote in message news:<············@newsreader2.netcologne.de>...
> I've implemented a lottery number generation (there are 49 balls,
> numbered from 1 to 49 and you take 6) like I could do it in Java, with a
> destructive remove-at (I didn't found something like this function in
> Common Lisp). How can I write it more Lisp-like?
First, most people use the word "destructive" for operations that
change the car/cdr pointers of existing lists. You code uses
remove-if, which makes a copy of a given list with certain items
removed. The corresponding destructive operation is delete-if.
Second, here's my attempt.
(defun lottery (num-balls num-to-choose)
(assert (<= 0 num-to-choose num-balls))
(do ((b num-balls (1- b))
(lyst '() (cons b lyst)))
((= b 0)
(lottery-aux num-balls num-to-choose lyst '()))))
(defun lottery-aux (n k lyst result)
(if (= k 0)
(sort result #'<)
(multiple-value-bind (ball shorter-lyst) (delete-rand lyst n)
(lottery-aux (1- n) (1- k) shorter-lyst (cons ball result)))))
(defun delete-rand (lyst &optional (len (length lyst)))
(delete-ith lyst '() lyst (random len)))
(defun delete-ith (all cons-before-item cons-at-item i)
(cond ((> i 0)
(delete-ith all cons-at-item (rest cons-at-item) (1- i)))
(t
(if cons-before-item
(rplacd cons-before-item (rest cons-at-item))
(pop all))
(values (first cons-at-item) all))))
···············@yahoo.com (Mark McConnell) wrote:
> First, most people use the word "destructive" for operations that
> change the car/cdr pointers of existing lists. You code uses
> remove-if, which makes a copy of a given list with certain items
> removed. The corresponding destructive operation is delete-if.
you are right, my function is not a desctructive operation, but I can't
change it with delete-if:
http://www.lisp.org/HyperSpec/Body/fun_removecm__elete-if-not.html
| delete, delete-if, and delete-if-not return a sequence of the same type
| as sequence that has the same elements except that those in the
| subsequence bounded by start and end and satisfying the test have been
| deleted. Sequence may be destroyed and used to construct the result;
| however, the result might or might not be identical to sequence.
I think this means, that an implementation is free to implement delete-if
simply as a call to remove-if.
> Second, here's my attempt.
this looks a bit complicated, but sorting the result is a good idea.
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
On 29 Oct 2004 12:32:04 -0700, Mark McConnell wrote:
> Frank Buss <··@frank-buss.de> wrote in message news:<············@newsreader2.netcologne.de>...
>> I've implemented a lottery number generation (there are 49 balls,
>> numbered from 1 to 49 and you take 6) like I could do it in Java, with a
>> destructive remove-at (I didn't found something like this function in
>> Common Lisp). How can I write it more Lisp-like?
> First, most people use the word "destructive" for operations that
> change the car/cdr pointers of existing lists. You code uses
May change, rather than does change, though. (And not necessarily in
any useful way)
> Second, here's my attempt.
> (defun lottery-aux (n k lyst result)
Why are you calling this thing "lyst"? What's wrong with "list"?
FWIW, I've put a CL translation of random.py from the Python standard
library on http://users.actrix.co.nz/mycroft/cl.html -- this has a
SAMPLE function and (unexported) Pythonesque RANGE function with which
you can just write
(sample (random::range 1 49) 6)
--
Men are born ignorant, not stupid; they are made stupid by education.
-- Bertrand Russell
(setq reply-to
(concatenate 'string "Paul Foley " "<mycroft" '(··@) "actrix.gen.nz>"))
Frank Buss <··@frank-buss.de> writes:
> I've implemented a lottery number generation (there are 49 balls,
> numbered from 1 to 49 and you take 6) like I could do it in Java, with a
> destructive remove-at (I didn't found something like this function in
> Common Lisp). How can I write it more Lisp-like?
>
> (defmacro remove-at (index list)
> (let ((element (gensym)))
> `(let ((,element (nth ,index ,list)))
> (setf ,list
> (remove-if (constantly t) ,list :start ,index :count 1))
> ,element)))
why macro?
(defun NREMOVE-AT (index list)
(declare
(inline NREMOVE-AT)
(type (integer 1) index)
(type list list))
(rplacd #1=(nthcdr (1- index) list) (cddr #1#)))
Regards, Szymon.
Szymon <············@o2.pl> wrote:
> why macro?
because I want to remove the 0-th element, too :-)
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Frank Buss wrote:
> Szymon <············@o2.pl> wrote:
> > why macro?
>
> because I want to remove the 0-th element, too :-)
Careful:
http://alu.cliki.net/lisp-user-meeting-amsterdam-april-2004#macros-and-codewalkers
I believe Norvig also wrote a style guide cautioning about use of
macros...
MfG,
Tayssir
"Tayssir John Gabbour" <···········@yahoo.com> wrote:
> Careful:
> http://alu.cliki.net/lisp-user-meeting-amsterdam-april-2004#macros-and-
> codewalkers
>
> I believe Norvig also wrote a style guide cautioning about use of
> macros...
how does it apply to my remove-at? It is a more general POP, only.
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Frank Buss wrote:
> > Careful:
> >
http://alu.cliki.net/lisp-user-meeting-amsterdam-april-2004#macros-and-
> > codewalkers
> >
> > I believe Norvig also wrote a style guide cautioning about use of
> > macros...
>
> how does it apply to my remove-at? It is a more general POP, only.
I just noticed your reply to Szymon, and the links came to mind. If
they don't apply to your situation, great.
Frank Buss <··@frank-buss.de> writes:
> I've implemented a lottery number generation (there are 49 balls,
> numbered from 1 to 49 and you take 6) like I could do it in Java, with a
> destructive remove-at (I didn't found something like this function in
> Common Lisp). How can I write it more Lisp-like?
I usually use a loop with 'on' for doing destructive lisp
insertion/removal.
> (defun 6-out-49 ()
> (let ((numbers (loop for i from 1 to 49 collect i)))
> (loop repeat 6 collect (remove-random numbers))))
How about something completely different? E.g. using a slight
generalization of Knuths shuffling algorithm:
(defun shuffle-n (seq &optional (k (length seq)))
"shuffle all of SEQ. Stop when k elements have been shuffled.
This generalizes Knuth's algorithm"
(let ((n (length seq)))
(dotimes (i k seq)
(rotatef (elt seq i)(elt seq (+ i (random (- n i))))))))
(let ((numbers (loop for i from 1 to 49 collect i)))
(defun 6-out-49 ()
(subseq (shuffle-n numbers 6) 0 6)))
--
(espen)
Frank Buss <··@frank-buss.de> writes:
> good idea. A faster implementation uses a vector:
Well, at least with LispWorks 4.3.7/linux with standard
optimize-settings, my version is actually still faster than yours,
provided that I, too, supply a vector (My shuffle-n works for all
sequences, so you can just replace the list with a vector):
(let ((numbers (coerce (loop for i from 1 to 49 collect i) 'vector)))
(defun 6-out-49 ()
(subseq (shuffle-n numbers 6) 0 6)))
--
(espen)
>>>>> "FB" == Frank Buss <··@frank-buss.de> writes:
FB> ... with a destructive remove-at (I didn't found
FB> something like this function in Common Lisp). How can I write
FB> it more Lisp-like?
The shortest I can think of is using nthcdr. I'll try to give the
reason why I think this:
CL-USER> (setf foo (list 1 2 3 4 5))
(1 2 3 4 5)
CL-USER> (nthcdr 3 foo)
(4 5)
CL-USER> (setf (nthcdr 3 foo) (cdr (nthcdr 3 foo)))
(5)
CL-USER> foo
(1 2 3 5)
cheers,
BM
In article <············@newsreader2.netcologne.de>,
Frank Buss <··@frank-buss.de> wrote:
> I've implemented a lottery number generation (there are 49 balls,
> numbered from 1 to 49 and you take 6) like I could do it in Java, with a
> destructive remove-at (I didn't found something like this function in
> Common Lisp). How can I write it more Lisp-like?
(defun lottery-draw (draws balls)
(subseq (mapcar #'car (sort (loop for i from 1 upto balls
collect (cons i (random 1.0)))
#'< :key #'cdr))
0 draws))
CL-USER> (lottery-draw 6 49)
(12 47 49 22 36 21)
A destructive shuffling algorithm in a vector is probably faster, but I
like how that looks I think.
-bcd
--
*** Brian Downing <bdowning at lavos dot net>
Just to add my own solution:
(defun lottery (&key (max 49) (draw 6))
(let ((balls (loop for i from 1 to max collect i)))
(loop for i from 0 to (1- draw) collect
(pop (nthcdr (random (- max i)) balls)))))
No shuffling required.
Jeff M.
Jeff M. wrote:
> (defun lottery (&key (max 49) (draw 6))
> (let ((balls (loop for i from 1 to max collect i)))
> (loop for i from 0 to (1- draw) collect
> (pop (nthcdr (random (- max i)) balls)))))
Runs with Lispworks. But CMUCL complains:
* (lottery)
;
; Warning: This function is undefined:
; (SETF NTHCDR)
Error in FDEFINITION: the function (SETF NTHCDR) is undefined.
[Condition of type UNDEFINED-FUNCTION]
Restarts:
0: [ABORT] Return to Top-Level.
Debug (type H for help)
(FDEFINITION (SETF NTHCDR))
Source:
; File: target:code/fdefinition.lisp
; File has been modified since compilation:
; target:code/fdefinition.lisp
; Using form offset instead of character position.
(FDEFN-OR-LOSE FUNCTION-NAME)
0]
Bug in CMUCL?
--
Bernd
Bernd Beuster <·············@lycos.de> writes:
> Error in FDEFINITION: the function (SETF NTHCDR) is undefined.
[...]
> Bug in CMUCL?
It's not a bug. Section 5.1.2.2 of CLHS lists the functions
with which SETF can be used, and NTHCDR is not among them.
Nevertheless, would this be a good way to define it?
(define-setf-expander nthcdr (n place &environment env)
(multiple-value-bind (vars vals store-vars writer-form reader-form)
(get-setf-expansion place env)
(let* ((gn (gensym))
(gstore (if store-vars (first store-vars) (gensym "STORE"))))
(values (list* gn vars)
(list* n vals)
(list gstore)
;; Intentionally leaves 0.0 unrecognized.
`(if (eql ,gn 0)
,(case (length store-vars)
(0 `(progn ,writer-form ,gstore))
(1 writer-form)
(t `(let ,(rest store-vars)
(values ,writer-form))))
(setf (cdr (nthcdr (1- ,gn) ,reader-form)) ,gstore))
`(nthcdr ,gn ,reader-form)))))
Frank Buss <··@frank-buss.de> wrote in message news:<············@newsreader2.netcologne.de>...
> I've implemented a lottery number generation (there are 49 balls,
> numbered from 1 to 49 and you take 6) like I could do it in Java, with a
> destructive remove-at
If you don't mind allocating a data structure with the first n
numbers, it's easier to just shuffle the them and take the first k of
the permutation you get back. Try something like this, which is
faster by a factor of n in the general case:
(defun iota (lo hi &optional (step 1))
(loop for i from lo to hi by step
collect i))
(defun random-k-set (n k)
(assert (>= n k))
(loop with a = (coerce (iota 1 n) 'vector)
for i from 0 below k
for j = (+ i (random (- n i)))
doing (rotatef (aref a i) (aref a j))
finally (return (coerce (subseq a 0 k) 'list))))
(defun lottery ()
(random-k-set 49 6))
Frank Buss <··@frank-buss.de> writes:
> I've implemented a lottery number generation (there are 49 balls,
> numbered from 1 to 49 and you take 6) like I could do it in Java, with a
> destructive remove-at (I didn't found something like this function in
> Common Lisp). How can I write it more Lisp-like?
(defun 6-out-of-49 ()
(mapcar (function cdr)
(subseq (sort (mapcar (lambda (n) (cons (random 1e6) n)) (iota 49 1))
(function <) :key (function car)) 0 6)))
Your remove-at is not destructive because it uses remove-if. You
should name it delete-at and use delete-if to make it destructive.
(defun iota (count &optional (start 0)(step 1))
"
RETURN: A list containing the elements
(start start+step ... start+(count-1)*step)
The start and step parameters default to 0 and 1, respectively.
This procedure takes its name from the APL primitive.
EXAMPLES: (iota 5) => (0 1 2 3 4)
(iota 5 0 -0.1) => (0 -0.1 -0.2 -0.3 -0.4)
"
(when (< 0 count)
(do ((result '())
(item (+ start (* step (1- count))) (- item step)))
((< item start) result)
(push item result))));;iota
Or you may prefer:
(defun iota (count &optional (start 0)(step 1))
(loop for i from start by step repeat count collect i))
But note the differences in macroexpansion:
(macroexpand-1 '(loop for i from start by step repeat count collect i))
(MACROLET ((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-ERROR)))
(BLOCK NIL
(LET ((I START) (#1=#:G2152 STEP))
(LET ((#2=#:G2153 COUNT))
(PROGN
(LET ((#3=#:ACCULIST-VAR-2154 NIL))
(MACROLET ((LOOP-FINISH NIL '(GO SYSTEM::END-LOOP)))
(TAGBODY SYSTEM::BEGIN-LOOP (UNLESS (PLUSP #2#) (LOOP-FINISH))
(PROGN (SETQ #3# (CONS I #3#))) (PSETQ I (+ I #1#)) (SETQ #2# (1- #2#))
(GO SYSTEM::BEGIN-LOOP) SYSTEM::END-LOOP
(MACROLET
((LOOP-FINISH NIL (SYSTEM::LOOP-FINISH-WARN) '(GO SYSTEM::END-LOOP)))
(RETURN-FROM NIL (SYSTEM::LIST-NREVERSE #3#))))))))))), T
(macroexpand-1 '(do ((result '())
(item (+ start (* step (1- count))) (- item step)))
((< item start) result)
(push item result)))
(BLOCK NIL
(LET ((RESULT 'NIL) (ITEM (+ START (* STEP (1- COUNT)))))
(TAGBODY #1=#:G2155 (IF (< ITEM START) (GO #2=#:G2156)) (PUSH ITEM RESULT)
(PSETQ ITEM (- ITEM STEP)) (GO #1#) #2# (RETURN-FROM NIL (PROGN RESULT))))),
T
(It should not matter with a smart enough compiler though... :-)
--
__Pascal Bourguignon__ http://www.informatimago.com/
Voting Democrat or Republican is like choosing a cabin in the Titanic.
Pascal Bourguignon <····@mouse-potato.com> wrote:
> (defun 6-out-of-49 ()
> (mapcar (function cdr)
> (subseq (sort (mapcar (lambda (n) (cons (random 1e6) n))
> (iota 49 1))
> (function <) :key (function car)) 0 6)))
looks like Brian's solution.
> Your remove-at is not destructive because it uses remove-if. You
> should name it delete-at and use delete-if to make it destructive.
you are right, it is not destructive, but delete-if need not to be
destructive, too, if I understand the hyperspec correctly. So the best
would be to use Bulent's nice nthcdr solution, if I want to write a
destructive remove-at.
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Frank Buss wrote:
> I've implemented a lottery number generation (there are 49 balls,
> numbered from 1 to 49 and you take 6) like I could do it in Java, with a
> destructive remove-at (I didn't found something like this function in
> Common Lisp). How can I write it more Lisp-like?
>
I would try to make it more expressive. Other languages can make things
hard to understand, so.... in real life I would do something like:
(in-package :cl-user)
(defclass lotto-ball-machine ()
((number-of-balls :initarg :number-of-balls :reader number-of-balls)
(balls :accessor balls)))
(defmethod load-balls ((machine lotto-ball-machine))
(setf (balls machine) (loop for i from 1 upto (number-of-balls machine)
collect i))
machine)
(defmethod initialize-instance :after ((machine lotto-ball-machine) &rest initargs)
(declare (ignore initargs))
(load-balls machine))
(defmethod draw-ball ((machine lotto-ball-machine))
(with-slots (balls) machine
(let ((ball (elt balls (random (length balls)))))
(prog1 ball
(setf balls (delete ball balls))))))
(defun lotto (n outof)
(loop with lotto = (make-instance 'lotto-ball-machine :number-of-balls outof)
for i from 0 to n
collect (draw-ball lotto)))
CL-USER 12 > (lotto 6 49)
(7 29 47 22 31 37 45)
CL-USER 13 > (lotto 6 49)
(25 13 31 4 8 14 2)
CL-USER 14 > (lotto 20 103)
(45 5 3 32 4 60 82 62 26 46 44 87 95 24 27 2 29 1 72 51 90)
CL-USER 15 >
Wade
Wade Humeniuk <····································@telus.net> wrote:
> Frank Buss wrote:
>
>> I've implemented a lottery number generation (there are 49 balls,
>> numbered from 1 to 49 and you take 6) like I could do it in Java,
>> with a destructive remove-at (I didn't found something like this
>> function in Common Lisp). How can I write it more Lisp-like?
>>
>
> I would try to make it more expressive. Other languages can make
> things hard to understand, so.... in real life I would do something
> like:
you are right, splitting it into different methods and packing it in a
class makes it easier to enhance it for different use-cases, for exampe if
you want to display it in a GUI after each draw.
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Frank Buss wrote:
> Wade Humeniuk <····································@telus.net> wrote:
>>I would try to make it more expressive. Other languages can make
>>things hard to understand, so.... in real life I would do something
>>like:
...
[ at least 19 lines of CLOS code following ]
...
>
>
> you are right, splitting it into different methods and packing it in a
> class makes it easier to enhance it for different use-cases, for exampe if
> you want to display it in a GUI after each draw.
I don't think so. The solution should be appropriate to the problem.
After all the function shall only choose a set of numbers of a given
range with no repetition.
--
Bernd
Bernd Beuster wrote:
> I don't think so. The solution should be appropriate to the problem.
> After all the function shall only choose a set of numbers of a given
> range with no repetition.
>
That could be the only requirement. But a lotto system might require that
the code is:
1) auditable (i.e. a trace log)
2) maintainable by other programmers, thus expressive and hopefully obvious
I sounds like Frank may have a GUI in mind. This adds more to think about.
When I am actually coding deliverable code I tend to leave some
doors open. Also I find that being pedantic gives me some assurance
of the correctness of the algorithm.
Wade
"Wade Humeniuk" <····································@telus.net> wrote in
message ·························@edtnps84...
> Bernd Beuster wrote:
>
>
>> I don't think so. The solution should be appropriate to the problem.
>> After all the function shall only choose a set of numbers of a given
>> range with no repetition.
>>
>
> That could be the only requirement. But a lotto system might require that
> the code is:
>
> 1) auditable (i.e. a trace log)
> 2) maintainable by other programmers, thus expressive and hopefully
> obvious
>
> I sounds like Frank may have a GUI in mind. This adds more to think
> about.
>
> When I am actually coding deliverable code I tend to leave some
> doors open. Also I find that being pedantic gives me some assurance
> of the correctness of the algorithm.
I agree and I liked your approach. But I would not delete balls, would move
them to a drawn-balls slot or something. So many enhancements, so little
time!
Alan Crowe wrote:
> (do ((draw '()))
> ((= (length draw) 6) draw)
> (pushnew (+ (random 49) 1) draw))
>
> => (33 17 2 39 40 5)
How many loops will be nessecary for 48 draws out of 49?
--
Bernd
From: ·········@cern.ch
Subject: Re: Lottery number generation
Date:
Message-ID: <yzor7ngfaq9.fsf@cern.ch>
Alan> (do ((draw '()))
Alan> ((= (length draw) 6) draw)
Alan> (pushnew (+ (random 49) 1) draw))
Alan> => (33 17 2 39 40 5)
Bernd> How many loops will be nessecary for 48 draws out of 49?
On average, I believe it is close to:
CL-USER> (loop for i below 48 sum (/ 49 (- 49 i)))
10782212182893138320231/63245806209101973600
CL-USER> (coerce * 'float)
170.48106
I guess you are alluding to the fact that there is no upper bound on
the number of iterations needed even to draw 2 numbers out of 49 -
*if* RANDOM was truly so (ie not pseudo-). This is related to the fact
that there is no guarantee that a real dice will come up with `6' in a
finite number of rolls.
It would be interesting to know what is the upper bound on the length
of a sequence from (1+ (RANDOM 6)) not containing `6' - for RANDOM
being a practical pseudo-random generator. Is it proportional to the
length of the random state or to the total sequence length?
Ole
Bernd Beuster <·············@lycos.de> wrote in message news:<············@online.de>...
> Alan Crowe wrote:
> > (do ((draw '()))
> > ((= (length draw) 6) draw)
> > (pushnew (+ (random 49) 1) draw))
> >
> > => (33 17 2 39 40 5)
> How many loops will be nessecary for 48 draws out of 49?
O(n*log n) expectation, and it's sharply concentrated around this.
But each iteration is a linear time operation, so the whole thing has
Theta(n^2*log n) expected running time, which is a lot worse than
shuffling.
^L
Bernd asks
> How many loops will be nessecary for 48 draws out of 49?
6 out of 49 are the parameters of the UK national lottery.
6 and 49 are fixed as far as writing code is concerned.
--
Alan