I have a function that takes a list and outputs the powerset of that list. So given, (1 2 3) it should output (() (1) (2) (3) (1 2) (1 3) (2 3) (1 2 3)).
I am currently getting the correct values, it just not in a nice order. The current output is (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3)).
I wrote two functions that will be passed to the standard sort function to check the length of each element and if it is in order and sort accordingly. The output of that gives me ((1 2 3) (1 2) (1 3) (1) (2 3) (2) (3) ()).
What am I doing wrong in these two functions given the final-list is (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))?
;define element-ordered
(define (element-ordered? ls0 ls1)
(cond
[(equal? ls0 ls1) #t]
[(< (car ls0) (car ls1)) #t]
[else #f]))
;define length-ordered
(define (length-ordered? ls0 ls1)
(cond
[< (length ls0) (length ls1) #t]
[> (length ls0) (length ls1) #f]
[eq? (length ls0) (length ls1) (element-ordered? ls0 ls1)]))
;sort using provided sort
(sort final-list length-ordered?))
I'm not sure if your element-ordered? function is quite correct. Here's what I came up with:
(define (element-ordered? ls0 ls1)
(cond
((< (car ls0) (car ls1)) #t)
((> (car ls0) (car ls1)) #f)
(else (element-ordered? (cdr ls0) (cdr ls1)))
)
)
(define (length-ordered? ls0 ls1)
(cond
((< (length ls0) (length ls1)) #t)
((> (length ls0) (length ls1)) #f)
(else (element-ordered? ls0 ls1))
)
)
Note also that in your code snippet, the conditions of length-ordered? are not parenthesized correctly, so this might have also caused a problem with your function.
Related
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 need a function that will do this:
Odd Length list
Input '(1 2 3 4 5) = '(1 (2 (3) 4) 5)
Even length list
Input '(1 2 3 4) = '(1 (2 () 3) 4)
It needs to use very minimal built in functions. I have spent hours trying to figure this out and I am completely out of ideas at this point.
Here is what I have:
(define (listInList L)
(define length (listLength L))
(define L2 (listInListHelper length L '() '()))
(define L3 (listInListHelper (- length 2) L L2 '()))
L3
)
(define (listInListHelper N L NL)
(cond
((= N 0) '()
((= N 1) (cons (list (car L)) NL))
(else (cons (cons (car L) (list (lastItem L))) NL)
(remove 1 L)))
)
)
(define (lastItem L)
(if (null? (cdr L))(car L)
(lastItem (cdr L)))
)
(define (remove N L)
(cond ((eq? N 0) (cdr L))
(else (cons (car L) (remove (- N 1)(cdr L))))))
This would be one way to do it, you need to tell me if it's minimal enough:
(define (f lst)
(define (helper lst rlst half)
(cond
((= half 0 ) null)
((= half 1/2) (list (car lst)))
(else (list (car lst)
(helper (cdr lst) (cdr rlst) (sub1 half))
(car rlst)))))
(helper lst (reverse lst) (/ (length lst) 2)))
testing:
> (f '(1 2 3 4 5))
'(1 (2 (3) 4) 5)
> (f '(1 2 3 4))
'(1 (2 () 3) 4)
I am writing a function which give the sum of all the number in a list neglecting words or alphabets.
(define (sum-list ls)
(cond ((null? ls) 0)
((not (number? (car ls))) (sum-list(cdr ls)))
(else (+ (car ls) (sum-list (cdr ls))))
)
)
(deep-sum '(a 2 (b (1 c)) 3)) => ; should return 6.
but i am getting 5. that mean my code is not reaching in the inner loop
That's not the way to traverse a list of lists, it goes more like this:
(define (deep-sum ls)
(cond ((null? ls) 0)
((not (pair? ls)) ; only add atoms
(if (number? ls) ls 0)) ; only add numbers
(else (+ (deep-sum (car ls)) ; advance recursion on both car and car
(deep-sum (cdr ls))))))
Now it works as expected:
(deep-sum '(a 2 (b (1 c)) 3))
=> 6
If you want to check nested lists, you must have another condition that checks if the element is a list, and then call sum-list recursively.
Adding this line below the null? condition should do it.
((list? (car ls)) (+ (sum-list (car ls)) (sum-list (cdr ls))))
Remove duplicates in a MULTI-LEVEL list (using Common Lisp) without changing list's inner structure. This problem seems to be a hard nut and a big headache for me.
Source list:
(1 2 (6 5) 2 3 (5 4)) ==> Result: (1 (6) 2 3 (5 4))
Here's my not-working decision:
LispWokrs:
(defun F (l &optional (lst (remove-duplicates (flatten l))))
(cond
((null l) nil)
((atom (car l))
(if (member (car l) lst)
(cons (car l) (F (cdr l) (remove (car l) lst)))
(F (cdr l) lst)))
(t (cons (F (car l) lst) (F (cdr l) lst)))))
I tried to use lst for keeping a clear set (1 2 6 5 3 4) and I've been trying to remove an element from this set each time I add a new element.
But what I get is almost the same source sequence (parallel recursion...):
(f '(1 2 (6 5) 2 3 (5 4))) ==> (1 2 (6 5) 3 (5 4))
(f '(А ((B C E) D (B E A)))) ==> (А ((B C E) D (B E A)))
Then I searched over the net, but there was no decision for this problem.
Try this:
(defun multi-level-list-remove-duplicates (tree)
(let ((seen NIL))
(labels ((rec (l)
(cond
((null l) NIL)
((consp (car l)) (cons (rec (car l))
(rec (cdr l))))
((member (car l) seen) (rec (cdr l)))
(T (push (car l) seen)
(cons (car l) (rec (cdr l)))))))
(rec tree))))
This maintains a list of already-seen values in seen and removes these if seen again. The recursive function rec closes over this value and thus all the sub-lists share one seen variable for each call to multi-level-list-remove-duplicates.
I have a list '(1 2 1 1 4 5) and want output list as '((1 3)(2 1)(4 1)(5 1)). I have written a small code but I am stuck with how to calculate the cardinality for each number and then put it as pair in list. Can anyone please look at my code and give some ideas?
(define set2bags
(lambda (randlist)
(cond ((null? randlist) '())
(else
(sort randlist)
(makepairs randlist)))))
(define makepairs
(lambda (inlist)
(let ((x 0)) ((newlist '()))
(cond ((zero? (car inlist)) '())
(else
(eq? (car inlist)(car (cdr inlist)))
(+ x 1)
(makepairs (cdr inlist))
(append newlist (cons (car inlist) x)))))))
Your current solution is incorrect - it doesn't even compile. Let's start again from scratch, using a named let for traversing the input list:
(define set2bags
(lambda (randlist)
(cond ((null? randlist) '())
(else (makepairs (sort randlist >))))))
(define makepairs
(lambda (inlist)
(let loop ((lst inlist)
(prv (car inlist))
(num 0)
(acc '()))
(cond ((null? lst)
(cons (list prv num) acc))
((= (car lst) prv)
(loop (cdr lst) prv (add1 num) acc))
(else
(loop (cdr lst) (car lst) 1 (cons (list prv num) acc)))))))
Now it works as expected:
(set2bags '(1 2 1 1 4 5))
=> '((1 3) (2 1) (4 1) (5 1))
The trick is keeping a counter for the cardinality (I called it num), and incrementing it as long as the same previous element (I named it prv) equals the current element. Whenever we find a different element, we add a new pair to the output list (called acc) and reset the previous element and the counter.
Your code is fairly hard to read without proper formating.
I notice a two branch cond, which is easier to read as an if.
In your else clause of set2bags, you call (sort randlist) but leave it as is. You actually want to use this in the next s-expression (makepairs (sort randlist))
So far a pretty good idea.
Now in makepairs you should have better abstraction, say let variables like-first and unlike-first. If the inlist is null, then the function should be the null list, else it's the pair with the car being the list of the car of like-first and the length of like-first and the cdr being the result of calling makepairs on the unlike-first list
(define (makepairs inlist)
(let ((like-first (filter (lambda (x) (equal? x (car inlist)) inlist))
(unlike-first (filter (lambda (x) (not (equal? x (car inlist))) inlist)))
(if (null? inlist)
'()
(cons (list (car inlist) (length like-first)) (makepairs unlike-first)))))
more effecient version
(define (makepairs inlist)
(if (null? inlist)
'()
(let loop ((firsts (list (car inlist)))
(but-firsts (cdr inlist)))
(if (or (null? but-firsts)
(not (equal? (car firsts) (car but-firsts))))
(cons (list (car firsts) (length firsts))
(makepairs but-firsts))
(loop (cons (car but-firsts) firsts) (cdr but-firsts))))))
]=> (makepairs (list 1 1 1 2 4 5))
;Value 17: ((1 3) (2 1) (4 1) (5 1))
If you have your own implementation of sort, say a mergesort you could write this right into the merge part for the best effeciency.
(define (set2bags lst)
(mergesort2bags lst <))
(define (mergesort2bags lst pred)
(let* ((halves (divide-evenly lst))
(first-half (car halves))
(other-half (cadr halves)))
(cond ((null? lst) '())
((null? (cdr lst)) (list (list (car lst) 1)))
(else
(merge-bags
(mergesort2bags first-half pred)
(mergesort2bags other-half pred)
pred)))))
(define (divide-evenly lst)
(let loop
((to-go lst)
(L1 '())
(l2 '()))
(if (null? to-go)
(list L1 L2)
(loop (cdr to-go) (cons (car to-go) L2) L1))))
(define (merge-bags L1 L2 pred)
(cond ((null? L1) L2)
((null? L2) L1)
((pred (caar L1) (caar L2))
(cons (car L1) (merge-bags (cdr L1) L2 pred)))
((equal? (caar L1) (caar L2))
(cons (list (caar L1) (+ (cadar L1) (cadar L2)))
(merge-bags (cdr L1) (cdr L2) pred)))
(else (cons (car L2) (merge-bags L1 (cdr L2) pred)))))
(mergesort2bags (list 1 2 1 1 4 5) <)
;Value 46: ((1 3) (2 1) (4 1) (5 1))
I'm thinking for very large datasets with a lot of repetition this method would pay off.