Wednesday, February 29, 2012

How to use Apache Httpget in Clojure

Clojure's slurp function is great for quick retrieval of websites, but sometimes it's not enough and you'll get an 403 error.

As a quick fix I suggest using the Apache httpclient library. You will need httpclient-4.x.x.jar, httpcore-4.x.x.jar and commons-logging-1.x.x.jar in your classpath, which you can find here:
 The function http-get is a simple replacement for slurp. You can easily extend, e.g. adding timeouts, etc.

(ns apache-http
   (org.apache.http.client ResponseHandler HttpClient methods.HttpGet)
   (org.apache.http.impl.client BasicResponseHandler DefaultHttpClient)))

(defn http-get [ url ]
  (let [client (DefaultHttpClient.)
        httpget (HttpGet. url)
        handler (BasicResponseHandler.)]
      (let [body (.execute client httpget handler)]
      (catch Exception e (println e))
        (println "shutdown connection")
        (.shutdown (.getConnectionManager client))
        )) ))

usage is simple:
(http-get "")

Monday, February 27, 2012

A template for binomial coefficients in C++

Here's how you could implement a compile time calculation of
binomial numbers "n over k" in C++ with a template.



template<int n, int k>
struct Binomial
  const static int value =  (Binomial<n-1,k-1>::value + Binomial<n-1,k>::value);

struct Binomial<0,0>
  const static int value = 1;

template<int n>
struct Binomial<n,0>
  const static int value = 1;

template<int n>
struct Binomial<n,n>
  const static int value = 1;

template<int n, int k>
inline int binomial()
  return Binomial<n,k>::value;


Now let's try it with a short main:
#include "Binomial.hpp"
#include <iostream>

int main()
  std::cout << "30 over 15: " << binomial<30,15>() << std::endl;
  return 0;

30 over 15: 155117520
It works! When it will break depends on your compiler. I used g++ 4.6.2

Android ListView Widget Example in Clojure

This is how you would implement the
Android ListViev Tutorial on Android dev in Clojure.
Follow the tutorial and the build instructions from Sattvik's Neko.

Replace the Java code with

( ns
   :exposes-methods {onCreate superOnCreate})
(:import android.util.Log)

(def STRINGS ["String1" "String2" "String3"])

