Input1:
(decompose '(* 1 2 3 4))
Output1:
'(* 1 (* 2 (* 3 4)))
Input2
(decompose '(+ 1 2 3 (* 5 6 7)))
Output2
'(+ 1 (+ 2 (+ 3 (* 5 (* 6 7)))))
Does anyone have ideas about this?
Same way as you would evaluate it, but instead of outputting the result, you simply output the expression that would be used.
Here's my implementation, tested on Racket:
(define (decompose expr)
(define (expand x)
(if (list? x)
(decompose x)
x))
(define oper (car expr))
(let next ((args (map expand (cdr expr))))
(if (<= (length args) 2)
(cons oper args)
(list oper (car args) (next (cdr args))))))
I see you posted your own solution, so I guess it's ok to show my complete answer. Here's another possible implementation, as a mutually-recursive pair of procedures. I like the fact that this solution doesn't require using length or list? (which might entail unnecessary traversals over the list), and uses only elementary functions (no foldr, reverse, map or any other higher-order procedures are needed.)
(define (decompose lst)
(if (or (null? lst) ; if the list is empty
(null? (cdr lst)) ; or has only one element
(null? (cddr lst))) ; or has only two elements
lst ; then just return the list
(process (car lst) ; else process car of list (operator)
(cdr lst)))) ; together with cdr of list (operands)
(define (process op lst)
(cond ((null? (cdr lst)) ; if there's only one element left
(if (not (pair? (car lst))) ; if the element is not a list
(car lst) ; then return that element
(decompose (car lst)))) ; else decompose that element
((not (pair? (car lst))) ; if current element is not a list
(list op ; build a list with operator,
(car lst) ; current element,
(process op (cdr lst)))) ; process rest of list
(else ; else current element is a list
(list op ; build a list with operator,
(decompose (car lst)) ; decompose current element,
(process op (cdr lst)))))) ; process rest of list
It works for your examples, and then some:
(decompose '(* 1 2 3 4))
=> '(* 1 (* 2 (* 3 4)))
(decompose '(+ 1 2 3 (* 5 6 7)))
=> '(+ 1 (+ 2 (+ 3 (* 5 (* 6 7)))))
(decompose '(+ 1 (* 4 5 6) 2 3))
=> '(+ 1 (+ (* 4 (* 5 6)) (+ 2 3)))
(decompose '(+ 1 2 3 (* 5 6 7) 8))
=> '(+ 1 (+ 2 (+ 3 (+ (* 5 (* 6 7)) 8))))
(decompose '(+ 1 2 3 (* 5 6 7) (* 8 9 10) (* 11 12 (- 1))))
=> '(+ 1 (+ 2 (+ 3 (+ (* 5 (* 6 7)) (+ (* 8 (* 9 10)) (* 11 (* 12 (- 1))))))))
Modified from Chris Jester-Young's solution:
(define (decompose x)
(if (pair? x)
(let ((operator (car x))
(expanded-x (map decompose x)))
(let decompose-helper ((operands (cdr expanded-x)))
(if (<= (length operands) 2)
(cons operator operands)
(list operator (car operands) (decompose-helper (cdr operands))))))
x))
Related
I am a lisp newbie.
I'm trying to create a function in lisp that receives an unsorted list and the function has to sort de list and return a list with the longest sequence of numbers.
Example: (2 1 8 9 3 11 10 20 12 21)(1 2 3 8 9 10 11 12 20 21) -> return (8 9 10 11 12)
I don't want to use the sort function and I have created 2 functions (With some help) to sort, but now I have no idea how I could find and return the longest sequence of numbers.
I could go through the list but, how I can store the numbers and check if a list of consecutive numbers is longer than another?
This are my functions to sort
(defun sortOne (list)
(let ((ca1 (car list)) (cd1 (cdr list)))
(if (null cd1)
list
(let ((cd (sortOne cd1))) ; cd = sorted tail
(let ((ca2 (car cd)) (cd2 (cdr cd)))
(if (<= ca1 ca2)
(cons ca1 cd)
(cons ca2 (cons ca1 cd2))))))))
(defun sortAll (list)
(if (null list)
nil
(let ((s (sortOne list)))
(cons (car s) (sortAll (cdr s))))))
Hope someone can help me.
¡Thanks!
Tonight I managed to do it, but surely it is not the best solution, I would like to know how to use a lambda function or recursion to do it better.
(defun listilla (lista)
(setq lista (sort lista #'<))
(setq lista1 (list (car lista)))
(setq lista2 '())
(loop for i from 0 to (- (length lista) 2) do
(cond ((= (nth i lista) (- (nth (+ i 1) lista) 1))
(push (nth (+ i 1) lista) (cdr (last lista1))))
(t (push lista1 lista2)
(setq lista1 (list (nth (+ i 1) lista)))
)
)
)
(push lista1 lista2)
(setq masLargo (car lista2))
(loop for i from 1 to (- (length lista2) 2) do
(if (< (length (nth i lista2)) (length (nth (+ i 1) lista2)))
(setq masLargo (nth (+ i 1) lista2))
)
)
masLargo
)
(print (listilla '(23 15 6 5 78 4 77)))
(defun group-consecutives (l &optional (acc '()))
(cond ((null l) (nreverse acc))
((and acc (= 1 (- (car l) (caar acc)))) (consecutives (cdr l) (cons (cons (car l) (car acc)) (cdr acc))))
(t (consecutives (cdr l) (cons (list (car l)) (when acc (cons (nreverse (car acc)) (cdr acc))))))))
(defun longest-consecutive (l)
(car (sort (consecutives (sort l #'<)) #'> :key #'length)))
(longest-consecutive '(2 1 8 9 3 11 10 20 12 21))
;;=> (8 9 10 11 12)
Probably the second function is easier to understand like this:
(defun sort-increasing (l)
(sort l #'<))
(defun sort-groups-by-length (groups)
(sort groups #'> #'length))
(defun longest-consecutive (l)
(car (sort-groups-by-length (group-consecutives (sort-increasing l))))))))
I'm currently working on building a function that returns a row of Pascal's triangle. My function passes in a list that contains a row in Pascal's triangle and returns the next row depending on which row was passed in.
ex. pass in '(1 2 1) and it should return '(1 3 3 1).
However I cannot seem to get the beginning 1 in the list.
(define build-next
(lambda(thisRow)
(cond
[(null? thisRow) '(1)]
[(null? (cdr thisRow)) (cons 1 (cdr thisRow))]
[else (cons (+ (car thisRow) (car (cdr thisRow))) (build-next(cdr thisRow)))])))
(build-next '(1 2 1))
Running this code will give me the output
'(3 3 1)
without the leading 1
Your functions works if the input row has a zero as first element.
Renaming your original function to build-next-helper and introducing
a new build-next that simply calls your existing function after prefixing a zero works fine:
(define build-next-helper
(lambda (thisRow)
(cond
[(null? thisRow) '(1)]
[(null? (cdr thisRow)) (cons 1 (cdr thisRow))]
[else (cons (+ (car thisRow) (car (cdr thisRow)))
(build-next-helper (cdr thisRow)))])))
(define (build-next thisRow)
(build-next-helper (cons 0 thisRow)))
(build-next '(1 2 1))
You can also use a named let to write build-next as follows:
(define (build-next row)
(let loop ([row row]
[acc 0])
(cond
[(zero? acc)
(cons 1 (loop row (add1 acc)))]
[(null? row) empty]
[(null? (cdr row)) (list 1)]
[else
(cons (+ (car row) (cadr row))
(loop (cdr row) acc))])))
The loop parameter acc is used as an accumulator to add the leading 1 in the next row (ie. first cond case).
For example,
(build-next '()) ;;=> '(1)
(build-next '(1)) ;;=> '(1 1)
(build-next '(1 1)) ;;=> '(1 2 1)
(build-next '(1 2 1)) ;;=> '(1 3 3 1)
(build-next '(1 3 3 1)) ;;=> '(1 4 6 4 1)
(build-next '(1 4 6 4 1)) ;;=> '(1 5 10 10 5 1)
Here is a possible solution:
(define build-next
(lambda(thisRow)
(define helper-build-next
(lambda (lst prev)
(if (null? lst)
(list prev)
(cons (+ prev (car lst)) (helper-build-next (cdr lst) (car lst))))))
(if (null? thisRow)
(list 1)
(cons (car thisRow) (helper-build-next (cdr thisRow) (car thisRow))))))
The recursion is performed through a helper function, that gets the rest of the row and the previous element of the row. Initially the function checks if the parameter is the empty list, so that the first row of the triangle is returned. Otherwise, the helper function is called with the initial parameters.
I need to write for school a function that can calculate numbers and ignore the letters. Do I need to make a case for every operation? I don't know how to start. For example:
(+ 1 A 2 X) = (3 A X)
(- A 5 1 A) = 4
(* 2 C 0) = 0
So I have done a part of the problem. The 2 functions DELNUM and DELSYM are for deleting the numbers respectively the symbol from a list. It's all working now, just for example like (- A 5 A) -> 5 isn't, because I need some conditions for that.
(defun delnum (l)
(remove-if-not #'symbolp l))
(delnum '(4 S 56 h ))
;;-> (S H)
(defun delsym (l)
(remove-if-not #'numberp l))
(delsym '(+ a 1 2 3 b))
;;-> (1 2 3)
(defun test (l)
(cond
((null l) nil)
((case (car l)
(+ (cons (apply #'+ (delsym l)) (delnum (cdr l))))
(- (cons (apply #'- (delsym l)) (delnum (cdr l))))
(* (cond ((eql (apply #'* (delsym l)) 0) 0)
( t (cons (apply #'* (delsym l)) (delnum (cdr l))))))
(/ (cond ((eql (car (delsym l)) 0) '(error division by zero))
((eql (find 0 (delsym l)) 0) '(error division by zero))
(t (cons (apply #'/ (delsym l)) (delnum (cdr l))))))))))
(test '(/ 0 )) ;-> (ERROR DIVISION BY ZERO)
(test '(+ 1 2 A)) ;-> (3 A)
(test '(- 6 5 A C)) ;-> (1 AC)
(test '(- 1 5 A C X 0)) ;-> (-4 A C X)
(test '(* 0 5 A C)) ;-> 0
(test '(* 10 5 A C)) ;-> (50 A C)
(test '(/ 12 0 V 1 2)) ;-> (ERROR DIVISION BY ZERO)
(test '(/ S 3 7 C)) ;-> (3/7 S C)
(test '(+ -A A 5)) ;-> it gotta display 5 or (5)
(defun filter-numbers-rec (inlist)
"This function filters out non-numbers from its input list and returns
the result, a list of numbers"
(cond
((not (listp inlist))
(princ "Argument must be a list")
(terpri)
())
((null inlist)
())
((not (numberp (car inlist)))
(filter-numbers-rec (cdr inlist)))
(t
(cons (car inlist)
(filter-numbers-rec (cdr inlist))))))
Well, the description of what the function does is that you want to remove each thing from the the list if it is not a number, so a good candidate here is remove-if-not, which you would use as follows:
(remove-if-not 'numberp '(1 a 2 b 3 c #\x (y 4)))
;=> (1 2 3)
If, for some reason, you want to write this in a way that (might) not use recursion, you could use do:
(do ((list '(1 a 2 b 3 c #\x (y 4)) (rest list))
(result '()))
((endp list) (nreverse result))
(when (numberp (car list))
(push (car list) result)))
;=> (1 2 3)
If you don't like the wordiness of do, you can use loop:
(loop :for x :in '(1 a 2 b 3 c #\x (y 4))
:when (numberp x)
:collect x)
;=> (1 2 3)
I was doing a problem from the HTDP book where you have to create a function that finds all the permutations for the list. The book gives the main function, and the question asks for you to create the helper function that would insert an element everywhere in the list. The helper function, called insert_everywhere, is only given 2 parameters.
No matter how hard I try, I can't seem to create this function using only two parameters.
This is my code:
(define (insert_everywhere elt lst)
(cond
[(empty? lst) empty]
[else (append (cons elt lst)
(cons (first lst) (insert_everywhere elt (rest lst))))]))
My desired output for (insert_everywhere 'a (list 1 2 3)) is (list 'a 1 2 3 1 'a 2 3 1 2 'a 3 1 2 3 'a), but instead my list keeps terminating.
I've been able to create this function using a 3rd parameter "position" where I do recursion on that parameter, but that botches my main function. Is there anyway to create this helper function with only two parameters? Thanks!
Have you tried:
(define (insert x index xs)
(cond ((= index 0) (cons x xs))
(else (cons (car xs) (insert x (- index 1) (cdr xs))))))
(define (range from to)
(cond ((> from to) empty)
(else (cons from (range (+ from 1) to)))))
(define (insert-everywhere x xs)
(fold-right (lambda (index ys) (append (insert x index xs) ys))
empty (range 0 (length xs))))
The insert function allows you to insert values anywhere within a list:
(insert 'a 0 '(1 2 3)) => (a 1 2 3)
(insert 'a 1 '(1 2 3)) => (1 a 2 3)
(insert 'a 2 '(1 2 3)) => (1 2 a 3)
(insert 'a 3 '(1 2 3)) => (1 2 3 a)
The range function allows you to create Haskell-style list ranges:
(range 0 3) => (0 1 2 3)
The insert-everywhere function makes use of insert and range. It's pretty easy to understand how it works. If your implementation of scheme doesn't have the fold-right function (e.g. mzscheme) then you can define it as follows:
(define (fold-right f acc xs)
(cond ((empty? xs) acc)
(else (f (car xs) (fold-right f acc (cdr xs))))))
As the name implies the fold-right function folds a list from the right.
You can do this by simply having 2 lists (head and tail) and sliding elements from one to the other:
(define (insert-everywhere elt lst)
(let loop ((head null) (tail lst)) ; initialize head (empty), tail (lst)
(append (append head (cons elt tail)) ; insert elt between head and tail
(if (null? tail)
null ; done
(loop (append head (list (car tail))) (cdr tail)))))) ; slide
(insert-everywhere 'a (list 1 2 3))
=> '(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
In Racket, you could also express it in a quite concise way as follows:
(define (insert-everywhere elt lst)
(for/fold ((res null)) ((i (in-range (add1 (length lst)))))
(append res (take lst i) (cons elt (drop lst i)))))
This has a lot in common with my answer to Insert-everywhere procedure. There's a procedure that seems a bit odd until you need it, and then it's incredibly useful, called revappend. (append '(a b ...) '(x y ...)) returns a list (a b ... x y ...), with the elements of (a b ...). Since it's so easy to collect lists in reverse order while traversing a list recursively, it's useful sometimes to have revappend, which reverses the first argument, so that (revappend '(a b ... m n) '(x y ...)) returns (n m ... b a x y ...). revappend is easy to implement efficiently:
(define (revappend list tail)
(if (null? list)
tail
(revappend (rest list)
(list* (first list) tail))))
Now, a direct version of this insert-everywhere is straightforward. This version isn't tail recursive, but it's pretty simple, and doesn't do any unnecessary list copying. The idea is that we walk down the lst to end up with the following rhead and tail:
rhead tail (revappend rhead (list* item (append tail ...)))
------- ------- ------------------------------------------------
() (1 2 3) (r 1 2 3 ...)
(1) (2 3) (1 r 2 3 ...)
(2 1) (3) (1 2 r 3 ...)
(3 2 1) () (1 2 3 r ...)
If you put the recursive call in the place of the ..., then you get the result that you want:
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst))
(if (null? tail)
(revappend rhead (list item))
(revappend rhead
(list* item
(append tail
(ie (list* (first tail) rhead)
(rest tail))))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
Now, this isn't tail recursive. If you want a tail recursive (and thus iterative) version, you'll have to construct your result in a slightly backwards way, and then reverse everything at the end. You can do this, but it does mean one extra copy of the list (unless you destructively reverse it).
(define (insert-everywhere item lst)
(let ie ((rhead '())
(tail lst)
(result '()))
(if (null? tail)
(reverse (list* item (append rhead result)))
(ie (list* (first tail) rhead)
(rest tail)
(revappend tail
(list* item
(append rhead
result)))))))
> (insert-everywhere 'a '(1 2 3))
'(a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
How about creating a helper function to the helper function?
(define (insert_everywhere elt lst)
(define (insert_everywhere_aux elt lst)
(cons (cons elt lst)
(if (empty? lst)
empty
(map (lambda (x) (cons (first lst) x))
(insert_everywhere_aux elt (rest lst))))))
(apply append (insert_everywhere_aux elt lst)))
We need our sublists kept separate, so that each one can be prefixed separately. If we'd append all prematurely, we'd lose the boundaries. So we append only once, in the very end:
insert a (list 1 2 3) = ; step-by-step illustration:
((a)) ; the base case;
((a/ 3)/ (3/ a)) ; '/' signifies the consing
((a/ 2 3)/ (2/ a 3) (2/ 3 a))
((a/ 1 2 3)/ (1/ a 2 3) (1/ 2 a 3) (1/ 2 3 a))
( a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a ) ; the result
Testing:
(insert_everywhere 'a (list 1 2 3))
;Value 19: (a 1 2 3 1 a 2 3 1 2 a 3 1 2 3 a)
By the way this internal function is tail recursive modulo cons, more or less, as also seen in the illustration. This suggests it should be possible to convert it into an iterative form. Joshua Taylor shows another way, using revappend. Reversing the list upfront simplifies the flow in his solution (which now corresponds to building directly the result row in the illustration, from right to left, instead of "by columns" in my version):
(define (insert_everywhere elt lst)
(let g ((rev (reverse lst))
(q '())
(res '()))
(if (null? rev)
(cons elt (append q res))
(g (cdr rev)
(cons (car rev) q)
(revappend rev (cons elt (append q res)))))))