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))))))))
Related
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 '()))
(define (associate lst)
(if (or (null? lst) (= (length lst) 1))
'()
(cons (cons (car lst) (cadr lst)) (associate (cddr lst)))))
(define (disassociate lst)
;(display (caar lst))
(if (null? lst)
'()
(cons (cons (caar lst) (cdar lst)) (disassociate (cdr lst)))))
(display (disassociate '((a . 1) (b . 2) (c . 3))))
(newline)
(display (associate '(a 1 b 2 c)))
(newline)
OUTPUT:
;; with list
((a 1) ((b 2) ((c 3) ())))
((a . 1) (b . 2))
;; with cons
((a . 1) (b . 2) (c . 3))
((a . 1) (b . 2))
I'm trying to flatten an association list in Scheme but the brackets
keep turning up even when I change the list to cons. Am I doing something wrong?
There's an error in the way you're creating the list in disassociate. Try this:
(define (disassociate lst)
(if (null? lst)
'()
(cons (caar lst)
(cons (cdar lst)
(disassociate (cdr lst))))))
Or alternatively, using list*:
(define (disassociate lst)
(if (null? lst)
'()
(list* (caar lst)
(cdar lst)
(disassociate (cdr lst)))))
The above assumes that the association list is using cons to stick together the values, notice how the output list is created by consing the first element, then the second and then calling the recursion. On the other hand, if the association list was created using list to stick together the values, then this is the way to disassociate it:
(define (disassociate lst)
(if (null? lst)
'()
(cons (caar lst)
(cons (cadar lst) ; here's the change
(disassociate (cdr lst))))))
Or alternatively:
(define (disassociate lst)
(if (null? lst)
'()
(list* (caar lst)
(cadar lst) ; here's the change
(disassociate (cdr lst)))))
A more idiomatic solution would be to use higher-order procedures to process the input list. Here's how, using foldr for the two association list variants described in the question:
; associations created with cons
(define (disassociate lst)
(foldr (lambda (pr ac) (list* (car pr) (cdr pr) ac))
'()
lst))
; associations created with list
(define (disassociate lst)
(foldr (lambda (pr ac) (list* (car pr) (cadr pr) ac))
'()
lst))
Your disassociate line needs to read:
(cons (caar lst) (cons (cdar lst) (disassociate (cdr lst)))))
quasi-quotation! Sometimes these are more clearly implemented using quasi-quotation because quasi-quotation lets you see the resulting list structure.
(define (associate lst)
(if (or (null? lst) (null? (cdr lst)))
'()
`(,(cons (car lst) (cadr lst)) ,#(associate (cddr lst)))))
(define (disassociate lst)
(if (null? lst)
'()
`(,(caar lst) ,(cdar lst) ,#(disassociate (cdr lst)))))
> (associate (disassociate '((a . 1) (b . 2))))
((a . 1) (b . 2))
Note that you could also write the associate quasi-quotation as:
`((,(car lst) . ,(cadr lst)) ,#(associate (cddr list)))))
but that starts getting harder to read for me even though it makes the association pair explicit.
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 wrote this code to create a list from en number of arguments given
(define (create-list . e)
e)
But I need it to remove any duplicated numbers from the list within this block itself.
I have tried and searched for hours and can't find a solution without placing dozens of lines of code on other blocks.
For example let's say my input is
(create-list . 2 2 3 5 5 )
I need the list created to be '(2 3 5) and not '(2 2 3 5 5 )...
The order of the numbers doesn't matter.
Basically, you need to do something like:
(define (create-list . e) (dedupe e))
I can think of a really simple but probably inefficient way to do this:
(define (dedupe e)
(if (null? e) '()
(cons (car e) (dedupe (filter (lambda (x) (not (equal? x (car e))))
(cdr e))))))
If you can't use existing functions like filter, you can make one yourself:
(define (my-filter pred ls)
(cond ((null? ls) '())
((pred (car ls)) (cons (car ls) (my-filter pred (cdr ls))))
(else (my-filter pred (cdr ls)))))
This one is faster:
(define (remove-duplicates l)
(cond ((null? l)
'())
((member (car l) (cdr l))
(remove-duplicates (cdr l)))
(else
(cons (car l) (remove-duplicates (cdr l))))))
But even better,
mit-scheme provides delete-duplicates, which does exactly what you want.
The most efficient (traversing the list once) way to do this is to define a function which goes through the list element-by-element. The function stores a list of which elements are already in the de-duped list.
An advantage of this solution over #Tikhon Jelvis's, is that the list elements don't need to be in order, to be deduplicated.
Given a function elem, which says if a is an element of l:
(define (elem? a l)
(cond ((null? l) #f)
((equal? a (car l)) #t)
(else (elem? a (cdr l)))))
We can traverse the list, storing each element we haven't seen before:
(define (de_dupe l_remaining already_contains)
(cond ((null? l_remaining) already_contains)
((elem? (car l_remaining) already_contains) (de_dupe (cdr l_remaining) already_contains))
(else (de_dupe (cdr l_remaining) (cons (car l_remaining) already_contains)))))
Note: for efficiency, this returns the elements in reverse order
(define (delete x)
(cond
((null? x) x)
((= (length x) 1) x) | ((null? (cdr x)) x)
((= (car x) (cadr x)) (delete (cdr x)))
(#t (cons (car x) (delete (cdr x))))
)
)
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)