Right now I"m working on a program that should be able to pick 3 people out of a list of 7 ( a b c d e f g) and assign them to be criminals. This "game" then picks 3 random peolpe out of the 7, tells you how many of those people are criminals and asks if you want to guess who the three criminals are, having one guess ( "two of these three are crimnals would you like to guess who the criminals are). However, I currently have a program that pulls 3 random criminals from the list, however the struggle I"m having is initially assigning who's a criminal or not ( randomly picking 3 out of a list and assigning them to values that can be recalled later ) and then being able to print that back out. This is my code so far and I was hoping somebody could point me in the right direction, I'm still very new to functional programming as a whole.
;allows us to use prompt to ask the user for input
(defun prompt-read (prompt)
(format *query-io* "~a: " prompt)
(force-output *query-io*)
(read-line *query-io*))
;allows you to add elements in needed spots
(defun element-at (org-list pos &optional (ini 1))
(if (eql ini pos)
(car org-list)
(element-at (cdr org-list) pos (+ ini 1))))
(defun element-at (lista n)
(if (= n 1)
(first lista)
(element-at (rest lista) (1- n))))
;allows for the removal of unneeded elements
(defun remove-at (org-list pos &optional (ini 1))
(if (eql pos ini)
(cdr org-list)
(cons (car org-list) (remove-at (cdr org-list) pos (+ ini 1)))))
;returns a chosen number of random elements from a list
(defun rnd-select (org-list num &optional (selected 0))
(if (eql num selected)
nil
(let ((rand-pos (+ (random (length org-list)) 1)))
(cons (element-at org-list rand-pos) (rnd-select (remove-at org-list rand-pos) num (+ selected 1))))))
;returns 3 random criminals from a list of 7
(defun rnd-criminals ()
(rnd-select '(a b c d e f g) 3))
(defun game ()
(prompt-for-players))
;allows for the storing of number of players
(defun num-of-players(number)
(list :number number))
;prompts for the amount of players you want to play
(defun prompt-for-players ()
(num-of-players
(or (parse-integer (prompt-read "How many players are there?"
:junk-allowed t) 0))))
This is a sampling without replacement problem (since, I'd assume, you wouldn't want to "pick three criminals" by picking the same person from the list each time). There are lots of ways to do this. One way is to generate indices until you've got enough distinct ones. How about something like this:
(defun pick (sequence n)
"Return n elements chosen at random from the sequence."
(do ((len (length sequence)) ; the length of the sequence
(indices '()) ; the indices that have been used
(elements '())) ; the elements that have been selected
((zerop n) ; when there are no more elements to select,
elements) ; return the elements that were selectd.
(let ((i (random len))) ; choose an index at random
(unless (member i indices) ; unless it's been used already
(push i indices) ; add it to the list of used indices
(push (elt sequence i) elements) ; and grab the element at the index
(decf n))))) ; and decrement n.
If you're not so familiar with do, you could use a recursive approach, e.g., with a local recursive function:
(defun pick2 (sequence n &aux (len (length sequence)))
(labels ((pick2 (indices elements n)
(if (zerop n) ; if no more elements are needed,
elements ; then return elements.
(let ((i (random len))) ; Otherwise, pick an index i.
;; If it's been used before,
(if (member i indices)
;; then continue on with the same indices,
;; elements, and n.
(pick2 indices elements n)
;; else, continue with it in the list of
;; indices, add the new element to the list of
;; elements, and select one fewer elements
;; (i.e., decrease n).
(pick2 (list* i indices)
(list* (elt sequence i) elements)
(1- n)))))))
;; Start the process off with no indices, no elements, and n.
(pick2 '() '() n)))
Another approach would one based on Efficiently selecting a set of random elements from a linked list which suggests Reservoir Sampling.
Related
Here's the exact question:
COUNT-BASES counts the number of bases of each type in
either single- or double-stranded DNA and returns the result
as a table.
(COUNT-BASES '((G C) (A T) (T A) (C G))) should return
((A 2) (T 2) (G 2) (C 2))
(COUNT-BASES '(A G T A C T C T)) should return
((A 2) (T 3) (G 1) (C 2)).
I've written a function my-count that returns the occurences of one char but can't figure out how to apply this for all 4 letters (A T G C) and return as a table.
;returns the count of a base (a) from a list (L)
(defun my-count (a L)
(cond ((null L) 0)
((equal a (car L)) (+ 1 (my-count a (cdr L))))
(t (my-count a (cdr L)))))
I'd handle the flat case (single stranded, i. e. a list of bases) first. Loop over the list and count each base into a hash table:
(defun count-bases (dna)
(let ((counts (make-hash-table)))
(dolist (base dna counts)
(incf (gethash base counts 0)))))
Now, it might be double stranded, so each element is not a base, but a list of bases. But we already know how to handle a list of bases. In order to count into a single table, make it possible to pass it into the recursive call:
(defun count-bases (dna &optional (counts (make-hash-table)))
(dolist (base-or-pair dna counts)
(if (symbolp base-or-pair)
(incf (gethash base-or-pair counts 0))
(count-bases base-or-pair counts))))
A purely imperative version of the code could be as follows:
(defun count-bases (bases)
(let ((atgc (vector 0 0 0 0)))
(dolist (dna bases (map 'list #'list #(a t g c) atgc))
(dolist (base (if (listp dna) dna (list dna)))
(incf (svref atgc (position base #(a t g c))))))))
Create a vector of 4 elements, that store counters for all bases.
Iterate over all entries in the list, and iterate over all bases in each entry: typically this is done with alexandria:ensure-list, but here it is written in plain.
Find the position of each base in the literal vector #(a t g c), a vector of symbols. Use the returned position to increment the associated counter.
Finally (last form in DOLIST), build the return value in the expected format:
MAP over both #(a t g c) and the counter vector atgc, build a 'list by applying the function #'list to each pair of elements taken from both sequences: for example, the first iteration visits a and the counter for base a, and calls #'list on them, which builds (a ...), where ... is the actual value.
I have a questions about multiple if-statements in lisp. If count is not equal to n I want to continue on with the let and if statements, else I want to do (= (abs (- row i)) and if that is t return nil.
However, I find that whenever count is not n I will return nil because progn always returns the last line of code in the block. Please share with me how I can write the program so that I only when count is not n I will only return nil when any of the or clauses are t.
(loop for i below n
do (if (/= count n)
(progn
(let ((tcol (getqueencol i n)))
(if (or (= col tcol) (= (abs (- row i)) (abs (- col tcol))))
(return-from queen-can-be-placed-here nil))))
(if (= (abs (- row i)))
(return-from queen-can-be-placed-here nil))))
UPDATED:
Thank you for good response. Yes, indeed I am trying to solve the N queen puzzle :P The problem I have right now is that my control to determine if placing a queen at a certain row and column is not working when the row is empty. That is because getqueencol will return nil when the row is empty and in queen-can-be-placed-here there will be a (= nil NUMBER).
To combat that I tried to make a count variable in queen-can-be-placed-here that knows whether a row is empty or not, and that would enable me to not call getqueencol on an empty row. The problem is though that I do not know how the check will be in queen-can-be-placed-here when a queen is to be added to an empty row.
Here is the code so far:
(defvar *board* (make-array '(5 5) :initial-element nil))
(defun getqueencol (row n)
"Traverses through the columns of a certain row
and returns the column index of the queen."
(loop for i below n
do (if (aref *board* row i)
(return-from getqueencol i))))
(defun print-board (n)
"Prints out the solution, e.g. (1 4 2 5 3),
where 1 denotes that there is a queen at the first
column of the first row, and so on."
(let ((solutionlist (make-list n)))
(loop for row below n
do (loop for col below n
do (when (aref *board* row col)
(setf (nth row solutionlist) col))))
(print solutionlist)))
(defun queen-can-be-placed-here (row col n)
"Returns t if (row,col) is a possible place to put queen, otherwise nil."
(let ((count 0))
(loop for i below n ;This is the block I added to keep track of if a row is empty (count = n)
do (if (not (aref *board* row i))
(setf count (+ 1 count))))
(loop for i below n
do (if (/= count n)
(let ((tcol (getqueencol i n)))
(if (or (= col tcol) (= (abs (- row i)) (abs (- col tcol))))
(return-from queen-can-be-placed-here nil)))
(if (= (abs (- row i))) ;Here is where I don't know what to check
(return-from queen-can-be-placed-here nil)))))
(return-from queen-can-be-placed-here t))
(defun backtracking (row n)
"Solves the NxN-queen problem with backtracking"
(if (< row n)
(loop for i below n
do (when (queen-can-be-placed-here row i n)
(setf (aref *board* row i) 't)
(backtracking (+ row 1) n)
(setf (aref *board* row i) 'nil)))
(print-board n)))
(defun NxNqueen-solver (k)
"Main program for the function call to the recursive solving of the problem"
(setf *board* (make-array (list k k) :initial-element nil))
(backtracking 0 k))
I have a questions about multiple if-statements in lisp. If count is
not equal to n I want to continue on with the let and if statements,
else I want to do (= (abs (- row i)) and if that is t return nil.
Once you start having multiple forms on either branch of an if, it's often clearer to use cond instead:
(cond
((/= n count) ; if n is not count, then ...
(let ...
(return-from ...))) ; maybe return something
((= (abs (- row i)) ...) ; else if |row-i] = ...,
(return-from ...))) ; return nil
That said, you don't actually have multiple branches in the then part of your if. There's no need to wrap let in progn. You can just do:
(if (/= count n)
(let ((tcol (getqueencol i n)))
(if (or (= col tcol) (= (abs (- row i)) (abs (- col tcol))))
(return-from queen-can-be-placed-here nil)))
(if (= (abs (- row i)))
(return-from queen-can-be-placed-here nil)))
As to returning nil from the if, there are two things to consider. You're using return-from, which means that you're performing a non-local exit. While the value of an expression of the form (if test then) is nil when test is false, you're never doing anything with that value. Actually, it's a fairly common style in Common Lisp to use when in the case that there's no else part. That is, (when test then) is equivalent to (if test then nil) and to (if test then). It's true that it means (if ...) evaluates to nil, so nil is the value of the let, and thus of the progn, but you don't actually do anything with the value of the progn; it's just a form that you're evaluating within the loop.
Each call to backtrack tries to place a queen at each possible column. That means that when you are calling queen-can-be-placed-here at row row, you can be sure that all rows including row that come after row are empty (you erase the board when backtracking).
So you only need to check if the queen can be placed correctly at current column col and current row by looking at the subset of the board that has a lesser row.
col
v
c0 v c1
r0 Q - - -
r1 - - Q -
row >> - ? - -
- - - -
There can be a queen only if, for all above rows, guetqueencol returns a column that is different from col or in a direct diagonal position (the computations with abs). So you don't really need to count anything, just ensure that a test is never met.
There are minor issues with the code like variable names, so once you are sure everything works as intended you can ask on CodeReview for more feedback, if you want.
What I think is the appropriate answer is inside the following spoiler section.
(defun queen-can-be-placed-here (row col n)
"Returns t if (row,col) is a possible place to put queen, otherwise nil."
(loop
for r below row
for c = (getqueencol r n)
never (or (= col c)
(= (abs (- row r))
(abs (- col c))))))
I want to test this list whether it's palindrome or not by comparing first element with last element , second element with before the last element and so on
(setq l '(1 5 7 8 8 7 5 1))
(defun f (l)
(cond ((null l) 0)
((atom l) l)
(if (equal (car l) (car(cdr l))))
Is there a reason for this way of comparing them? If not, it would be easier to use the reverse function:
(defun palindrome-p (l)
(equal l (reverse l)))
The #Pascal solution reverses the entire list to check if it is palindrome, but this is not necessary. Why not reverse only half of it?
(defun palindrome-p (l)
(let* ((half (floor (length l) 2))
(secondhalf (reverse (nthcdr half l))))
(loop for x in l
for y in secondhalf
always (eq x y))))
This solution (which, I have to admit, is more “common-lispy” and less “lispy”) allocates only half of memory of the solution that reverses the entire list, and in CCL, on my laptop, for long lists uses less then half time.
Another option that conses only half the list:
(defun palindrome-p (list)
(let* ((length (length list))
;; The following lists will NOT include the middle element if length is odd
(half-length (ceiling length 2))
(tail (nthcdr half-length list))
(reversed-head (nreverse (butlast list half-length))))
(equal tail reversed-head)))
The thing about this option is that you get two lists of similar length, you don't have to worry about whether iteration stops at the smallest one, and it's easier to adapt and debug later for other purposes.
Yet another option that is usually disregarded is to copy the whole list into a vector. Most implementations take 1 or 2 architecture words (32-bit/64-bit) to represent a cons, thus the worst case for a list is:
2 × length words
These same implementations take about 1 to 2 words for the vector's header, plus 1 word per element, thus the worst case for a vector is:
2 + length words
What I mean is, you'll have about the same memory allocation cost for consing half of the list compared to copying the whole list into a vector.
The compromise is to find out when the header is no longer much of an overhead compared to consing and (n)reversing the list, or from accessing the nth element of a not-that-small list.
If this threshold is found, I'd redefine it as follows, making it accept a sequence:
;; Mere example, I did not research this on any implementation
(defconstant +list-to-vector-overhead-threshold+ 8)
(defun palindrome-p (sequence)
(if (and (consp sequence)
(not (null (nthcdr +list-to-vector-overhead-threshold+ sequence))
(palindrome-p (concatenate 'vector sequence)
(let ((length (length sequence)))
(dotimes (i (floor length 2))
(when (not (equal (elt sequence i) (elt sequence (- length i 1))))
(return nil)))
t)))
PS: Here's some implementations' object sizes found by experimentation (meaning, I might be wrong about these numbers) with 32-bit implementations:
Allegro CL
List: 2 × length words
Vector: 2 + length words, 2 words aligned (i.e. in 32-bit, 8-byte aligned)
Clozure CL
List: 2 × length words
Vector: 1 + length words, 2 words aligned (i.e. in 32-bit, 8-byte aligned)
LispWorks
List: 3 × length words
Vector: 2 + length words
SBCL
List: 2 × length words
Vector: 2 + length words
; Get the reverse of a list
(defun revList (l)
(cond
((null (cdr l)) l)
(t (append (revList (cdr l)) (list(car l) ) ))
)
)
; Check whether a given a list is a palindrome
(defun palindrome (l)
(cond ((null l) t)
((equal (car l) (car (last l)))(palindrome (cdr (revList (cdr l)))))
)
)
This implements a recursive function that returns (t) if a string (represented as a flat list of atoms) is a palindrome and (nil) otherwise. you can use the built-in "reverse" lisp function instead of "revList".
(defun palind (l1)
(if (equal l1 (reverse l1))
'palindrome
'no-palindrome))
How would I go about coding a lotto in Lisp where the user randomly generates 6 numbers (non repetitive) between 1- 45, then input their own selection of lotto numbers to see if they match, and then tell them if they've won or not ?
(defun shuffle (list)
(let ((len (length list)))
(loop repeat len
do (rotatef (nth (random len) list)
(nth (random len) list))
finally (return list))))
(defun lottery ()
(sort (subseq (shuffle (loop for i from 1 to 49 collect i))
0 6)
#'<))
(lottery)
(The code was actually taken from other authors from this question: Get numbers for the lottery)
This outputs the random numbers I need but I'm having a lot of trouble getting the user input of 6 numbers and comparing them to these numbers to see if they have 'won'.
Let's start with getting n non repeating random numbers.
(defun get-n-rand (n)
(loop :for i = (adjoin (1+ (random 44)) i)
:when (= (length i) n) :return i))
Now if we want 6 of them is simple enough to write (get-n-rand 6)
Next we want to check if every member of one list can be found in another.
(defun check-user-guess (guess-list actual-list)
(equal (sort guess-list #'<) (sort actual-list #'<)))
Hopefully this covers the core logic. Input I will leave for now as it was covered in the other answer.
If your problem is the input this should be a (unsafe) solution:
(defun play-lotto (&aux list)
(dotimes (i 6)
(loop
(princ "Write a Integer between 0 and 50: ")
(let ((number (read)))
(if (and (integerp number) (< 0 number 50))
(if (member number list)
(progn
(princ "You can only choose a number once")
(terpri))
(progn
(push number list)
(return)))
(progn
(princ "Not a Integer between 0 and 50")
(terpri))))))
(if (equal (sort list #'<) (lottery))
(princ "You won!")
(princ "You lost...")))
I have two lists as follows:
(x y z) & (2 1)
and I want to have a result like:
((x y) (z))
The relation of the lists is quite clear. So basically I want to rearrange the members of the first list into a list of lists with two (length of second list) lists.
I have tried running two dotimes iterations to do this:
(let ((result) (list1* list1))
(dotimes (n (length list2) result)
(progn (setq result
(append result
(list (let ((result2))
(dotimes (m (nth n list2) result2)
(setq result2
(append result2
(list (nth m list1*)))))))))
(setq list1*
(subseq list1* 0 (nth n list2))))))
The idea is that I make the first list of the expected result (x y), and then I want to update the (x y z) list so that the x any y are removed and I only have (z). Then the loop runs again to get the (z) list in the expected result. This does not work correctly and results in:
((x y) (x))
which means apparently the second command for progn which is basically updating the list1* is not working. Clearly there must be a correct and better way of doing this and I was wondering whether anyone can help with this. Also explain why it is not possible to have the solution explained?
If I see that right, your problem is in (subseq list1* 0 (nth n list2)), which returns the part of the list that you do not want.
I have the following to offer:
(defun partition-list (list lengths)
(mapcar (lambda (length)
(loop :repeat length
:collect (pop list)))
lengths))
This is a bit simplistic, of course, as it does not handle unexpected input, such as (length list) being smaller than (reduce #'+ lengths), but it can be expanded upon.
Just for the sake of example, an alternative using iterate:
(defun partition-list (list by)
(iter:iter
(iter:for element in list)
(iter:for i from 1)
(iter:generating measure in by)
(iter:collect element into sublist)
(when (= (or measure (iter:next measure)) i)
(iter:collect sublist)
(iter:next measure)
(setf i 0 sublist nil))))