I'm trying to write a function to analyze game trees. The trees are represented by nested lists where each sub-list represents a branch. Basically, there are two things I want to figure out:
what is the minimax value of a nested list?
what is the index of that value?
I thought I had mostly solved the first problem, but my code keeps returning the wrong values--I've checked everything over and can't see what I've done wrong.
Any help would be much appreciated, thanks!
;MINIMAX*
(define minimax*
(lambda (l operation hilo)
(cond
((null? l) hilo)
((equal? operation 'max)
(cond
((null? (cdr l)) (if
(list? (car l))
(minimax* (car l) 'min hilo)
(if
(> (car l) hilo)
(car l)
hilo)))
(else (if
(list? (car l))
(if
(> (minimax* (car l) 'min hilo) hilo)
(minimax* (cdr l) 'max (minimax* (car l) 'min hilo))
(minimax* (cdr l) 'max hilo))
(if
(> (car l) hilo)
(minimax* (cdr l) 'max (car l))
(minimax* (cdr l) 'max hilo))))))
((equal? operation 'min)
(cond
((null? (cdr l)) (if
(list? (car l))
(minimax* (car l) 'max hilo)
(if
(< (car l) hilo)
(car l)
hilo)))
(else (if
(list? (car l))
(if
(< (minimax* (car l) 'max hilo) hilo)
(minimax* (cdr l) 'min (minimax* (car l) 'max hilo))
(minimax* (cdr l) 'min hilo))
(if
(< (car l) hilo)
(minimax* (cdr l) 'min (car l))
(minimax* (cdr l) 'min hilo))))))
(else (error "Invalid operation type, must be 'max or 'min")))))
You should change your approach a little bit. Instead of programming one fundamental procedure that makes the everything, you can implement some utility procedures.
For the minimax procedure it does not matter if the data comes in a tree or a list. So you can write yourself a procedure that converters your tree into a list like this one
(define (fringe t)
(cond ((null? t) t)
((pair? (car t)) (append (fringe (car t))
(fringe (cdr t))))
(else (cons (car t) (fringe (cdr t))))))
Checking for minimum or maximum is basically an iteration over a list or tree. So you could do that with fold. See http://www.gnu.org/software/mit-scheme/documentation/mit-scheme-ref/Reduction-of-Lists.html
So you can write your procedure like this:
(define (minimax op t)
(let ((flat-list (fringe t)))
(fold op (car t) (cdr t))))
For further reading Structure and Interpretation of Computer Programs. It is a great book for learning Scheme and programing in general.
Related
(define (oddrev ls)
(cond ((null? ls) ls)
((null? (cdr ls)) ls)
(else (cons (car ls) (oddrev (cdr (cdr ls)))))))
I have a scheme that returns odd array elements but I want to reverse the list at the end.
How would I do that??
The trivial solution is to add a layer of indirection:
(define (oddrev-helper ls)
(cond ((null? ls) ls)
((null? (cdr ls)) ls)
(else (cons (car ls) (oddrev-helper (cdr (cdr ls)))))))
(define (oddrev ls) (reverse (oddrev-helper ls)))
This looks wasteful, but is much more efficient than repeatedly appending a singleton list at the end.
But if you have encountered the way to transform a recursive process to an iterative by way of an accumulator and tail recursion, you will have noticed that list procedures have a habit of producing the result in reverse.
You can take advantage of this if you actually want the result in reverse.
(define (oddrev-helper ls acc)
(cond ((null? ls) acc)
((null? (cdr ls)) (cons (car ls) acc))
(else (oddrev-helper (cdr (cdr ls)) (cons (car ls) acc)))))
(define (oddrev ls) (oddrev-helper ls '()))
By tail recursion (and leaving out the usual reverseing at the end when returning.
(define (oddrev ls (acc '()))
(cond ((or (null? ls) (null? (cdr ls))) acc)
(else (oddrev (cdr (cdr ls)) (cons (car ls) acc)))))
Or by standard higher order functions:
(define (oddrev ls)
(reverse (filter odd? ls)))
Try out:
(oddrev '(1 2 3 4 5 6))
;; '(5 3 1)
change the line
(cond ((or (null? ls) (null? (cdr ls))) acc)
to:
(cond ((or (null? ls) (null? (cdr ls))) (reverse acc))
to let it return in the input order: '(1 3 5)
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 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))))
)
)
I'd like to create a Scheme function that yields true if it is passed a list that is composed entirely of identical elements. Such a list would be '(1 1 1 1). It would yield false with something like '(1 2 1 1).
This is what I have so far:
(define (list-equal? lst)
(define tmp (car lst))
(for-each (lambda (x)
(equal? x tmp))
lst)
)
Clearly this is incorrect, and I'm new to this. I guess I'm unable to express the step where I'm supposed to return #t or #f.
Thanks in advance!
EDIT:
I fiddled a bit and found a solution that seems to work very well, and with a minimal amount of code:
(define (list-equal? lst)
(andmap (lambda (x)
(equal? x (car lst)))
lst))
Thanks again for the help everyone.
Minimal amount of code, if you don't care that it only works for numbers:
(define (list-equel? lst)
(apply = lst))
Examples:
> (list-equel? '(1 1 2 1))
#f
> (list-equel? '(1 1 1 1))
#t
> (list-equel? '(1))
#t
The andmap solution is nice, but if andmap is not available, you can use this. It uses basic operations (and, or, null check, equality check) and handles empty lists and one element lists. Similar to Sean's implementation, but no helper definition is necessary.
(define (list-equal? args)
(or (or (null? args)
(null? (cdr args)))
(and (eq? (car args) (cadr args))
(list-equal? (cdr args)))))
Try something like this:
(define (list-equal? lst)
(define (helper el lst)
(or (null? lst)
(and (eq? el (car lst))
(helper (car lst) (cdr lst)))))
(or (null? lst)
(helper (car lst) (cdr lst))))
This might not be the cleanest implementation, but I think it will correctly handle the cases of empty lists and one-element lists.
In R6RS there's the for-all function, which takes a predicate and a list, and returns #t if the predicate returns true for all elements in the list and #f otherwise, which is exactly what you need here.
So if you're using R6RS (or any other scheme dialect that has the for-all function), you can just replace for-each with for-all in your code and it will work.
(define (list-equal? lst)
(if (= (cdr lst) null)
true
(and (equal? (car lst) (cadr lst))
(list-equal? (cdr lst)))))
Something like this should work:
(define (list-equal? lst)
(cond ((< (length lst) 2) #t)
(#t (and (equal? (car lst) (cadr lst))
(list-equal? (cdr lst))))))
The other answers in this thread all seem too complicated (I read through them all), so here's my take on it:
(define (all-equal? lst)
(define item (car lst))
(let next ((lst (cdr lst)))
(cond ((null? lst) #t)
((equal? item (car lst)) (next (cdr lst)))
(else #f))))
(It does not work with an empty list, by design. It's easy to add a (if (null? lst) #t ...) if necessary.)
A short, concise solution:
#lang racket
(define (all-equal? lst)
(for/and
([i (in-permutations lst)])
(equal? (first i) (second i))))
; TEST CASES
(require rackunit)
(check-false (all-equal? '(1 2 3)))
(check-true (all-equal? '(1 1 1)))
(check-true (all-equal? '()))
Note that this uses racket, so this may not work with your scheme implementation.
Yet another solution:
(define (all-same ls)
(cond
((or (null? ls)
(null? (cdr ls))) #t)
(else (and (equal? (car ls) (next ls))
(all-same (cdr ls)))))))
(define (next ls)
(cond
((or (null? ls)
(null? (cdr ls))) '())
(else (cadr ls)))))
For is bad in these languages. Try
(define list-equal?
(lambda (lst)
(if (= lst null)
(true)
(foldr = (car lst) (cdr lst))
)))
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))))))