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)
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 trying to do a program in scheme for a school assignment. Given a list, it's supposed to return all given permutations of that list. My issue is that I don't know why it would work for numbers but not characters. Doesn't seem like it would change any of the logic!
Here is my code:
(define (remove1 x lst)
(cond
((null? lst) '())
((= x (car lst)) (remove1 x (cdr lst)))
(else (cons (car lst)
(remove1 x (cdr lst))))))
(define (permute lst)
(cond
((= (length lst) 1) (list lst))
(else (apply append (map (lambda (i)
(map (lambda (j) (cons i j))
(permute (remove1 i lst))))
lst)))))
(permute '(1 2 3))
= is used for comparing numbers; for more general comparisons, use eq?, equal? or (as has been suggested) eqv?.
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.
I'm new to Lisp and I have a problem when appending a list to an existing list.
(Funcion spec) The following function takes 2 args; an atom and a list. The list takes 2-dimensional form where each sub-list looks like (index counter) (both index and counter are atoms). If target is equal to one of the indexes, counter increments. If no sub-list contains target, add a new sub-list with counter = 1.
(defun contained (target list)
(cond ((null list) (list target 1))
((= (car (car list)) target)
(setf (cadr (car list))
(+ (cadr (car list)) 1)))
(t (push (contained target (cdr list)) list))))
The problem is when target doesn't exist yet. As shown below, lists and parentheses get redundant.
> la
((1 4) (2 1))
> (contained 3 la)
(((3 1) (2 1)) (1 4) (2 1))
What I want is something like:
((3 1) (1 4) (2 1))
Sorry not to have been able to simplify the problem, but thanks.
(defun contained (target list)
(cond
((null list) (list target 1)) ; you are returning a new element of target
((= (car (car list)) target)
(setf (cadr (car list))
(+ (cadr (car list)) 1))) ; you are returning... what?
;; yet you are pushing on every recursive call!
(t (push (contained target (cdr list)) list))))
At the risk of doing your homework for you, here's one way to do it (with help from Miron Brezuleanu):
(defun contained (target list)
(let ((elm (assoc target list)))
(if elm
(progn (incf (cadr elm)) list)
(cons (list target 1) list))))
Here's a way to do it closer to your original
(defun contained (target list)
(cond
((null list) (list (list target 1)))
((= (car (car list)) target)
(setf (cadr (car list))
(+ (cadr (car list)) 1))
list)
(t (setf (cdr list) (contained target (cdr list)))
list)))
This is my first experience with Scheme. I have a list with integers and I wanna get the sum of all even number in list.
; sum_even
(define (sum_even l)
(if (null? l) l
(cond ((even? (car l)) 0)
((not(even? (car l))) (car l)))
(+ (sum_even (car l) (sum_even(cdr l))))))
(sum_even '(2 3 4))
(define (sum_even l)
(cond ((null? l) 0)
((even? (car l)) (+ (car l) (sum_even (cdr l))))
(else (sum_even (cdr l)))))
Not tested
You're not exactly asking a question. Are you checking if your solution is correct or looking for an alternate solution?
You can also implement it as follows via
(apply + (filter even? lst))
edit: If, as you mentioned, you can't use filter, this solution will work and is tail-recursive:
(define (sum-even lst)
(let loop ((only-evens lst) (sum 0))
(cond
((null? only-evens) sum)
((even? (car only-evens))
(loop (cdr only-evens) (+ (car only-evens) sum)))
(else (loop (cdr only-evens) sum)))))
(define (sum-even xs)
(foldl (lambda (e acc)
(if (even? e)
(+ e acc)
acc))
0
xs))
Example:
> (sum-even (list 1 2 3 4 5 6 6))
18
Here is another one with higher order functions and no explicit recursion:
(use srfi-1)
(define (sum-even ls) (fold + 0 (filter even? ls)))
Consider using the built-in filter function. For example:
(filter even? l)
will return a list of even numbers in the list l. There are lots of ways to sum numbers in a list (example taken from http://groups.engin.umd.umich.edu/CIS/course.des/cis400/scheme/listsum.htm):
;
; List Sum
; By Jerry Smith
;
(define (list-sum lst)
(cond
((null? lst)
0)
((pair? (car lst))
(+(list-sum (car lst)) (list-sum (cdr lst))))
(else
(+ (car lst) (list-sum (cdr lst))))))