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))
Related
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.
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))))
I apologize for the bad English..
I have a task to write a function called "make-bag" that counts occurences of every value in a list
and returns a list of dotted pairs like this: '((value1 . num-occurences1) (value2 . num-occurences2) ...)
For example:
(make-bag '(d c a b b c a))
((d . 1) (c . 2) (a . 2) (b . 2))
(the list doesn't have to be sorted)
Our lecturer allows us to us functions MAPCAR and also FILTER (suppose it is implemented),
but we are not allowed to use REMOVE-DUPLICATES and COUNT-IF.
He also demands that we will use recursion.
Is there a way to count every value only once without removing duplicates?
And if there is a way, can it be done by recursion?
First of, I agree with Mr. Joswig - Stackoverflow isn't a place to ask for answers to homework. But, I will answer your question in a way that you may not be able to use it directly without some extra digging and being able to understand how hash-tables and lexical closures work. Which in it's turn will be a good exercise for your advancement.
Is there a way to count every value only once without removing duplicates? And if there is a way, can it be done by recursion?
Yes, it's straight forward with hash-tables, here are two examples:
;; no state stored
(defun make-bag (lst)
(let ((hs (make-hash-table)))
(labels ((%make-bag (lst)
(if lst
(multiple-value-bind (val exists)
(gethash (car lst) hs)
(if exists
(setf (gethash (car lst) hs) (1+ val))
(setf (gethash (car lst) hs) 1))
(%make-bag (cdr lst)))
hs)))
(%make-bag lst))))
Now, if you try evaluate this form twice, you will get the same answer each time:
(gethash 'a (make-bag '(a a a a b b b c c b a 1 2 2 1 3 3 4 5 55)))
> 5
> T
(gethash 'a (make-bag '(a a a a b b b c c b a 1 2 2 1 3 3 4 5 55)))
> 5
> T
And this is a second example:
;; state is stored....
(let ((hs (make-hash-table)))
(defun make-bag (lst)
(if lst
(multiple-value-bind (val exists)
(gethash (car lst) hs)
(if exists
(setf (gethash (car lst) hs) (1+ val))
(setf (gethash (car lst) hs) 1))
(make-bag (cdr lst)))
hs)))
Now, if you try to evaluate this form twice, you will get answer doubled the second time:
(gethash 'x (make-bag '(x x x y y x z z z z x)))
> 5
> T
(gethash 'x (make-bag '(x x x y y x z z z z x)))
> 10
> T
Why did the answer doubled?
How to convert contents of a hash table to an assoc list?
Also note that recursive functions usually "eat" lists, and sometimes have an accumulator that accumulates the results of each step, which is returned at the end. Without hash-tables and ability of using remove-duplicates/count-if, logic gets a bit convoluted since you are forced to use basic functions.
Well, here's the answer, but to make it a little bit more useful as a learning exercise, I'm going to leave some blanks, you'll have to fill.
Also note that using a hash table for this task would be more advantageous because the access time to an element stored in a hash table is fixed (and usually very small), while the access time to an element stored in a list has linear complexity, so would grow with longer lists.
(defun make-bag (list)
(let (result)
(labels ((%make-bag (list)
(when list
(let ((key (assoc (car <??>) <??>)))
(if key (incf (cdr key))
(setq <??>
(cons (cons (car <??>) 1) <??>)))
(%make-bag (cdr <??>))))))
(%make-bag list))
result))
There may be variations of this function, but they would be roughly based on the same principle.
I'm having issues trying to form code for a problem I want to resolve. It goes like this:
~ Goal: flatten a nested list into one number
If the object is a list, replace the list with the sum of its atoms.
With nested lists, flatten the innermost lists first and work from there.
Example:
(CONDENSE '(2 3 4 (3 1 1 1) (2 3 (1 2)) 5))
(2 3 4 (6) (2 3 (3)) 5)
(2 3 4 (6) (8) 5)
(28)
=> 28
I've tried to implement the flatten list function for this problem and I ended up with this:
(defun condense (lst)
(cond
((null lst) nil)
((atom lst) (list lst)))
(t (append (flatten (apply #'+ (cdr lst))))))
But it gives me errors :(
Could anyone explain to me what is wrong with my processing/code? How can I improve it?
UPDATE: JUNE 5 2012
(defun condense(lxt)
(typecase lxt
(number (abs lxt))
(list
(if (all-atoms lxt)
(calculate lxt)
(condense (mapcar #'condense lxt))))))
So here, in this code, my true intent is shown. I have a function calculate that performs a calculation based off the values in the list. It is not necessarily the same operation each time. Also, I am aware that I am returning the absolute value of the number; I did this because I couldn't find another way to return the number itself. I need to find a way to return the number if the lxt is a number. And I had it recurse two times at the bottom, because this is one way that it loops on itself infinitely until it computes a single number. NOTE: this function doesn't implement a flatten function anymore nor does it use anything from it.
Imagine you have your function already. What does it get? What must it produce?
Given an atom, what does it return? Given a simple list of atoms, what should it return?
(defun condense (x)
(typecase x
(number
; then what?
(condense-number x))
(list
; then what?
(if (all-atoms x)
(condense-list-of-atoms x) ; how to do that?
(process-further-somehow
(condense-lists-inside x))))
; what other clauses, if any, must be here?
))
What must condense-lists-inside do? According to your description, it is to condense the nested lists inside - each into a number, and leave the atoms intact. So it will leave a list of numbers. To process that further somehow, we already "have" a function, condense-list-of-atoms, right?
Now, how to implement condense-lists-inside? That's easy,
(defun condense-lists-inside (xs)
(mapcar #'dowhat xs))
Do what? Why, condense, of course! Remember, we imagine we have it already. As long as it gets what it's meant to get, it shall produce what it is designed to produce. Namely, given an atom or a list (with possibly nested lists inside), it will produce a number.
So now, fill in the blanks, and simplify. In particular, see whether you really need the all-atoms check.
edit: actually, using typecase was an unfortunate choice, as it treats NIL as LIST. We need to treat NIL differently, to return a "zero value" instead. So it's better to use the usual (cond ((null x) ...) ((numberp x) ...) ((listp x) ...) ... ) construct.
About your new code: you've erred: to process the list of atoms returned after (mapcar #'condense x), we have a function calculate that does that, no need to go so far back as to condense itself. When you substitute calculate there, it will become evident that the check for all-atoms is not needed at all; it was only a pedagogical device, to ease the development of the code. :) It is OK to make superfluous choices when we develop, if we then simplify them away, after we've achieved the goal of correctness!
But, removing the all-atoms check will break your requirement #2. The calculation will then proceed as follows
(CONDENSE '(2 3 4 (3 1 1 1) (2 3 (1 2)) 5))
==
(calculate (mapcar #'condense '(2 3 4 (3 1 1 1) (2 3 (1 2)) 5)))
==
(calculate (list 2 3 4 (condense '(3 1 1 1)) (condense '(2 3 (1 2))) 5))
==
(calculate (list 2 3 4 (calculate '(3 1 1 1))
(calculate (list 2 3 (calculate '(1 2)))) 5))
==
(calculate (list 2 3 4 6 (calculate '(2 3 3)) 5))
==
(calculate (list 2 3 4 6 8 5))
==
28
I.e. it'll proceed in left-to-right fashion instead of the from the deepest-nested level out. Imagining the nested list as a tree (which it is), this would "munch" on the tree from its deepest left corner up and to the right; the code with all-atoms check would proceed strictly by the levels up.
So the final simplified code is:
(defun condense (x)
(if (listp x)
(reduce #'+ (mapcar #'condense x))
(abs x)))
a remark: Looking at that last illustration of reduction sequence, a clear picture emerges - of replacing each node in the argument tree with a calculate application. That is a clear case of folding, just such that is done over a tree instead of a plain list, as reduce is.
This can be directly coded with what's known as "car-cdr recursion", replacing each cons cell with an application of a combining function f on two results of recursive calls into car and cdr components of the cell:
(defun condense (x) (reduce-tree x #'+ 0))
(defun reduce-tree (x f z)
(labels ((g (x)
(cond
((consp x) (funcall f (g (car x)) (g (cdr x))))
((numberp x) x)
((null x) z)
(T (error "not a number")))))
(g x)))
As you can see this version is highly recursive, which is not that good.
Is this homework? If so, please mark it as such. Some hints:
are you sure the 'condensation' of the empty list in nil? (maybe you should return a number?)
are you sure the condensation of one element is a list? (maybe you should return a number?)
are you sure the condensation of the last case is a list? (shouldn't you return a number)?
In short, how is your condense ever going to return 28 if all your returned values are lists?
Task: With nested lists, flatten the innermost lists first and work from there
sum
flatten lists
For sum use REDUCE, not APPLY.
For flatten lists you need a loop. Lisp already provides specialized mapping functions.
Slightly more advanced: both the sum and the flatten can be done by a call to REDUCE.
You can also write down the recursion without using a higher-order function like APPLY, REDUCE, ... That's a bit more work.
Here's added the explanation of the errors you were having, actually you were close to solving your problem, just a bit more effort and you would get it right.
; compiling (DEFUN CONDENSE ...)
; file: /tmp/file8dCll3
; in: DEFUN CONDENSE
; (T (APPEND (FLATTEN (APPLY #'+ (CDR LST)))))
;
; caught WARNING:
; The function T is undefined, and its name is reserved
; by ANSI CL so that even
; if it were defined later, the code doing so would not be portable.
;
; compilation unit finished
; Undefined function:
; T
; caught 1 WARNING condition
;STYLE-WARNING: redefining CONDENSE in DEFUN
(defun condense (lst)
(cond
((null lst) nil)
((atom lst) (list lst)))
;.------- this is a function call, not a condition
;| (you closed the parens too early)
(t (append (flatten (apply #'+ (cdr lst))))))
;; Argument Y is not a NUMBER: (3 1 1 1)
;; [Condition of type SIMPLE-TYPE-ERROR]
(defun condense (lst)
(cond
((null lst) nil)
((atom lst) (list lst)); .-- not a number!
;You are calling #'+ -------. |
;on something, which | '(3 4 (3 1 1 1) (2 3 (1 2)) 5)
; is not a number. | |
(t (append (flatten (apply #'+ (cdr lst)))))))
;; You probably wanted to flatten first, and then sum
(defun condense (lst)
(cond
((null lst) nil); .--- returns just the
((atom lst) (list lst)); / atom 28, you can
; .---------------------/ just remove it.
(t (append (apply #'+ (flatten lst))))))
;; Now, you are lucky that append would just return the
;; atom if it's not a list
(defun condense (lst)
(cond
((null lst) nil)
((atom lst) (list lst))
(t (apply #'+ (flatten lst)))))
;; Again, you are lucky because (apply can take enough arguments
;; while your list is reasonably small - this will not always be
;; the case, that is why you need to use something more durable,
;; for example, reduce.
(defun condense (lst)
(cond
((null lst) nil)
((atom lst) (list lst))
(t (reduce #'+ (flatten lst)))))
;; Whoa!
(condense '(2 3 4 (3 1 1 1) (2 3 (1 2)) 5))
This is all given the flatten function actually works.
If your lisp already implements flatten and reduce functions (such as Clojure, which I will use here), you can just do something like:
user=> (defn condense [l] (reduce + 0 (flatten l)))
#'user/condense
user=> (condense [1 [2 [[3 4] 5]]])
15
user=>
Failing that, a naive implementation of those functions might be:
(defn flatten [l]
(cond (nil? l) l
(coll? l) (let [[h & t] l]
(concat (flatten h) (flatten t)))
true [l]))
and:
(defn reduce [op initial-value [h & t]]
(if (nil? t)
(op initial-value h)
(op initial-value (reduce op h t))))
But make sure to check the semantics of the particular Lisp you are using. Also, if you are implementing reduce and flatten, you may want to make them tail recursive which I didn't so as to maintain clarity.
In Common Lisp you would do something like:
(defun flatten (l)
(cond ((null l) l)
((atom l) (list l))
(t (append (flatten (car l))
(flatten (cdr l))))))
and use apply instead of reduce:
(defun condense (l) (apply #'+ (flatten l)))
I'm trying to write a function in Common Lisp similar to the built in position function, that returns a list of the positions of all elements in the haystack that match the needle, as opposed to just the first. I've come up with a few possible solutions (for example recursively searching for the next element using a cdr-from function on the position and adding the result to the previous position) but none of the approaches I've come up with so far seem particularly elegant.
Can anyone suggest what would be the best way of approaching this, as I'm currently struggling.
The obvious way to solve the problem is just to look at each element of the list in turn, and each time one compares as equal to the needle collect its position into an output list. Getting the position is very easy in this case, because we are starting from the beginning of haystack; we can use a variable to count the current position starting from 0.
So if we describe the full algorithm in a sentence, we'd say something like "to find all the positions of a needle in a haystack, for each element in the haystack, and the position starting from 0, when the element is equal to the needle, collect the position."
The LOOP facility is basically the right thing to break out when you want to do iterative processing. Even though its syntax is complicated to describe formally, after some experience you can pretty much just put the English-language description of the algorithm in the body of LOOP and it will work.
(defun all-positions (needle haystack)
(loop
for element in haystack
and position from 0
when (eql element needle)
collect position))
Take this one with a grain of salt (and be sure to load Alexandria beforehand):
(defun positions (item sequence &key (test #'eql))
(mapcar #'car
(remove item (map 'list #'cons (alexandria:iota (length sequence)) sequence)
:test-not test
:key #'cdr)))
That said, it does have the advantage of working on arbitrary sequences:
CL-USER> (positions 'x #(x x y y x x y y))
(0 1 4 5)
CL-USER> (positions 5 (list 5.0 -1 5 5.0 -1) :test #'=)
(0 2 3)
CL-USER> (positions #\l "Hello")
(2 3)
If you want a recursive function, rather than a (loop ...) based one, you could use something like:
(defun all-positions (needle haystack)
(labels ((f (n h c r)
(if (null h)
r
(if (eql (car h) n)
(f n (cdr h) (1+ c) (cons c r))
(f n (cdr h) (1+ c) r))))))
(reverse (f needle haystack 0 nil)))
Here's another (not necessarily better) way to do it.
(defun get-positions (needle haystack)
(let ((result nil))
(dotimes (i (length haystack))
(if (eq (nth i haystack) needle)
(push i result)))
(nreverse result)))