LISP extract an element from a list only in a specific case - lisp

The function i'm looking for has to return the index of the first , that is out of a pair of " ".
For example, with the sequence
{ " h i , a l l " : 3 , " h o w , i s " : " x " }
'( #\{ #\" #\h #\i #\, #\a #\l ... )
The function should return 11, not 4 (first occurrence of comma) because it is between " ".
I tried with this:
(defun control-comma (x p)
(cond ((eql (car x) #\")
(control-comma (subseq x (+ (position #\" x :start (+ 1 p)) 1)) p))
((eql (car x) #\,)
p)
(t
(control-comma (cdr x) (+ 1 p)))
)
)
Using x as list of input and p as a 0-parameter to count the position, but it doesn't work and seems to be far away from the solution i'm looking for.
Thank you for every suggestion.

Instead of defining a complex function, I suggest you to use the predefined position-if operator:
(defun first-comma (string start)
(let ((in-double-quote nil))
(position-if
(lambda (x)
(case x
((#\") (progn (setf in-double-quote (not in-double-quote)) nil))
((#\,) (not in-double-quote))))
string
:start start)))
CL-USER> (first-comma (coerce "{ \"hi, all\" : 3, \"how, is\" : \"x\" }" 'list) 0)
15
A more complex, recursive solution based again on the idea of scanning the input list one character at time, is given by the following function, where the state “inside double-quote” is encoded through a couple of recursive local functions:
(defun fist-comma (x pos)
(labels ((looking-for-comma (x pos)
(cond ((null x) nil)
((eql (car x) #\,) pos)
((eql (car x) #\") (looking-for-double-quote (cdr x) (1+ pos)))
(t (looking-for-comma (cdr x) (1+ pos)))))
(looking-for-double-quote (x pos)
(cond ((null x) nil)
((eql (car x) #\") (looking-for-comma (cdr x) (1+ pos)))
(t (looking-for-double-quote (cdr x) (1+ pos))))))
(looking-for-comma (nthcdr pos x) pos)))
Finally, note that in both the above functions one should take into account possible escaping of the double quote with appropriate means.

Related

how to solve badly formed lambda in lisp?

I am trying to check if a list has a mountain aspect or not in lisp.
e.g:1,5,9,6,4,3
l is my list and aux is 0-the ascending part of l or 1-the descending part of the list.
muntemain just call munte starting with aux=0,the ascending part
my error is :
Badly formed lambda: (AND (< (CAR L) (CAR (CDR L))) (EQ AUX 0))
and I can't see the problem.Can someone help please?
(defun munte (l aux)
(cond
((and (atom l) (null aux)) NIL)
((and (null l) (null aux)) NIL)
((and (atom l) (eq aux 1)) T)
((and (null l) (eq aux 1) T)
((and (< (car l) (car(cdr l))) (eq aux 0)) (munte(cdr l) 0))
((and (or (> (car l) (cadr l)) (= (car l) (cadr l))) (eq aux 0))(munte(cdr l) 1))
( and (> (car l) (cadr l)) (eq aux 1)) (munte(cdr l) 1))
(T NIL)
)
)
(defun muntemain (l)
(cond
((> (car l) (cadr l)) NIL)
((< (length l) 2) NIL)
(T (munte l 0))
)
)
Formatting
As noted by Barmar, you really need to use an editor to help you with the parenthesis. There are many tutorials for installing Emacs+Slime. Take some time to install proper tools.
Don't use EQ for numbers and characters
An implementation is permitted to make "copies" of characters and
numbers at any time. The effect is that Common Lisp makes no guarantee
that eq is true even when both its arguments are "the same thing" if
that thing is a character or number.
Factorize tests
((and (atom l) (null aux)) NIL)
((and (null l) (null aux)) NIL)
((and (atom l) (eq aux 1)) T)
((and (null l) (eq aux 1) T)
From the definition of atom, NIL is an atom, so you don't need (null L). The different cases for aux can be grouped too. The clause below is sufficient to account for all the above ones:
((atom L) (eql aux 1))
But I don't understand why aux is not a boolean in the first place if you always bind it to 0 or 1. Just use t and nil and return aux in the above clause.
Use meaningful functions
(< (car l) (car(cdr l)))
Of course, (car(cdr ..)) is known as (cadr ..), but also as second. The above test is equivalent to:
(< (first L) (second L))
And what if your list has no second element? You will compare a number against nil and signal an error (not what you want). You need more tests. In muntemain, you seem to have a special case for when length is below 2, but the test is done only if the previous returns nil, which won't happen if an error is signaled.
An iterative alternative
Here is a completely different way to attack the problem, just to give you ideas.
(lambda (list)
(loop
;; memories
for px = nil then x
for pdx = nil then dx
;; current element
for x in list
;; first and second "derivatives" (signs only)
for dx = 1 then (signum (- x px))
for ddx = 0 then (signum (- dx pdx))
;; checks
sum ddx into total
always (and (<= dx 0) (<= -1 total 0))
finally (return (= total -1))))

Converting list of strings to list of ints in Common Lisp

I have a line like "fun,arg1,arg2" <- it is a string
I split this string into list of strings by "," separator. Then I compare "fun" with some string (e.g. "Fibonacci").
Function for splitting (works fine)
(defun split-str (string &optional (r nil))
(let ((n (position "," string
:from-end t
:test #'(lambda (x y)
(find y x :test #'string=)))))
(if n
(split-str (subseq string 0 n)
(cons (subseq string (1+ n)) r))
(cons string r))))
Test function
(defun tmp (a)
(if (string= (nth 0 a) "Fibonacci")
(progn
(setf tab '())
(dolist (n (cdr a))
(cons tab '(parse-integer n))) ; parsing works fine (checked with write)
(write tab)) ; always NIL
;(apply #'parse-integer (apply #'values a)) - doesn't work
(write "nok")))
Calling:
(tmp (split-str "Fibonacci,15,33"))
Why my tab hasn't 2 elements?
cons doesn't change anything; it returns a new list using tab.

Undefined function in lisp

I am writing a lisp function and I keep getting EVAL - undefined function x when I try to return the value of x from the function.
(defun p+ (x y)
(recurcollect (gluelist x y) '()))
(defun isinlist (x y)
(if (car y)
(if (equal (cdr x) (cdar y))
t
(if (cdr y)
(isinlist(x (cdr y)))
NIL))
NIL))
(defun collectvalue (x y) ;takes an expression and a list and returns the sum of all like expressions from the list
(if (equal x NIL)
(print '(x is NIL))
(if (equal (cdr x) (cdar y))
(if (cdr y)
(collectvalue (list (+ (car x) (caar y)) (cdr x)) (cdr y))
(list (+ (car x) (caar y)) (cdr x)))
(if (cdr y)
(collectvalue x (cdr y))
x))))
(defun recurcollect (x y) ;returns a flat list of collected expressions
(if (isinlist (car x) y)
(recurcollect (cdr x) y)
(if (cdr x)
(recurcollect x (cons y (collectvalue (car x) (cdr x))))
(cons y (car x)))))
(defun gluelist (x y)
(if (cdr x)
(cons (car x) (gluelist (cdr x) y))
(cons (car x) y)))
(print (p+ '(2 0 1) '(4 0 1))) ;(6 0 1)
I believe the error is caused by the x at the end of the function but I cant see why, as far as I can tell my brackets are correctly paired up and I cant see why it is trying to evaluate x as a function.
The problem is in isinlist which is called recursively as (isinlist(x (cdr y))).
(x ...) is interpreted as a function call of function x.
You probably want (isinlist x (cdr y)) instead.
Incidentally, you can replace isinlist with member (with :key #'cdr :test #'equal).

stable-union lisp

Need to write a union function in lisp that takes two lists as arguments and returns a list that is the union of the two with no repeats. Order should be consistent with those of the input lists
For example: if inputs are '(a b c) and '(e c d) the result should be '(a b c e d)
Here is what I have so far
(defun stable-union (x y)
(cond
((null x) y)
((null y) x))
(do ((i y (cdr i))
(lst3 x (append lst3
(cond
((listp i)
((null (member (car i) lst3)) (cons (car i) nil) nil))
(t (null (member i lst3)) (cons i nil) nil)))))
((null (cdr i)) lst3)))
My error is that there is an "illegal function object" with the segment (null (member (car i) lst3))
Advice?
You've got your parens all jumbled-up:
(defun stable-union (x y)
(cond
((null x) y)
((null y) x) ) END OF COND form - has no effect
(do ((i y (cdr i))
^^
(lst3 x (append lst3
(cond
((listp i)
( (null (member (car i) lst3))
^^ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ called as a function
(cons (car i) nil) with two arguments
nil ) )
^^
(t NEXT 3 forms have no effect
(null (member i lst3))
(cons i nil)
nil )))) )
^^
((null (cdr i)) lst3)))
Here's your code as you probably intended it to be, with corrected parenthesization and some ifs added where needed:
(defun stable-union (x y)
(cond
((null x) y)
((null y) x)
(t
(do ((i y (cdr i))
(lst3 x (append lst3
(cond
((listp i)
(if (null (member (car i) lst3))
(cons (car i) nil)
nil))
(t
(if (null (member i lst3))
(cons i nil)
nil))))))
((null (cdr i)) lst3)))))
There are still problems with this code. Your do logic is wrong, it skips the first element in y if it contains just one element. And you call append all the time whether it is needed or not. Note that calling (append lst3 nil) makes a copy of top-level cons cells in lst3, entirely superfluously.
Such long statements as you have there are usually placed in do body, not inside the update form for do's local variable.
But you can use more specialized forms of do, where appropriate. Here it is natural to use dolist. Following "wvxvw"'s lead on using hash-tables for membership testing, we write:
(defun stable-union (a b &aux (z (list nil)))
(let ((h (make-hash-table))
(p z))
(dolist (i a)
(unless (gethash i h)
(setf (cdr p) (list i) p (cdr p))
(setf (gethash i h) t)))
(dolist (i b (cdr z))
(unless (gethash i h)
(setf (cdr p) (list i) p (cdr p))
(setf (gethash i h) t)))))
using a technique which I call "head-sentinel" (z variable pre-initialized to a singleton list) allows for a great simplification of the code for the top-down list building at a cost of allocating one extra cons cell.
The error is because you're trying to execute the result of evaluating (null (member (car i) lst3)). In your cond expression, if i is a list, then it attempts to evaluate the expression
((null (member (car i) lst3)) (cons (car i) nil) nil))
And return the result. The first element in an expression should be a function, but
(null (member (car i) lst3))
Is going to return a boolean value. Hence the failure. The structure of your code needs some attention. What you've missed is that you need an inner cond, there.
Incidentally, this would be a much cleaner function if you did it recursively.
I'm a Schemer rather than a Lisper, but I had a little think about it. Here's the skeleton of a recursive implementation:
(defun stable-union (x y)
(cond
((null x) y)
((null y) x)
((listp y)
(cond
((member (car y) x) (stable-union ??? (???)))
(t (stable-union (append x (??? (???))) (cdr y)))))
((not (member y x)) (append x (list y)))
(t x)))
(Edited to correct simple tyop in second-last line, thanks to Will Ness for spotting it)
(remove-duplicates (append '(a b c) '(e c d)) :from-end t)
Because you started off with do, and because a recursive solution would be even worse, here's what you could've done:
(defun union-stable (list-a list-b)
(do ((i list-b (cdr i))
filtered back-ref)
((null i) (append list-a back-ref))
(unless (member (car i) list-a)
(if back-ref
(setf (cdr filtered) (list (car i))
filtered (cdr filtered))
(setf back-ref (list (car i))
filtered back-ref)))))
This is still quadratic time, and the behaviour is such that if the first list has duplicates, or the second list has duplicates, which are not in the first list - they will stay. I'm not sure how fair it is to call this function a "union", but you'd have to define what to do with the lists if they have duplicates before you try to unify them.
And this is what you might've done if you were interested in the result, rather than just exercising. Note that it will ensure that elements are unique, even if the elements repeat in the input lists.
(defun union-stable-hash (list-a list-b)
(loop for c = (car (if list-a list-a list-b))
with back-ref
with hash = (make-hash-table)
for key = (gethash c hash)
with result
do (unless key
(if back-ref
(setf (cdr result) (list c)
result (cdr result))
(when (or list-a list-b)
(setf back-ref (list c)
result back-ref)))
(setf (gethash c hash) t))
do (if list-a (setf list-a (cdr list-a))
(setf list-b (cdr list-b)))
do (unless (or list-a list-b)
(return back-ref))))

Finding the maximum number of child nodes in a tree

First, I should make it clear that this is required for an academic project. I am trying to find the maximum number of child nodes for any node in a tree, using Common Lisp.
My current code is shown below - I'm not 100% on the logic of it, but I feel it should work, however it isn't giving me the required result.
(defun breadth (list y)
(setf l y)
(mapcar #'(lambda (element)
(when (listp element)
(when (> (breadth element (length element)) l)
(setf l (breadth element (length element)))
))) list)
l)
(defun max-breadth(list)
(breadth list (length list))
)
As an example, running
(max-breadth '(a ( (b (c d)) e) (f g (h i) j)))
should return 4.
Edit:
Trace results and actual return values, forgot these:
CG-USER(13): (max-breadth '(a ( (b (c d)) e) (f g (h i) j)))
0[6]: (BREADTH (A ((B (C D)) E) (F G (H I) J)) 3)
1[6]: (BREADTH ((B (C D)) E) 2)
2[6]: (BREADTH (B (C D)) 2)
3[6]: (BREADTH (C D) 2)
3[6]: returned 2
2[6]: returned 2
1[6]: returned 2
1[6]: (BREADTH (F G (H I) J) 4)
2[6]: (BREADTH (H I) 2)
2[6]: returned 2
1[6]: returned 2
0[6]: returned 2
2
Does anyone have any ideas where I'm going wrong? I suspect it's related to the second conditional, but I'm not sure.
First, standard formatting:
(defun breadth (list y)
(setf l y)
(mapcar #'(lambda (element)
(when (listp element)
(when (> (breadth element (length element)) l)
(setf l (breadth element (length element))))))
list)
l)
(defun max-breadth (list)
(breadth list (length list)))
Your problem is the (setf l y), which should give you a warning about l being undefined. Setf should not be used on unbound variables. Use let to make a lexical scope:
(defun breadth (list y)
(let ((l y))
(mapcar #'(lambda (element)
(when (listp element)
(when (> (breadth element (length element)) l)
(setf l (breadth element (length element))))))
list)
l))
Then, instead of two nested when, use a single one and and:
(when (and (listp element)
(> (breadth element (length element)) 1))
(setf l (breadth element (length element))))
I find dolist more concise here:
(dolist (element list)
(when (and (listp element)
(> (breadth element (length element)) l))
(setf l (breadth element (length element)))))
The parameter y is always the length of the parameter list, so this call can be simplified. You also do not need to alias y:
(defun breadth (list &aux (y (length list)))
(dolist (element list)
(when (and (listp element)
(> (breadth element) y))
(setf y (breadth element))))
y)
You could eliminate the double recursive call through a let, but we can use max here:
(defun breadth (list &aux (y (length list)))
(dolist (element list)
(when (listp element)
(setf y (max y (breadth element)))))
y)
You could also use reduce for this:
(defun breadth (l)
(if (listp l)
(reduce #'max l
:key #'breadth
:initial-value (length l))
0))
L is not a local variable, so the function will return the last value assigned to it (ie, the breadth of the last subtree).
Use LET to declare a local variable:
(LET ((l y))
...
)
Isn't the correct answer 6? Since e and j in your example are also technically child nodes? If that's how you're defining your problem, the following solution should get you there:
(defun max-breadth (lst)
(cond
((atom lst) 0)
((every #'atom lst) (length lst))
(t (+ (max-breadth (car lst)) (max-breadth (cdr lst))))))
version 2:
(defun max-breadth (lst)
(cond
((atom lst) 0)
((every #'atom lst) (length lst))
(t (+
(max-breadth (car lst))
(max-breadth (remove-if-not #'consp (cdr lst)))))))