This function reads in a list and swaps values, but only when there's a key in the hash table that matches an element in the list. However, the list that is read in could contain other lists, and I want to check this recursively. I use if (list? elementInList) to determine whether I'm dealing with a list, so I can search that list for elements that may need to be swapped using a recursive call. I tried to do this but it's not handling the lists within the list correctly. What am I doing wrong?
(define (let-helper L)
(map (lambda (x) (swap x (hash-ref *variable-table* x) L))
(filter (lambda (x)
(if (list? x)
(let-helper x) ;; recursion here
(hash-has-key? *variable-table* x)))
L)))
I'd suggest just flattening the list so that you can continue to use map and filter like this:
(define (let-helper L)
(map (lambda (x) (swap x (hash-ref *variable-table* x) L))
(filter (lambda (x) (hash-has-key? *variable-table* x))
(flatten L))))
Otherwise to get it to work would require writing it without map and filter like this:
(define (let-helper L)
(let ((action (lambda (x) (swap x (hash-ref *variable-table* x) L)))
(predicate (lambda (x) (hash-has-key? *variable-table* x))))
(let loop ((a '()) (L L))
(if (null? L)
(reverse a)
(if (list? (car L))
(loop (cons (let-helper (car L)) a) (cdr L))
(if (predicate (car L))
(loop (cons (action (car L)) a) (cdr L))
(loop a (cdr L))))))
Untested.
So the swap should only occur if the hash has the key but the returned list should still have the elements that weren't swapped? If so then not removing the element from the list of it isn't a key would fix that like this:
(define (let-helper L)
(map (lambda (x)
(if (list? x)
(let-helper x)
(if (hash-has-key? *variable-table* x)
(swap x (hash-ref *variable-table* x) L)
x))))
L)
Or
(define (let-helper L)
(let ((action (lambda (x) (swap x (hash-ref *variable-table* x) L)))
(predicate (lambda (x) (hash-has-key? *variable-table* x))))
(let loop ((a '()) (L L))
(if (null? L)
(reverse a)
(if (list? (car L))
(loop (cons (let-helper (car L)) a) (cdr L))
(if (predicate (car L))
(loop (cons (action (car L)) a) (cdr L))
(loop (cons (car L) a) (cdr L))))))
Related
Resolution takes a list and removes negated elements from that list. The negated form is represented by a list with not in its head. For example if I have '(a (not b) c (not f) (not a) b e) my output should be '(c (not f) e). I have written functions remove-x, which removes an element from the list and match? which takes a value and returns the matching value in the list. If my value is 'a it would return '(not a) from the list.
So my problem is in the resolution function. I want to find if there are any negated elements and if there are, I want to delete both the element and its negation. I also need a way to figure out how to return false if no changes were made to my list:
(define (resolution? alist)
(cond ((null? alist) '())
((not (equal? #f (match? (car alist) (cdr alist))))
(and (remove-x (match? (car alist) (cdr alist)) alist)
(remove-x (car alist) alist)))
(else (cons (car alist) (resolution? cdr alist)))))
These two functions below work:
(define (match? value alist)
(cond ((null? alist) #f)
((and (list? (car alist))
(equal? value (car (cdr (car alist)))))
(car alist))
((equal? value (car alist)) (car alist))
(else (match? value (cdr alist)))))
(define (remove-x x alist)
(cond ((null? alist) '())
((equal? x (car alist)) (cdr alist))
(else (cons (car alist) (remove-x x (cdr alist))))))
I think your solution needs a bit more of work, I'd suggest writing more helper procedures. At the core, the problem to solve is how to find the set difference between two lists. Here's my shot:
; obtain the non-negated variables in the list
(define (vars alist)
(filter (lambda (e) (not (pair? e))) alist))
; obtain the negated variables in the list
(define (negated-vars alist)
(map cadr (filter pair? alist)))
; find the set difference between two lists
(define (difference lst1 lst2)
(cond ((null? lst1) '())
((member (car lst1) lst2)
(difference (cdr lst1) lst2))
(else
(cons (car lst1) (difference (cdr lst1) lst2)))))
; build the resolution, traverse alist and for each member
; check if it's in the corresponding white list of variables
(define (build-resolution alist clean-vars clean-negs)
(cond ((null? alist) alist)
((if (pair? (car alist))
(member (cadar alist) clean-negs)
(member (car alist) clean-vars))
(cons (car alist) (build-resolution (cdr alist) clean-vars clean-negs)))
(else
(build-resolution (cdr alist) clean-vars clean-negs))))
; pre-calculate lists, call the procedure that does the heavy lifting
(define (resolution? alist)
(let* ((vs (vars alist))
(nv (negated-vars alist))
(clean-vars (difference vs nv))
(clean-negs (difference nv vs))
(resp (build-resolution alist clean-vars clean-negs)))
(if (equal? alist resp) #f resp)))
It works as advertised:
(resolution? '(a (not b) c (not f) (not a) b e))
=> '(c (not f) e)
(resolution? '(a (not b) c (not d) (not e) f g))
=> #f
An alternative solution, which could be simplified by the use of fold.
(define resolution?
(lambda (lst)
(let loop ((todo lst)
(result '()))
(if (null? todo)
(alist->list result)
(let ((item (car todo)))
(loop (cdr todo)
(modify-alist result item)))))))
(define modify-alist
(lambda (alist item)
(let ((key (if (symbol? item) item (cadr item)))
(value (if (symbol? item) 'affirmed 'negated)))
(let loop ((todo alist)
(result '()))
(if (null? todo)
(cons (cons key value) result)
(let ((item (car todo)))
(if (eq? key (car item))
(let* ((old-value (cdr item))
(new-value (cond ((eq? value old-value) value)
((eq? 'cancelled old-value) old-value)
(else 'cancelled))))
(cons (cons key new-value)
(append result (cdr todo))))
(loop (cdr todo)
(cons item result)))))))))
(define alist->list
(lambda (lst)
(let loop ((todo lst)
(result '()))
(if (null? todo)
result
(let* ((item (car todo))
(value (cdr item)))
(loop (cdr todo)
(case (cdr item)
((affirmed) (cons (car item) result))
((negated) (cons (list 'not (car item)) result))
(else result))))))))
I have a deeply nested list and I want to delete a given element from all its occurrences in the list. I have this code:
(defn eliminate [value lst]
(defn sub-eliminate [lst]
(def currentItem (first lst))
(if-not (empty? lst)
(if (seq? currentItem)
(cons (sub-eliminate currentItem) (sub-eliminate (rest lst)))
(if (= value currentItem)
(sub-eliminate (rest lst))
(cons currentItem (sub-eliminate (rest lst)))
)
)
'()
)
)
(sub-eliminate lst)
)
But, it doesn't delete at inner levels. Why??
My guess is that you're using vectors as sequences.
(eliminate 3 [3 3])
;()
(eliminate 3 [3 [3]])
;([3])
This would have been trivial to find had you shown us an example: tut, tut!
What's going on?
Although vectors are seqable, they are not sequences:
(seq? [])
;false
At the outer level, you treat lst as a sequence, so first and rest work, since they wrap their argument in an implicit seq. But seq? will fail on any immediately enclosed vector, and those further in won't even be seen.
If you replace seq? with sequential?, lists and vectors will work.
(sequential? [])
;true
More serious, as #noisesmith noted, is your use of def and defn at inner scope. Replace them with let or letfn.
You could also improve your style:
Replace (if-not (empty? lst) ... ) with (if (seq lst) ...).
Use cond to flatten your nested ifs. This requires inverting
the test in (1), so removes the need for it.
Use recur for the tail-recursive case where you find value, as
#Mark does.
If you don't want to see the result, look away now:
(defn eliminate [value lst]
(letfn [(sub-eliminate [lst]
(let [current-item (first lst)]
(cond
(empty? lst) '()
(sequential? current-item) (cons (sub-eliminate current-item)
(sub-eliminate (rest lst)))
(= value current-item) (recur (rest lst))
:else (cons current-item (sub-eliminate (rest lst))))))]
(sub-eliminate lst)))
There is a remaining tender spot:
You invoke (first lst) before you know that lst is not empty. No
harm done: you'll just get nil, which you ignore.
An Alternative Apporach using Destructuring
You can often use destructuring to abbreviate recursive processing of sequences. I'd be inclined to express your function thus:
(defn eliminate [x xs]
((fn rem-x [xs]
(if-let [[y & ys] (seq xs)]
(if (= x y)
(recur ys)
(cons
(if (sequential? y) (rem-x y) y)
(rem-x ys)))
()))
xs))
For the sake of learning take a look at this function:
(define rember*
(lambda (x l)
(cond ((null? l) '())
((atom? (car l))
(if (eq? (car l) x)
(rember* x (cdr l))
(cons (car l)
(rember* x (cdr l)))))
(else (cons (rember* x (car l))
(rember* x (cdr l)))))))
This is a simple recursive function from book 'The Little Schemer', which is a good source to learn how to write such recursive functions.
Let's see if we can translate it into Clojure:
(defn rember* [x l]
(cond (empty? l) '()
(seq? (first l)) (cons (rember* x (first l))
(rember* x (rest l)))
:else (if (= (first l) x)
(recur x (rest l))
(cons (first l)
(rember* x (rest l))))))
user> (rember* 'x '((x y) x (z (((((x))))))))
;; => ((y) (z ((((()))))))
(defn expel [victim xs]
(mapcat (fn [x]
(cond
(sequential? x) [(expel victim x)]
(= x victim) []
:else [x]))
xs))
This program takes a list where elements are repeated, e.g L = (a a a b b b c c c d), and output a list of items and number of repetition e.g ((a 3)(b 3)(c 3) d)
(define counter 0)
(define (compress liste)
(if (or (null? liste) (null? (cdr liste)))
liste
(let ((compressed-cdr (compress (cdr liste))))
(if (equal? (car liste) (car compressed-cdr))
((+ counter 1) compressed-cdr)
((cons (car liste) counter) (= counter 0) (compressed-cdr))))
))
However, I get this error:
Error: application: not a procedure; expected a procedure that can be applied to arguments
given: 1 arguments ...
The error is at the true predicate of the second if condition.
Building the result list in a top-down manner, with the "head-sentinel trick", for simplicity:
(define (rle lst)
(if (null? lst)
'()
(let ((res (list 1))) ; head sentinel
(let loop ((p res) ; result's last cons cell
(elt (car lst))
(cnt 1)
(lst (cdr lst)))
(if (and (not (null? lst))
(equal? elt (car lst)))
(loop p elt (+ cnt 1) (cdr lst))
(begin
(set-cdr! p (list (if (= 1 cnt) elt (list elt cnt))))
(if (null? lst)
(cdr res) ; skip the head in result, on return
(loop (cdr p) (car lst) 1 (cdr lst)))))))))
As #uselpa explained, this is called run-length encoding; for the uniformity of the result I'd suggest using (x 1) representation for non-repeating elements.
And the error "Error: application: not a procedure; expected a procedure", as others have said, means that the system expected to find a procedure but found something else, so can't apply it. Scheme expects to find a procedure as the first form in a list: (proc args ...), and tries to apply it to the arguments. But in your code it is not a procedure, but some other type of data.
If your Scheme has left fold, or reduce, you can run through it twice - first collecting the uniform results, and then applying your special format while reversing (left fold's results are usually built in reversed order):
(define (fold f init lst) ; if fold is not defined,
(reduce f init (cons init lst))) ; define it in terms of reduce
(define (rle lst)
(fold (lambda (x acc) ; NB! MIT-Scheme: (acc x)
(if (= 1 (cadr x)) (cons (car x) acc) (cons x acc)))
'()
(fold (lambda (x acc) ; NB! MIT-Scheme: (acc x)
(if (or (null? acc) (not (equal? (caar acc) x)))
(cons (list x 1) acc)
(cons (list x (+ (cadar acc) 1)) (cdr acc))))
'()
lst)))
As the error message says, the problem is located "at the true predicate of the second if condition":
((+ counter 1) compressed-cdr)
In this case, (+ counter 1) should evaluate to a procedure but it evaluates to a number. I think the problem is that you don't know how to increment the counter.
Your false predicate has the same problem:
((cons (car liste) counter) (= counter 0) (compressed-cdr))))))
where (cons (car liste) counter) yields a list and not a procedure.
I don't think we could really work with this code. I suggest looking at R Sahu's answer, which is close. Alternatively, I can show you a tail-recursive version which you could also have a look at. BTW, this is called run-length encoding, hence I've called my procedure rle:
(define (rle lst)
(define (newres prv cnt res)
(case cnt
((0) res)
((1) (cons prv res))
(else (cons (list prv cnt) res))))
(let loop ((lst lst) (prv null) (cnt 0) (res null))
(if (null? lst)
(if (zero? cnt)
(reverse res)
(loop null null 0 (newres prv cnt res)))
(let ((c (car lst)))
(if (eq? c prv)
(loop (cdr lst) prv (add1 cnt) res)
(loop (cdr lst) c 1 (newres prv cnt res)))))))
It was hard for me to figure out where the problem is in your code. I tried the following that seems to work.
(define (compress liste)
(define (helper in prev out)
(if (null? in)
(list (list (car out) (length out)))
(if (equal? prev (car in))
(helper (cdr in) prev (append out (list (car in))))
(cons (list (car out) (length out)) (compress in)))))
(if (null? liste)
'()
(helper (cdr liste) (car liste) (list (car liste))))
)
It uses helper to gather the output for matching items. When it finds a mismatch, it calls the main function to process the rest of the list. helper simply prepends its results to the results obtained from the main function.
A slightly improved version:
(define (compress liste)
(define (helper in prev out)
(if (null? in)
(list (list prev out))
(if (equal? prev (car in))
(helper (cdr in) prev (+ 1 out))
(cons (list prev out) (compress in)))))
(if (null? liste)
'()
(helper (cdr liste) (car liste) 1))
)
Here's tail-recursive version:
(define (compress liste)
(define (helper-1 in out)
(if (null? in)
'()
(helper-2 (cdr in) (car in) 1 out)))
(define (helper-2 in prev count out)
(if (null? in)
(append out (list (list prev count)))
(if (equal? prev (car in))
(helper-2 (cdr in) prev (+ 1 count) out)
(helper-1 in (append out (list (list prev count)))))))
(helper-1 liste '()))
My implementation of flatten looks like this:
(define flatten
(lambda (lst)
(if (null? lst)
lst
(append
(rtn-lst (car lst))
(flatten (cdr lst))))))
(define rtn-lst
(lambda (lst)
(cond
((null? lst)
empty)
((atom? lst)
(list lst))
(else
(flatten lst)))))
While standard implementation is:
(define (flatten lst)
(cond
((null? list)
empty)
((list? (car lst))
(append (flatten (car lst)) (flatten (cdr lst))))
(else
(cons (car lst) (flatten (cdr lst))))))
Apart from the obvious verboseness, what else is wrong with my code?
I'd try this:
(define rtn-lst
(lambda (lst)
(cond
((list? lst)
(if (null? lst)
empty
(flatten-list lst)))
((atom? lst)
(list lst))
(else
(flatten-list lst)))))
Probably we have different implementations of Scheme.
EDIT:
With modified else branch:
(define rtn-lst
(lambda (lst)
(cond
((list? lst)
(if (null? lst)
empty
(flatten-list lst)))
(else
(list lst)))))
I would consider atom? to be wrong. You want to know if the lst is a list, so use list?. atom? can return false on vector or string for some implementations. But i do not know for sure. The rest is quit good.
How about something like this:
(define foo
(lambda (e)
(cond ((pair? e) `(,#(foo (car e)) ,#(foo (cdr e))))
((null? e) '())
(else (list e)))))
Where for example:
> (foo '(((2 3) (4 . 5) 8)))
(2 3 4 5 8)
Does this do what you want?
How about something like this:
(define (flatten x y)
(if (null? x)
y
(if (list? (car x))
(flatten (append (car x) (cdr x)) y)
(flatten (cdr x) (append y (list (car x)))))))
(define (flat x)
(flatten x '()))
> (flat '(1(2(3(4(5)6)7)8)9))
(1 2 3 4 5 6 7 8 9)
and closure version:
(define (flatten x)
(define (flatten x y)
(if (null? x)
y
(if (list? (car x))
(flatten (append (car x) (cdr x)) y)
(flatten (cdr x) (append y (list (car x)))))))
(flatten x '()))
> (flatten '(1(2(3(4(5)6)7)8)9))
(1 2 3 4 5 6 7 8 9)
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))))))