chess: bishop move with CLIPS - chess

I'm trying to implement the possible moves of a bishop on a chess table, which can have other pieces on random cells. I've been able to make a sketch of an answer, but it doesn't detect other pieces.
Previously to this rule I've written some code that creates a fact like the following for each cell of the table, indicating its contents:
(cell-info (coor {i} {j}) (contents {empty|black|white}))
and a fact that shows the position of a piece:
(piece (row {r}) (column {c}) (type {t}) (color {col}))
And here's my rule so far (probably it's also not too efficient):
(defrule bishop-moves
(declare (salience 30))
(piece (row ?rb) (column ?cb) (type bishop) (color black))
(cell-info (coor ?i ?j) (contents empty|white))
=>
(loop-for-count (?n 1 8)
(if (or (and (= ?i (+ ?rb ?n)) (= ?j (+ ?cb ?n)))
(and (= ?i (- ?rb ?n)) (= ?j (- ?cb ?n)))
(and (= ?i (+ ?rb ?n)) (= ?j (- ?cb ?n)))
(and (= ?i (- ?rb ?n)) (= ?j (+ ?cb ?n))))
then (assert (movement-allowed
(destination-cell ?i ?j)
(type bishop)
(start-cell ?rb ?cb))))))
Does anybody now what could I do? Thanks in advance.

;;; Added deftemplates and deffacts
;;; Replaced rule variable ?i with ?r and ?j with ?c.
;;; Made rule applicable for both black or white bishop
;;; Moved diagonal logic from actions of rule to conditions
;;; Added logic to rule for intervening pieces
(deftemplate piece (slot row) (slot column) (slot type) (slot color))
(deftemplate cell-info (multislot coor) (slot contents))
(deftemplate movement-allowed (multislot destination-cell) (slot type) (multislot start-cell))
(deffacts test-data
(piece (row 1) (column 1) (type pawn) (color black))
(cell-info (coor 1 1) (contents black)) ; Invalid - friendly piece
(cell-info (coor 1 2) (contents empty)) ; Invalid - not on diagonal
(cell-info (coor 1 3) (contents empty)) ; Valid
(piece (row 2) (column 2) (type bishop) (color black))
(cell-info (coor 2 2) (contents black)) ; Invalid - friendly piece
(cell-info (coor 2 8) (contents empty)) ; Invalid - not on diagonal
(cell-info (coor 3 1) (contents empty)) ; Valid
(cell-info (coor 3 3) (contents empty)) ; Valid
(cell-info (coor 4 4) (contents empty)) ; Valid
(cell-info (coor 5 5) (contents empty)) ; Valid
(piece (row 6) (column 6) (type pawn) (color white))
(cell-info (coor 6 6) (contents white)) ; Valid
(cell-info (coor 7 7) (contents empty)) ; Invalid - blocked by pawn
(piece (row 8) (column 8) (type pawn) (color white))
(cell-info (coor 8 8) (contents white))) ; Invalid - blocked by pawn
(defrule bishop-moves
(declare (salience 30))
(piece (row ?rb) (column ?cb) (type bishop) (color ?color))
;; The destination cell must be empty or contain
;; an opposing piece
(cell-info (coor ?r ?c) (contents empty | ~?color))
;; If the cell and piece are on the same diagonal, the
;; absolute difference between the two should be the same
(test (= (abs (- ?r ?rb)) (abs (- ?c ?cb))))
;; Check that there is not another piece that is within
;; the rectangle formed by the bishop and the destination
;; cell and is also on the same diagonal as the bishop
(not (and (piece (row ?ro) (column ?co))
(test (and (or (< ?rb ?ro ?r) (< ?r ?ro ?rb))
(or (< ?cb ?co ?c) (< ?c ?co ?cb))))
(test (= (abs (- ?ro ?rb)) (abs (- ?co ?cb))))))
=>
(assert (movement-allowed
(destination-cell ?r ?c)
(type bishop)
(start-cell ?rb ?cb))))

Related

Iterating through a nested list using filter or fold Racket

