Common Lisp map numbers to words - lisp

I am trying to make a translate function that takes a list of numbers `(1 2 3) and writes ("ONE" "TWO" "THREE"). Here's what I have so far:
(defun translate-number (num)
(if (= num 0) (return "ZERO") ())
(if (= num 1) (return "ONE") ())
(if (= num 2) (return "TWO") ())
(if (= num 3) (return "THREE") ())
(if (= num 4) (return "FOUR") ())
(if (= num 5) (return "FIVE") ())
(if (= num 6) (return "SIX") ())
(if (= num 7) (return "SEVEN") ())
(if (= num 8) (return "EIGHT") ())
(if (= num 9) (return "NINE") ())
)
(defun translate (L)
(mapcar #'translate-number L)
)
(translate `(1 2 3))
If I try to run this, I get this error that I have not been able to figure out:
*** - RETURN-FROM: no block named NIL is currently visible
Any ideas? Thanks.

return doesn't do what it does in other languages :] You are looking for return-from translate-number, but this is not idiomatic.
First, did you know that the format function has a ~R "roman" directive ?
(format nil "~R" 1) ;; => one
If you really want uppercase, use string-upcase or the format directive ~( ... ~) with the modifiers #::
(format nil "~#:(~R~)" 1)
;; "ONE"
https://lispcookbook.github.io/cl-cookbook/strings.html#to-upper-case--
CL quick reference with format directives: http://clqr.boundp.org/
So:
(mapcar (lambda (nb)
(format nil "~#:(~R~)" nb))
'(1 2 3))
("ONE" "TWO" "THREE")
For many if in a row you can use case or cond.
(defun translate-number (num)
(case num
(1 "ONE")
(2 "FOO")))
No need of void () for the second form of if.
https://learnxinyminutes.com/docs/common-lisp/ ;)

You're returning within your if statements from an empty list (NIL) after a return statement. There is no block named nil, but an empty list will return nil. Instead, you could use a (return-from block-name (optiopnal-statement)) at for the else condition in each of your if blocks. Another issue is your design pattern here. Instead of using multiple if statements, with a return statement for each one, you can instead create a cond block, in place of multiple if statements. But, it would make even more sense to use a case statement within your translate-number function. If you are going to use multiple if statements consider a cond block, and where that doesn't make since (usually when you want to return a value depending on the type of argument passed to a function)) consider a case statement. The if statements become repetitive as you can see. Here is an example so that you don't have a nil return-from:
(defun translate-number(num)
(case num
(1 "ONE")
(2 "TWO")
(3 "THREE")
(4 "FOUR")
(5 "FIVE")
(6 "SIX")
(7 "SEVEN")
(8 "EIGHT")
(9 "NINE")))
(defun translate(&rest nums)
(apply #'mapcar #'translate-number nums))
(translate '(1 2 3))
("ONE" "TWO" "THREE")

CL-USER > (getf '(1 "ONE" 2 "TWO" 3 "THREE" 4 "FOUR" 5 "FIVE"
6 "SIX" 7 "SEVEN" 8 "EIGHT" 9 "NINE")
2
:dont-know)
"TWO"
CL-USER > (aref #("ZERO" "ONE" "TWO" "THREE" "FOUR"
"FIVE" "SIX" "SEVEN" "EIGHT" "NINE")
2)
"TWO"

Related

Writing the Foo Function In LISP With the following Specification

I am struggling to find the right approach to solve the following function
(FOO #'– '(1 2 3 4 5))
=> ((–1 2 3 4 5) (1 –2 3 4 5) (1 2 –3 4 5) (1 2 3 –4 5) (1 2 3 4 –5))
The first Parameter to the foo function is supposed to be a function "-" that has to be applied to each element returning a list of list as shown above. I am not sure as to what approach I can take to create this function. I thought of recursion but not sure how I will preserve the list in each call and what kind of base criteria would I have. Any help would be appreciated. I cannot use loops as this is functional programming.
It's a pity you cannot use loop because this could be elegantly solved like so:
(defun foo (fctn lst)
(loop
for n from 0 below (length lst) ; outer
collect (loop
for elt in lst ; inner
for i from 0
collect (if (= i n) (funcall fctn elt) elt))))
So we've got an outer loop that increments n from 0 to (length lst) excluded, and an inner loop that will copy verbatim the list except for element n where fctn is applied:
CL-USER> (foo #'- '(1 2 3 4 5))
((-1 2 3 4 5) (1 -2 3 4 5) (1 2 -3 4 5) (1 2 3 -4 5) (1 2 3 4 -5))
Replacing loop by recursion means creating local functions by using labels that replace the inner and the outer loop, for example:
(defun foo (fctn lst)
(let ((len (length lst)))
(labels
((inner (lst n &optional (i 0))
(unless (= i len)
(cons (if (= i n) (funcall fctn (car lst)) (car lst))
(inner (cdr lst) n (1+ i)))))
(outer (&optional (i 0))
(unless (= i len)
(cons (inner lst i) (outer (1+ i))))))
(outer))))
Part of the implementation strategy that you choose here will depend on whether you want to support structure sharing or not. Some of the answers have provided solutions where you get completely new lists, which may be what you want. If you want to actually share some of the common structure, you can do that too, with a solution like this. (Note: I'm using first/rest/list* in preference to car/car/cons, since we're working with lists, not arbitrary trees.)
(defun foo (operation list)
(labels ((foo% (left right result)
(if (endp right)
(nreverse result)
(let* ((x (first right))
(ox (funcall operation x)))
(foo% (list* x left)
(rest right)
(list* (revappend left
(list* ox (rest right)))
result))))))
(foo% '() list '())))
The idea is to walk down list once, keeping track of the left side (in reverse) and the right side as we've gone through them, so we get as left and right:
() (1 2 3 4)
(1) (2 3 4)
(2 1) (3 4)
(3 2 1) (4)
(4 3 2 1) ()
At each step but the last, we take the the first element from the right side, apply the operation, and create a new list use revappend with the left, the result of the operation, and the rest of right. The results from all those operations are accumulated in result (in reverse order). At the end, we simply return result, reversed. We can check that this has the right result, along with observing the structure sharing:
CL-USER> (foo '- '(1 2 3 4 5))
((-1 2 3 4 5) (1 -2 3 4 5) (1 2 -3 4 5) (1 2 3 -4 5) (1 2 3 4 -5))
By setting *print-circle* to true, we can see the structure sharing:
CL-USER> (setf *print-circle* t)
T
CL-USER> (let ((l '(1 2 3 4 5)))
(list l (foo '- l)))
((1 . #1=(2 . #2=(3 . #3=(4 . #4=(5))))) ; input L
((-1 . #1#)
(1 -2 . #2#)
(1 2 -3 . #3#)
(1 2 3 -4 . #4#)
(1 2 3 4 -5)))
Each list in the output shares as much structure with the original input list as possible.
I find it easier, conceptually, to write some of these kind of functions recursively, using labels, but Common Lisp doesn't guarantee tail call optimization, so it's worth writing this iteratively, too. Here's one way that could be done:
(defun phoo (operation list)
(do ((left '())
(right list)
(result '()))
((endp right)
(nreverse result))
(let* ((x (pop right))
(ox (funcall operation x)))
(push (revappend left (list* ox right)) result)
(push x left))))
The base case of a recursion can be determined by asking yourself "When do I want to stop?".
As an example, when I want to compute the sum of an integer and all positive integers below it, I can do this recusively with a base case determined by answering "When do I want to stop?" with "When the value I might add in is zero.":
(defun sumdown (val)
(if (zerop val)
0
(+ (sumdown (1- val)) val)))
With regard to 'preserve the list in each call', rather than trying to preserve anything I would just build up a result as you go along. Using the 'sumdown' example, this can be done in various ways that are all fundamentally the same approach.
The approach is to have an auxiliary function with a result argument that lets you build up a result as you recurse, and a function that is intended for the user to call, which calls the auxiliary function:
(defun sumdown1-aux (val result)
(if (zerop val)
result
(sumdown1-aux (1- val) (+ val result))))
(defun sumdown1 (val)
(sumdown1-aux val 0))
You can combine the auxiliary function and the function intended to be called by the user by using optional arguments:
(defun sumdown2 (val &optional (result 0))
(if (zerop val)
result
(sumdown2 (1- val) (+ val result))))
You can hide the fact that an auxiliary function is being used by locally binding it within the function the user would call:
(defun sumdown3 (val)
(labels ((sumdown3-aux (val result)
(if (zerop val)
result
(sumdown3-aux (1- val) (+ val result)))))
(sumdown3-aux val 0)))
A recursive solution to your problem can be implemented by answering the question "When do I want to stop when I want to operate on every element of a list?" to determine the base case, and building up a result list-of-lists (instead of adding as in the example) as you recurse. Breaking the problem into smaller pieces will help - "Make a copy of the original list with the nth element replaced by the result of calling the function on that element" can be considered a subproblem, so you might want to write a function that does that first, then use that function to write a function that solves the whole problem. It will be easier if you are allowed to use functions like mapcar and substitute or substitute-if, but if you are not, then you can write equivalents yourself out of what you are allowed to use.

LISP : Counting Sub strings to check occurrences

(defun count-sub (str pat)
(loop with z = 0 with s = 0 while s do
(when (setf s (search pat str :start6 s))
(incf z) (incf s (length pat)))
finally (return z))))
Right so i have this code for counting sub strings but it will only take to sub string inputs at a time, how do i get it to take in more inputs ?
I.e. so the input would be like:
(count-sub "abcde" "a" "d" "e" "c")
instead of just:
(count-sub "abcd" "a")
I would have it so that the unary function has a different name:
(defun count-sub-1 (str pat)
(loop with z = 0 with s = 0 while s do
(when (setf s (search pat str :start2 s)) ;; :start6 typo fixed
(incf z) (incf s (length pat)))
finally (return z))))
Then the N-ary API function is just a reduce job over this:
(defun count-sub (str &rest patterns)
(reduce #'+ patterns :key (lambda (item) (count-sub-1 str item))))
Some tests:
(count-sub "aabc") -> 0
(count-sub "aabc" "a") -> 2
(count-sub "aabc" "a" "a") -> 4
(count-sub "aabc" "b") -> 1
(count-sub "aabc" "a" "b") -> 3
You have a bug in your logic, however. If a pattern is the empty string, you get an infinite loop, because (incf s (length pat)) doesn't change the value of s:
(count-sub "abc" "") -> #<non-termination!>
A possible fix is:
(incf s (min (length pat) 1))
to always advance by at least one character, in the event of a zero length match. In this case, the empty string will match numerous times in the target string; if that is undesirable (you want an empty pattern to result in zero) then a check has to be put against that:
(if (plusp (length pat))
(loop ...)
0)
Then the (min (length pat) 1) compensation is unnecessary.

writing my own version of `in` as an Arc macro

In Arc there's a macro called in
> (let x 1
(in x 4 5 6))
nil
> (let x 1
(in x 1 5 6))
t
that checks if its first parameter is equal to any of the rest. I want a version of this that takes a parameter plus a list (semantically identical to Python's in), so I wrote:
(assign weak-tens* '(11 12))
(mac in? (elt lst)
(cons 'in (cons elt lst)))
(def transform-deck (deck)
(map [if (in? _ weak-tens*) #\T _] deck))
output:
arc> (load "main.arc")
*** redefining in?
map: contract violation
expected: list?
given: '(_ . weak-tens*)
argument position: 2nd
other arguments...:
#<procedure:ac-niltree>
To answer your immediate question, you can use mem, as follows:
arc> (let x 3
(mem x '(1 2 3 4)))
(3 4)
Also, there's no reason this should be a macro. It doesn't do anything that requires a macro.
But let's look at why the macro doesn't work:
arc> (macex1 '(in? 1 '(1 2 3)))
(in 1 quote (1 2 3))
Ah, we're putting the value "quote".
Here's how we want the code to expand:
(in? 1 '(1 2 3))
should expand to:
(in 1 1 2 3)
But as mentioned, we don't even want this to be a macro in the first place. Ignoring mem, it could be written as follows:
(def in? (elt lst)
(if (no lst)
nil
(is elt ;;if we've found the element
(car lst))
t
(in? elt (cdr lst)))) ;;otherwise recurse

how to test whether one list is a member of another

Lets say I have two lists, ((1 2 3)) and (((1 2 3)) ((4 5))). I want to be able to tell if the first list is a member of the second list. I have tried to use subsetp, but it does not return true for this query. How can I accomplish this?
As Rainer Joswig mentioned in the comments, you're not checking for subsets, but for members, which you can do using the aptly named member function. Member returns a generalized boolean, i.e., nil for false, and something, not necessarily t, non-nil for true. Specifically, if an element is a member of the list, member returns the tail of the list whose first element is the element.
CL-USER> (member 3 '(1 2 3 4 5))
(3 4 5)
CL-USER> (member 7 '(1 2 3 4 5))
NIL
Of course, when checking membership in a list, there's a question of how to compare the given item with the elements of the list. Member's default comparison is eql, which works on things like numbers, as shown in the example above. For your case, however, you probably want to test with equal, since ((1 2 3)) might not be the same object as the first element of (((1 2 3)) ((4 5))):
CL-USER> (member '((1 2 3)) '(((1 2 3)) ((4 5))))
NIL
CL-USER> (member '((1 2 3)) '(((1 2 3)) ((4 5))) :test 'equal)
(((1 2 3)) ((4 5)))
CL-USER> (member '((4 5)) '(((1 2 3)) ((4 5))) :test 'equal)
(((4 5)))
CL-USER> (member '((1 2 4)) '(((1 2 3)) ((4 5))) :test 'equal)
NIL
If you want to have lists as elements of your sets for subsetp, you have to change the value of the :test keyword.
CL-USER 1 > (subsetp '(1 2 3) '(1 2 3 4 5))
T
CL-USER 2 > (subsetp '((1) (2) (3)) '((1) (2) (3) (4) (5)))
NIL
The first one gives T, the second one gives NIL. Why? Because equality is checked with #'eql which works for identical objects or numbers of the same value and of same type. Since two lists must not be identical objects, (eql '(1) '(1)) gives NIL. (That may depend on your CL implementation.) If you want to compare a tree of conses, tree-equal can help you.
CL-USER 3 > (subsetp '((1) (2) (3)) '((1) (2) (3) (4) (5)) :test #'tree-equal)
T
I don't understand the structure of the sets you gave as example completely, but I hope this helps.

How to convert a string to list using clisp?

How can i convert the string "1 2 3 4 5 6 7" into the list (1 2 3 4 5 6 7) elegantly? I am using CLISP.
Here is a recursive solution.
;Turns a string into a stream so it can be read into a list
(defun string-to-list (str)
(if (not (streamp str))
(string-to-list (make-string-input-stream str))
(if (listen str)
(cons (read str) (string-to-list str))
nil)))
You should use parse-integer in a loop.
For example, using loop:
(let ((string "1 2 3"))
(loop :for (integer position) := (multiple-value-list
(parse-integer string
:start (or position 0)
:junk-allowed t))
:while integer
:collect integer))
⇒ (1 2 3)
If you need better control about the splitting, use the split-sequence or cl-ppcre library.
If you need to parse more general number formats, use the parse-number library.
Libraries are available from Quicklisp.
Hint: Take a look at with-input-from-string.
(with-input-from-string (s "1 2 3 4 5 6 7" :index i :start 0 :end 13)
(list (read s) (read s) (read s) (read s) (read s) (read s)))
(1 2 3 4 5 6 7)
it works however i feel it is not so elegant as there are many read call .
thanks again!
I think this might work:
(setf s "1 2 3 4 5 6 7")
(setf L-temp (coerce s 'list))
This makes a list with spaces as elements. Remove spaces:
(setf L-final (remove #\Space L-temp))
I see that Svante is right. My previous attempt did not work. Here is another attempt. I use concatenate to change the string into a list representation. Then I use read-from-string to convert the string (s-2) into an actual list.
(setf s-0 "1 2 3 4 5 6 7")
(setf s-1 (concatenate 'string "(" s ")" ))
(setf s-2 (read-from-string s-1))
I roll it into a function like this:
(defun from-string-to-list (s)
(let ((L (read-from-string
(concatenate 'string "(" s ")"))))
L))
The only purpose of "let" and "L" is to make the function from-string-to-list return only the list and not return multiple values. read-from-string returns two values: The list and the size of the string, I think.
That would do,
(with-input-from-string (s "1 2 3 4 5")
(let ((r nil))
(do ((line (read s nil 'eof)
(read s nil 'eof)))
((eql line 'eof))
(push line r))
(reverse r)))