Linear programming in R using lpsolve

You can read more about linear programming basics here. Here’s how one can work through this example in R using lpsolve library.

Problem

Problem definition copied from the above link:

Suppose a farmer has 75 acres on which to plant two crops: wheat and barley. To produce these crops, it costs the farmer (for seed, fertilizer, etc.) $120 per acre for the wheat and $210 per acre for the barley. The farmer has $15000 available for expenses. But after the harvest, the farmer must store the crops while awaiting favourable market conditions. The farmer has storage space for 4000 bushels. Each acre yields an average of 110 bushels of wheat or 30 bushels of barley. If the net profit per bushel of wheat (after all expenses have been subtracted) is $1.30 and for barley is $2.00, how should the farmer plant the 75 acres to maximize profit?

Mathematical definition

Also copied from the above:

maximize
    P = (110)(1.30)x + (30)(2.00)y = 143x + 60y
subject to
    120x + 210y <= 15000
    110x + 30y <= 4000
    x + y <= 75
    x >= 0
    y >= 0

To reference this again, we have this as the generic mathematical formulation:

- A linear function to be maximized or minimized
    maximize c1 x1 + c2 x2
- Problem constraints of the following form
    a11 x1 + a12 x2 <= b1
    a21 x1 + a22 x2 <= b2
    a31 x1 + a32 x2 <= b3
- Default lower bounds of zero on all variables

Matching to our problem, we have:

- A linear function to be maximized or minimized
    P = (110)(1.30)x + (30)(2.00)y = 143x + 60y
        c1 = 143
        c2 = 60
- Problem constraints of the following form
    120x + 210y <= 15000
         a11 = 120
         a12 = 210
         b1  = 15000
    110x + 30y <= 4000
         a21 = 110
         a22 = 30
         b2  = 4000
    x + y <= 75
         a31 = 1
         a32 = 1
         b3  = 75
- Default lower bounds of zero on all variables
    x >= 0
    y >= 0

Note that lpsolve by default includes the last condition (i.e. all variables non-negative).

Using R to solve

See this for more details.

  • Install lpsolve library
> install.packages("lpSolveAPI")
  • Load lpsolve library
> library("lpSolveAPI")
  • Represent our problem
> lprec <- make.lp(0, 2)
> lp.control(lprec, sense="max")
> set.objfn(lprec, c(143, 60))
> add.constraint(lprec, c(120, 210), "<=", 15000)
> add.constraint(lprec, c(110, 30), "<=", 4000)
> add.constraint(lprec, c(1, 1), "<=", 75)
  • Display the lpsolve matrix
> lprec
Model name: 
            C1    C2           
Maximize   143    60           
R1         120   210  <=  15000
R2         110    30  <=   4000
R3           1     1  <=     75
Kind       Std   Std           
Type      Real  Real           
Upper      Inf   Inf           
Lower        0     0           
  • Solve
> solve(lprec)
[1] 0
  • Get maximum profit
> get.objective(lprec)
[1] 6315.625
  • Get the solution
> get.variables(lprec)
[1] 21.875 53.125

Thus, to achieve the maximum profit ($6315.625), the farmer should plant 21.875 acres of wheat and 53.125 acres of barley.

Be Sociable, Share!

Leave a Reply


nine + 9 =

Project Euler in Haskell

I’m in the process of familiarizing myself with Haskell (wouldn’t say it’s learning at this point), so decided to work on some Project Euler problems. Here are my solutions to problems 1-5. One thing to notice – they are unusually long for a Haskell program and as usual – take them with a grain of salt.

Project Euler 1 in Haskell

Project Euler problem 1

mul35 :: Int -> Int
mul35 n = sum xs
  where
    xs = [i | i <- [1..n-1], 
          (i `mod` 3 == 0) ||
          (i `mod` 5 == 0)]
    
main =
  do
    print $ mul35 10
    print $ mul35 1000

Project Euler 2 in Haskell

Project Euler problem 2

fibs :: [Int]
fibs = 1 : 2 : [a + b | (a, b) <- zip fibs (tail fibs)]

sumFibs :: Int -> Int
sumFibs ms = sum [x | x <- takeWhile (< ms) fibs, even x]

main = do
  print $ sumFibs 4000000

Project Euler 3 in Haskell

Project Euler problem 3

lpf :: Int -> Int
lpf n = if md == n then n
        else lpf (n `div` md)
        where md = head [x | x <- [2..n], n `mod` x == 0]

main = do
  print $ lpf 13195
  print $ lpf 600851475143 

Project Euler 4 in Haskell

Project Euler problem 4

import Data.List (tails)

numsLen :: Int -> [Int]
numsLen l = [mx,mx-1..mi] where
  mi = 10^(l-1)
  mx = 10^l - 1
  
digits :: Int -> [Int]
digits 0 = []
digits n = n `mod` 10 : digits (n `div` 10)

palindrome :: Int -> Bool
palindrome n = digits n == reverse (digits n)
  
lpal :: Int -> Int
lpal d = maximum ps where
  ns = numsLen d
  xss = tails ns
  ps = [y | x:xs <- xss, y <- map (* x) xs, palindrome y]
  
main = do
  print $ lpal 2
  print $ lpal 3

Project Euler 5 in Haskell

Project Euler problem 5

lcmm :: [Int] -> Int
lcmm [] = error "Empty list"
lcmm [x] = x
lcmm xs = foldr1 lcm xs

hdbf :: Int -> Int
hdbf n = lcmm [1..n] 

main = do
  print $ hdbf 10
  print $ hdbf 20
  print $ hdbf 30
Be Sociable, Share!

Leave a Reply


six − 3 =

WebGL charts

I wanted to see how hard it would be to make a WebGL chart. Here’s the code with comments. The code is written in CoffeeScript.

class ThreeJsPrb
  initCSR: ->
    width = 800
    height = 600
    viewAngle = 45
    aspect = width / height
    near = 0.1
    far = 20000
    
    @camera = new THREE.PerspectiveCamera viewAngle, aspect, near, far
    @camera.position.z = 15000
    
    @scene = new THREE.Scene
    @scene.add @camera

    @renderer = new THREE.WebGLRenderer
      antialias: true
      premultipliedAlpha: false
    @renderer.setSize width, height
    
    $('<div>')
      .append(@renderer.domElement)
      .appendTo(document.body)

We are making a class called ThreeJsPrb. The first method is called initCSR, short for init camera, scene and renderer. WebGL needs these three:

  • Camera to define where we are looking from
  • Scene that defines what the world contains
  • Rendered to render all this

In the above:

  • We define a few variables defining dimensions of the renderer, view angle aspect and near / far z-index
  • Setup a camera and it’s position
  • Setup a scene and add a camera to it
  • Setup a renderer, with some options (antialias and premultipliedAlpha) and set it’s weight
  • Finally, add the renderer to dom using jQuery
  draw: =>
    @render()
    setTimeout(() =>
        requestAnimationFrame @draw
      , 1000 / @fps)

This method is the main “loop” of this app. It will render the current scene, then use a combination of setTimeout and requestAnimationFrame to repeat this in the future. The combination in this case is necessary to be able to set a relatively constant fps that doesn’t max out the fps all the time.

  render: =>
    if Math.abs(@group.rotation.y) > Math.PI / 8
      @rot *= -1
    @group.rotation.y += @rot
    @renderer.render @scene, @camera

The render method itself does two things:

  • Applies a see-saw-behaving rotation (i.e. rotate right up to Math.PI / 8 radians, then reverse the direction)
  • Renders the scene using the given camera
  # http://en.wikipedia.org/wiki/World_population#Population_growth_by_region
  worldPopulation: {
         1: 200
      1000: 310
      1750: 791
      1800: 978
      1850: 1262
      1900: 1650
      1950: 2519
      1955: 2756
      1960: 2982
      1965: 3335
      1970: 3692
      1975: 4068
      1980: 4435
      1985: 4831
      1990: 5263
      1995: 5674
      2000: 6070
      2005: 6454
      2010: 6972
    }

