fffej

;; From http://norvig.com/paip/patmatch.lisp
(defun match-if (pattern input bindings)
  "Test an arbitrary expression involving variables.
  The pattern looks like ((?if code) . rest)."
  ;; *** fix, rjf 10/1/92 (used to eval binding values)
  (and (progv (mapcar #'car bindings)
              (mapcar #'cdr bindings)
          (eval (second (first pattern))))
       (pat-match (rest pattern) input bindings)))

fffej

(defn match-if
  "Test an arbitrary expression involving variables."
  [pattern input bindings]
  (dbg :patmatch (format "match-if %s %s %s" pattern input bindings))
  (let [f (postwalk-replace bindings (second (first pattern)))]
    (when (eval f)
      (pat-match (rest pattern) input bindings))))

fffej

(defn histogram
  [filename]
  (reduce
   (fn [accum x]
     (let [h (Math/floor (/ x 10))]
       (assoc accum h (inc (get accum h 0)))))
   {}
   (take-nth 2 (drop 1 (read-lines filename)))))

fffej

(ns uk.co.fatvat.wave.parrot
  (:import [com.google.wave.api RobotMessageBundle EventType])
  (:gen-class :extends com.google.wave.api.AbstractRobotServlet))
                                      
(defn- add-blip
  [wavelet message]
  (.append (.getDocument (.appendBlip wavelet)) message))

(defn -processEvents                                                  
  [_ bundle]

fffej

(defn solve
  "Solve a system of equations by constraint propagation"
  [equations known]
  (dbg :student (format "SOLVE %s %s" equations known))
  (or
   (some (fn [equation]
           (let [x (one-unknown equation)]
             (when x
               (let [answer (solve-arithmetic (isolate equation x))]
                 (solve (postwalk-replace {(:lhs answer) (:rhs answer)}

fffej

(defn isolate 
  "Isolate the lone x in e on the left-hand side of e"
  [e x]
  (dbg :student (format "e=%s x=%s" e x))
  (cond
    ;; X = A ==> X = n
    (= (:lhs e) x) e
    
    ;; A = f(X) ==> f(X) = A
    (in-exp x (:rhs e)) (isolate (mk-exp (:rhs e) '= (:lhs e)) x)

fffej

(defn separation 
  "Avoid crowding neighbours (short-range repulsion)"
  [boid boids]
  (reduce 
   (fn [[x y] b] 
     [(- x (- (:x b) (:x boid)))
      (- y (- (:y b) (:y boid)))])
   [0 0]
   (filter
    (fn [b] (< (distance [(:x boid) (:y boid)] [(:x b) (:y b)]) separation-distance))

fffej

(defn animate
  [_]
  (when @running
    (send-off *agent* animate)
    (doseq [agent-boid boids]
      (send-off agent-boid behave (remove (partial = @agent-boid) (map deref boids))))
    (.repaint canvas)
    (Thread/sleep animation-delay-ms)))

(defn start-animate []

fffej

(defstruct transform :coefficients :prob)

(defn mk-transform
  [[a b c d e f] prob]
  (struct transform [a b c d e f] prob))
  
(defn calculate-point
  "Calculate the next point to render based on the previous"
  [transform [x y]]
  (let [r (rand)

fffej

(ns uk.co.fatvat.ifs
  (:import [javax.swing JFrame JPanel])
  (:import [java.awt Color Polygon])
  (:import [java.awt.image BufferedImage])
  (:import [javax.swing.event MouseInputAdapter])
  (:use clojure.contrib.def))

(defvar width 512 "Width of the rendering plane")
(defvar height 512 "Height of the rendering plane")
(defvar running (atom false) "Are we going?")