Re: connected?

Jon wrote:
> is this in relation to the checkers contest this past weekend?

Yeah, once your pieces are connected you win.  The contest was full of fun
predicates.  One rule is you can't jump over pieces of your opponents team.
Which means you need a between? predicate.  between? takes two positions and a
list of positions and returns true if any position in the list is between the
two given.  The domain of between? covers only the 4 directions a move may be
made in.  The vertical and horizontal cases are easy.  It's the diagonal cases
that are slightly hairy.

The diagonal case uses a helper function gen-positions that is a bit nasty
since it is higher order.  It takes as parameters two predicates, a row
predicate and a column predicate.  The generating terminates if either return
true.  It also takes a row successor function and column successor function
that given some row or column will generate the next one.  The horizontal,
vertical, diagonal up and diagonal down positions can all be generated easily
using this function.  Also, we can generate positions between some end points.
 You see where I'm going?  We generate all the positions between x and y and
see if any in this list are in the list of positions we are checking for.

Some examples of gen-positions:

All positions in the first column
((gen-positions (lambda (x) (> x 8)) (lambda (x) #f) add1 id) '(1 1))

All positions in the diagonal up direction
((gen-positions (lambda (x) (> 8 x)) (lambda (x) #f) add1 add1) '(1 1))

All position in the diagonal direction between (7 7) and (3 3)
((gen-positions (lambda (x) (> 7 x)) (lambda (x) #f) add1 add1) '(3 3))

David


;; Returns true if any of the pieces are between x and y.



;; (row * col) * (row * col) * list of (row * col) -> bool

(define between?
  (match-lambda*
    [((and x (x-row x-col)) (and y (y-row y-col)) pieces)
     (cond
       [(horizontal? x y)
        (any (match-lambda [(r c)
                            (and (= r x-row)
                                 (if (> x-col y-col)
                                     (and (> c y-col) (< c x-col))
                                     (and (> c x-col) (< c y-col))))])
             pieces)]

       [(vertical? x y)
        (any (match-lambda [(r c)
                            (and (= c x-col)
                                 (if (> x-row y-col)
                                     (and (> r y-row) (< r x-row))
                                     (and (> r x-row) (< r y-row))))])
             pieces)]

       [(diagonal-down? x y)
        (let ((f (if (< x-row y-row) add1 sub1)))
          (any (lambda (x) (in? x pieces))
               ((gen-positions
                 (lambda (x) (= x y-row)) f
                 (lambda (x) (= x y-col)) f)
                (f x-row) (f x-col))))]

       [(diagonal-up? x y)
        (let ((f (if (< x-row y-row) add1 sub1))
              (g (if (< x-row y-row) sub1 add1)))
          (any (lambda (x) (in? x pieces))
               ((gen-positions
                 (lambda (x) (= x y-row)) f
                 (lambda (x) (= x y-col)) g)
                (f x-row) (g x-col))))]
       )]))


;; (row -> bool) * (row -> row) * (col -> bool) * (col -> col)

;;  -> (row * col -> list of row * col)



(define (gen-positions stop-row? succ-row stop-col? succ-col)

  (lambda (r c)

    (let loop ((ls null) (r r) (c c))

      (if (or (stop-row? r) (stop-col? c)) ls

          (loop (cons (list r c) ls) (succ-row r) (succ-col c))))))