I have a function called clean-up which basically does what the already available flatten function does. I then have a function called multiplier, which takes in a list and multiplies all the numbers within it. The one issue is that sometimes there could be a weird syntax for the list used in multiplier, and it doesn't multiply every number together. For example:
Example Input
(multiplier '((1 (2 3)) 4 5 (6)))
Correct Output
720
My Output
*: contract violation
expected: number?
given: '(6 . 1)
argument position: 2nd
other arguments...
We don't like errors now do we? This multiplier function works in a normal-looking list, something like (multiplier '(1 2 3 4 5 6)). So I wrote the clean-up function to turn some confusing-looking list into a normal-looking list. However, I don't know how to call it to clean-up my list before trying to parse through and do the multiplication. I can verify that the clean-up function does its job perfectly. Can anyone help? Here is the code I have for both:
(define (clean-up s)
(cond [(null? s) '()]
[(not (pair? s)) (list s)]
[else (append (clean-up (car s)) (clean-up (cdr s)))]
))
(define multiplier
(lambda (s)
(cond [(null? s) 1]
[(number? (car s)) (* (car s) (multiplier(cdr s)))]
[list? (car s) (append (car s) (multiplier(cdr s)))]
[else (multiplier (cdr s))]
)))
There is no need for the clean-up function to solve the problems encountered in multiplier. However, you could call clean-up on the input first simply with:
scratch.rkt> (multiplier (clean-up '((1 (2 3)) 4 5 (6))))
720
Or, you could create a helper function to do this for you:
(define (multiplier-workaround s)
(multiplier (clean-up s)))
scratch.rkt> (multiplier-workaround '((1 (2 3)) 4 5 (6)))
720
A workaround like this might help you out in a pinch, but it does not fix the real problems in the code.
Some of the problems here may be easier to see with better code formatting. It is bad style to leave hanging parentheses in Lisps as if these are C-style languages; but that probably isn't causing you problems here. Yet it is good style to show the structure of your expressions using indentation. With proper indentation it becomes apparent that there are missing parentheses in the line with the list? predicate:
(define multiplier
(lambda (s)
(cond [(null? s) 1]
[(number? (car s))
(* (car s) (multiplier(cdr s)))]
[list? (car s)
(append (car s) (multiplier (cdr s)))]
[else
(multiplier (cdr s))])))
Further investigation of that line shows that the code is attempting to append (car s) to the result of (multiplier (cdr s)); yet, (car s) is now known to be a list, and multiplier is supposed to return a number! The intention here was surely to multiply the result of calling multiply on the list (car s) together with the result of (multiplier (cdr s)):
(define multiplier
(lambda (s)
(cond [(null? s) 1]
[(number? (car s))
(* (car s)
(multiplier (cdr s)))]
[(list? (car s))
(* (multiplier (car s))
(multiplier (cdr s)))]
[else
(multiplier (cdr s))])))
It isn't clear why the else branch is needed, unless OP wants to be able to process lists such as (a (1 (2 b) (3 (c (4 5) 6) d) e))). For code that is expecting nested lists of numbers, this would be fine:
(define multiplier-2
(lambda (s)
(cond [(null? s) 1]
[(number? (car s))
(* (car s) (multiplier (cdr s)))]
[else
(* (multiplier (car s))
(multiplier (cdr s)))])))
Both functions now work for OP example expression, and the corrected OP code also works for input with spurious values:
scratch.rkt> (multiplier '((1 (2 3)) 4 5 (6)))
720
scratch.rkt> (multiplier-2 '((1 (2 3)) 4 5 (6)))
720
scratch.rkt> (multiplier '(a (1 (2 3)) 4 5 b (6) c))
720
I think buildin flatten have more error handling.
(define (multiplier lst)
(apply * (filter number? (flatten lst))))
;;; TEST
(define test-lst1 (list + (vector 1) '(1 (2 3) c) "w" 4 5 '(6) + - * sqr))
(define test-lst2 '(1(a 2(3 b (c 4(d 5 e(6) (f)))))))
(multiplier test-lst1) ; 720
(multiplier test-lst2) ; 720
Related
(define (lst-double-helper lst acc)
(if (empty? list)
acc
(lst-double-helper (rest lst) (cons (* (first lst) 2) acc))))
(define (lst-double lst)
(lst-double-helper lst '()))
I feel I'm doing it in the right way. But this gives me an error
(lst-double '(1,2,3))
*: contract violation
expected: number?
given: ',2
argument position: 1st
other arguments...:
Why do it expect the second argument to be a number?
A couple of comments:
List elements are separated by spaces, not commas. That's the error being reported.
The base case of the recursion must refer to the parameter lst, not to list.
Your tail-recursive solution reverses the list, an extra reverse is needed at the end to restore the original order
With the above changes in place, it works as expected:
(define (lst-double-helper lst acc)
(if (empty? lst) ; parameter is called `lst`
acc
(lst-double-helper (rest lst) (cons (* (first lst) 2) acc))))
(define (lst-double lst)
(reverse ; required to restore original order
(lst-double-helper lst '())))
(lst-double '(1 2 3)) ; use spaces to separate elements
=> '(2 4 6)
Be aware that a tail-recursive solution that traverses an input list and conses its elements to build an output list, will necessarily reverse the order of the elements in the input list. This is ok, and it's normal to do a reverse at the end. Possible alternatives to avoid reversing the elements at the end would be to reverse the input list at the beginning or to write a non-tail-recusive solution.
One such way is by using continuation-passing style. Here we add a parameter named return which effectively encodes a return-like behavior with a lambda. double now takes two arguments: the list to double, xs, and the continuation of the result, return –
(define (double xs return)
(if (empty? xs)
(return empty)
(double (cdr xs)
(lambda (result)
(return (cons (* 2 (car xs))
result))))))
As an example, the result of double applied to a list of '(1 2 3) is sent to print
(double '(1 2 3) print)
;; '(2 4 6)
;; => #<void>
double evaluates to whatever the final continuation evaluates to; in this case, print evaluates to #<void>. We can use the identity function to effectively get the value out –
(double '(1 2 3) identity)
;; => '(2 4 6)
Racket allows you to easily specify default arguments, so we can modify double to use identity as the default continuation
(define (double xs (return identity))
;; ...
)
This style results in convenient programs that work in two call styles at simultaneously: continuation-passing style –
(double '(10 11 12) print)
;; '(20 22 24)
;; => #<void>
(double '(10 11 12) length)
;; => 3
(double '(10 11 12) car)
;; => 20
(double '(10 11 12) cdr)
;; => '(22 24)
... or in direct style, using the default identity continuation
(print (double '(10 11 12)))
;; '(20 22 24)
(length (double '(10 11 12)))
;; => 3
(car (double '(10 11 12)))
;; => 20
(cdr (double '(10 11 12)))
;; => '(22 24)
use map.
(map (lambda (a) (* a 2)) '(1 2 3))
For nested lists:
(define (atom? x)
(and (not (null? x))
(not (pair? x))))
(define (lst-double-helper lst acc)
(cond ((empty? lst) acc)
((atom? (car lst)) (lst-double-helper (rest lst) (cons (* (first lst) 2) acc)))
(else (lst-double-helper (rest lst) (cons (lst-double (first lst))
acc) ))))
(define (lst-double lst)
(reverse ; required to restore original order
(lst-double-helper lst '())))
but actually to make this function tail-recursive is a little bit meaningless,
because as #simmone mentioned, map would do it
(define (list-doubler lst)
(map (lambda (x) (* 2 x)) lst))
(list-doubler '(1 2 3))
;; '(2 4 6)
I have this homework in LISP where I need to sort out atoms and then sublists from a list. I'm sure this is supposed to be easy task but as I'm not much of a programmer then this is really taking quite a while for me to understand.
I have this list of numbers:
(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)
And if I understand correctly my task then I should get something like this:
(5 -1 -6 (2 6 1) (8 7 -3) (0 (9 4)))
So far all I found out is how to count atoms and/or sublists but I don't need that.
(DEFUN ATOMNUMBER (L) (COND ((NULL L) 0)
((ATOM (CAR L)) (+ 1 (ATOMNUMBER (CDR L))))
(T (ATOMNUMBER (CDR L))) ))
Also that function should work correctly even when there are only sublists, only atoms or just empty list.
Maybe someone can give me any examples?
Thanks in advance!
There are several possible approaches in Common Lisp:
use REMOVE-IF to remove the unwanted items. (Alternatively use REMOVE-IF-NOT to keep the wanted items.) You'll need two lists. Append them.
use DOLIST and iterate over the list, collect the items into two lists and append them
write a recursive procedure where you need to keep two result lists.
it should also be possible to use SORT with a special sort predicate.
Example:
> (sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(atom a)))
(1 10 -6 1 4 4 1 (2 6 1) (8 7 -3) (0 (9 4)))
As stable version:
(stable-sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(and (atom a)
(not (atom b)))))
(1 4 4 1 -6 10 1 (2 6 1) (8 7 -3) (0 (9 4)))
I am more used to Scheme but here's a solution that works in Lisp:
(defun f (lst)
(labels
((loop (lst atoms lists)
(cond
((null lst)
(append (reverse atoms) (reverse lists)))
((atom (car lst))
(loop (cdr lst) (cons (car lst) atoms) lists))
(T
(loop (cdr lst) atoms (cons (car lst) lists))))))
(loop lst '() '())))
(f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
Basically you iterate over the list, and each element is either appended to the atoms list or the lists lists. In the end you join both to get your result.
EDIT
The remove-if version is way shorter, of course:
(let ((l '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
(append
(remove-if-not #'atom l)
(remove-if #'atom l)))
Just in case you will want to exercise more, and you will find that the examples provided here are not enough :P
(defun sort-atoms-first-recursive (x &optional y)
(cond
((null x) y)
((consp (car x))
(sort-atoms-first-recursive (cdr x) (cons (car x) y)))
(t (cons (car x) (sort-atoms-first-recursive (cdr x) y)))))
(defun sort-atoms-first-loop (x)
(do ((a x (cdr a))
(b) (c) (d) (e))
(nil)
(if (consp (car a))
(if b (setf (cdr b) a b (cdr b)) (setf b a d a))
(if c (setf (cdr c) a c (cdr c)) (setf c a e a)))
(when (null (cdr a))
(cond
((null d) (return e))
((null c) (return d))
(t (setf (cdr b) nil (cdr c) d) (return e))))))
(sort-atoms-first-recursive '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
(sort-atoms-first-loop '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
The second one is destructive (but doesn't create any new conses).
Here's an iterative code, constructing its output in a top-down manner (the comment is in Haskell syntax):
;atomsFirst xs = separate xs id id where
; separate [] f g = f (g [])
; separate (x:xs) f g
; | atom x = separate xs (f.(x:)) g
; | True = separate xs f (g.(x:))
(defmacro app (l v)
`(progn (rplacd ,l (list ,v)) (setq ,l (cdr ,l))))
(defun atoms-first (xs)
(let* ((f (list nil)) (g (list nil)) (p f) (q g))
(dolist (x xs)
(if (atom x) (app p x) (app q x)))
(rplacd p (cdr g))
(cdr f)))
The two intermediate lists that are being constructed in a top-down manner are maintained as open-ended lists (i.e. with explicit ending pointer), essentially following the difference-lists paradigm.
You can do this recursive way:
(defun f (lst)
(cond
((null lst) nil)
((atom (car lst))
(append (list (car lst)) (f (cdr lst))))
(T
(append (f (cdr lst)) (list (f (car lst))))
)
)
)
(step (f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
Output:
step 1 --> (F '(5 -1 (2 6 1) (8 7 -3) ...))
step 1 ==> value: (5 -1 -6 (0 (9 4)) (8 7 -3) (2 6 1))
I have a series of expressions to convert from postfix to prefix and I thought that I would try to write a program to do it for me in DrRacket. I am getting stuck with some of the more complex ones such as (10 (1 2 3 +) ^).
I have the very simple case down for (1 2 \*) → (\* 1 2). I have set these expressions up as a list and I know that you have to use cdr/car and recursion to do it but that is where I get stuck.
My inputs will be something along the lines of '(1 2 +).
I have for simple things such as '(1 2 +):
(define ans '())
(define (post-pre lst)
(set! ans (list (last lst) (first lst) (second lst))))
For the more complex stuff I have this (which fails to work correctly):
(define ans '())
(define (post-pre-comp lst)
(cond [(pair? (car lst)) (post-pre-comp (car lst))]
[(pair? (cdr lst)) (post-pre-comp (cdr lst))]
[else (set! ans (list (last lst) (first lst) (second lst)))]))
Obviously I am getting tripped up because (cdr lst) will return a pair most of the time. I'm guessing my structure of the else statement is wrong and I need it to be cons instead of list, but I'm not sure how to get that to work properly in this case.
Were you thinking of something like this?
(define (pp sxp)
(cond
((null? sxp) sxp)
((list? sxp) (let-values (((args op) (split-at-right sxp 1)))
(cons (car op) (map pp args))))
(else sxp)))
then
> (pp '(1 2 *))
'(* 1 2)
> (pp '(10 (1 2 3 +) ^))
'(^ 10 (+ 1 2 3))
Try something like this:
(define (postfix->prefix expr)
(cond
[(and (list? expr) (not (null? expr)))
(define op (last expr))
(define args (drop-right expr 1))
(cons op (map postfix->prefix args))]
[else expr]))
This operates on the structure recursively by using map to call itself on the arguments to each call.
The map! procedure should modify the existing list to have the values of the operator applied to the original values.
For example:
(define a '(1 2 3 4 5))
(define double (lambda (x) (* x 2)))
(map! double a)
returns
done
Then when a is evaluated, a should return
(2 4 6 8 10)
map! procedure must do that work.
(define (map! operator given-list)
(if (null? given-list) 'done
(<the procedure that does the modification>)))
My guess1:
(map (lambda (x) (set! x (operator x))) given-list)
(map! double a)
returns:
'(#<void> #<void> #<void> #<void> #<void>)
My guess2:
(cons (operator (car given-list)) (map! double (cdr given-list)))
(map! double a)
returns:
'(2 4 6 8 10 . done)
My guess3:
(set! given-list (map operator given-list))
(map! double a)
returns:
'(2 4 6 8 10)
My guess4:
(let ((element (car given-list)))
(set! element (operator given-list) (map! operator (cdr given-list)))
(map! double a)
returns:
'done
but, when "a" is evaluated, it still says:
'(1 2 3 4 5)
What do I have to do for this?????
You cannot use set! for this. You need to use set-car! on the cons cell you're changing. Here's how you might write it:
(define (map! f lst)
(let loop ((rest lst))
(unless (null? rest)
(set-car! rest (f (car rest)))
(loop (cdr rest)))))
If you have SRFI 1, it's even easier (if we ignore for a moment that SRFI 1 already defines map! ;-)):
(define (map! f lst)
(pair-for-each (lambda (pair)
(set-car! pair (f (car pair))))
lst))
I have this homework in LISP where I need to sort out atoms and then sublists from a list. I'm sure this is supposed to be easy task but as I'm not much of a programmer then this is really taking quite a while for me to understand.
I have this list of numbers:
(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)
And if I understand correctly my task then I should get something like this:
(5 -1 -6 (2 6 1) (8 7 -3) (0 (9 4)))
So far all I found out is how to count atoms and/or sublists but I don't need that.
(DEFUN ATOMNUMBER (L) (COND ((NULL L) 0)
((ATOM (CAR L)) (+ 1 (ATOMNUMBER (CDR L))))
(T (ATOMNUMBER (CDR L))) ))
Also that function should work correctly even when there are only sublists, only atoms or just empty list.
Maybe someone can give me any examples?
Thanks in advance!
There are several possible approaches in Common Lisp:
use REMOVE-IF to remove the unwanted items. (Alternatively use REMOVE-IF-NOT to keep the wanted items.) You'll need two lists. Append them.
use DOLIST and iterate over the list, collect the items into two lists and append them
write a recursive procedure where you need to keep two result lists.
it should also be possible to use SORT with a special sort predicate.
Example:
> (sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(atom a)))
(1 10 -6 1 4 4 1 (2 6 1) (8 7 -3) (0 (9 4)))
As stable version:
(stable-sort '(1 (2 6 1) 4 (8 7 -3) 4 1 (0 (9 4)) -6 10 1)
(lambda (a b)
(and (atom a)
(not (atom b)))))
(1 4 4 1 -6 10 1 (2 6 1) (8 7 -3) (0 (9 4)))
I am more used to Scheme but here's a solution that works in Lisp:
(defun f (lst)
(labels
((loop (lst atoms lists)
(cond
((null lst)
(append (reverse atoms) (reverse lists)))
((atom (car lst))
(loop (cdr lst) (cons (car lst) atoms) lists))
(T
(loop (cdr lst) atoms (cons (car lst) lists))))))
(loop lst '() '())))
(f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
Basically you iterate over the list, and each element is either appended to the atoms list or the lists lists. In the end you join both to get your result.
EDIT
The remove-if version is way shorter, of course:
(let ((l '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
(append
(remove-if-not #'atom l)
(remove-if #'atom l)))
Just in case you will want to exercise more, and you will find that the examples provided here are not enough :P
(defun sort-atoms-first-recursive (x &optional y)
(cond
((null x) y)
((consp (car x))
(sort-atoms-first-recursive (cdr x) (cons (car x) y)))
(t (cons (car x) (sort-atoms-first-recursive (cdr x) y)))))
(defun sort-atoms-first-loop (x)
(do ((a x (cdr a))
(b) (c) (d) (e))
(nil)
(if (consp (car a))
(if b (setf (cdr b) a b (cdr b)) (setf b a d a))
(if c (setf (cdr c) a c (cdr c)) (setf c a e a)))
(when (null (cdr a))
(cond
((null d) (return e))
((null c) (return d))
(t (setf (cdr b) nil (cdr c) d) (return e))))))
(sort-atoms-first-recursive '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
(sort-atoms-first-loop '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6))
The second one is destructive (but doesn't create any new conses).
Here's an iterative code, constructing its output in a top-down manner (the comment is in Haskell syntax):
;atomsFirst xs = separate xs id id where
; separate [] f g = f (g [])
; separate (x:xs) f g
; | atom x = separate xs (f.(x:)) g
; | True = separate xs f (g.(x:))
(defmacro app (l v)
`(progn (rplacd ,l (list ,v)) (setq ,l (cdr ,l))))
(defun atoms-first (xs)
(let* ((f (list nil)) (g (list nil)) (p f) (q g))
(dolist (x xs)
(if (atom x) (app p x) (app q x)))
(rplacd p (cdr g))
(cdr f)))
The two intermediate lists that are being constructed in a top-down manner are maintained as open-ended lists (i.e. with explicit ending pointer), essentially following the difference-lists paradigm.
You can do this recursive way:
(defun f (lst)
(cond
((null lst) nil)
((atom (car lst))
(append (list (car lst)) (f (cdr lst))))
(T
(append (f (cdr lst)) (list (f (car lst))))
)
)
)
(step (f '(5 -1 (2 6 1) (8 7 -3) (0 (9 4)) -6)))
Output:
step 1 --> (F '(5 -1 (2 6 1) (8 7 -3) ...))
step 1 ==> value: (5 -1 -6 (0 (9 4)) (8 7 -3) (2 6 1))