I am doing this problem set in preparation for an exam. It's in the book. Basically it tells us to design a program that counts all occurrences of "hello" in an instance of XEnum.v2.
Everything works perfectly except this problem. I am having problems with this check expect
(check-expect (count-in-xitem xitem3) 3)
it says it expects a non-empty list, but given 'ol. It should absolutely give me 3. Why does it keep telling me it expects a non-empty list? I dumbfounded and can't figure out why.
;; An XEnum.v2 is one of:
;; – (cons 'ol [List-of XItem.v2])
;; – (cons 'ol (cons [List-of Attribute] [List-of XItem.v2]))
;; An XItem.v2 is one of:
;; – (cons 'li (cons XWord empty))
;; – (cons 'li (cons [List-of Attribute] (cons XWord empty)))
;; – (cons 'li (cons XEnum.v2 empty))
;; – (cons 'li (cons [List-of Attribute] (cons XEnum.v2 empty)))
;; A XWord is '(word ((text String)))
;; An Attribute is
;; - (cons Symbol (cons String empty))
(define xword1 '(word ((text "hello"))))
(define xword2 '(word ((text "Hello"))))
(define attr1 (cons 'Symbol (cons "hello" empty)))
(define attr2 (cons 'Symbol (cons "elo" empty)))
(define xitem1 (cons 'li (cons xword1 empty)))
(define xitem2 (cons 'li (cons (list attr1 attr2) (cons xword1 empty))))
(define xe1 (cons 'ol (list xitem1 xitem2))) ;; 3
(define xe2 (cons 'ol (cons (list attr1 attr2) (list xitem2 xitem1))))
(define xitem3 (cons 'li (cons xe1 empty))) ;; 1
(define xitem4 (cons 'li (cons (list attr1 attr2) (cons xe1 empty))))
;; X-Item.v2 -> Number
;; returns number of "hello" occurences in an X-Item.v2
(define (count-in-xitem xi)
(cond
[(is-xword? (second xi)) (count-in-xword (second xi))]
[(is-xenum? xi) (+ (count-in-xitem (second xi))
(count-in-xitem (second (rest xi))))]
[(is-attribute? (first (second xi))) (+ (count-in-loa (second xi))
(count-in-xword (first (rest (rest xi)))))]
[else (+ (count-in-loa (second xi))
(occurrences (second (rest xi))))]))
;; tests for count-in-xitem function
;(check-expect (count-in-xitem xitem1) 1)
;(check-expect (count-in-xitem xitem2) 2)
;(check-expect (count-in-xitem xe1) 3)
(check-expect (count-in-xitem xitem3) 3)
;; XWord -> Natural
;; returns 1 if string is "hello"
(define (count-in-xword x)
(if (string=? (second (first (first (rest x))))
"hello")
1
0))
;; tests for count-in-xword function
(check-expect (count-in-xword xword1) 1)
(check-expect (count-in-xword xword2) 0)
;; [List-of Attribute] -> Natural
;; returns 1 if occurrences of "hello" in the list of attributes
(define (count-in-loa loa)
(foldr (λ(s b) (if (string=? (second s) "hello") (+ 1 b) b)) 0 loa))
;; tests for count-in-loa function
(check-expect (count-in-loa (list attr2)) 0)
(check-expect (count-in-loa (list attr1
(cons 'b (cons "hello" empty)))) 2)
;; XEnum.v2 -> Number
;; counts all occurrences of "hello" in an instance of XEnum.v2
(define (occurrences xe)
(if (eqv? (rest (rest xe)) empty)
(xenum2 empty (rest xe))
(xenum2 (second xe) (rest (rest xe)))))
;; [List-of Attribute] [List-of XItem.v2] -> Number
;; returns number of "hello" occurences
(define (xenum2 atr item)
(+ (count-in-loa atr)
(count-in-xitem item)))
;; tests for xenum2 function
;(check-expect (xenum2 (list attr1 attr2) (list xitem1 xitem2)) 0)
;; [List-of Any] -> Boolean
;; checks if the list is an XEnum.v2
(define (is-xenum? xe)
(cond
[(empty? xe) false]
[(symbol? (first xe))
(symbol=? (first xe) 'ol)]))
;; tests for is-attribute? function
(check-expect (is-xenum? xe1) true)
(check-expect (is-xenum? xe2) true)
(check-expect (is-xenum? (cons 'al (list xitem1 xitem2))) false)
(check-expect (is-xenum? empty) false)
;; ATTRIBUTE
(define (is-attribute? xe)
(and (symbol? (first xe))
(string? (second xe))
(not (symbol=? (first xe) 'ol))))
;; tests for is-attribute? function
(check-expect (is-attribute? attr1) true)
(check-expect (is-attribute? attr2) true)
(check-expect (is-attribute? (cons 1 (cons "hi" empty))) false)
;; XWORD
(define (is-xword? xe)
(and (symbol? (first xe))
(symbol=? 'word (first xe))
(symbol=? 'text (first (first (second '(word ((text String)))))))
(symbol=? 'String (second (first (second '(word ((text String)))))))))
;; tests for is-xword? function
(check-expect (is-xword? xword1) true)
(check-expect (is-xword? xword2) true)
(check-expect (is-xword? '(world ((text "hello")))) false)
I think the problem is here
;; ATTRIBUTE
(define (is-attribute? xe)
(and (symbol? (first xe))
(string? (second xe))
(not (symbol=? (first xe) 'ol))))
It looks like you can track this problem down using the stepper.
Click the "step" button, and wait until all of the steps have been computed (you'll see the denominator stop changing in the step count). Then, choose "jump to end" from the drop-down menu. You'll see that your test case is asking for (first 'ol). To see how this arises, step backward; I can see that you're calling is-attribute? on 'ol, but I didn't step any further back to see why this was the case.
Related
I am trying to define the rule 3 of "MIU System" of "Gödel, Escher, Bach" (Douglas Hofstadter), which says:
Replace any III with a U
Example:
MIIIIU → MUIU and MIIIIU → MIUU
Main code:
(define (rule-tree lst)
(if (<= 3 (counter lst #\I))
(append (delete #\I lst) (list #\U))
(append lst empty)))
(define (delete x lst)
(cond [(empty? lst) lst]
[(eq? (first lst) x) (delete x (rest lst))]
[else (append (list (first lst)) (delete x (rest lst)))]))
(define (counter lst target)
(if (empty? lst)
0
(+ (counter (rest lst) target)
(let ((x (first lst)))
(if (list? x)
(counter x target)
(if (eqv? x target) 1 0))))))
With this expression there is no problem:
>(rule-tree '(#\M #\I #\I #\I))
'(#\M #\U)
But I don't know how to determine the position that the "U" should take when finding the 3 "I".
Any suggestion will be very helpful :)
Here is an alternative recursive version, where repl2 encodes the information “we have just encountered one #\I”, while repl3 encodes the information “we have just encountered two #\I”:
(define (repl lst)
(cond ((empty? lst) lst)
((eqv? (first lst) #\I) (repl2 (rest lst)))
(else (cons (first lst) (repl (rest lst))))))
(define (repl2 lst)
(cond ((empty? lst) (list #\I))
((eqv? (first lst) #\I) (repl3 (rest lst)))
(else (cons #\I (cons (first lst) (repl (rest lst)))))))
(define (repl3 lst)
(cond ((empty? lst) (list #\I #\I))
((eqv? (first lst) #\I) (cons #\U (repl (rest lst))))
(else (cons #\I (cons #\I (cons (first lst) (repl (rest lst))))))))
Of course this solution is some kind of hack and cannot scale to a greater number of repetitions. But looking at the structure of this solution and simply generalizing the three functions we can produce a general solution:
(define (repl lst n from to)
(define (helper lst k)
(cond ((empty? lst) (repeat from (- n k)))
((eqv? (first lst) from)
(if (= k 1)
(cons to (helper (rest lst) n))
(helper (rest lst) (- k 1))))
(else (append (repeat from (- n k))
(cons (first lst) (helper (rest lst) n))))))
(define (repeat x n)
(if (= n 0)
'()
(cons x (repeat x (- n 1)))))
We define a function repl that takes a list, the number of copies to replace (n), the element to replace (from) and the element that must be substituted (to). Then we define a helper function to do all the work, and that has as parameters the list to be processed and the number of copies that must be still found (k).
Each time the function encounters a copy it checks if we have finished with the number of copies and substitutes the element, restarting its work, otherwise it decrements the number of copies to find and continues.
If it founds an element different from from it recreates the list with the elements “consumed” until this point (maybe 0) with repeat and then continues its work.
Note that the previous version of the helper function had an error in the final case, when lst is null. Instead of returning simply the empty list, we must return the possibly skipped from elements.
I'm still learning Racket.
I have to call an unknown function. The function and its parameters are in the following list:
(define l1 '((function-name parameter1)
(function-name parameter3)))
To run that function, I'm doing:
(first (car l1)) (second (car l1)) another-parameter
But I get the error:
application: not a procedure;
expected a procedure that can be applied to arguments
given: 'function-name
arguments...:
How can I run that function-name?
UPDATE:
I have tried Óscar's answer:
(eval (first (car l1)) (second (car l1)) another-parameter)
And I get the error:
eval: arity mismatch;
the expected number of arguments does not match the given number
given: 3
arguments...:
I have also tried:
(define-namespace-anchor a)
(define ns (namespace-anchor->namespace a))
(eval (first (car l1)) (second (car l1)) another-parameter ns)
And I get the same error:
eval: arity mismatch;
the expected number of arguments does not match the given number
given: 4
arguments...:
Then, I tried this:
(eval (list (first (car l1)) (second (car l1)) another-parameter))
And I get the error:
function-name: unbound identifier;
also, no #%app syntax transformer is bound in: function-name
Finally, I have tried:
(eval (list (first (car l1)) (second (car l1)) another-parameter) ns)
And I get an internal error from function-name. But this function, works perfectly.
function-name could be at least three functions (or more), this is why I haven't put it here before. All of them will have two lists as parameters, and they will return #t or #f.
One of then, then one is testing now is:
(define match (lambda (list1 list2) ...))
Obviously, list1 and list2 are lists.
UPDATE 2:
I have tried Óscar's Minimal, Complete and verifiable example, and it works. But, I have modified to used on my on work, and it doesn't work. Look:
(define function-name
(lambda (list1 list2)
(append list1 list2)))
(define parameter1 '(1 2))
(define parameter3 '(3 4))
(define another-parameter '(5 6))
(define l1 '((function-name parameter1)
(function-name parameter3)))
(define-namespace-anchor a)
(define ns (namespace-anchor->namespace a))
(define another-function
(lambda (l1 the-parameter)
(cond
[(eval (list (first (car l1)) (second (car l1)) 'the-parameter) ns) l1])
)
)
(another-function l1 another-parameter)
I have created another-function, and it fails with the parameter 'the-parameter. It complains saying:
the-parameter: undefined;
cannot reference an identifier before its definition
So the problem is when I use a function's parameter as a parameter for the eval function.
Please consider evaluating the procedure like this:
(define l1 `((,sin ,(+ 1 2))
(,+ 1 2 3)))
(sin (+ 1 2)) ; ==> 0.14..
((caar l1) (cadar l1)) ; ==> 0.14..
(apply (caar l1) (cdar l1)) ; ==> 0.14..
(+ 1 2 3) ; ==> 6
(apply (caadr l1) (cdadr l1)) ; ==> 6
Why does this work? Well. Your attempted to call the name of a procedure. By evaluating the procedure name you get the actual procedure object. You can indeed evaluate a procedure in the REPL and see what you get back:
+ ; ==> #<procedure:+>
l1 ; ==> ((#<procedure:sin> 3) (#<procedure:+> 1 2 3))
If l1 were defined as '((sin (+ 1 2)) (+ 1 2 3)) evaluating it would return ((sin (+ 1 2)) (+ 1 2 3)) so there is a big difference.
And of course. Using the quasiquote/unquote is just a fancy way of writing this:
(define l1 (list (list sin (+ 1 2))
(list + '1 '2 '3)))
You can use eval and quasiquoting for this, it works for your input. Do notice that this is how you should post your questions, it's a Minimal, Complete, and Verifiable example that anyone can copy and run, without having to guess what you were thinking:
(define function-name
(lambda (list1 list2)
(append list1 list2)))
(define parameter1 '(1 2))
(define parameter3 '(3 4))
(define another-parameter '(5 6))
(define l1 '((function-name parameter1)
(function-name parameter3)))
(define-namespace-anchor a)
(define ns (namespace-anchor->namespace a))
(define another-function
(lambda (l1 the-parameter)
(cond
[(eval `(,(first (car l1)) ,(second (car l1)) ',the-parameter) ns)
l1])))
(another-function l1 another-parameter)
=> '((function-name parameter1) (function-name parameter3))
How do I recursively merge jumping pairs of elements of a list of lists? I need to have
'((a b c) (e d f) (g h i))
from
'((a b) c (e d) f (g h) i)
My attempt
(define (f lst)
(if (or (null? lst)
(null? (cdr lst)))
'()
(cons (append (car lst) (list (cadr lst)))
(list (append (caddr lst) (cdddr lst))))))
works if I define
(define listi '((a b) c (d e) f))
from which I obtain
((a b c) (d e f))
by doing simply
(f listi)
but it does not work for longer lists. I know I need recursion but I don't know where to insert f again in the last sentence of my code.
A simpler case that your algorithm fails: (f '((1 2) 3)) should result in '((1 2 3)), but yours results in an error.
We will define some terms first:
An "element" is a regular element, like 1 or 'a.
A "plain list" is simply a list of "element"s with no nested list.
E.g., '(1 2 3) is a plain list. '((1 2) 3) is not a plain list.
A "plain list" is either:
an empty list
a cons of an "element" and the next "plain list"
A "list of jumping pairs" is a list of even length where the odd index has a "plain list", and the even index has an element. E.g., '((1) 2 (a) 4) is a "list of jumping pairs". A "list of jumping pairs" is either:
an empty list
a cons of
a "plain list"
a cons of an "element" and the next "list of jumping pairs"
We are done with terminology. Before writing the function, let's start with some examples:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
(f '((1 2) 3 (4) a)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
(cons (cons 4 empty)
(cons 'a
empty)))))
should output '((1 2 3) (4 a))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
(cons (cons 4 (cons 'a empty))
empty))
So, f is a function that consumes a "list of jumping pairs" and returns a list of "plain list".
Now we will write the function f:
(define (f lst)
???)
Note that the type of lst is a "list of jumping pairs", so we will perform a case analysis on it straightforwardly:
(define (f lst)
(cond
[(empty? lst) ???] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '()) equivalent to (f empty)
should output '()
equivalent to empty
we know that the empty case should return an empty list, so let's fill in the hole accordingly:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ??? ;; the cons case has
(first lst) ;; the "plain list",
(first (rest lst)) ;; the "element", and
(rest (rest lst)) ;; the next "list of jumping pairs"
???])) ;; that are available for us to use
From the example:
(f '((1 2) 3)) equivalent to (f (cons (cons 1 (cons 2 empty))
(cons 3
empty)))
should output '((1 2 3))
equivalent to (cons (cons 1 (cons 2 (cons 3 empty)))
empty)
we know that we definitely want to put the "element" into the back of the "plain list" to obtain the resulting "plain list" that we want:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the next "list of jumping pairs"
(rest (rest lst))
;; that are available for us to use
???]))
There's still the next "list of jumping pairs" left that we need to deal with, but we have a way to deal with it already: f!
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case has:
???
;; the resulting "plain list" that we want
(append (first lst) (cons (first (rest lst)) empty))
;; the list of "plain list"
(f (rest (rest lst)))
;; that are available for us to use
???]))
And then we can return the answer:
(define (f lst)
(cond
[(empty? lst) empty] ;; the empty list case
[else ;; the cons case returns
;; the resulting list of "plain list" that we want
(cons (append (first lst) (cons (first (rest lst)) empty))
(f (rest (rest lst))))]))
Pattern matching (using match below) is insanely useful for this kind of problem -
(define (f xs)
(match xs
;; '((a b) c . rest)
[(list (list a b) c rest ...)
(cons (list a b c)
(f rest))]
;; otherwise
[_
empty]))
define/match offers some syntax sugar for this common procedure style making things even nicer -
(define/match (f xs)
[((list (list a b) c rest ...))
(cons (list a b c)
(f rest))]
[(_)
empty])
And a tail-recursive revision -
(define (f xs)
(define/match (loop acc xs)
[(acc (list (list a b) c rest ...))
(loop (cons (list a b c) acc)
rest)]
[(acc _)
acc])
(reverse (loop empty xs)))
Output for each program is the same -
(f '((a b) c (e d) f (g h) i))
;; '((a b c) (e d f) (g h i))
(f '((a b) c))
;; '((a b c))
(f '((a b) c x y z))
;; '((a b c))
(f '(x y z))
;; '()
(f '())
;; '()
As an added bonus, this answer does not use the costly append operation
There is no recursive case in your code so it will just work statically for a 4 element list. You need to support the following:
(f '()) ; ==> ()
(f '((a b c) d (e f g) h)) ; ==> (cons (append '(a b c) (list 'd)) (f '((e f g) h)))
Now this requires exactly even number of elements and that every odd element is a proper list. There is nothing wrong with that, but onw might want to ensure this by type checking or by adding code for what should happen when it isn't.
Here is a task: a list is given, some of the elements are also lists. It's nescessary to replace the nested lists with the sum of the numbers in them, if all of them are even, using recursion. For example:
(1 2 NIL (2 4 6) 5 7) -> (1 2 NIL 12 5 7)
if the parent list matches the condition after the transformation:
(2 2 (4 4) (2 2)) -> (2 2 8 4) -> 16
Now i have the following code:
;; check for all list elements are even
(defun is-even-list (lst)
(cond ((null lst) t)
((and (numberp (car lst)) (evenp (car lst))) (is-even-list (cdr lst)))
(t nil)
)
)
;; list summing
(defun sum-list (lst)
(cond ((null lst) 0)
(t (+ (car lst) (sum-list (cdr lst))))
)
)
;; main func
(defun task (lst)
(cond ((null lst) nil)
((atom (car lst)) (cons (car lst) (task (cdr lst))))
((is-even-list (car lst)) (cons (list (sum-list (car lst))) (task (cdr lst))))
(t (cons (task (car lst)) (task (cdr lst))))
)
)
But now it processes only the “lowest” level of the list if it exists:
(2 4) -> (2 4)
(2 (2 4 6) 6) -> (2 12 6)
(2 (4 (6 8) 10) 12) -> (2 (4 14 10) 12)
(2 (4 6) (8 10) 12) -> (2 10 18 12)
How can i change this code to get "full" processing?
It's definitely not the best solution but it works:
(defun is-even-list (lst)
(cond ((null lst) t)
((and (numberp (car lst)) (evenp (car lst))) (is-even-list (cdr lst)))
(t nil)
)
)
(defun sum-list (lst)
(cond ((null lst) 0)
(t (+ (car lst) (sum-list (cdr lst))))
)
)
(defun test (lst)
(dotimes (i (list-length lst))
(cond
((not (atom (nth i lst))) (setf (nth i lst) (test (nth i lst))))
)
)
(cond
((is-even-list lst) (setf lst (sum-list lst)))
((not (is-even-list lst)) (setf lst lst))
)
)
Here's a solution which I think meets the requirements of the question: recursively sum a list each element of which is either an even number or a list meeting the same requirement. It also does this making only a single pass over the structure it is trying to sum. For large lists, it relies on tail-call elimination in the implementation which probably is always true now but is not required to be. sum-list-loop could be turned into something explicitly iterative if not.
(defun sum-list-if-even (l)
;; Sum a list if all its elements are either even numbers or lists
;; for which this function returns an even number. If that's not
;; true return the list. This assumes that the list is proper and
;; elements are numbers or lists which meet the same requirement but
;; it does not check this in cases where it gives up for other
;; reasons first: (sum-list-if-even '(2 "")) signals a type error
;; (but (sum-list-if-even '(1 "")) fails to do so)
(labels ((sum-list-loop (tail sum)
(etypecase tail
(null sum) ;all the elements of '() are even numbers
(cons
(let ((first (first tail)))
(etypecase first
(integer
;; Easy case: an integer is either an even number
;; or we give up immediately
(if (evenp first)
(sum-list-loop (rest tail) (+ sum first))
;; give up immediately
l))
(list
;; rerurse on the car ...
(let ((try (sum-list-if-even first)))
;; ... and check to see what we got to know if
;; we should recurse on the cdr
(if (not (eq try first))
(sum-list-loop (rest tail) (+ sum try))
l)))))))))
(sum-list-loop l 0)))
Allow me to show some improvements on your own answer.
First, use conventional formatting: no dangling parentheses, bodies indented two spaces, other argument forms aligned. Use appropriate line breaks.
(defun is-even-list (lst)
(cond ((null lst) t)
((and (numberp (car lst))
(evenp (car lst)))
(is-even-list (cdr lst)))
(t nil)))
(defun sum-list (lst)
(cond ((null lst) 0)
(t (+ (car lst)
(sum-list (cdr lst))))))
(defun test (lst)
(dotimes (i (list-length lst))
(cond ((not (atom (nth i lst)))
(setf (nth i lst) (test (nth i lst))))))
(cond ((is-even-list lst) (setf lst (sum-list lst)))
((not (is-even-list lst)) (setf lst lst))))
The first function checks two things: that every element is a number, and that every element is even. In this context, the first condition mainly means: no sublists.
(defun flat-all-even-p (list)
(and (every #'numberp list)
(every #'even list)))
The second function sums a list and assumes that all elements are numbers (sublists would signal an error here).
(defun sum (list)
(reduce #'+ list))
The third function does not test, it sums. Note that it only accidentally returns the answer, since setf returns the value it sets. Another problem is that you do index lookup on lists in a loop, which is very inefficient. Finally, you modify the list you were given, which will surprise your caller.
(defun sum-if-all-even (tree)
(if (listp tree)
(let ((recursed-tree (mapcar #'sum-if-all-even tree)))
(if (flat-all-even-p recursed-tree)
(sum recursed-tree)
recursed-tree))
tree)
I'm trying to add a given variable x to a list L. Both of which are parameters of the function ADDV. The code I have so far is as follows:
(defun addV(L x)
(cond
((eq L nil) nil)
((eq (cdr L) nil) (list(+(car L) x)))
(+ x (first(last L)))
(butlast L)
(append L x) ) )
With the parameters
L = '(1 2 3 4)
x = 2
When the statement: (+ x (first(last L)))) is evaluated, it's value is 4. The final goal should be
L = '(1 2 3 6)
I'm not sure what I'm doing wrong. Any help would be greatly appreciated. Thanks.
Your code is badly formatted. Re-indenting, we get
(defun addV(L x)
(cond
((eq L nil)
nil)
((eq (cdr L) nil)
(list (+ (car L) x)))
(+
x
(first (last L)))
(butlast
L)
(append
L
x) ) )
do you see the problem now?
Since (not +) is NIL, the corresponding clause in the COND form is entered. Its body's forms (x and (first (last L))) are evaluated for effects, of which there are none. Then the last form's value is returned.
What you evidently wanted it to be, is
(defun addV (L x)
(cond
((eq L nil)
nil)
((eq (cdr L) nil)
(list (+ (car L) x)))
(T
(append
(butlast L)
(list (+ x (first (last L))))))))
Coincidentally, the 2nd clause it completely unnecessary and may just be omitted, making it
(defun addV (L x)
(if (not (null L))
(append (butlast L)
(list (+ x (first (last L)))))))
If you can do this destructively, then you can use incf and last:
(defun increment-last (list x)
(prog1 list ; return the list
(incf (first (last list)) x)))
If you do need to make a new list, you'll have to walk to the end of the list to get to the last element. While you're doing that, you could keep track of the elements you've already seen (in reverse order) and efficiently use that reverse order list to construct the new list for you using nreconc:
(defun plus-last (list x)
(do ((list list (rest list))
(rhead '() (list* (first list) rhead)))
((endp (rest list))
(nreconc rhead (list (+ x (first list)))))))
CL-USER> (plus-last '(1 2 3 4) 2)
(1 2 3 6)
If you're not so comfortable with do syntax, you could use a tail recursive function, too (which some Common Lisp implementations can optimize into a loop):
(defun plus-last (list x)
(labels ((pl (list rhead)
(if (endp (rest list))
(nreconc rhead (list (+ x (first list))))
(pl (rest list)
(list* (first list) rhead)))))
(pl list '())))
You could also use loop, and express the logic pretty clearly:
(defun plus-last (list x)
(loop for (a . b) on list
if (null b) collect (+ a x)
else collect a))
This could also be done with maplist:
(defun plus-last (list x)
(maplist (lambda (list)
(if (endp (rest list))
(+ x (first list))
(first list)))
list))