I want to write a function that will return a string formatted with alternative upcase/downcase in Common Lisp. For example, entering "stackoverflow" should return the string "StAcKoVeRfLoW". Here's my attempt, but it just returns a list of cons pairs. Am I on the right track?
(defun mockify (chars)
(let ((lst (coerce chars 'list)))
(if (equal lst nil) nil
(coerce (cons
(cons (char-upcase (car lst)) (char-downcase (cadr lst)))
(mockify (cddr lst)))
'string))))
CL-USER> (mockify "meow")
((#\M . #\e) (#\O . #\w))
Using MAP: we are creating a new string, moving over the original string and upcase/downcase based on an alternating boolean variable.
CL-USER 353 > (let ((string "stackoverflow")
(upcase t))
(map (type-of string)
(lambda (element)
(prog1 (if upcase
(char-upcase element)
(char-downcase element))
(setf upcase (not upcase))))
string))
"StAcKoVeRfLoW"
(defun mockify (chars)
(let ((lst (coerce chars 'list)))
(if (equal lst nil)
;; return nil
nil
;; return a string (coerce)
(coerce
;; a list whose elements are cons-cells, but ...
(cons (cons (char-upcase (car lst))
(char-downcase (cadr lst)))
;; ... the rest is computed by calling mockify,
;; which returns either an empty list or a string
(mockify (cddr lst)))
'string))))
The types of your expressions are confusing, and in fact your example leads to an error when using SBCL:
> (mockify "meow")
The value
(#\O . #\w)
is not of type
CHARACTER
when setting an element of (ARRAY CHARACTER)
[Condition of type TYPE-ERROR]
Also, you are going to have to handle corner cases in your code, because as is, it is possible that (cadr list), i.e. (second list), is called on a list that has only one element. Then, the result would be NIL and char-downcase would fail with an error.
Using only strings
I'd suggest writing a version of the function that does not use intermediate lists:
let R be the string-downcase of the whole string
then modify every other character of R by upcasing it
So for example, one way to do it (among others) would be:
(defun mockify (chars)
(let ((chars (string-downcase chars)))
(prog1 chars
(upcasify chars 0))))
(defun upcasify (string index)
(when (< index (length string))
(setf (char string index) (char-upcase (char string index)))
(upcasify string (+ index 2))))
Using only lists
If you prefer having a recursive function that processes lists, I'd rather define it in layers:
coerce string to list
process the list recursively
eventually, coerce the resulting list back to a string
This will avoid doing conversions from strings to lists at every step, and make the code simpler at each level.
(defun mockify (chars)
(coerce (mockify-list (coerce chars 'list)) 'string))
(defun mockify-list (chars)
...)
The list version is recursive and look like what you tried to do, but take care of corner cases.
There is more than one way to do it. Here is a loop based solution:
(let ((string "StackOverflow"))
(with-output-to-string (s)
(loop :for c :across string
:for up := t :then (not up)
:do (princ (if up
(char-upcase c)
(char-downcase c))
s))))
Fun thing - I actually wrote a similar thing some time ago.
https://github.com/phoe/string-pokemonize
Related
I am trying to modify this function in a way that when given a list it will only keep the words ending with a given letter. I have few restriction on what I am allowed to use and needs to keep char,rplacd and length to do it. I'm now having difficulties with the 'length ' part. I initially manage to do it in a way that it would keep all words starting with given letter but I am having trouble doing the opposite in line 5.
(setq liste '(have read nose art silence))
I would get the following result
(endingwith 'e liste) => (have nose silence)
(defun endingwith (x liste)
(cond
((not liste) nil)
((equal
(char (string (length (car liste))) 0)
(char (string x) 0) )
(rplacd liste (endingwith x (cdr liste))) )
(t (endingwith x (cdr liste))) ) )
Note that the task you have been given teaches a style of Lisp programming which is in the real world not used.
we need to operate of strings, which are vectors of characters
we can use the standard function remove
destructively changing a list is sometimes useful but can be avoided. See delete for a destructive version of remove
Example:
(defun keep-symbols-ending-with-char (char symbols)
"returns a sequence, where all symbols end with the given char"
(when (symbolp char)
(setf char (char (symbol-name char) 0)))
(remove char
symbols
:test-not #'eql
:key (lambda (item &aux (string (symbol-name item)))
(char string (1- (length string))))))
CL-USER> (keep-symbols-ending-with-char 'e '(have read nose art silence))
(HAVE NOSE SILENCE)
Given the limited resources you are given, this calls for a recursive solution. The value of (endingwith 'e liste) should be defined in terms of the value of calling endingwith with the rest of the list, and adding or not the first element if it matches 'e.
Further notice that in your case, length should be used with a string, so use (length (string (car liste))) instead of (string (length (car liste))).
The function would look like this:
(defun endingwith (x liste)
(cond
((not liste) nil)
((eql (char (string x) 0) (char (string (car liste)) (- (length (string (car liste))) 1)))
(cons (car liste) (endingwith x (cdr liste))) )
(t (endingwith x (cdr liste))) ))
Some points of style: don't use (not liste); instead use either (null liste) or (endp liste) which emphasize that liste is either an empty list, or that processing has reached the end of liste, respectively. Also, use '() when the intention is to represent an empty list; use nil when the intention is to represent boolean False.
The elements of liste are symbols, and x itself is a symbol; these symbols need to be converted to sequences so that the final character of the symbol can be assessed. string will do the job. But OP code has two problems here: length takes a sequence argument, so the value of (car liste) must also be converted using string; and sequences are zero-indexed in Common Lisp, so the last index of a sequence is one less than its length.
(defun endingwith (x liste)
(cond
((null liste) '())
((equal (char (string (car liste))
(- (length (string (car liste))) 1))
(char (string x) 0))
(rplacd liste (endingwith x (cdr liste))))
(t
(endingwith x (cdr liste)))))
One way to debug programs like this in Common Lisp is to get into the REPL and experiment. When you use a function and it sends you to the debugger, look for lines in that function that may have problems.
In the posted code, (char (string (length (car liste))) 0) is the first likely candidate. Try (car liste) at the REPL and see if that evaluates to 'HAVE as expected. When it does, try (length (car liste)). That will send you to the debugger again with a type error and a message like
LENGTH: HAVE is not a SEQUENCE.
This suggests that you need to use (string (car liste)) in the same way that (string x) is used in the next line of the original function definition. So, try (length (string (car liste))) at the REPL. Now you should see the expected value of 4, but it becomes apparent that the original line of code was a bit jumbled up, because char wants the first argument to be a string, and the second argument to be an index. So try again at the REPL (char (string (car liste)) (length (string (car liste)))). This again lands us in the debugger with a message like:
CHAR: index 4 should be less than the length of the string.
But that message reminds us that sequences are zero-indexed in Common Lisp, and that the last index of a string of length 4 is 3. So, once again at the REPL: (char (string (car liste)) (- (length (string (car liste))) 1)). Now we have success, with the REPL returning the expected #\E. Having worked through this problematic line at the REPL, we can now replace the line in the original function definition and see if that works. It does.
(defun ends-with-p (end s)
(string= end (subseq s (- (length s) (length end)))))
(defun keep-ending-with (end strings)
(remove-if-not #'(lambda (x) (ends-with-p end x)) strings))
I want to solve a lisp function that returns a NUMBER(count) of numbers which are greater than the first number in the list.The list is a linear list of numbers.
(defun foo (lst)
(cond ((null lst) 0)
(car = k)
((> (car lst) k)
(1+ (foo (cdr lst))))
(T (foo (cdr lst)))))
My problem is that I cannot keep the first element and compare it with the others.
Let's take apart your problem:
You have a set of numbers. Really, you have a “special” first number, and then the rest of them. Specifically, you probably want only real numbers, because “less than” does not make sense in terms of complex (imaginary) numbers.
You can use first to get the first number from the list, and rest for the others.
Of these, you want to count any that are not greater than the first.
So let's start with sort of pseudocode
(defun count-numbers-greater-than-first (list)
;; split out first and rest
;; call the real count function
)
Well, we know now that we can use first and rest (also, as you used, historically car and cdr), so:
(defun count-numbers-greater-than-first (list)
(count-numbers-greater-than (first list) (rest list))
You already probably know that > is used to test whether real numbers are greater than one another.
A quick look at the CLHS reveals a nice function called count-if
(defun count-numbers-not-greater-than (reference other-numbers)
(count-if ??? other-numbers))
The ??? needs to be an object of function type, or the name of a function. We need to “curry” the reference (first number) into that function. This means we want to create a new function, that is only used for one run through the count-if, that already has “closed over” the value of reference.
If we knew that number would always be, say, 100, that function would look like this:
(defun greater-than-100 (number)
(> number 100))
That function could then get used in the count-if:
(defun count-numbers-greater-than (reference other-numbers)
(count-if (function greater-than-100)
other-numbers))
(defun count-numbers-greater-than (reference other-numbers)
(count-if #'greater-than-100 other-numbers))
But that doesn't solve the problem of getting the reference number “curried” into the function.
Without reaching for Alexandria (I'll explain in a moment), you can use a lambda form to create a new, anonymous function right here. Since reference is available within count-numbers-not-greater-than, you can use its value within that lambda. Let's convert for 100 first:
(defun count-numbers-greater-than (reference other-numbers)
(count-if (lambda (number) (> number 100))
other-numbers))
Now we can use reference:
(defun count-numbers-greater-than (reference other-numbers)
(count-if (lambda (number) (> number reference))
other-numbers))
And, in fact, you could even merge this back into the other function, if you wanted:
(defun count-numbers-greater-than-first (list)
(count-if (lambda (number) (> number (first list)))
(rest list)))
That Alexandria thing
But, what about Alexandria? Alexandria is a collection of super-useful utility functions that's available in Quicklisp or elsewhere.
(ql:quickload "alexandria")
(use-package #:alexandria)
Of course, you'd normally use it in your own defpackage
(defpackage my-cool-program
(:use :common-lisp :alexandria))
Two of the things it provides are curry and rcurry functions. It turns out, that lambda function in there is a really common case. You have an existing function — here, > — that you want to call with the same value over and over, and also some unknown value that you want to pass in each time.
These end up looking a lot like this:
(lambda (x) (foo known x))
You can use curry to write the same thing more concisely:
(curry #'foo known)
It also work with any number of arguments. RCurry does the same, but it puts the unknown values “x” at the left, and your known values at the right.
(lambda (x) (foo x known)) = (rcurry #'foo known)
So another way to write the count-if is:
(defun count-numbers-greater-than-first (list)
(count-if (rcurry #'> (first list))
(rest list)))
* (count-numbers-greater-than-first '(10 9 8 7 11 12))
2
Your function indented correctly looks like this:
(defun foo (lst)
(cond ((null lst) 0)
(car = k) ; strange cond term
((> (car lst) k)
(1+ (foo (cdr lst))))
(T (foo (cdr lst)))))
I have commented the second term in your cond. It is quite strange. It first evaluates the variable car (not the function #'car). If car is not nil it first evaluates the variable = (not the function #'=) and since it is not the last consequent expression in the cond term it throws that away and returns the last which is k.
Secondly you write that you say you use the first element as comparison, however you call it k in your function but it is not defined anywhere. You need to do something before you do the recursion and thus you cannot let the actual function do the recursion since it will take the first element each time. Here is where labels can be used:
;; didn't call it foo since it's not very descriptive
(defun count-larger-than-first (list)
(let ((first (car list)))
(labels ((helper (list)
(cond ((null list) 0)
((> (car list) first)
(1+ (helper (cdr list))))
(t (helper (cdr list))))))
(helper (cdr list)))))
Of course. Since you now have the possibility to add more arguments I would have added an accumulator:
(defun count-larger-than-first (list)
(let ((first (car list)))
(labels ((helper (list acc)
(cond ((null list) acc)
((> (car list) first)
(helper (cdr list) (1+ acc)))
(t (helper (cdr list) acc)))))
(helper (cdr list) 0))))
And of course recursion might blow the stack so you should really write it without in Common Lisp:
(defun count-larger-than-first (list)
(let ((first (car list)))
(loop :for element :in (cdr list)
:counting (> element first))))
There are higher order functions that count too which might be more suitable:
(defun count-larger-than-first (list)
(let ((first (car list)))
(count-if (lambda (element) (> element first))
(cdr list))))
I'm trying to create a function that would test whether the given list is circular with a re-starting point being the beginning of the list.
Expected results:
(setq liste '(a b c))
(rplacd (cddr liste) liste)
(circular liste) => t
(circular '(a b c a b c)) => nil
As I simply want to test if any subsequent item is 'eq' to the first one, I don't want to build the whole tortoise and hare algorithm.
Here is my code :
(defun circular (liste)
(let (beginningliste (car liste)))
(labels ( (circ2 (liste)
(cond
((atom liste) nil)
((eq (car liste) beginningliste) t)
(t (circ2 (cdr liste)))
) ) ) ) )
It doesn't give the expected result but I don't understand where my error is
I'm not sure I'm using 'labels' correctly
Is there a way to do that without using 'labels'?
Edit. I guess I have answered my third question as I think I have found a simpler way. Would this work?
(defun circular (liste)
(cond
((atom liste) nil)
((eq (car liste) (cadr liste)) t)
(t (circular (rplacd liste (cddr liste))))
)
)
First, the behavior is undefined when you mutate constant data: when you quote something (here the list), the Lisp environment has the right to treat it as a constant. See also this question for why defparameter or defvar is preferred over setq. And so...
(setq list '(a b c))
(rplacd (cddr list) list)
... would be better written as:
(defparameter *list* (copy-list '(a b c)))
(setf (cdr (last *list*)) *list*)
Second, your code is badly formatted and has bad naming conventions (please use dashes to separate words); here it is with a conventional layout, with the help of emacs:
(defun circularp (list)
(let (first (car list)))
(labels ((circ2 (list)
(cond
((atom list) nil)
((eq (car list) first) t)
(t (circ2 (cdr list))))))))
With that formatting, two things should be apparent:
The let contains no body forms: you define local variables and never use them; you could as well delete the let line.
Furthermore, the let is missing one pair of parenthesis: what you wrote defines a variable name first and another one named car, bound to list. I presume you want to define first as (car list).
You define a local circ2 function but never use it. I would expect the circularp function (the -p is for "predicate", like numberp, stringp) to call (circ2 (cdr list)). I prefer renaming circ2 as visit (or recurse), because it means something.
With the above corrections, that would be:
(defun circularp (list)
(let ((first (car list)))
(labels ((visit (list)
(cond
((atom list) nil)
((eq (car list) first) t)
(t (visit (cdr list))))))
(visit (cdr list)))))
However, if your list is not circular but contains the same element multiple times (like '(a a b)), you will report it as circular, because you inspect the data it holds instead of the structure only. Don't look into the CAR here:
(defun circularp (list)
(let ((first list))
(labels ((visit (list)
(cond
((atom list) nil)
((eq list first) t)
(t (visit (cdr list))))))
(visit (cdr list)))))
Also, the inner function is tail recursive but there is no guarantee that a Common Lisp implementation automatically eliminates tail calls (you should check with your implementation; most can do it on request). That means you risk allocating as many call stack frames as you have elements in the list, which is bad. Better use a loop directly:
(defun circularp (list)
(loop
for cursor on (cdr list)
while (consp cursor)
thereis (eq cursor list)))
Last, but not least: your approach is a very common one but fails when the list is not one big circular chain of cells, but merely contains a loop somewhere. Consider for example:
CL-USER> *list*
#1=(A B C . #1#)
CL-USER> (push 10 *list*)
(10 . #1=(A B C . #1#))
CL-USER> (push 20 *list*)
(20 10 . #1=(A B C . #1#))
(see that answer where I explain what #1= and #1# mean)
The lists with numbers in front exhibit circularity but you can't just use the first cons cell as a marker, because you will be looping forever inside the sublist that is circular. This is the kind or problems the Tortoise and Hare algorithm solves (there might be other techniques, the most common being storing visited elements in a hash table).
After your last edit, here is what I would do if I wanted to check for circularity, in a recursive fashion, without labels:
(defun circularp (list &optional seen)
(and (consp list)
(or (if (member list seen) t nil)
(circularp (cdr list) (cons list seen)))))
We keep track of all the visited cons cells in seen, which is optional and initialized to NIL (you could pass another value, but that can be seen as a feature).
Then, we say that a list is circular with respect to seen if it is a cons cell which either: (i) already exists in seen, or (ii) is such that its CDR is circular with respect to (cons list seen).
The only additional trick here is to ensure the result is a boolean, and not the return value of member (which is the sublist where the element being searched for is the first element): if your environment has *PRINT-CIRCLE* set to NIL and the list is actually circular, you don't want it to try printing the result.
Instead of (if (member list seen) t nil), you could also use:
(when (member list seen))
(position list seen)
and of course (not (not (member list seen)))
This is the Common Lisp code:
(defun take (L)
(if (null L) nil
(cons (car L) (skip (cdr L)))))
(defun skip (L)
(if (null L) nil
(cons (car L) (take (cdr L)))))
The idea here is that, "take" will give all the odd sequence elements in the input list and "skip" will give all the even sequence elements in the input list. However, in both cases the entire list is returned.
What is the error in this code? Is this something to do with how CL handles lists, because the similar code in SML gives the desired output.
fun take(lst) =
if lst = nil then nil
else hd(lst)::skip(tl(lst))
and
skip(lst) =
if lst = nil then nil
else hd(lst)::take(tl(lst));
To expound on what Sylwester has said, your skip is wrong in both Lisp and SML. It should be
(defun take (L) ; even-indexed elements of a list L
(if (not (null L))
(cons (car L) (skip (cdr L)))))
(defun skip (L) ; odd-indexed elements of a list L
(if (not (null L))
(take (cdr L))))
and
fun take(lst) =
if lst = nil then nil
else hd(lst)::skip(tl(lst))
and
skip(lst) =
if lst = nil then nil
else take(tl(lst));
The take and skip are identical so that is no mystery. skip should just tail call instead of cons-ing. It's the consing that makes the return here.
It's worth pointing out that indexing in Common Lisp (like many other programming languages) starts with 0, so the even-indexed elements of a list are the first, the third, the fifth, and so on, since those have indices 0, 2, 4, etc. It's also worth noting that in Common Lisp, you can take the rest of the empty list and get back the empty list. (You can't do this in every Lisp, though. E.g., in Scheme it's an error to call cdr on something that's not a pair.) This means that you can implement even-elements and odd-elements rather easily. even-elementsjust returns a list of the first element, and the odd elements of the rest of the list. odd-elements returns the even-elements of the rest of the list:
(defun even-elements (list)
(if (endp list) list
(list* (first list) (odd-elements (rest list)))))
(defun odd-elements (list)
(even-elements (rest list)))
These behave in the expected fashion:
CL-USER> (even-elements '(0 1 2 3 4 5))
(0 2 4)
CL-USER> (odd-elements '(0 1 2 3 4 5))
(1 3 5)
Of course, if you note that the call to (odd-elements x) is just a call to (even-elements (rest x)), we could have implemented even-elements as follows, and had the same result:
(defun even-elements (list)
(if (endp list) list
(list* (first list) (even-elements (rest (rest list))))))
The program should reformat the string like below.
Example: (game-print '(THIS IS A SENTENCE。 WHAT ABOUT THIS？ PROBABLY.))
This is a sentence. What about ths? Probably.
But something is wrong( Lisp nesting exceeds `max-lisp-eval-depth) and i don't know why. This piece of code is actually from the book "Land of lisp" in page 97. The original code is written in common lisp. I want to rewrite it in elisp. The last two argument in tweak-text means captain and literal.
(defun tweak-text (lst caps lit)
(when lst
(let ((item (car lst))
(rest (cdr lst)))
(cond ((eql item ?\ ) (cons item (tweak-text rest caps lit)))
((member item '(?\! ?\? ?\.)) (cons item (tweak-text rest t lit)))
((eql item ?\") (tweak-text rest caps (not lit)))
(lit (cons item (tweak-text rest nil lit)))
(caps (cons (upcase item) (tweak-text rest nil lit)))
(t (cons (downcase item) (tweak-text rest nil nil)))))))
(defun game-print (lst)
(print (coerce (tweak-text (coerce (prin1-to-string lst) 'list) t nil) 'string)))
(game-print '(not only does this sentence have a "comma," it also mentions the "iPad."))
The orignal code written in common lisp.
(defun tweak-text (lst caps lit)
(when lst
(let ((item (car lst))
(rest (cdr lst)))
(cond ((eql item #\space) (cons item (tweak-text rest caps lit)))
((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit)))
((eql item #\") (tweak-text rest caps (not lit)))
(lit (cons item (tweak-text rest nil lit)))
(caps (cons (char-upcase item) (tweak-text rest nil lit)))
(t (cons (char-downcase item) (tweak-text rest nil nil)))))))
(defun game-print (lst)
(princ (coerce (tweak-text (coerce (string-trim "() " (prin1-to-string lst)) 'list) t nil) 'string))
(fresh-line))
In both cases, you have non-terminal recursions, so you're using
O(length(lst)) stack space. Obviously, systems may limit the stack
space you can use, and you do indeed reach this limit in emacs. (Now
then in emacs, you can increase the limit by changing
max-lisp-eval-depth, but this won't solve the fundamental problem).
The solution is to use iteration instead of recursion.
But first, write in emacs:
(defun character (x)
"common-lisp: return the character designated by X."
(etypecase x
(integer x)
(string (aref x 0))
(symbol (aref (symbol-name x) 0))))
(defun string-trim (character-bag string-designator)
"common-lisp: returns a substring of string, with all characters in \
character-bag stripped off the beginning and end."
(unless (sequencep character-bag)
(signal 'type-error "expected a sequence for `character-bag'."))
(let* ((string (string* string-designator))
(margin (format "[%s]*" (regexp-quote
(if (stringp character-bag)
character-bag
(map 'string 'identity character-bag)))))
(trimer (format "\\`%s\\(\\(.\\|\n\\)*?\\)%s\\'" margin margin)))
(replace-regexp-in-string trimer "\\1" string)))
(require 'cl)
so that you can write a single function for both CL and elisp:
(defun tweak-text (list caps lit)
(let ((result '()))
(dolist (item list (nreverse result))
(cond ((find item " !?.") (push item result))
((eql item (character "\"")) (setf lit (not lit)))
(lit (push item result)
(setf caps nil))
(caps (push (char-upcase item) result)
(setf caps nil))
(t (push (char-downcase item) result)
(setf caps nil
lit nil))))))
(defun game-print (list)
(princ (coerce (tweak-text (coerce (string-trim "() " (prin1-to-string list)) 'list)
t nil)
'string))
(terpri))
Then:
(game-print '(not only does this sentence have a "comma," it also mentions the "iPad."))
in emacs:
prints: Not only does this sentence have a comma, it also mentions the iPad.
returns: t
in Common Lisp:
prints: Not only does this sentence have a comma, it also mentions the iPad.
returns: nil
Now, in general there's little point of using lists to process strings, both emacs lisp and Common Lisp have powerful primitives to deal with sequences and strings directly.
Note that elisp (sadly) does not optimise for tail-recursion, so that turns out to be a very inefficient way to write this function.
You are indeed hitting the 'max-lisp-eval-depth' limit when recursing in tweak-text. I don't see anything wrong with the way the code is(I didn't check if its doing what you intend it to do).
You can configure/raise the 'max-lisp-eval-depth' limit. The documentation for that variable states that you can raise it as long as you are confident that you are not going to trip into running out of stack space. The limit is conservatively set to 541 on my machine. Raising it to 600 got the function definition above to work on the input you gave as example.
As Pascal Bourguignon already mentioned it, using strings w/o coercing them to lists and back would be a better approach, below is my take at it. Note that it is slightly different in that literal strings are verified for punctuation, and if they appear to have punctuation such as would cause it otherwise to have the next letter upper-cased, then it would be upper cased too. I'm not sure this is a disadvantage, this is why I didn't take care of this difference.
(defun tweak-text (source)
(let ((i 0) (separator "") (cap t) current)
(with-output-to-string
(dolist (i source)
(setq current
(concat separator
(etypecase i
(string i)
(symbol (downcase (symbol-name i)))))
separator " ")
(let (current-char)
(dotimes (j (length current))
(setq current-char (aref current j))
(cond
((position current-char " \t\n\r"))
(cap (setq cap nil
current-char (upcase current-char)))
((position current-char ".?!")
(setq cap t)))
(princ (char-to-string current-char))))))))
(tweak-text '(not only does this sentence have a "comma," it also mentions the "iPad."))
"Not only does this sentence have a comma, it also mentions the iPad."
I think you should write something like this:
(defun tweak-text-wrapper (&rest args)
(let ((max-lisp-eval-depth 9001)) ; as much as you want
(apply tweak-text args)))