This is just a sample chart data, taken from Wikipedia.

  makeScene: ->
    material = new THREE.MeshLambertMaterial
      color: 0x80b2ff
        
    @group = new THREE.Object3D
    @scene.add @group
    
    @graph = new THREE.Object3D
    @graph.position.y -= 3000
    @group.add @graph
    
    xpos = 0
    
    radius = 200
    for k, v of @worldPopulation
      radiusTop = radius
      radiusBottom = radius
      height = v
      radiusSegments = 50
      heightSegments = 50
      openEnded = false
      cylinderGeometry = new THREE.CylinderGeometry radiusTop, radiusBottom, height, radiusSegments, heightSegments, openEnded

      cylinder = new THREE.Mesh cylinderGeometry, material
      cylinder.position.x = xpos
      cylinder.position.y = v / 2
      xpos += radius * 3
      @graph.add cylinder
      
    @graph.position.x = -xpos / 2
    
    @rot = 0.01
    @group.rotation.x = Math.PI / 8
    
    directionalLight = new THREE.SpotLight 0xffffff
    directionalLight.position.set -xpos, 1000, 3000
    directionalLight.angle = Math.PI / 2
    directionalLight.target.position.set xpos / 3, 0, 0
    @scene.add directionalLight

This is the meat of the app. The above code is responsible for setting up the scene. As our scene doesn’t change except for rotation, this is done only once. Here’s what’s going on:

  • We define a lambert material of a given bluish color
  • We define a Object3D called group. This will be used for easier around-the-center rotation later
  • We create another Object3D called graph and add it to the group. We also move it “down” by setting the y-axis position
  • For each of the keys in worldPopulation map, we create a cylinder geometry and a mesh out of this and the material we made above. We add that to the graph
  • We move the graph within it’s parent element (group) to be split in the middle along x-axis. Again, this is to achieve around-the-center rotation later
  • We setup the rotation step
  • We add a direction light
  run: ->
    console.log '> ThreeJsPrb.run'

    @initCSR()
    @makeScene()
    
    @fps = 15
    @draw()
    
    console.log '< ThreeJsPrb.run'

module.exports = ThreeJsPrb

Finally, the initialization code and module export.

Here’s a screenshot:

screenshot

Be Sociable, Share!

One Response to “WebGL charts”

three.js clock « Blog Archive « icyrock.com on April 29th, 2014 22:48:

[…] the three.js charts post, here’s the clock using […]

[WORDPRESS HASHCASH] The comment’s server IP (127.0.0.1) doesn’t match the comment’s URL host IP (127.0.1.1) and so is spam.


Leave a Reply


five + = 14

Brunch / Marionette sample application

The other day I ran into Brunch. You can visit the site to get more information, but in a nutshell it’s a build tool. I decided to play with it a bit.

Installation

Installation is simple:

$ npm install -g brunch

Creating a sample project

In order to create a new project, a skeleton is used. At the moment, there are a few dozen skeletons listed here. I am going to use this, which is “Brunch with Coffee Script, Stylus, Backbone, Marrionette, and jQuery.”.

To create the project, this needs to be done:

$ brunch new https://github.com/monokrome/brunch-with-grits

After the skeleton is cloned and the libraries downloaded, you will have something like this:

app
bower_components
bower.json
config.coffee
node_modules
package.json
README.md
vendor

Here:

  • config.coffee is a brunch configuration
  • bower.json is bower configuration
  • vendor is where brunch will put the bower-fetched dependencies (which are managed by bower under bower_components)
  • app is where files related to our application should go

In order to build it for the first time, do this:

$ npm install
$ brunch build

After this, another folder appears – public. This one contains compiled files:

index.html
javascripts
stylesheets

Watching

When developing, all the compilation that needs to be done can be done automatically. This is the watching functionality of brunch. Just invoke this:

$ brunch watch --server

The --server parameter will start a development Web server (defaults to localhost:3333).

Pieces

The above skeleton already contains application.coffee file. This one initializes Backbone.Marionette.Application and does nothing else. In order to display something, Marionette has a few concepts. This is I think best explained on the main page here, but briefly:

  • Template translates into a HTML that will be shown
  • View renders a template and handles events
  • Region defines a jQuery selector that will hold a View instance

View also depends on Backbone.Model or Backbone.Collection to hold the data that is used by a Template instance when rendering.

Basic app

Let’s do a small app – a bounded (to [-5, 5] integer range) counter. In brief:

  • Our model is a number
  • Our view is a text box and a button
  • Button click will make the model’s number to be increased by one

I’m also going to use Handlebars templates, so will first add this:

    "handlebars-brunch": ">= 1.0 < 1.8"

to the dependencies secdion of package.json, followed by:

$ npm install

Let's do this step by step.

Modules

I'm going to use the regular CommonJS modules here. Thus, when I say "this goes to file abc", it needs to be put in that file for the require logic to work. If you change the file names or the folders where they belong, please update the require lines appropriately. Just to make it simple, all files here will go to the root of app folder.

Main HTML

The main HTML in the skeleton is not surprisingly index.html. We just need to add one line in the body:

    <div id="main"></div>

As to why, it will be clear when we discuss the controller a bit later. This edit goes to assets/index.html.

Model

Our model is simple:

module.exports = class Number extends Backbone.Model
  defaults:
    number: 1

  inc: ->
    @set 'number', @get('number') + 1

This goes to number-model.coffee. So we have:

  • Number class that extends Backbone.Model class
  • Default number is 1
  • Inc method that increases the number property
  • Emphasis on property here - calling set on number will send a change:number event, which we will use later

Template

Template is simple as well:

<input id="number" type="text" value="{{number}}" readonly="false" />
<button id="inc">Inc</button>

This goes to number-template.hbs. We have this:

  • This is a Handlebars template
  • It contains two HTML elements - an input box to display our number
  • Both have the IDs that we'll reference later (#number and #inc)
  • Input has it's value set to {{number}} which Handlebars will render appropriately
  • It also has readonly set to false, just so user cannot change the value, as we don't have the binding for this update

View

View is simple, though a bit more complex than model:

module.exports = class NumberView extends Backbone.Marionette.ItemView
  template: require('number-template')
  events:
    'click #inc': 'inc'
  ui:
    incInp: '#number'

  initialize: ->
    @listenTo @model, "change:number", @numberChanged

  numberChanged: ->
    @ui.incInp.attr 'value', @model.get 'number'

  inc: (evt) ->
    @trigger 'number:inc'

