Archive for June, 2007

The Farmer, Fox, Chicken and Grain problem (in lisp)

Monday, June 18th, 2007

The same problem in lisp. Here you can see how much work has to be done to mimic sets.


(defun safe-p (list)
  (or (member 'farmer list)
      (and (not (and (member 'fox list)
                     (member 'chicken list)))
           (not (and (member 'chicken list)
                     (member 'grain list))))))

(defun permute-state (state)
  (let (result)
    (destructuring-bind (near far) state
      (if (member 'farmer near)
          (let ((others (set-difference near '(farmer))))
            (push (list 'farmer (list others
                                      (cons 'farmer far))) result)
            (loop for item in others
                  do (push (list item (list  (remove item others) (cons item (cons 'farmer far)))) result))
            result)
          ; we just reverse the sides
          (loop for (move (near far)) in (permute-state (reverse state))
                collect (list move (list far near)))))))

(defvar *history* nil)
(defun solve (initial-state goal-state moves)
  (if (and (null (set-difference (first initial-state) (first goal-state)))
           (null (set-difference (second initial-state) (second goal-state))))
      (progn
        (format t "Found solution~%")
        (loop for move in (reverse moves)
              and direction = 'forward then (if (eq direction 'forward)
                                                'back
                                                'forward)
              do (if (eq move 'farmer)
                     (format t "Farmer crosses ~A~%" direction)
                     (format t "Farmer crosses ~A with ~A~%" direction move)))))
  (loop for (move new-state) in (permute-state initial-state)
        do
        (if (and (not (member (sort  (copy-list (first new-state)) #'string-lessp) *history* :test #'equal))
                 (safe-p (first new-state))
                 (safe-p (second new-state)))
            (progn
              (push (sort (copy-list (first new-state)) #'string-lessp) *history*)
              (solve new-state goal-state (cons move moves))))))

and the output:

CL-USER: (progn (setf *history* nil) (solve '((farmer fox chicken grain) ()) '(() (farmer fox chicken grain)) nil))
Found solution
Farmer crosses FORWARD with CHICKEN
Farmer crosses BACK
Farmer crosses FORWARD with GRAIN
Farmer crosses BACK with CHICKEN
Farmer crosses FORWARD with FOX
Farmer crosses BACK
Farmer crosses FORWARD with CHICKEN
NIL
CL-USER:

Posted in Lisp, Programming | 1 Comment »

Space filling curves

Monday, June 18th, 2007

Last year I discovered space filling curves, they are shapes that can fill a plane without intersection. They can be used to create a spatial index for data in two (or three) dimensions.

I wrote a small pygtk script that uses cairo to draw some peano iterations:
Peano space filling curve

The drawing routine is quite simple


        def turn(cr):
                cr.rotate( pi / 2)

        def extend(cr):
                cr.rel_line_to(0, -unitsize)

        def flip(cr):
                cr.transform(cairo.Matrix(-1,0,0,1,0,0))

        def draw_piece(cr):
                cr.rel_line_to(0, - unitsize * 2)
                cr.rel_line_to(unitsize, 0)
                cr.rel_line_to(0, 2.0 * unitsize)
                cr.rel_line_to(unitsize, 0)
                cr.rel_line_to(0, unitsize * -2.0)

        def doturn(b):
                if (not (b % 243 == 0)) and (b % 81 == 0):
                        return
                if (not (b % 27 == 0)) and (b % 9 == 0):
                        return
                turn(cr)

        for b in range(1,iterations):
                draw_piece(cr)
                if b % 3 == 0:
                        doturn(b)
                if not (b == iterations - 1):
                        extend(cr)
                if b % 3 == 0:
                        doturn(b)
                flip(cr)

Posted in Programming | No Comments »

The Farmer, Fox, Chicken and Grain problem (in maude)

Monday, June 18th, 2007

In my previous post I solved this problem with prolog. Here I have written a solution using the rewrite logic of the Maude system.


mod FARMER is
        sort GameState .
        sort Bank .
        sort Actor .
        subsort Actor < Bank .

        op state : Bank Bank -> GameState [ ctor ] .
        ops Farmer, Fox, Chicken, Grain : -> Actor [ ctor ] .

        op Empty : -> Bank [ ctor ] .
        op __ : Bank Bank -> Bank [ctor assoc comm id: Empty] .

        op safe : Bank -> Bool .

        vars A1 : Actor .
        vars X Y Z : Bank .
        eq safe( Farmer X ) = true .
        eq safe( Chicken Fox X) = false .
        eq safe( Chicken Grain X) = false .
        eq safe( X ) = true [owise] .

        crl [cross_with] : state((Farmer A1 X),Y) => state(X,(Farmer A1 Y)) if safe(X) .
        crl [cross_alone] : state((Farmer X),Z) => state(X,(Farmer Z)) if safe(X) .
        crl [cross_back_with] : state(X,(Farmer A1 Z)) => state((Farmer A1 X),Z) if safe(Z) .
        crl [cross_back_alone] : state(X,(Farmer Z)) => state((Farmer X),Z) if safe(Z) .
endm

Maude has a built-in search mechanism that allows us to find a solution:


Maude> search state(Farmer Fox Chicken Grain,Empty) =>+ state(Empty, Farmer Grain Chicken Fox) .
search in FARMER : state(Farmer Fox Chicken Grain, Empty) =>+ state(Empty, Farmer Fox Chicken Grain) .

Solution 1 (state 9)
states: 10  rewrites: 43 in 0ms cpu (0ms real) (~ rewrites/second)
empty substitution

No more solutions.
states: 10  rewrites: 50 in 0ms cpu (0ms real) (~ rewrites/second)
Maude> show path 9 .
state 0, GameState: state(Farmer Fox Chicken Grain, Empty)
===[ crl state(Farmer X A1, Y) => state(X, Farmer Y A1) if safe(X) = true [label cross_with] . ]===>
state 1, GameState: state(Fox Grain, Farmer Chicken)
===[ crl state(X, Farmer Z) => state(Farmer X, Z) if safe(Z) = true [label cross_back_alone] . ]===>
state 2, GameState: state(Farmer Fox Grain, Chicken)
===[ crl state(Farmer X A1, Y) => state(X, Farmer Y A1) if safe(X) = true [label cross_with] . ]===>
state 3, GameState: state(Grain, Farmer Fox Chicken)
===[ crl state(X, Farmer Z A1) => state(Farmer X A1, Z) if safe(Z) = true [label cross_back_with] . ]===>
state 5, GameState: state(Farmer Chicken Grain, Fox)
===[ crl state(Farmer X A1, Y) => state(X, Farmer Y A1) if safe(X) = true [label cross_with] . ]===>
state 7, GameState: state(Chicken, Farmer Fox Grain)
===[ crl state(X, Farmer Z) => state(Farmer X, Z) if safe(Z) = true [label cross_back_alone] . ]===>
state 8, GameState: state(Farmer Chicken, Fox Grain)
===[ crl state(Farmer X A1, Y) => state(X, Farmer Y A1) if safe(X) = true [label cross_with] . ]===>
state 9, GameState: state(Empty, Farmer Fox Chicken Grain)

Posted in Programming | No Comments »

The Farmer, Fox, Chicken and Grain problem

Monday, June 4th, 2007

I haven’t had much opportunity to work with logic programming languages, so I attempted this simple planning problem in Prolog:

A farmer is returning to his farm after a long day of working in the fields. He has with him a fox, a chicken, and some grain. He must cross a small stream on his way back to the barn. At the stream, there is a canoe, in which he can transport at most one item across at a time. However, he cannot leave the fox alone with the chicken, or the fox will eat the chicken. Similarly, he cannot leave the chicken alone with the grain because the chicken will eat the grain. Devise a plan (sequence of actions) that the farmer can take to safely bring all of his possessions across the stream and continue on his way home.

I wrote the following solution using gprolog. Both gprolog and the other prolog available on Debian systems, swi-prolog, have really horrible programming environments. I can see why many people would skip over prolog given such poor implementations.


initial(X) :- sort([farmer,fox,chicken,grain],X).

% exclude invalid combinations

check_invalid([chicken, fox]) :- !, fail.
check_invalid([chicken, grain]) :- !, fail.
check_invalid([chicken, fox, grain]) :- !,fail.
check_invalid(_) :- true.

% check if we have reached the goal

find_solution(Goal,Goal,_, Moves,Plan) :-
    reverse(Moves,Plan).

% try to make a move, check whether the result is valid
% and check the history to see if we are repeating a move

find_solution(Initial,Goal,History, Moves, Plan) :-
    cross(Initial,[Near,Far],Move),
    sort(Near,SNear),
    sort(Far,SFar),
    check_invalid(SNear),
    check_invalid(SFar),
    \\+(member([SNear,SFar],History)),
    find_solution([SNear,SFar], Goal, [[SNear,SFar] | History], [ Move | Moves], Plan).

% cross from Near to Far side
cross([Near,Far],Result,Move) :-
    member(farmer, Near),
    cross1([Near,Far],Result, Move, forward).

% cross from Far to Near side
cross([Near,Far],[NN,NF],Move) :-
    member(farmer, Far),
    cross1([Far,Near],[NF,NN], Move, backward).

% let the farmer cross alone
cross1([Near,Far],[NN,NF],Move,Direction) :-
    select(farmer,Near,NN),
    append([farmer],Far, NF),
    Move = [Direction, farmer, []].

% let the farmer cross with one Animal/grain
cross1([Near,Far],[NN,NF],Move,Direction) :-
    select(farmer,Near,RemainingNear),
    member(Animal,RemainingNear),
    select(Animal,RemainingNear,NN),
    append([farmer,Animal],Far, NF),
    Move = [Direction, farmer, [Animal]].

run(Plan) :-
    initial(I),
    find_solution([I,[]],
                  [[],I],
                  [],
                  [],
                  Plan).

Posted in Open Source, Programming | 2 Comments »