(defn -onCreate  [this bundle]
    (.superOnCreate this bundle )
    (let [aa (android.widget.ArrayAdapter. 
 this$layout/list_item STRINGS)]
      (.setListAdapter this aa)
      (let [lv (.getListView this)]
        (.setTextFilterEnabled lv true)
        (.setOnItemClickListener lv 
         (proxy  [android.widget.AdapterView$OnItemClickListener] []
           (onItemClick [parent view position id]
            (Log/d "CLOJURE" "CLICKED" ))

Use adb logcat and you should see the message when an item is clicked.

Clojure Falling Blocks Game

A game with falling blocks in Clojure :-)

load it in the repl and start with


This code is loosely based on the Snake example in the excellent book Programming Clojure by Stuart Halloway.

(ns titres
(:import (java.awt Color Dimension)
         (javax.swing JPanel JFrame Timer JOptionPane)
         (java.awt.event ActionListener KeyListener WindowAdapter)) )

(def frame-millis 60)
(def cell-size 40)
(def width 10)
(def height 15)
(def dirs { java.awt.event.KeyEvent/VK_LEFT [-1 0]
            java.awt.event.KeyEvent/VK_RIGHT [1 0] })
(def frames-to-drop 6)

(def blocks  [ '([0 0] [1 0] [0 1] [1 1]) '([0 0] [1 0] [2 0] [0 1])
               '([0 0] [1 0] [2 0] [2 1]) '([0 0] [1 0] [1 1] [2 1]) 
               '([0 0] [1 0] [2 0] [1 1]) '([1 0] [2 0] [0 1] [1 1])
               '([0 0] [1 0] [2 0] [3 0]) ] )
(def colors [(Color. 15 160 70)  (Color. 160 15 70) (Color. 15 70 160)
             (Color. 70 160 15) (Color. 70 15 160) (Color. 160 70 15) (Color. 160 70 160)] )

(defn make-block 
  { :location [0 0] 
    :body  ( blocks n ) 
    :color ( colors n )})
 ([] (make-block (rand-int (count blocks)))))

(defn point-to-screen-rect [pt] 
  (map #(* cell-size %) [(pt 0) (pt 1)  1 1]))

(defn fill-point [g pt color]
  (let [[x y width height] (point-to-screen-rect pt)]
  (.setColor g color)
  (.fillRect g x y width height)))

(defn paint-block [g {:keys [body location color]}]
  (doseq [point body]
    (fill-point g  (vec (map + point location)) color)))

(defn paint-stash [g stash] 
  (doseq [m stash]
    (fill-point g (key m) (val m)))) 

(defn insert-to-stash [stash {:keys [body location color] }]
  (let [body-shifted (map #(vec (map + location %)) body) ]
    (merge stash (zipmap body-shifted (repeat color)) )))

(defn hits-bottom? [{:keys [location body] }]
  (let [[x y] (map + location (apply map max body))]
    (= y height) ))

(defn collision? [stash {:keys [location body]} direction]
  (let [body-shifted (map #(vec (map + location direction %)) body) ]
    (some #(contains? stash %) body-shifted) ))

(defn hits-stash? [stash block]
  (collision? stash block [0 1]))
(defn delete-row [stash row]
  (let [new-stash (filter #(not= row ((key %) 1)) stash)
        new-stash-keys ( map #( cond (< (% 1) row) 
                                (vec (map + % [0 1])) 
    :else % ) (keys new-stash) ) ]
    (zipmap new-stash-keys (vals new-stash))  ))

(defn count-row [stash row]
  (count (filter #(= row (% 1)) (keys stash))) )

(defn delete-rows [stash row]
  (if (> row height) stash 
   (if (> (count-row stash row)  width) 
      (recur  (delete-row stash row) (inc row) )
      (recur  stash (inc row) ) 
   ) ))
(defn transpose-pt [pt height]
  [(- height (pt 1)) (pt 0) ])

(defn rotate-right [{:keys [body] :as block}]
  (let [[width height] (apply map max body)]
    (assoc block :body (map #(transpose-pt % height) body))))

(defn rotate-left [block]
  (rotate-right (rotate-right (rotate-right block))))

(defn move [{:keys [location] :as block} direction]
  (assoc block :location (vec (map + location direction))) )

(defn block-hits-border? [{:keys [body location] } newdir]
  (let [min_x (first (map + (vec (apply map min body)) newdir location)) 
        max_x (first (map + (vec (apply map max body)) newdir location)) ]
  (or (< min_x 0) (> max_x width)) ))

(defn adjust-border [{:keys [body location] :as block}]
  (let [offset (- width (first (map + (apply map max body) location)))]
   (cond (< offset 0) (move block [offset 0]) 
    :else block ) ))

(defn update-position [stash block newdir]
  (when-not (or (collision? stash @block newdir
    (block-hits-border? @block newdir) ) 
    (dosync (alter block move newdir)) ))

(defn update-drop [stash block]
  (when-not (collision? stash @block [0 1])    
    (dosync (alter block move [0 1])) ))

(defn update-rotation [f stash block]
  (let [shifted-block (adjust-border (f @block))]
    (when-not (collision? stash shifted-block [0 0])   
      (dosync (ref-set block shifted-block)) )))  

(defn update-stash  [stash block]
  (dosync (alter stash insert-to-stash block))
  (dosync (alter stash delete-rows 0)) ) 

(defn game-panel [frame block]
(let [framecounter (ref  0)
      stash (ref {})]
(proxy [JPanel ActionListener KeyListener] []  
  (paintComponent [g]
   (proxy-super paintComponent g)
   (paint-block g @block)
   (paint-stash g @stash)
  (actionPerformed [e] 
   (dosync (alter framecounter inc))
   (when (= 0 (mod @framecounter frames-to-drop)) 
    (update-drop @stash block)
    (when (or (hits-stash? @stash @block) (hits-bottom? @block)) 
     (update-stash stash @block)
     (dosync (ref-set block (make-block)))))
    (.repaint this) )
  (keyPressed [e]       
   (let [key (.getKeyCode e)]
     (= key java.awt.event.KeyEvent/VK_UP)   (update-rotation rotate-right @stash block)
     (= key java.awt.event.KeyEvent/VK_DOWN) (update-rotation rotate-left  @stash block)
     (update-position @stash block (dirs key)) ))  )
  (keyReleased [e])
  (keyTyped [e])
  (getPreferredSize []
    (Dimension. (* (inc width) cell-size)
                (* (inc height) cell-size)))

(defn frame-closing [timer] (proxy [WindowAdapter] []
                (windowClosing [e] (do (println "stopped") (.stop timer)))))

(defn game[]
  (let [frame (JFrame. "Tetris")
 block (ref (make-block))
        panel (game-panel frame block)
        timer (Timer. frame-millis panel)]
  (doto panel
   (.setFocusable true)
   (.addKeyListener panel))
  (doto frame
   (.addWindowListener  (frame-closing timer))
   (.add panel)
   (.setVisible true))
   (.start timer) [timer]))

Clojure Game of Life

This is a Conway's Game of Life in functional style written in Clojure.
You would start it in the repl as

 (game "GUN44.LIF")

where "GUN44.LIF" is a LIF file -- you can find LIF files all over the
internet, e.g. Paul Calahan's great collection

The lif reader demonstrates how to read and process a file in Clojure.

(ns gol
  (:import (java.awt Color Dimension)
           (javax.swing JPanel JFrame Timer JOptionPane)
           (java.awt.event ActionListener KeyListener WindowAdapter))
  (:use lif))

(def frame-millis 30)
(def cell-size 5)
(def width 250)
(def height 160)

(def glider ^ints #{ [1 0] [2 1] [0 2] [1 2] [2 2] })
(def gun ^ints (process-file "../../lifep/GUN44.LIF"))

(defn get-neighbors[ ^ints [ox oy] ]
  (for [x (range (- ox 1) (+ ox 2))
        y (range (- oy 1) (+ oy 2)) ]
    [x y] ))

(defn collect-neighbors [field]
  (distinct (mapcat get-neighbors field)))

(defn count-alive-neighbors [ ^ints field]
  (fn [ cell ] (count (filter field (get-neighbors cell) ))))

(defn survives? [field]
 (let [count-alive-neighbors (count-alive-neighbors field)]
  (fn [ cell ]
    (let [n (count-alive-neighbors cell)]
      (or (= n 3) (= n 4))))))

(defn birth? [field]
  (let [count-alive-neighbors (count-alive-neighbors field)]
    (fn [ cell ]
      (= 3 (count-alive-neighbors cell)))))

(defn apply-rules [filterfunc]
  (fn [ field ]
    (let [dead-cells (remove field (collect-neighbors field))
          survives?  (survives? field)
          birth?     (birth? field)]
      (set (concat
            (filterfunc survives? field)
            (filterfunc birth?    dead-cells))))))

(defn pfilter [pred list]
  (map second (filter first (pmap (fn [cell] [(pred cell) cell]) list))))

(def apply-rules-p (apply-rules pfilter))
(def apply-rules-n (apply-rules filter))

(defn update-field [field]
  (swap! field apply-rules-n))

(defn point-to-screen-rect [pt] 
  (map #(* cell-size %) [(pt 0) (pt 1)  1 1]))

(defn fill-point [^java.awt.Graphics g pt color]
  (let [[x y width height] (point-to-screen-rect pt)]
   (.fillRect g x y width height)))

(defn paint-game [^java.awt.Graphics g field]
  (let [center [(bit-shift-right width 1) (bit-shift-right height 1)]
        color (Color. 15 160 70)]
    (.setColor g color)
    (doseq [point field]
      (fill-point g (vec (map + center point)) color) )))

(defn game-panel [frame field]
(proxy [JPanel ActionListener KeyListener] []  
  (paintComponent [^java.awt.Graphics g]
   (proxy-super paintComponent g)
   (paint-game g @field))
  (actionPerformed [e]
    (.repaint this)
    (println "active cells:" (count @field))
    (time (update-field field)))
  (keyPressed [e] )
  (keyReleased [e])
  (keyTyped [e])
  (getPreferredSize []
    (Dimension. (* (inc width) cell-size)
                (* (inc height) cell-size)))

(defn frame-closing [timer] (proxy [WindowAdapter] []
  (windowClosing [e] (do (println "stopped") (.stop timer)))))

(defn game
  (let [frame (JFrame. "Game of Life")
        field (atom (^ints process-file filename) )
        panel (game-panel frame field)
        timer (Timer. frame-millis panel)]
  (doto panel
   (.setFocusable true)
   (.addKeyListener panel))
  (doto frame
   (.addWindowListener  (frame-closing timer))
   (.add panel)
   (.setVisible true))
  (.start timer) [timer]))
  ([] (game "../../lifep/GUN44.LIF")))

The lif reader:
(ns lif
  (:import ( BufferedReader FileReader))
  (:use  [clojure.string :only (split)]
         [ :only (reader)])

(defn collect-data [[x y] line]
  (remove nil?  (map #(when (= %1 \*) [%2 y]) line (iterate inc x))))

(defn is-data? [line]
  (or (= \. (first line)) (= \* (first line))))

(defn char-to-long [c]
  (Long. (str c)))

(defn is-coords? [line]
  (let [tokens (split line #"\s")]
    (= "#P" (tokens 0))))

(defn get-coords [line]
  (let [tokens (split line #"\s")]
    [(char-to-long (tokens 1)) (char-to-long (tokens 2)) ]))

(defn process-lines [[x y] lines accu]
  (let [line (first lines)]
    (cond (empty? lines)  accu   
          (is-data? line)
          (recur [x (inc y)] (rest lines)
                 (concat accu (collect-data [x y] line)))
          (is-coords? line)
          (recur (get-coords line )(rest lines) accu)
          :else  (recur [x y] (rest lines) accu))))

(defn process-file [file-name]
  (with-open [rdr (reader file-name)]
    (set (process-lines [0 0]  (line-seq rdr) nil))))

Have fun!


I cleaned the mess up a bit. Still not as concise as cgrand's solution. Hope I find the time to check it out and see if it's faster than mine.