This goes to number-view.coffee. Here we have:

  • NumberView extends Backbone.Marionette.ItemView. This class is responsible for showing a single item, hence the name
  • We specify the template as number-template
  • The events says that when our button (HTML ID is #inc, our Inc button) is clicked, we invoke inc method on the view
  • ui property is just an alias map. It allows us to say @ui.incInp and reference the HTML element specified, in this case #number, which is our input element
  • initialize method binds a listener to our model. It says: whenever the model triggers change:number event, call our numberChanged function on this view
  • numberChanged is just updating the input with the number whenever it changes
  • inc method is the event listener for button click - it triggers number:inc event, which our controller is going to catch and then act appropriately

Controller

The controller looks like this:

module.exports = class NumberController extends Marionette.Controller
  initialize: (options) ->
    @model = options.model
    @view = options.view
    @listenTo @view, 'number:inc', @numberInc

  numberInc: ->
    newNumber = @model.get 'number'
    newNumber++
    newNumber = -5 if newNumber > 5
    @model.set 'number', newNumber

Note that this (as per this doc paragraph) is not equivalent to the C in MVC. I'm however using it for this purpose only.

This goes to number-controller.coffee. It has two things:

  • initialize method remembers the provided model and view instances and subscribes to number:inc event. This event is triggered from view when button is clicked, see above
  • numberInc is the method that encapsulates the business logic of our bounded counter. It will increase the number and make sure it stays in [-5, 5] range
  • Just a reminder here: doing @model.set will trigger a change:number event, which will complete the cycle by going to our view and rendering it via numberChanged method, see above

Application initialization - wiring all this together

We need to update application.coffee to wire this together. We can also do this in initialize.coffee, depending on how we want to do the separation of concerns. Here's how it looks:

NumberModel = require('number-model')
NumberView = require('number-view')
NumberController = require('number-controller')

class Application extends Backbone.Marionette.Application
  initialize: =>
    @on 'initialize:after', @startHistory

    model = new NumberModel
    view = new NumberView model: model
    new NumberController model: model, view: view

    @addRegions mainRegion: '#main'
    @mainRegion.show view

    @start()

  startHistory: (options) => Backbone.history.start()

module.exports = Application

Here we do the following:

  • Import the necessary classes, NumberModel, NumberView and NumberController
  • In initialize, instantiate the model, view and controller and wire them up as needed
  • Add a region - this references the #main div that we added to index.html
  • Finally, show the view into this region and start the app

Conclusion

I can say this about the simple app:

  • Brunch makes it very easy to start the project - installation and getting up and running from the appropriate skeleton is just a few commands away
  • It's watch command is a one-step way to a very good development experience - it compiles templates, CoffeeScript files, bundles everything and a refresh of the dev Web server just brings the latest - like it a lot
  • Bower allows for a very nice dependency management
  • Marionette provides a very good and simple framework for decoupling things into sensible, well-contained units (models, templates, views, controllers, application - and there are also layouts and under-the-cover event aggregator that we actually used above)

All in all, I think this is a very good model - I hope to use it going forward.

Be Sociable, Share!

6 Responses to “Brunch / Marionette sample application”

Litts on October 7th, 2013 15:38:

Nice tutorial , Do you have an example here your views are in separate directories

[WORDPRESS HASHCASH] The poster sent us ‘0 which is not a hashcash value.


Dan on October 15th, 2013 08:23:

Hi,

great introduction to Marionette!

One question though: what’s the purpose of this one:

inc: -> @set ‘number’, @get(‘number’) + 1

Doesn’t the controller already take care of that here:

numberInc: -> newNumber = @model.get ‘number’ newNumber++ newNumber = -5 if newNumber > 5 @model.set ‘number’, newNumber


icyrock.com on October 15th, 2013 21:47:

Thanks Litts! In order to have views in separate folders, you follow the same logic. E.g. if you put your view in app/view1/view1-view.coffee, you’d just use a different require: require(‘view1/view1-view’). Otherwise, things would look the same.


icyrock.com on October 15th, 2013 21:49:

Thanks Dan, glad you liked it! The inc method of the model is not used – I guess just wanted to emphasize that you cannot just do number++, but instead need to use set / get, which trigger the ‘change:number’ event. Agree however – the active logic is in the controller.


Poplinr on February 24th, 2014 18:27:

This helped me get setup really quickly! Thanks for the post.


icyrock.com on February 27th, 2014 23:54:

Sure thing, glad it was useful!


Leave a Reply


× nine = 54

Split string with regex and keep delimiters

The other day I needed to split a string with regex delimiter, but also keep these delimiters. Java’s default String.split does not do that – it throws away the delimiters. Below is the code that can be used to achieve this.

Java

import java.util.List;
import java.util.ArrayList;
import java.util.Arrays;
import java.util.regex.Pattern;
import java.util.regex.Matcher;

public class SplitWithDelimiters {
  public static void main(String[] args) {
    new SplitWithDelimiters().run();
  }

  private void run() {
    String regex = "\\s*[+\\-*/]\\s*";

    assert !new String[] { }.equals(
      splitWithDelimiters("", regex));
    assert !new String[] { "1" }.equals(
      splitWithDelimiters("1", regex));
    assert !new String[] { "1", "+" }.equals(
      splitWithDelimiters("1+", regex));
    assert !new String[] { "-", "1" }.equals(
      splitWithDelimiters("-1", regex));
    assert !new String[] { "- ", "- ", "-", "1" }.equals(
      splitWithDelimiters("- - -1", regex));
    assert !new String[] { "1", " + ", "2" }.equals(
      splitWithDelimiters("1 + 2", regex));
    assert !new String[] { "-", "1", " + ", "2", " - ", "3", "/", "4" }.equals(
      splitWithDelimiters("-1 + 2 - 3/4", regex));
    
    System.out.println("Done.");
  }

  private String[] splitWithDelimiters(String str, String regex) {
    List<String> parts = new ArrayList<String>();

    Pattern p = Pattern.compile(regex);
    Matcher m = p.matcher(str);

    int lastEnd = 0;
    while(m.find()) {
      int start = m.start();
      if(lastEnd != start) {
        String nonDelim = str.substring(lastEnd, start);
        parts.add(nonDelim);
      }
      String delim = m.group();
      parts.add(delim);

      int end = m.end();
      lastEnd = end;
    }

    if(lastEnd != str.length()) {
      String nonDelim = str.substring(lastEnd);
      parts.add(nonDelim);
    }

    String[] res =  parts.toArray(new String[]{});
    System.out.println("result: " + Arrays.toString(res));

    return res;
  }
}

Clojure

Here’s a test file for the Clojure version:

(deftest split-keep-delim-test
  (is (= []
         (split-keep-delim "" #"\d+")))
  (is (= ["abc"]
         (split-keep-delim "abc" #"\d+")))
  (is (= ["-" "1" " + " "2" " - " "3" "/" "4"]
         (split-keep-delim "-1 + 2 - 3/4" #"\s*[+\-*/]\s*")))
  (is (= ["a" "b" "12" "b" "a"]
         (split-keep-delim "ab12ba" #"[ab]"))))

and the implementation:

(defn split-keep-delim 
  "Splits str with re-delim. Returns list of parts, including delimiters. Lazy.

   > (split-keep-delim \"-1 + 2 - 3/4\" #\"\\s*[+\\-*/]\\s*\")
   [\"-\" \"1\" \" + \" \"2\" \" - \" \"3\" \"/\" \"4\"]
   > (split-keep-delim \"ab12ba\" #\"[ab]\")
   [\"a\" \"b\" \"12\" \"b\" \"a\"]"
  [str re-delim]
  (let [m (.matcher re-delim str)]
    ((fn step [last-end]
       (if (.find m)
         (let [start (.start m)
               end (.end m)
               delim (.group m)
               new-head (if (not= last-end start)
                          [(.substring str last-end start) delim]
                          [delim])]
           (concat new-head (lazy-seq (step end))))
         (if (not= last-end (.length str))
           [(.substring str last-end)]
           []))) 0)))

This version is lazy, though I did not notice any speedup as you can see from the timings below. Timings are rather good for what I needed:

> (let [s (apply str (take 100 (cycle "-1 + 2 - 3/4"))) pat #"\s*[+\-*/]\s*"] (time (dotimes [_ 1000] (take 1 (split-keep-delim s pat)))))
"Elapsed time: 26.013445 msecs"
nil
> (let [s (apply str (take 100 (cycle "-1 + 2 - 3/4"))) pat #"\s*[+\-*/]\s*"] (time (dotimes [_ 1000] (take 3 (split-keep-delim s pat)))))
"Elapsed time: 28.754948 msecs"
nil
> (let [s (apply str (take 100 (cycle "-1 + 2 - 3/4"))) pat #"\s*[+\-*/]\s*"] (time (dotimes [_ 1000] (take 300 (split-keep-delim s pat)))))
"Elapsed time: 28.388654 msecs"
nil
Be Sociable, Share!

Leave a Reply


seven − = 3

Hand-written markup language parser in ClojureScript

Broadly speaking, there are two ways to write a parser:

Obviously, using parser generators usually allows for a faster time-to-market. I wanted, however, to write a parser by hand for these reasons:

  • To see how hard it is in ClojureScript
  • No external dependencies
  • No need to have a separate compilation step
  • Informal, i.e. no grammars involved

Markup language

I’m going to develop a parser for a markup language with the following rules:

  • Header
= Header 1
== Header 2
=== Header 3
  • List
- Unordered 11
  # Ordered 21
  # Ordered 22
- Unordered 12
  • Table
|>header1|header2|
|cell11|cell12|
|cell21|cell22|
  • Code with language specification
!clojure
(def a 1)
!
  • Inline code
Some `inline code` here
  • Bold, italics
*bold*
_italics_
_italics and *bold italics* words_
  • Horizontal line
---
  • Manual and automatic links
[http://example.com/|my http site]

http://example.com/

[ftp://example.com/|my ftp site]
ftp://example.com/

[ssh://example.com/|ssh link]
ssh://example.com/

[mailto:me@example.com|my mail]
mailto:me@example.com
  • Image
@/favicon.png|My favorite icon

Parser

The goals are:

  • Make sure all cases are covered by tests
  • Make it work for usual cases
  • Error handling is not the focus
  • Make a parser that produces an AST
  • Have an AST->HTML output producer

I’ll do it in several steps:

  • Make the line-based parser
  • Enhance it to combine blocks
  • Make the HTML output functionality

I did some research on this and I think the most similar methodology is one described in this paper: A Nanopass Framework for Compiler Education.

In this post, I’ll focus on the first part – parsing all of the above functionality on a per-line basis.

Individual line tests and parsers

Here are line-restricted parsers for each of the blocks:

Header

  • Test:
(deftest parse-header-line-test
  (is (= {:type :header
          :level 1
          :child {:type :unprc
                  :text "header"}}
         (parse-header-line \= "= header")))
  (is (= {:type :header
          :level 3
          :child {:type :unprc
                  :text "header"}}
         (parse-header-line \= "=== header"))))
  • Implementation
(defn parse-header-line [first-imp-ch line]
  (let [level (count (take-while #(= \= %1) line))]
    {:type :header
     :level level
     :child {:type :unprc
             :text (triml (.substring line level))}}))

Horizontal line

  • Test
(deftest parse-hor-line-line-test
  (is (= {:type :hor-line}
         (parse-hor-line-line \- "---"))))
  • Implementation
(defn parse-hor-line-line [first-imp-ch line]
  {:type :hor-line})

List item

  • Test
(deftest parse-list-line-test
  (is (= {:type :list-item
          :sub-type :unord
          :indent 0
          :child {:type :unprc
                  :text "unord"}}
         (parse-list-line \- "- unord")))
  (is (= {:type :list-item
          :sub-type :unord
          :indent 1
          :child {:type :unprc
                  :text "unord"}}
         (parse-list-line \- "  - unord")))
  (is (= {:type :list-item
          :sub-type :ord
          :indent 0
          :child {:type :unprc
                  :text "ord"}}
         (parse-list-line \# "# ord")))
  (is (= {:type :list-item
          :sub-type :ord
          :indent 2
          :child {:type :unprc
                  :text "ord"}}
         (parse-list-line \# "    # ord"))))
  • Implementation
[(defn parse-list-line [first-imp-ch line]
  {:type :list-item
   :sub-type (case first-imp-ch
               \- :unord
               \# :ord)
   :indent (/ (.indexOf line (int first-imp-ch)) 2)
   :child {:type :unprc
           :text (triml (.substring (triml line) 1))}})

Table row

  • Test
(deftest parse-table-line-test
  (is (= {:type :table-row
          :sub-type :data
          :cols [{:type :unprc
                  :text "c1"}
                 {:type :unprc
                  :text "c2"}]}
       (parse-table-line \| "|c1|c2|")))
  (is (= {:type :table-row
          :sub-type :header
          :cols [{:type :unprc
                  :text "h1"}
                 {:type :unprc
                  :text "h2"}]}
       (parse-table-line \| "|>h1|h2|"))))
  • Implementation
[(defn parse-table-line [first-imp-ch line]
  {:type :table-row
   :sub-type (case (second (triml line))
               \> :header
               :data)
   :cols (map (fn 1
                {:type :unprc
                 :text text})
              (split (replace-first line #"^\|>?" "") #"\|"))})

Code rim

  • Test
(deftest parse-code-line-test
  (is (= {:type :code-rim
          :language ""}
         (parse-code-line \! "!")))
  (is (= {:type :code-rim
          :language "clojure"}
         (parse-code-line \! "! clojure"))))
  • Implementation
(defn parse-code-line [first-imp-ch line]
  {:type :code-rim
   :language (triml (.substring line 1))})

Image

  • Test
(deftest parse-image-line-test
  (is (let [line "@/favicon.png"]
        (= {:type :image
            :href "/favicon.png"
            :title "/favicon.png"}
           (parse-image-line (first line) line))))
  (is (let [line "@/favicon.png|My favorite png"]
        (= {:type :image
            :href "/favicon.png"
            :title "My favorite png"}
           (parse-image-line (first line) line)))))
  • Implementation
(defn parse-image-line [first-imp-ch line]
  (let [[href title] (split (.substring line 1) #"\|")
        good-title (if (blank? title) href title)]
    {:type :image
     :href href
     :title good-title}))

These are all quite readable.

Top level test

Here’s a top level test:

(deftest parse-test
  (let [lines ["= Header _italic *bold*_"
               "== Header 2"
               "---"
               "- Item 11"
               "  # Item `21`"
               "  # Item *22*"
               "- Item 12"
               "|>header1|header2|"
               "|c11|*c12*|"
               "|_c21_|*c _22_*|"
               "!clojure"
               "(def a 1)"
               "!"
               "http http://example.com/ _my website_"
               "mailto:me@example.com"
               "@/favicon.png|My favorite icon"]
        text (join "\n" lines)]
    (let [exp [{:type :header
                :level 1
                :child {:type :unprc
                        :text "Header _italic *bold*_"}}
               {:type :header
                :level 2
                :child {:type :unprc
                        :text "Header 2"}}
               {:type :hor-line}
               {:type :list-item
                :sub-type :unord
                :indent 0
                :child {:type :unprc
                        :text "Item 11"}}
               {:type :list-item
                :sub-type :ord
                :indent 1
                :child {:type :unprc
                        :text "Item `21`"}}
               {:type :list-item
                :sub-type :ord
                :indent 1
                :child {:type :unprc
                        :text "Item *22*"}}
               {:type :list-item
                :sub-type :unord
                :indent 0
                :child {:type :unprc
                        :text "Item 12"}}
               {:type :table-row
                :sub-type :header
                :cols [{:type :unprc
                        :text "header1"}
                       {:type :unprc
                        :text "header2"}]}
               {:type :table-row
                :sub-type :data
                :cols [{:type :unprc
                        :text "c11"}
                       {:type :unprc
                        :text "*c12*"}]}
               {:type :table-row
                :sub-type :data
                :cols [{:type :unprc
                        :text "_c21_"}
                       {:type :unprc
                        :text "*c _22_*"}]}
               {:type :code-rim
                :language "clojure"}
               {:type :unprc
                :text "(def a 1)"}
               {:type :code-rim
                :language ""}
               {:type :unprc
                :text "http http://example.com/ _my website_"}
               {:type :unprc
                :text "mailto:me@example.com"}
               {:type :image
                :href "/favicon.png"
                :title "My favorite icon"}]
          act (parse text)
          pairs (map vector exp act)]
      (doseq [[exp act] pairs]
        (is (= exp act))))))

It covers a lot of the above in one shot. You can see that so far it doesn’t work on some items, which are left as :unprc until the code for them is ready.

Top level parser

This is a top level parser:

(defn parse-line [line]
  (let [trimmed (triml line)
        first-imp-ch (first trimmed)]
    (case first-imp-ch
      \= (parse-header-line first-imp-ch line)
      (\- \#) (if (= "---" line)
                (parse-hor-line-line first-imp-ch line)
                (parse-list-line first-imp-ch line))
      \| (parse-table-line first-imp-ch line)
      \! (parse-code-line first-imp-ch line)
      \@ (parse-image-line first-imp-ch line)
      {:type :unprc
       :text line})))

(defn parse-lines [lines]
  (for [line lines]
    (parse-line line)))

(defn root-parser [lines]
  (parse-lines lines))

(defn parse [str]
  (root-parser (split str #"\n")))

Basically it will:

  • Split the given text into lines
  • Process each line one by one
  • The parse-line function is a router that routes to individual parsers for each of the above categories

Each line is substituted by a node describing it’s type:

  • Header
  • List item
  • Table row
  • Code rim (i.e. start / end of the code block)
  • Image
  • Unprocessed yet (:unprc symbol)

where each of these are parsed separately by the functions mentioned previously.

Conclusion and next steps

At the end, the code is a bit spread out (mostly tests), but I’m happy about the way it turned out.

With the above, the grand test passes fine, so all is good so far. Next time I’ll work on gluing these together, so e.g. a number of list items forms a list at the end and similar for other multi-line blocks. Also, I need to implement the things that are contained within line (such as bold and italic markup).

Be Sociable, Share!

Leave a Reply


3 + seven =

Maze generator in ClojureScript

Tags: clojurescript, maze generation

Here’s a simple maze generation program in ClojureScript. I’m developing this using a relatively standard stack for ClojureScript development:

Maze generator

The generator is basically a depth-first graph traversal, which generates a random spanning tree out of a maze that’s looked at as a graph. I’ll dissect the code in smaller chunks.

(ns com.icyrock.clojurescript.prb.maze-gen
  (:require-macros [dommy.macros :refer [sel1]])
  (:require 1]
            [dommy.core :as dommy]))

Standard ns declaration with a couple of requires.

(def board-dim {:h 24 :w 48})
(def doors (atom #{}))
(def visited-rooms (atom #{}))

Define:

  • The board dimensions (:h and :w stand for height and width, respectively)
  • Set of doors
  • Set of visited rooms
(defn is-door [pt1 pt2]
  (let [curr-doors @doors]
    (or (contains? curr-doors [pt1 pt2])
        (contains? curr-doors [pt2 pt1]))))

(defn set-door [pt1 pt2]
  (swap! doors conj [pt1 pt2]))

(defn visit-room [room]
  (swap! visited-rooms conj room))

A few helper functions:

  • The first determines whether there’s a door between two points / rooms in the maze
  • The second actually sets the doors there (i.e. connects the two rooms)
  • The third marks the room visited, so we don’t visit it twice when traversing
(defn pending-rooms [[row col]]
  (remove nil?
          (for [[rd cd] [[-1 0] [0 1] [1 0] [0 -1]]]
            (let [trow (+ row rd)
                  tcol (+ col cd)
                  room [trow tcol]]
              (when (and (<= 0 trow)
                         (<= 0 tcol)
                         (< trow (:h board-dim))
                         (< tcol (:w board-dim))
                         (not (@visited-rooms room)))
                room)))))

This one is used to determine which way we can go. Given any room (defined as [row col] point of a maze), it will try the four possible directions clockwise ([-1 0] [0 1] [1 0] [0 -1]) – i.e.:

  • Previous row (direction up)
  • Next column (direction right)
  • Next row (direction bottom)
  • Previous column (direction left)

For each of these rooms, it will make sure each of them is not:

  • Out of the bounds of the maze (the first four checks in the and call)
  • Already visited

It will collect all the rooms using for, then remove all that are nil (meaning they do not satisfy the above conditions).

(def maze-stack (atom []))

(defn push-maze-stack [pt]
  (swap! maze-stack conj pt))

(defn pop-maze-stack []
  (let [val @maze-stack]
    (reset! maze-stack (rest val))
    (first val)))

This piece defines:

  • The maze stack atom (i.e. the stack of rooms visited used for depth-first search)
  • Function to push a room to the stack
  • Function to pop the room off the stack
(defn start-building-maze [start-room]
  (reset! doors #{})
  (reset! maze-stack [start-room])
  (reset! visited-rooms #{start-room}))

This one resets all the state to start a new maze building cycle.

(defn maze-building-step []
  (loop []
    (when-let [room (first @maze-stack)]
      (let [pending (pending-rooms room)]
        (if (empty? pending)
          (do
            (pop-maze-stack)
            (recur))
          (let [shuffled (shuffle pending)
                next-room (first shuffled)]
            (push-maze-stack next-room)
            (visit-room next-room)
            (set-door room next-room)))))))

Guts of the maze building:

  • Get the top room from the stack, if there are any
  • Get the pending rooms (all that can be visited given the constraints, as provided above) from that room
  • If no pending rooms, discard this room and recur into the loop
  • Otherwise, shuffle the pending rooms (to randomize the maze), pick the next room, push it to the stack, mark it visited and make a door between the current room and that one
(def content (sel1 :#content))

(defn make-gui []
  (dommy/replace-contents! content [:pre {:id "maze"}]))

(def doors-to-char 
  (into cljs.core.PersistentHashMap/EMPTY
        {[false false false false]  "⬞"
         [true  false false false]  "╵"
         [false true  false false]  "╶"
         [true  true  false false]  "└"
         [false false true  false]  "╷"
         [true  false true  false]  "│"
         [false true  true  false]  "┌"
         [true  true  true  false]  "├"
         [false false false true ]  "╴"
         [true  false false true ]  "┘"
         [false true  false true ] "─"
         [true  true  false true ] "┴"
         [false false true  true ] "┐"
         [true  false true  true ] "┤"
         [false true  true  true ] "┬"
         [true  true  true  true ] "┼"}))

(defn board-str []
  (join "\n"
        (for [row (range (:h board-dim))]
          (join
           (for [col (range (:w board-dim))]
             (let [top-door (is-door [row col] [(dec row) col])
                   right-door (is-door [row col] [row (inc col)])
                   bottom-door (is-door [row col] [(inc row) col])
                   left-door (is-door [row col] [row (dec col)])]
               (doors-to-char [top-door right-door bottom-door left-door])))))))

(defn print-board []
  (dommy/replace! (sel1 :#maze) [:pre {:id "maze"} (board-str)]))

GUI-related code:

  • content is the parent div that will contain the maze
  • make-gui will create a pre HTML element with ID maze and put it inside the above content div

I’m actually using this pre element to output the Unicode string representation of the maze. Thus the doors-to-char map used for character lookup. It’s build like this to speed it up – see this StackOverflow question and David’s answer for explanation.

The lookup map is simple – the key is a vector of [top-door right-door bottom-door left-door], where each of the items are true / false monikers signifying whether the door is present or not, and the value is an Unicode character representing the correct room “image” given the possible exits out of that room.

  • board-str is actually making the string representation by traversing all rows, then all cells within each of the rows and getting the correct character to represent the door
  • print-board is just a helper function to output this to the pre element we created in make-gui
(defn run-maze-gen []
  (let [runs 50]
    (if (not-any? nil? (repeatedly runs maze-building-step))
      (do
        (print-board)
        (js/setTimeout run-maze-gen 50))
      (do (print-board)
          (dommy/append! content [:pre "Finished"])))))

(defn main []
  (make-gui)
  (start-building-maze [(quot (:h board-dim) 2)
                        (quot (:w board-dim) 2)])
  (run-maze-gen))

Top-level functions:

  • run-maze-gen runs the maze building step in batches of 50 (let [runs 50]), prints the board after each, then sets a timer to 50ms to run these again until the whole maze is generated
  • main makes the GUI, resets the maze and sets the starting room to the middle of the maze (parameters to start-building-maze), then calls run-maze-gen to actually start building the maze.

The result is something like this:

sample-maze

Note that maze corridors here are actually the lines, not the empty space between them, which I guess is more often how a maze is represented.

Be Sociable, Share!

Leave a Reply


3 × = twenty seven

ClojureScript development environment

Here’s what you need to set up a pretty nice ClojureScript development environment.

Editor

I’m using Emacs. I actually have it set up through Clojure before I started playing with ClojureScript. There’s a tutorial on the main site:

  • https://github.com/clojure/clojurescript/wiki/Emacs-%26-inferior-lisp-mode

where you can also find tutorials for other editors:

  • https://github.com/clojure/clojurescript/wiki#tools

Lein + lein-cljsbuild

Install Leiningen, make a new project:

$ lein new com.icyrock.clojurescript
Generating a project called com.icyrock.clojurescript based on the 'default' template.
To see other templates (app, lein plugin, etc), try `lein help new`.

and add lein-cljsbuild plugin to your project.clj:

(defproject com.icyrock.clojurescript "0.1.0-SNAPSHOT"
  :description "FIXME: write description"
  :url "http://example.com/FIXME"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.4.0"]]
  :plugins [[lein-cljsbuild "0.3.0"]]
  :cljsbuild {:builds [{:source-paths ["src-cljs"]
                        :compiler {:output-to "resources/public/js/cljsbuild-main.js"
                                   :optimizations :whitespace
                                   :pretty-print true}}]})

The above has some default configuration for the plugin:

  • The source folder for ClojureScript files is src-cljs
  • Turn some basic optimization and pretty-print the output
  • The output goes to resources/public/js/cljsbuild-main.js

Usually, you’d run cljsbuild in the background with:

$ lein cljsbuild auto

which will watch for the files in the source path for changes and then perform the necessary steps (compile, optimize, bundle) to get you the target .js file.

Ring

Ring is a Web server. It’s very nice for development, as it compiles the Clojure files on the fly. There’s also lein-ring which is a helper plugin to simplify usage when used with lein. Here’s the expanded project.clj:


(defproject com.icyrock.clojurescript "0.1.0-SNAPSHOT"
  :description "icyrock.com ClojureScript"
  :url "http://icyrock.com/clojure-script"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.5.1"]
                 [ring/ring-core "1.1.8"]]
  :plugins [[lein-cljsbuild "0.3.0"]
            [lein-ring "0.8.3"]]
  :ring {:handler com.icyrock.clojure.ring-main/handler
         :port 3000}
  :cljsbuild {:builds [{:source-paths ["src-cljs"]
                        :compiler {:output-to "resources/public/js/cljsbuild-main.js"
                                   :optimizations :whitespace
                                   :pretty-print true}}]})

As per Ring’s Getting Started, create a sample handler in src/com/icyrock/clojure/ring_main.clj:

(ns com.icyrock.clojure.ring-main)

(defn handler [request]
  {:status 200
   :headers {"Content-Type" "text/html"}
   :body "Welcome to com.icyrock.clojure.ring-main" })

You can run the server now with:

$ lein ring server
2013-04-15 23:16:21.815:INFO:oejs.Server:jetty-7.6.1.v20120215
2013-04-15 23:16:21.966:INFO:oejs.AbstractConnector:Started SelectChannelConnector@0.0.0.0:3000
Started server on port 3000

which will open your browser. You can use lein ring server-headless if you don’t want it to open your browser.

Compojure

The next step is to add some file serving to our Web server. Compojure allows for that. It’s a Clojure routing DSL that sits on top of Ring. Add this as a dependency and change the ring handler:

(defproject com.icyrock.clojurescript "0.1.0-SNAPSHOT"
  :description "icyrock.com ClojureScript"
  :url "http://icyrock.com/clojure-script"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.5.1"]
                 [ring/ring-core "1.1.8"]
                 [compojure "1.1.5"]]
  :plugins [[lein-cljsbuild "0.3.0"]
            [lein-ring "0.8.3"]]
  :ring {:handler com.icyrock.clojure.compojure-main/app
         :port 3000}
  :cljsbuild {:builds [{:source-paths ["src-cljs"]
                        :compiler {:output-to "resources/public/js/cljsbuild-main.js"
                                   :optimizations :whitespace
                                   :pretty-print true}}]})

then make a site router (see the routes.clj from the example project):

(ns com.icyrock.clojure.compojure-main
  (:require [compojure.core :refer :all]
            [hiccup.middleware :refer (wrap-base-url)]
            [compojure.route :as route]
            [compojure.handler :as handler]
            [compojure.response :as response]))

(defroutes main-routes
  (GET "/" [] "Welcome to com.icyrock.clojure.compojure-main")
  (route/resources "/")
  (route/not-found "Page not found"))

(def app
  (-> (handler/site main-routes)
      (wrap-base-url)))

The important part above is the (route/resources "/"). This allows for static resources to be served by ring. The default is to serve from the (first) public on the classpath. Lein accepts the parameter called :resources-path, which (as per this) defaults to resources. Thus, if we create a folder resources/public, the above would make ring serve all files from that folder under the root (i.e. /) of the site.

As an example:

$ mkdir -p resources/public
$ echo "I'm a resource" > resources/public/a-res.txt

Now do lein ring server and browse to http://localhost:3000/a-res.txt – you’ll get I'm a resource text, as expected.

Auto-recompiling ClojureScript

Let’s add:

  • jayq, which is a jQuery wrapper for ClojureScript
  • jQuery externs that allow Google Closure to recognize and not obfuscate jQuery calls (see this)
  • dommy, a small and fast ClojureScript templating engine

to our project.clj:

(defproject com.icyrock.clojurescript "0.1.0-SNAPSHOT"
  :description "icyrock.com ClojureScript"
  :url "http://icyrock.com/clojure-script"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.5.1"]
                 [ring/ring-core "1.1.8"]
                 [compojure "1.1.5"]
                 [hiccup "1.0.3"]
                 [jayq "2.3.0"]
                 [prismatic/dommy "0.1.0"]]
  :plugins [[lein-cljsbuild "0.3.0"]
            [lein-ring "0.8.3"]]
  :ring {:handler com.icyrock.clojure.compojure-main/app
         :port 3000}
  :cljsbuild {:builds [{:source-paths ["src-cljs"]
                        :compiler {:output-to "resources/public/js/cljsbuild-main.js"
                                   :externs ["externs/jquery-1.9.1.js"]
                                   :optimizations :whitespace
                                   :pretty-print true}}]})

Now we can make a sample ClojureScript file. All these go to src-cljs. This file is within that folder under com/icyrock/clojurescript/prb/hello_world.cljs and the contents are simple:

(ns com.icyrock.clojurescript.prb.hello-world
    (:require [jayq.core :as $]
              [dommy.core :as dommy]
              [dommy.template :as tpl]))

(defn hello-world []
  (dommy/append! js/document.body [:h1 "Hello, world!"])
  (let [body ($/$ js/document.body)
        para (-> ($/$ "<p>")
                 ($/text "This is a sample paragraph"))
        link (tpl/node [:a {:href "http://icyrock.com/"} "icyrock.com"])]
    ($/append body para)
    ($/append body link)))

This is the main file that will be used to call child functions, just for separation:

(ns com.icyrock.clojurescript.main
  (:require [jayq.core :as $]
            [com.icyrock.clojurescript.prb.hello-world :refer [hello-world]]))

($/$ hello-world)

Let’s run lein-cljsbuild in another terminal in auto-mode:

$ lein cljsbuild auto
Compiling "resources/public/js/cljsbuild-main.js" from ["src-cljs"]...
Successfully compiled "resources/public/js/cljsbuild-main.js" in 12.54909577 seconds.

Add a simple HTML to resources/public/main.htm:

<!doctype html>
<html lang="en">
  <head>
    <meta charset="utf-8" />
    <title>com.icyrock.clojurescript.main</title>
    <script src="lib/jquery-1.9.1.min.js"></script>
    <script src="js/cljsbuild-main.js"></script>
  </head>
  <body>
  </body>
</html>

Download the required files as needed:

Browse to http://localhost:3000/main.htm and you’ll see something like this:

hello_world

Note that further updates to the .cljs files are automatically recompiled by Google Closure compiler, that is used by ClojureScript through lein-cljsbuild

Be Sociable, Share!

2 Responses to “ClojureScript development environment”

JimBeam on June 18th, 2013 02:06:

Great tutorial! Thx a lot

[WORDPRESS HASHCASH] The poster sent us ‘0 which is not a hashcash value.


icyrock.com on June 22nd, 2013 09:24:

Thanks JimBeam, glad you liked it!


Leave a Reply


five − = 1

Maze display app for Always Turn Left

Last time, I presented a solution for Always Turn Left, a Google Code Jam problem. Given that their large dataset was quite big (up to 10k moves), I thought: “It would be interesting to see what mazes those moves produce”. So I set to write (in Clojure, of course) a maze-display app (using Seesaw, of course). Here’s what came out of that.

(ns com.icyrock.clojure.codejam.maze-display
  (:use clojure.java.io
        flatland.ordered.map
        seesaw.border
        seesaw.chooser
        seesaw.color
        seesaw.core
        seesaw.graphics
        seesaw.mig)
  (:require [seesaw.bind :as ssb]))

First, declare a lot of things I’m to use later. Most Seesaw and one thing from here, which is a Clojure implementation of ordered sets / maps which I wanted to try out.

(def state
  {:frame (atom nil)
   :file (atom nil)
   :cases (atom nil)
   :curr-case (atom nil)
   :maze (atom nil)})

Main state – contains:

  • Main frame
  • Currently selected case-file
  • Loaded cases themselves
  • Currently selected case
  • Maze bound to the currently selected case
(def room-width 16)
(def room-height 16)

Default room size when drawn, in pixels.

(def default-style
  (style
   :foreground "#000000"
   :stroke (stroke :width 3 :cap :round)))

Default style to use when drawing walls. It’s a black, 3-pixel wide line, with rounded edges.

(defn draw-wall [g w h wall]
  (case wall
    :n (draw g (line 0 0 w 0) default-style)
    :s (draw g (line 0 h w h) default-style)
    :w (draw g (line 0 0 0 h) default-style)
    :e (draw g (line w 0 w h) default-style)))

This draws a wall. Given that translation is used below, the north-west corner of the room is always at (0, 0), so the above is easy to understand given the case keys (:n for north, :s for south, :w for west and :e for east).

(defn draw-room [g w h walls-desc]
  (let [walls (case walls-desc
                \1 #{   :s :w :e}
                \2 #{:n    :w :e}
                \3 #{      :w :e}
                \4 #{:n :s    :e}
                \5 #{   :s    :e}
                \6 #{:n       :e}
                \7 #{         :e}
                \8 #{:n :s :w   }
                \9 #{   :s :w   }
                \a #{:n    :w   }
                \b #{      :w   }
                \c #{:n :s      }
                \d #{   :s      }
                \e #{:n         }
                \f #{           }
                )]
    (doseq [wall walls]
      (push g
            (draw-wall g w h wall)))))

The room is a set of cases to decipher the letter as set of walls for that room, as given in the problem description and then draw each of these walls.

(defn paint-maze 1
  (try
    (let [w room-width
          h room-height
          maze @(state :maze)]
      (when maze
        (anti-alias g)
        (translate g w h)
        (doseq [row maze]
          (push g
                (doseq [room row]
                  (draw-room g w h room)
                  (translate g w 0)))
          (translate g 0 h))))
    (catch Exception e
      (invoke-later (alert e))
      (println e))))

Main paint function:

  • Check if maze is valid (i.e. user has selected a case)
  • Turn on anit-aliasing
  • Go through the rows of the maze
  • Translate to the position of the current room
  • Draw it
(defn content-panel []
  (mig-panel
   :constraints ["fill" "[|grow]"]
   :items [[(button :id :load
                    :text "Load file...") ""]
           [(text :id :file-name) "growx, wrap"]
           [(scrollable (listbox :id :cases)
                        :border (line-border)) "grow"]
           [(let [s (scrollable (canvas :id :maze-pict
                                        :background "#ffffff"
                                        :paint paint-maze)
                                :border (line-border))]
              (-> s (.getHorizontalScrollBar) (.setUnitIncrement (* 3 room-width)))
              (-> s (.getVerticalScrollBar) (.setUnitIncrement (* 3 room-height)))
              s) "grow, push"]]))

Main window contents:

  • “Load” button
  • Current file name
  • List box for cases
  • Canvas for the maze

Uses MigLayout, of course.

(defn split-cases [acc line]
  (let [case (re-find #"^Case #\d+:$" line)]
    (if case
      ;; Found case start line
      (assoc acc
        :curr-case case
        :cases (assoc (acc :cases) case []))
      ;; Continuation of the current case (maze definition)
      (let [cases (acc :cases)
            curr-case (acc :curr-case)
            curr-maze (cases curr-case)
            new-maze (conj curr-maze line)
            new-cases (assoc cases curr-case new-maze)]
        (assoc acc
          :cases new-cases)))))

When loading, split the cases one by one, taking into account maze description has two kinds of lines:

  • Case start
  • Maze lines for the current case
(defn load-cases [file]
  (with-open [r (reader file)]
    (let [lines (reduce conj [] (line-seq r))
          {:keys [cases]} (reduce split-cases {:cases (ordered-map)} lines)]
      (reset! (state :cases) cases))))

Case loader function:

  • Use reader to read from the file
  • Get the lines
  • Reduce using previous split-cases function
(defn load [e]
  (let [frame (to-frame e)]
    (choose-file frame
                 :type :open
                 :success-fn (fn [fc file] (reset! (state :file) file)))))

Just shows the standard Java file chooser to pick the file.

(defn set-listeners [frame]
  (listen (select frame [:#load])
            :action load))

(defn set-bindings [frame]
  ;; File binding
  (ssb/bind
   (state :file)
   (ssb/tee
    (ssb/b-do* load-cases)
    (ssb/bind
     (ssb/transform #(.getPath %))
     (select frame [:#file-name]))))
  ;; Cases binding
  (ssb/bind
   (state :cases)
   (ssb/transform #(keys %))
   (ssb/tee
    (ssb/property (select frame [:#cases]) :model)
    (ssb/b-do* (fn [v] (selection! (select frame [:#cases]) (first v))))))
  ;; Case selection binding
  (ssb/bind
   (ssb/selection (select frame [:#cases]))
   (ssb/b-do* #(reset! (state :curr-case) %)))
  ;; Selected case binding
  (ssb/bind
   (state :curr-case)
   (ssb/transform #(@(state :cases) %))
   (ssb/b-do* #(reset! (state :maze) %)))
  ;; Maze binding
  (ssb/bind
   (state :maze)
   (ssb/b-do* (fn [maze] (let [canvas (select frame [:#maze-pict])
                               cw (* room-width (+ 2 (count (first maze))))
                               ch (* room-height (+ 2 (count maze)))]
                           (config! canvas :preferred-size [cw :by ch])
                           (.revalidate canvas)
                           (repaint! canvas))))))

These two set up the listeners (only one in this case – button click) and bindings which nicely describe the state machine for this simple app:

  • When file is selected, load the cases and display the file name
  • When cases were loaded, populate the list box with the case map description
  • When a case is selected, update the current case
  • When the current case changes, update the maze
  • When the maze is updated, draw it
(defn maze-display []
  (native!)
  (let [f (frame :title *ns*
                 :width 1200 :height 700
                 :on-close :dispose
                 :visible? true
                 :content (content-panel))]
    (.setLocation f (java.awt.Point. 100 100))
    (reset! (state :frame) f)
    (set-listeners f)
    (set-bindings f)))

Main function:

  • Make the frame
  • Set its location
  • Set the listeners and bindings

The final result looks like this:

maze-display-app

Be Sociable, Share!

Leave a Reply


− three = 5

Google Code Jam – Always Turn Left in Clojure

Last time I did the first practice problem (Alien Numbers). Now it’s time to do the second one – Always Turn Left.

Utilities

Utilities pretty much stayed the same – the only change is to the write-output function that now has three parameters – the last was added to allow for multi-line case output. This one is needed for this problem, while it was a series of one-liners in Alien Numbers. Read about these more in the Alien Numbers post, but here they are again for completeness:

(ns com.icyrock.clojure.codejam.utils
  (:use clojure.java.io))

(def base-res "com/icyrock/clojure/codejam/")

(defn read-case-lines [case-name]
  (let [res (resource (str base-res case-name))]
    (with-open [rdr (reader res)]
      (doall (line-seq rdr)))))
  
(defn read-cases [case-name]
  (let [lines (read-case-lines (str case-name ".in"))
        case-count (Integer/parseInt (first lines))
        cases (doall (rest lines))]
    {:case-count case-count
     :cases cases}))
  
(defn write-output [output case-name multi-line]
  (let [in-res (resource (str base-res case-name ".in"))
        in-file-name (.getFile in-res)
        out-file-name (clojure.string/replace in-file-name #".in$" ".out")]
    (with-open [wr (writer out-file-name)] 
      (doseq [[case-no case-out] (map vector (range 1 (inc (count output))) output)]
        (.write wr (str "Case #" case-no ":"
                        (if multi-line "\n" " ")
                        case-out "\n"))))))

Tests

Some tests to start with:

(ns com.icyrock.clojure.codejam.cj2008pp_test
  (:use 1)
  (:use [com.icyrock.clojure.codejam.cj2008pp]))

;; Always turn left
(deftest make-maze-test
  (is (= (make-maze
          {[0 0] #{   :s    :e}
           [0 1] #{      :w :e}
           [0 2] #{:n    :w   }
           [1 0] #{:n :s      }
           [1 1] #{         :e}
           [1 2] #{   :s :w   }
           [2 0] #{:n       :e}
           [2 1] #{      :w :e}
           [2 2] #{:n :s :w   }
           [3 0] #{   :s :w :e}
           [3 1] #{      :w   }
           [3 2] #{:n :s      }
           [4 0] #{:n       :e}
           [4 1] #{      :w :e}
           [4 2] #{:n    :w   }}
          0 0 4 2)
         '("ac5" "386" "9c7" "e43" "9c5"))))

(deftest always-turn-left-case-test
  (is (= (always-turn-left-case "WRWWLWWLWWLWLWRRWRWWWRWWRWLW" "WWRRWLWLWWLWWLWWRWWRWWLW")
         '("ac5" "386" "9c7" "e43" "9c5")))
  (is (= (always-turn-left-case "WW" "WW")
         '("3")))
  (is (= (always-turn-left-case "WWLW" "WLWRRWWW")
         '("3" "b" "1")))
  (is (= (always-turn-left-case "WWWRRWLW" "WLWW")
         '("3" "7" "1")))
  (is (= (always-turn-left-case "WWRWWLW" "WWRWWLW")
         '("ac7" "bc5")))
  (is (= (always-turn-left-case "WWRWRWW" "WWLWLWW")
         '("33" "95"))))

The first test is for the make-maze function. This one is used to generate the maze given the maze map, see below. Keys of the map are [row column] points and values are sets of directions (:n, :s, :w, :e, representing north, south, west and east, respectively).

As for the actual problem tests (always-turn-left-case-test) – the first two tests are from the problem page, the second of which covers an exit on the south. The next four of these cover east, west, south and north exits, in that order. I repeated the south exit as the one given on the problem page was rather trivial. Also, this example is also a “palindrome” maze – i.e. you walk in the same way (given the entrance-to-exit and exit-to-entrance descriptions) from entrance to exit and on the way back.

Solution overview

From my perspective, this problem yields itself quite nicely to the reduce function. That is – we start from the empty maze, we walk as given by the entrance-to-exit path description and improve our knowledge about the maze on the way. I chose to record the following information:

  • Current row index
  • Current column index
  • Minimal row index
  • Minimal column index
  • Maximal row index
  • Maximal column index
  • Current direction
  • The map of the maze, using points ([row column] vectors) as keys

After that, do the same in the opposite direction, updating the same set of information as above.

The first part above gives the maze map and the bounding box of the maze (min / max row / column index). The last thing left is to reconstruct the maze, which is rather trivial given that information.

Clojure solution

Here’s the actual code, explained step by step:

;; Always turn left
(defn opposite-dir [dir]
  ({:n :s, :e :w, :s :n, :w :e} dir))

This is a helper function to get the opposite direction of the one we are currently pointing toward.

(defn maze-move [[cr cc minr minc maxr maxc dir maze-map] cmd]
  (case cmd
    \W (let [nr (+ cr ({:n -1, :e 0, :s 1, :w 0} dir))
             nc (+ cc ({:n 0, :e 1, :s 0, :w -1} dir))
             croom (or (maze-map [cr cc]) #{})
             nroom (or (maze-map [nr nc]) #{})
             new-croom (conj croom dir)
             new-nroom (conj nroom (opposite-dir dir))
             new-maze-map (assoc maze-map [cr cc] new-croom [nr nc] new-nroom)]
         [nr nc
          (min minr nr) (min minc nc)
          (max maxr nr) (max maxc nc)
          dir new-maze-map])
    \L [cr cc minr minc maxr maxc
        ({:n :w, :e :n, :s :e, :w :s} dir)
        maze-map]
    \R [cr cc minr minc maxr maxc
        ({:n :e, :e :s, :s :w, :w :n} dir)
        maze-map]))

This one actually makes the move given the current parameters and yields the next state. This is used below to reduce over the set of moves. There are three possible moves:

  • L / R – these just change the direction, without changing the position or anything else. This is done by doing the map-lookup in both cases
  • W – perform the walk. Walking has three consequences:
    • Position is changed (so nr / nc = new row and column indices are updated, also using map-lookup method)
    • Current and new rooms’ (new-croom / new-nroom) walls are updated (i.e. removed on the appropriate sides, given walking is possible) and
    • The map is updated with the new rooms
(defn make-maze [maze-map minr minc maxr maxc]
  (for [r (range minr (inc maxr))] 
    (apply str
           (for 1
             (case (maze-map [r c])
               #{:n         } "1"
               #{   :s      } "2"
               #{:n :s      } "3"
               #{      :w   } "4"
               #{:n    :w   } "5"
               #{   :s :w   } "6"
               #{:n :s :w   } "7"
               #{         :e} "8"
               #{:n       :e} "9"
               #{   :s    :e} "a"
               #{:n :s    :e} "b"
               #{      :w :e} "c"
               #{:n    :w :e} "d"
               #{   :s :w :e} "e"
               #{:n :s :w :e} "f"
               "#")))))

This is the function that generates the maze layout in the format required by the problem given the parameters output by the reduce over the given moves.

(defn always-turn-left-case [ent-to-exit exit-to-ent]
  (let [[exr exc minr minc maxr maxc dir maze-map]
        (reduce maze-move [-1 0 0 0 0 0 :s {}] ent-to-exit)
        [_ _ _ minc maxr maxc _ maze-map]
        (reduce maze-move [exr exc minr minc maxr maxc (opposite-dir dir) maze-map] exit-to-ent)
        act-minc (if (= dir :w) (inc minc) minc)
        act-maxr (if (= dir :s) (dec maxr) maxr)
        act-maxc (if (= dir :e) (dec maxc) maxc)]
    (make-maze maze-map 0 act-minc act-maxr act-maxc)))

The core of the solver:

  • Reduce from entrance to exit
  • Reduce from exit to entrance
  • Calculate the bounding box (discarding the last step, as entrance and exit are always outside of the maze)
  • Make the maze map
(defn always-turn-left []
  (let [case-names ["sample" 
                    "B-small-practice" 
                    "B-large-practice"]
        case-names-full (for [case-name case-names] 
                          (str "08pp/always-turn-left/" case-name))] 
    (time
     (doseq [case-name case-names-full] 
       (let [{:keys [case-count cases]} (read-cases case-name)
             output (for [case cases]
                      (let [[ent-to-exit exit-to-ent] (split case #" ")]
                        (join "\n" (always-turn-left-case ent-to-exit exit-to-ent))))]
         (write-output output case-name true))))))

The wrapper around the solver to run the given problems – sample is the sample given in the description and B-small-practice and B-large-practice are the files that you can download when submitting the solution. Cases are read using the utility functions and written in the expected format.

Be Sociable, Share!

One Response to “Google Code Jam – Always Turn Left in Clojure”

Maze display app for Always Turn Left « Blog Archive « icyrock.com on April 3rd, 2013 21:50:

[…] Last time, I presented a solution for Always Turn Left, a Google Code Jam problem. Given that their large dataset was quite big (up to 10k moves), I thought: “It would be interesting to see what mazes those moves produce”. So I set to write (in Clojure, of course) a maze-display app (using Seesaw, of course). Here’s what came out of that. […]


Leave a Reply


− two = 4