I need to iterate through a list with sublists in Racket using list iteration and filtering, one of the lists is a nested list, I tried using "list?" and "car" to iterate inside but of course that would only apply to the first value of the sublist.
Is there a way to iterate through the whole nested list using list iteration and filtering?
(define (count-evens lst)
(length
(filter
(lambda (x)
(cond
[(and (list? x)
(and (number? (car x))
(eq? (modulo (car x) 2) 0)))
#t]
[(and (number? x)
(eq? (modulo x 2) 0))
#t]
[else
#f]))
lst)))
(count-evens '(1 2 5 4 (8 4 (b (10 3 3))) 3))
=> 3
Should return => 5
I would use a recursive function to do this but the assignment doesn't allow it.
"...assignment doesn't allow [recursive functions]"
Not sure what is allowed for this assignment, but
in ye olden days we processed recursive data structures with stacks...
(define (count-evens lst)
(define (lst-at stack) ;; (car stack) = index in deepest sub-list
;; produce list cursor within lst indexed by stack
(do ([stack (reverse stack) (cdr stack)]
[cursor (list lst) (list-tail (car cursor) (car stack))])
((null? stack) cursor)))
(do ([stack (list 0)
(cond
[(null? (lst-at stack))
(cdr stack)] ;; pop stack
[(pair? (car (lst-at stack)))
(cons 0 stack)] ;; push stack
[else ;; step through current (sub)list
(cons (+ 1 (car stack)) (cdr stack))])]
[count 0
(let ([item (car (lst-at stack))])
(if (and (number? item) (even? item)) (+ 1 count) count))])
((null? (lst-at stack)) count)))
> (count-evens '(1 2 5 4 (8 4 (b (10 3 3))) 3)) ;=>
5

filtering factor programming

I want to make function, which is filtering odd- index.
(filter-idx '(0 1 2 3 4)) => '(1 3)
(filter-idx '(#\a #\b #\c (0 1))) => '(#\b (0 1))
So, I made like this, but it doesn't work..
(define (filter-idx xs)
(memf (lambda (x)
(= (remainder x 2) 1))
xs))
You need to handle the indexes and the elements separately. This is one way to do it:
(define (filter-idx xs)
(for/list ([i (range (length xs))] ; iterate over indexes of elements
[x xs] ; iterate over elements of list
#:when (odd? i)) ; filter elements in odd indexes
x)) ; create a list with only the elements that meet the condition
For example:
(filter-idx '(0 1 2 3 4))
=> '(1 3)
(filter-idx '(#\a #\b #\c (0 1)))
=> '(#\b (0 1))

Custom Scheme indexing function returns list-external value

I'm a newbie to scheme programming and I was writing small codes when I encountered the following issue and couldn't reason about it satisfactorily.
(define (at_i lst i)
(if (eq? i 0)
(car lst)
(at_i (cdr lst)
(- i 1) )))
Evaluation of (at_i '(1 2 3 4) 0) returns 1.
Now lets define same procedure with a lambda syntax.
(define (at_i lst i)
(lambda (vec x)
(if (eq? x 0)
(car vec)
(at_i (cdr vec)
(- x 1) )))
lst i)
But now Evaluation of (at_i '(1 2 3 4) 0) returns 0, which is not in the list and in general, it returns element at index-1.
I don't understand why this is happening.
Note: I just realized its not returning element at index - 1 but the index itself. The reason for this has been well explained below by #Renzo. Thanks!
First, you should indent properly the code if you intend to learn the language, since code indentation is very important to understand programs in Scheme and Lisp-like languages.
For instance, your function correctly indented is:
(define (at_i lst i)
(lambda (vec x)
(if (eq? x 0)
(car vec)
(at_i (cdr vec) (- x 1))))
lst
i)
From this you can see that you are defining the function at_i exactly as before in terms of a function with two parameters (lst and i), and whose body is constitued by three expressions: the first lambda (vec x) ... (- x 1)))), which is an (anonymous) function (lambda) which is not called or applied, the second, which is the first parameter lst, and finally the third which is the second parameter i. So, when the function at_i is called with two arguments, the result is the evaluation of the three expressions in sequence, the first two values are discarded (the function and the value of lst), and the result is the value of the second parameter i. This is reason for which the result of (at_i '(1 2 3 4) 0) is 0, since it is the value of i.
A proper redefinition of the function in lambda form would be the following, for instance:
(define at_i
(lambda (vec x)
(if (eq? x 0)
(car vec)
(at_i (cdr vec) (- x 1)))))
(at_i '(1 2 3 4) 0) ;; => 1
in which you can see that the name at_i, through the define, is associated to a two parameter function which calculates correctly the result.
eq? is memory object equality. Only some Scheme implementations interpret (eq? 5 5) as #t. Use = for numbers, eqv? for values, and equal? for collections.
(define (index i xs) ; `index` is a partial function,
(if (= i 0) ; `i` may go out of range
(car xs)
(index (- i 1) ; Tail recursion
(cdr xs) )))
Your second function returns the index because you missed parenthesis around the lambda's application. It should be
(define (index i xs)
((lambda (i' xs')
(if (= i' 0)
(car xs')
(index (- i' 1) ; Not tail-recursive
(cdr xs') )))
i xs))
But this is verbose and differs semantically from the first formulation.
You say you are defining the "same procedure with a lambda syntax", but you are not. That would be (define at_i (lambda lst i) ...). Instead, you are effectively saying (define (at_i lst i) 1 2 3), and that is 3, of course.
In your particular case, you defined the procedure at_i to return (lambda (vec x) ...), lst and i. Now, if you call (at_i '(1 2 3 4) 0), the procedure will return 0, since that is the value of i at this point.

Racket: Map with keys/iterating?

I've got some function func and want to apply it on a list lst, so I used map but I need to have the first and last element of the list evaluated with some other function func2.
So basically I want this:
(map (lambda (x)
(cond [(isBeginningOfList? lst) (func2 x)]
[(isEndOfList? lst) (func2 x)]
[else (func x)]))
lst)
Obviously this doesn't work.
How can I achieve this functionality?
Can I somehow get a key of each list entry? Like lambda(key,val) and then compare (equal? key 0) / (equal? key (length lst))?
There's for/list with in-indexed and that does what you describe:
(define (f lst f1 f2)
(define last (sub1 (length lst)))
(for/list (((e i) (in-indexed lst)))
(if (< 0 i last)
(f1 e)
(f2 e))))
then
> (f '(1 2 3 4 5) sub1 add1)
'(2 1 2 3 6)
You can use a map on all the elements except the first and the last one and treat those two separately. In this way you avoid those comparisons which you would do for every element.
(define special-map
(λ (lst f1 f2)
(append (list (f1 (car lst)))
(map f2 (drop-right (cdr lst) 1))
(list (f1 (last lst))))))
Example
Let's try to increment the first and the last elements and decrement all the others.
> (special-map '(1 2 3 4 5) add1 sub1)
'(2 1 2 3 6)
Later edit
I changed (take (cdr lst) (- (length lst) 2)) with (drop-right (cdr lst) 1).

Scheme Help - File Statistics

So I have to finish a project in Scheme and I'm pretty stuck. Basically, what the program does is open a file and output the statistics. Right now I am able to count the number of characters, but I also need to count the number of lines and words. I'm just trying to tackle this situation for now but eventually I also have to take in two files - the first being a text file, like a book. The second will be a list of words, I have to count how many times those words appear in the first file. Obviously I'll have to work with lists but I would love some help on where to being. Here is the code that I have so far (and works)
(define filestats
(lambda (srcf wordcount linecount charcount )
(if (eof-object? (peek-char srcf ) )
(begin
(close-port srcf)
(display linecount)
(display " ")
(display wordcount)
(display " ")
(display charcount)
(newline) ()
)
(begin
(read-char srcf)
(filestats srcf 0 0 (+ charcount 1))
)
)
)
)
(define filestatistics
(lambda (src)
(let ((file (open-input-file src)))
(filestats file 0 0 0)
)
)
)
How about 'tokenizing' the file into a list of lines, where a line is a list of words, and a word is a list of characters.
(define (tokenize file)
(with-input-from-file file
(lambda ()
(let reading ((lines '()) (words '()) (chars '()))
(let ((char (read-char)))
(if (eof-object? char)
(reverse lines)
(case char
((#\newline) (reading (cons (reverse (cons (reverse chars) words)) lines) '() '()))
((#\space) (reading lines (cons (reverse chars) words) '()))
(else (reading lines words (cons char chars))))))))))
once you've done this, the rest is trivial.
> (tokenize "foo.data")
(((#\a #\b #\c) (#\d #\e #\f))
((#\1 #\2 #\3) (#\x #\y #\z)))
The word count algorithm using Scheme has been explained before in Stack Overflow, for example in here (scroll up to the top of the page to see an equivalent program in C):
(define (word-count input-port)
(let loop ((c (read-char input-port))
(nl 0)
(nw 0)
(nc 0)
(state 'out))
(cond ((eof-object? c)
(printf "nl: ~s, nw: ~s, nc: ~s\n" nl nw nc))
((char=? c #\newline)
(loop (read-char input-port) (add1 nl) nw (add1 nc) 'out))
((char-whitespace? c)
(loop (read-char input-port) nl nw (add1 nc) 'out))
((eq? state 'out)
(loop (read-char input-port) nl (add1 nw) (add1 nc) 'in))
(else
(loop (read-char input-port) nl nw (add1 nc) state)))))
The procedure receives an input port as a parameter, so it's possible to apply it to, say, a file. Notice that for counting words and lines you'll need to test if the current char is either a new line character or a white space character. And an extra flag (called state in the code) is needed for keeping track of the start/end of a new word.