Tuesday, October 23, 2007

Discriminated unions in Mercury

While reading the Mercury tutorial I learned how to define discriminated unions or algebraic datatypes.

Discriminated unions provide a way to define new structured data types.

For example here's a couple of type definitions that represent very simple arithmetic expressions:


:- type expression ---> const(int)
; var(string)
; binaryOperation(expression,operator,expression).
:- type operator ---> add ; subtract.


These definitions specify arithmetic expression parts such as constants(const), variables(var), binary operations(binaryOperation), etc.

Given these definitions we can instantiate them by calling the constructors:


main(!IO) :-
X = binaryOperation(var("x"),add,const(10)),


Also we can use Mercury's unification to easily manipulate them, for example the following function writes the content of the expression to the output:


:- func operator_to_string(operator) = string.
operator_to_string(add) = "+".
operator_to_string(subtract) = "-".

:- pred write_expression(expression::in,io::di,io::uo) is det.

write_expression(const(C),!IO) :-
io.write_int(C,!IO).
write_expression(var(S),!IO) :-
io.write_string(S,!IO).
write_expression(binaryOperation(Operand1,Operator,Operand2) ,!IO) :-
write_expression(Operand1,!IO),
io.write_string(operator_to_string(Operator),!IO),
write_expression(Operand2,!IO).


Calling this predicate like this:


main(!IO) :-
X = binaryOperation(var("x"),add,const(10)),
write_expression(X,!IO).

Generates:

x+10

Sunday, October 21, 2007

Drawing the Apollonian Gasket with Common Lisp and Vecto

In this post I'm going to show a simple, yet incomplete, program to draw the Apollonian Gasket using Common Lisp and Vecto.

The Wikipedia entry for the Apollonian Gasket defines it as:


In mathematics, an Apollonian gasket or Apollonian net is a fractal generated from three circles, any two of which are tangent to one another. It is named after Greek mathematician Apollonius of Perga.


Basically the Apollonian gasket is generated by finding the 4th circle that is tangent to a given tree tangent circles and repeating the process recursively.

According to Wikipedia in order to find the position and the radius of the 4th circle we use the Descartes theorem which implies that we can apply the following formula:



Given that kn is the curvature of the circle n. The curvature can be calculated as 1/radius of the circle.

According to the Wikipedia article this formula could also be used to determine the position of the 4th circle. By multiplying each curvature value kn with a complex number that represents the position of the circle we can obtain a complex number with the position of the remaining circle.

For example given the following circles:



We can calculate the position of the 4th circle (shown in red) by using the following function:


(defun solve-equation (k1 k2 k3)
(let ((equation
(lambda (op)
(+ k1 k2 k3
(funcall op
(* 2 (sqrt (+ (* k1 k2)
(* k2 k3)
(* k1 k3) ))))))))
(values (funcall equation #'+)
(funcall equation #'-))))


This function is used to solve the equation shown above. We use values to return multiple values implied by the solution of the equation . For this post I'm only using the first solution (that's why the program is incomplete!!!).

To find the radius we can say:


* (* 50 (solve-equation 1/50 1/50 1/50))

6.4641013


To find to position we use the complex numbers provided by Common Lisp and the same function defined above:


* (defvar radius (* 50 (solve-equation 1/50 1/50 1/50)))

RADIUS
* (* radius (solve-equation (* 1/50 #c(50 50)) (* 1/50 #c(150 50)) (* 1/50 #c(100 136.6))))

#C(83.56915 65.90832)




In order to draw the picture of the Apollonian gasket we use the Vecto library which provides an easy way for drawing the picture.


(defun draw-forth-circle (pos1 r1 pos2 r2 pos3 r3)
(set-rgb-stroke 1 0 0)
(let* ((curv1 (/ 1 r1))
(curv2 (/ 1 r2))
(curv3 (/ 1 r3))
(kz1 (* curv1 pos1))
(kz2 (* curv2 pos2))
(kz3 (* curv3 pos3))
(r4 (/ 1 (solve-equation curv1 curv2 curv3)))
(pos4 (* r4 (solve-equation kz1 kz2 kz3))))
(progn
(centered-circle-path
(realpart pos4)
(imagpart pos4)
r4)
(stroke)
(list pos4 r4))))


(defun draw-apollonian-gasket (c1 r1 c2 r2 c3 r3 steps)
(if (> steps 0)
(let ((lc41 (draw-forth-circle c1 r1 c2 r2 c3 r3)))
(draw-apollonian-gasket c1 r1 c2 r2 (car lc41) (cadr lc41) (- steps 1))
(draw-apollonian-gasket c2 r2 c3 r3 (car lc41) (cadr lc41) (- steps 1))
(draw-apollonian-gasket c3 r3 c1 r1 (car lc41) (cadr lc41) (- steps 1)))))

(defun tria (file)
(with-canvas (:width 300 :height 300)
(set-rgb-stroke 1 1 1)
(set-line-width 1)
(translate 50 150)

(let* ((pos1 #c(50 50))
(r1 50)
(pos2 #c(150 50))
(r2 50)
(pos3 (complex
100
(- 50 (sqrt (- (* 100 100) (* 50 50))))))
(r3 50))

(centered-circle-path (realpart pos1) (imagpart pos1) r1)
(centered-circle-path (realpart pos2) (imagpart pos2) r2)
(centered-circle-path (realpart pos3) (imagpart pos3) r3)
(stroke)
(draw-apollonian-gasket
pos1 r1
pos2 r2
pos3 r3 5))
(save-png file)))



Running this program generates the following picture:



By applying scale and translate command we can obtain a better picture:



This program only draws one portion of the complete Apollonian Gasket, in order draw the complete picture, the other solutions of the equation shown above must be used. In future posts I'm going to try to complete the program.

Friday, October 12, 2007

The Mercury Programming Language

Mercury is a programming language that combines concepts from the logic and functional programming paradigms. In this post I'm going to show a couple of features of this language.

The hello world program looks like this:


:- module hello.


:- interface.
:- import_module io.
:- pred main(io::di, io::uo) is det.

:- implementation.

main(!IO) :-
io.write_string("Hello world from Mercury!\n",!IO).



Where module hello is a module declaration, interface declares elements exported by this module and implementation contains the code for this module.

A couple of days ago I started reading the Ralph Becket's Mercury tutorial which is a very nice tutorial for learning the language. Also there's useful documentation available in the website including a Prolog to Mercury Transition Guide .

The language allows the creation of functions, for example here's the mandatory factorial function:


:- func factorial(int) = int.
factorial(N) = (if N = 0 then 1 else N*factorial(N-1)).


But also the language allows the creation of predicates that result in multiple solutions as in Prolog. For example see the following predicate that generates the numbers from 0 to N:


:- pred numbers(int::in, int::out) is nondet.

numbers(0,0).
numbers(N,R) :-
N > 0,
(
numbers(N-1,R);
R = N
).


The pred section declares the numbers predicate. It says that the first argument is of type int and is for input and the second argument is also type int and is for output. Finally the is nondet says that this predicate may result in zero or more solutions.

The first rule says that when asking for numbers from 0, return 0. The second rule says that if asking for a number greater than 0 then return all the numbers from 0 to N-1 and then return N.

Using this predicate we can implement the following example from a previous post:

We need to write a program to find a 4-digit number such that ABCD*4 = DCBA where A,B,C,D are the digits of that number.

(Complete problem is described here)

A Mercury predicate that solves this problem looks like this:


:- pred solve_problem(list(int)::out) is nondet.

solve_problem(R) :-
numbers(9,A),
numbers(9,B),
numbers(9,C),
numbers(9,D),
A > 0,
(1000*A + 100*B + 10*C + D)*4 = (1000*D + 100*C + 10*B + A),
R = [A,B,C,D].


As with Prolog the backtracking mechanism will find the values of A,B,C and D that satisfy the constraints.

In order to use the result of this predicate the solutions predicate is used. This predicate returns a list with all the results from the specified predicate.


main(!IO) :-
solutions(solve_problem,R),
io.write(R,!IO),
io.write_string("\n",!IO).


This program writes:


[[2, 1, 7, 8]]


In future post I'll try to explore more features of this interesting language.

Saturday, October 6, 2007

Starting with Vecto

A couple of days ago I read about a library for Common Lisp called Vecto that allows the creation of graphics by describing them using Lisp functions.

Before trying this library, I noticed that it could be installed by using ASDF-Install. ASDF is like a packaging system for Common Lisp libraries and ASDF-Install is a program that let's you locate and install thouse libraries with its dependencies.

I'm using Steel Bank Common Lisp which already has ASDF and ASDF-Install integrated with it.

In order to install Vecto the only thing that I did was:

* (require :asdf)

NIL
* (require :asdf-install)
...
* (asdf-install:install :Vecto)


After answering a couple of questions It downloaded and installed Vecto with all its dependencies.


The library has nice documentation. Here's a little example I created for this post.


(require :vecto)
(defpackage #:vecto-test
(:use #:cl #:vecto))

(in-package #:vecto-test)

(defun triangle (s c)
(set-rgb-stroke (car c)
(cadr c)
(caddr c))
(set-line-width 10)
(set-line-join :round)
(move-to 0 0)
(line-to (- s) 0)
(line-to 0 (- s))
(line-to s 0)
(close-subpath)
(stroke)
)

(defun gen-values (from to step)
(if (<= from to)
(cons from
(gen-values (+ from step) to step))
nil))

(defun tria (file)
(with-canvas (:width 300 :height 300)
(mapcar #'(lambda (x)
(with-graphics-state
(translate 150 150)
(rotate (cadr x))
(triangle (car x) (list (random 1.0)
(random 1.0)
(random 1.0)))))
(mapcar #'(lambda (length angle) (list length angle))
(gen-values 10 200 30)
(gen-values 0.0 3.14 0.4)))
(save-png file)))

(tria "vecto-test-image.png")



This code generates the following image:

Friday, September 28, 2007

Ruby's yield statement

Ruby provides a yield statement that eases the creation of iterators.

The first thing I noticed was that its behavior is different from the C# yield statement (which I knew from before).

Ruby's yield statement gives control to a user specified block from the method's body. A classic example is the Fibonacci Sequence:


class NumericSequences
def fibo(limit)
i = 1
yield 1
yield 1
a = 1
b = 1
while (i < limit)
t = a
a = a + b
b = t
yield a
i = i+1
end
end
...
end



The fibo method can be used by specifying a block that will be executed each time the control reaches a yield statement. For example:


irb(main):001:0> g = NumericSequences::new
=> #<NumericSequences:0xb7cd703c>
irb(main):002:0> g.fibo(10) {|x| print "Fibonacci number: #{x}\n"}
Fibonacci number: 1
Fibonacci number: 1
Fibonacci number: 2
Fibonacci number: 3
Fibonacci number: 5
Fibonacci number: 8
Fibonacci number: 13
Fibonacci number: 21
Fibonacci number: 34
Fibonacci number: 55
Fibonacci number: 89


The following example shows the sequence of numbers of a specific row of the Pascal's triangle :



def pascal_triangle_row(n)
for k in 0..n
yield(fact(n)/(fact(k)*fact(n-k)))
end
end



This method can be used like this:


irb(main):001:0> g = NumericSequences::new
=> #<NumericSequences:0xb7c9103c>
irb(main):002:0> (0..8).each {|n| g.pascal_triangle_row(n) {|r| print "#{r} "}; print "\n"}
1
1 1
1 2 1
1 3 3 1
1 4 6 4 1
1 5 10 10 5 1
1 6 15 20 15 6 1
1 7 21 35 35 21 7 1
1 8 28 56 70 56 28 8 1
=> 0..8


Methods using the yield statement can be combined. For example in order to create the sequence of Pascal's triangle read by rows we can write:


def pascal(limit_row)
i = 0
while (i <= limit_row)
pascal_triangle_row(i){|x| yield(x)}
i = i+1
end
end


And use it the same way:


irb(main):005:0> g.pascal(10) {|x| print "#{x} "}
1 1 1 1 2 1 1 3 3 1 1 4 6 4 1 1 5 10 10 5 1 1 6 15 20 15 6 1 1 7 21 35 35 21 7 1 1 8 28 56 70 56 28 8 1 1 9 36 84 126 126 84 36 9 1 1 10 45 120 210 252 210 120 45 10 1 => nil

Tuesday, August 28, 2007

Exploring L-Systems with F# and C#

In this post I'm going to show a little program for displaying graphical representations of L-Systems using turtle graphics implemented in F#, C# and WPF.

First of all this program could be easily implemented using only F#, but for me is interesting to see the interaction between native F# type/structures and C#. Because of this, the code that performs the L-system rewrite is written in F# and the code that takes the result is written in C# and uses WPF.

The first thing we need is an implementation of the turtle. Since we want to use this library with several graphics toolkits, we define our own point type for the generated data.


#light

namespace Langexplr.Lsystems

open System
open Microsoft.FSharp.Math.Vector

type Point =
{x : int; y : int }

module Funcs = begin

let my_create_vector(i,j) =
let result = (create 2 0.0)
result.[0] <- i
result.[1] <- j
result
end

type TurtleGraphics =
class
val mutable direction : vector
val mutable position : Point

new(iX,iY) = { position = {x = iX; y = iY};
direction = Funcs.my_create_vector(1.0,0.0)}

member t.Position
with get() = t.position and
set(v) = t.position <- {x = v.x; y = v.y }

member t.Direction
with get() = t.direction and
set(v) = t.direction <- v

member t.Advance(distance : int) =
let aX = int_of_float (t.direction.[0] * float_of_int distance)
let aY = int_of_float (t.direction.[1] * float_of_int distance)
t.position <- { x = aX+t.position.x;
y = aY+t.position.y }
t.position

member t.Rotate(angle) =
let nI = (t.direction.[0] * Math.Cos(angle)) - (t.direction.[1] * Math.Sin(angle))
let nJ = (t.direction.[0] * Math.Sin(angle)) + (t.direction.[1] * Math.Cos(angle))
t.direction <- Funcs.my_create_vector(nI,nJ)


end


Now we need to represent the elements required for the L-Systems. The following elements are required:

Start point or axiomthe initial sequence of elements
Rules L-system substitution rules
AngleThe angle used when rotating the turtle
Number of iterationsThe number of times the rules will be applied to the axiom
Size of the initial segmentThe size in pixels of the line that is drawn when the turtle moves forward


Also the elements inside the rule and the axiom must be translated to turtle graphics commands. The following commands are supported:

|Draws a line forward, the size of the line inversely proportional to the iteration number
+Turn left by the specified angle
-Right left by the specified angle
[Saves the position and direction of the turtle in a stack
]Restores the position and direction of the turtle from the stack
LetterIf activated, draws a line forward


The following code shows the implementation of this:


#light

namespace Langexplr.Lsystems

open Langexplr.Lsystems

open System

type LsystemElement =
| Var of String
| Constant of String
| PipeCommand of int

type Rule =
| Rule of LsystemElement * LsystemElement list

module LsystemFuncs = begin
let rec gettingLsystemElements (str:string) i result =
if str.Length > i then
if System.Char.IsLetterOrDigit(str.[i]) then
gettingLsystemElements str (i+1) ((Var(str.[i].ToString()))::result)
else
gettingLsystemElements str (i+1) ((Constant(str.[i].ToString()))::result)
else
List.rev result
let getLsystemElements str =
gettingLsystemElements str 0 []
end


type TurtleGraphicsLsystemProcessor =
class
val start : LsystemElement list
val angle : double
val rules : Rule list
val seg_size : int
val mutable saved_positions : Point list
val mutable saved_directions : vector list
val mutable drawVariables : bool

new (a_start,a_angle,t_rules,s_size,drawVars) = {
start = a_start;
angle = (Math.PI/180.0)* a_angle;
rules = t_rules;
seg_size = s_size;
saved_positions = [];
saved_directions = [];
drawVariables = drawVars}

member lp.generate_for n current =
match n with
| 0 -> current
| o -> lp.generate_for (n - 1) (lp.apply_rules current n)

member lp.apply_rules elements iteration =
match elements with
| ((Var v)::rest) -> List.append (lp.apply_rule_for v) (lp.apply_rules rest iteration)
| ((Constant "|")::rest) -> (PipeCommand iteration)::(lp.apply_rules rest iteration)
| (e::rest) -> e::(lp.apply_rules rest iteration)
| [] -> elements

member lp.apply_rule_for v =
match (List.tryfind (fun r -> match r with
| Rule(Var vvar,_) when vvar = v -> true
| _ -> false)
lp.rules) with
| Some (Rule(_, result)) -> result
| None -> [Var v]


member lp.generate_iteration n (tg:TurtleGraphics)=
let final = lp.generate_for n lp.start
in
List.rev(lp.generate_points n final tg [tg.Position] [])

member lp.generate_points iterations elements (tg:TurtleGraphics) current lines =
match elements with
| ((Var _)::rest) ->
if (lp.drawVariables) then
tg.Advance(lp.seg_size)
lp.generate_points iterations rest tg (tg.Position::current) lines
else
lp.generate_points iterations rest tg current lines
| ((Constant "+")::rest) ->
tg.Rotate(lp.angle)
lp.generate_points iterations rest tg current lines
| ((Constant "-")::rest) ->
tg.Rotate(-1.0*lp.angle)
lp.generate_points iterations rest tg current lines
| ((Constant "[")::rest) ->
lp.saved_directions <- tg.Direction::lp.saved_directions
lp.saved_positions <- tg.Position::lp.saved_positions
lp.generate_points iterations rest tg current lines
| ((Constant "]")::rest) ->
match (lp.saved_directions,lp.saved_positions) with
| (cdir::rest_dir,cpos::rest_pos) ->
lp.saved_directions <- rest_dir
lp.saved_positions <- rest_pos
tg.Position <- cpos
tg.Direction <- cdir
lp.generate_points iterations rest tg [tg.Position] (current::lines)
| _ -> lp.generate_points iterations rest tg current lines
| ((Constant "|")::rest) ->
tg.Advance(lp.seg_size / (iterations) )
lp.generate_points iterations rest tg (tg.Position::current) lines
| ((PipeCommand iteration)::rest) ->
tg.Advance(lp.seg_size / (iterations - iteration) )
lp.generate_points iterations rest tg (tg.Position::current) lines
| (_::rest) -> lp.generate_points iterations rest tg current lines
| [] -> current::lines



end



The generate_iteration method is the one that generates the line information. Its result is a list of lists of elements of type Point.

The C# code that takes this F# list of lists of Points and converts it to a group of Polyline instances is the following:


private void b_Click(object sender, RoutedEventArgs e)
{
string origin = this.originTB.Text;
int originX = 50;
int originY = 50;
string[] oparts = origin.Split(',');
if (oparts.Length == 2)
{
originX = int.Parse(oparts[0]);
originY = int.Parse(oparts[1]);
}

TurtleGraphics tg = new TurtleGraphics(originX, originY);
int iterations = int.Parse(this.iterationsTB.Text);

this.canvas1.Children.Clear();

List<Rule> rules = GetRules();

TurtleGraphicsLsystemProcessor tgls =
new TurtleGraphicsLsystemProcessor(
LsystemFuncs.getLsystemElements(this.axiomTextBox.Text),
int.Parse(this.angleTB.Text),
Microsoft.FSharp.Collections.ListModule.of_IEnumerable<List<Rule>, Rule>(rules),
int.Parse(this.segmentSizeTB.Text),
drawVariablesCB.IsChecked == true);

var pointCollections =
from pc in (tgls.generate_iteration(int.Parse(this.iterationsTB.Text))).Invoke(tg)
select (new PointCollection(
from p in pc
select new System.Windows.Point(p.x, p.y)));

foreach (PointCollection pcol in pointCollections)
{
Polyline pLine = new Polyline();

pLine.Points = pcol;
pLine.Stroke = this.colorButton.Background;
this.canvas1.Children.Add(pLine);
}
}



What is interesting to see is that the list generated in F# is easily manipulated using LINQ. The expression that sets the value of pointCollections takes the native list of lists of points and converts it to a list of PointCollection objects in one expression .

Another interesting thing about the interaction between F# and C# is that the definition of the generate_iteration says that it could be applied with one or two arguments (because of Currying) this is used in C# by invoking the result of calling the method with one argument: (tgls.generate_iteration(int.Parse(this.iterationsTB.Text))).Invoke(tg).

Executing the program with the following L-system (from Wikipedia):




Also with using the "|" command:




Code for this experiment can be found here.

Friday, August 17, 2007

Little JRuby experiment

Today I ran a Ruby program from a previous post with JRuby. I worked without modifications!

It's very nice to know that you can access Java libraries from within a Ruby. For example I decided to do a little experiment to create a TreeModel to display the contents of the loaded XSD definition in a JTree.

Here's an initial (and incomplete) implementation of the model:


require "java"
include_class 'javax.swing.JTree'
include_class 'javax.swing.JFrame'
include_class 'javax.swing.JScrollPane'
include_class 'java.awt.BorderLayout'
include_class 'javax.swing.tree.TreeModel'

class XsdTreeModel
include TreeModel
attr_reader :schema

def initialize(s)
@schema = s
end

def getChild(a,i)
case a
when XSDInfo::SchemaInformation
return a.elements.values[i]
when XSDInfo::SchemaElement
return a.element_type
when XSDInfo::SchemaComplexType
return a.attributes.values[i]
end
end
def getChildCount(a)
case a
when XSDInfo::SchemaInformation
return a.elements.length
when XSDInfo::SchemaElement
return 1
when XSDInfo::SchemaComplexType
return a.attributes.length
else
return 0
end
end
def getIndexOfChild(a,h)
case a
when XSDInfo::SchemaInformation
return a.elements.values.index(h)
when XSDInfo::SchemaElement
return 0
when XSDInfo::SchemaComplexType
return a.attributes.index(h)
else
return -1
end
end

def getRoot()
return @schema

end

def isLeaf(o)
return false
end

# Interface methods without implementation

def addTreeModelListener(l)
end
def removeTreeModelListener(l)
end
def valueForPathChanged(arg0, arg1)
end
end




Now we can use it:


sc = XSDInfo::SchemaCollection.new
sc.add_schema XSDInfo::SchemaInformation.new("xhtml1-strict.xsd")
sc.namespaces.each {|ns| sc[ns].solve_references sc}
a_schema = sc[sc.namespaces[0]]

f = JFrame.new
f.setSize(300,300)

f.getContentPane.setLayout(BorderLayout.new)
tree = JTree.new
sp = JScrollPane.new(tree)

tree.setModel(XsdTreeModel.new(a_schema))
f.getContentPane.add(sp,BorderLayout::CENTER)

f.setVisible(true)


Running this program generates the desired tree: