Auto-memoizing recursive functions

(use-syntax (ice-9 syncase))
 
;; memoizing macro
(define-syntax memoize
  (syntax-rules ()
    ((_ f)
     (let ((memo
            (lambda (f)
              (let ((t (make-hash-table)))
                (lambda args
                  (let ((res (hash-ref t args)))
                       (if res
                           res
                           (let ((res (apply f args)))
                                (hash-set! t args res)
                                res))))))))
       (set! f (memo f)) ;; ensures recursive calls of f, are memoized too
       f)))) 
 
;; usual suspect 
(define (fib n)
  (if (< n 2)
      n
      (+ (fib (- n 1))
         (fib (- n 2)))))
 
;; test  
(display ((memoize fib) 100))
Publié dans Uncategorized

Break, Continue and Return

In imperative languages, break, continue and return allow, respectively, to
break out of a loop, skip to the next iteration within a loop, and return prematurely from a procedure.

Scheme, has none of these built-in, but they can be easily be implemented with first-class continuations:

breaking out of a loop is calling the loop’s continuation:

(call-with-current-continuation
 (lambda (break)
   (let loop ((i 0))
     (cond ((< i 5) (display i))
               (else (break 'BREAK))) ;; will break out of the loop when i >= 5
     (loop (+ i 1)))))

Continuing, is calling the continuation of the loop’s body:

(let loop ((i 0))
  (cond ((< i 10)
         (call-with-current-continuation
          (lambda (continue)
            (cond ((even? i) (continue #f))) ;; will skip even values of i
            (display i)))
         (loop (+ i 1)))))

Returning from a procedure, is calling the procedure’s continuation:

(define test
  (lambda (n)
    (call-with-current-continuation
     (lambda (return)
       (cond ((> n 5) (return 'RETURNED))) ;; will return for n > 5
       (display n)
       (test (+ n 1))))))
 
(test 0)
Publié dans Uncategorized

Tree from inorder and preorder traversals

(define (2-tree ino-t root)
  (let ((sub
         (if (eq? (car ino-t) root)
             (list '() (cadr ino-t))
             (list (car ino-t) '()))))
    (list root sub)))
 
(define (split-ino ino-t root)
  (letrec ((loop
            (lambda (in2 in1)
              (cond ((null? in2) 
                     (list in1 '()))
                     ((eq? root (car in2)) 
                      (list in1 (cdr in2)))
                     (else
                      (loop (cdr in2) 
                        (append in1 (list (car in2)))))))))
    (loop ino-t '())))
 
(define (split-pre pre in)
  (letrec ((loop
            (lambda (i pre2 pre1)
              (if (= i 0)
                  (list pre1 pre2)
                  (loop (- i 1)
                        (cdr pre2)
                        (append pre1 (list (car pre2))))))))
    (loop (length in) pre '())))
 
; takes an inorder and a preorder traversals
(define (rec ino-t pre-t)
    (case (length ino-t)
      ((0) '())
      ((1) (list (car ino-t) '() '()))
      ((2) (2-tree ino-t (car pre-t)))
      ((3) (list (car pre-t) 
                 (list (cadr pre-t)
                       (caddr pre-t))))
      (else 
       (let* ((ino-ts (split-ino ino-t (car pre-t)))
              (ino-t1 (car ino-ts))
              (ino-t2 (cadr ino-ts))
              (pre-ts (split-pre (cdr pre-t) ino-t1))
              (pre-t1 (car pre-ts))
              (pre-t2 (cadr pre-ts)))
         (list (car pre-t) 
               (rec ino-t1 pre-t1)
               (rec ino-t2 pre-t2))))))
 
(display (rec (read) (read)))

Publié dans Uncategorized

Turing Machines

Design a Turing machine to accept the language over the alphabet {a, b, @} consisting of all words of the form w@w, where w in {a,b}*

module Main where
 
import Prelude hiding (Left, Right)
import System.Environment (getArgs)
import Data.List (elem)
 
-- data types
-- tape alphabet
type G = Char
 
-- states
data Q = Q0 
       | NextSym
       | SeenA
       | SeenB
       | SeenN
       | FindA
       | FindB
       | Back
       | BackNext
       | Accepts deriving (Show, Eq)
 
-- head moves
data Move = Left 
          | Right deriving (Show, Eq)
 
-- outcome of a transition
data Transition = Halt | Trans Q G Move
 
-- transition function 
delta :: Q -> G -> Transition
delta Q0 '_' = Trans NextSym '_' Right
 
delta NextSym 'a' = Trans SeenA 'X' Right
delta NextSym 'b' = Trans SeenB 'X' Right
delta NextSym '@' = Trans SeenN '@' Right
 
delta SeenA 'a' = Trans SeenA 'a' Right
delta SeenA 'b' = Trans SeenA 'b' Right
delta SeenA '@' = Trans FindA '@' Right
 
delta SeenB 'a' = Trans SeenB 'a' Right
delta SeenB 'b' = Trans SeenB 'b' Right
delta SeenB '@' = Trans FindB '@' Right
 
delta SeenN 'X' = Trans SeenN 'X' Right
delta SeenN '_' = Trans Accepts '_' Right
 
delta FindA 'a' = Trans Back 'X' Left
delta FindA 'X' = Trans FindA 'X' Right
 
delta FindB 'b' = Trans Back 'X' Left
delta FindB 'X' = Trans FindB 'X' Right
 
delta Back 'X' = Trans Back 'X' Left
delta Back '@' = Trans BackNext '@' Left
 
delta BackNext 'a' = Trans BackNext 'a' Left
delta BackNext 'b' = Trans BackNext 'b' Left
delta BackNext 'X' = Trans NextSym 'X' Right
 
delta Accepts  _  = Halt
 
delta _   _  = Halt
 
-- start state 
q0 = Q0
 
-- final states
final = [Accepts]
 
-- TM as a computer : output is the tape
compute :: [G] -> IO [G]
compute input = computeIter q0 tape []
 
  where tape = '_' : (input ++ repeat '_')
        computeIter :: Q -> [G] -> [G] -> IO [G]
        computeIter q xs ys = do
            print $ (show q) ++ " : " ++ (reverse ys) ++ "." ++ (takeWhile (/='_') xs)
            let x = head xs
            --print x
            case delta q x of
              Trans q' o Left  -> if null ys
                                  then error "Halting abnormally, too far left"
                                  else computeIter q' (head ys:o:(tail xs)) (tail ys)
 
              Trans q' o Right -> computeIter q' (tail xs) (o:ys)
              Halt             -> if q `elem` final
                                  then return (reverse (init ys) ++ xs)
                                  else error ("Halting, no transition for " 
                                              ++ show q 
                                              ++ " x " ++ [x])
 
-- TM as a language acceptor
accept :: [G] -> Bool
accept = undefined
 
main = do
  --input <- head `fmap` getArgs
  --print $ takeWhile (/= '_') $ compute input
  -- quickCheck prop_accept
  input <- getLine
  compute input

Design a Turing machine to accept the language over the alphabet {a, b, @} consisting of all words of the form w@akbl, where where w in {a,b}* and w contains exactly k a’s and l b’s.

module Main where
 
import Prelude hiding (Left, Right)
import Data.List (elem)
 
-- data types
-- tape alphabet
type G = Char
 
-- states
data Q = Q0 
       | NextSymbol
       | SeenA
       | SeenB
       | SeenN
       | FindA 
       | FindB
       | Back
       | BackNext
       | Accepts deriving (Show, Eq)
 
-- head moves
data Move = Left 
          | Right deriving (Show, Eq)
 
-- outcome of a transition
data Transition = Halt | Trans Q G Move
 
-- transition function 
delta :: Q -> G -> Transition
 
delta Q0 '_' = Trans NextSymbol '_' Right
 
delta NextSymbol 'a' = Trans SeenA 'X' Right
delta NextSymbol 'b' = Trans SeenB 'X' Right
delta NextSymbol '@' = Trans SeenN '@' Right
 
delta SeenA 'a' = Trans SeenA 'a' Right
delta SeenA 'b' = Trans SeenA 'b' Right
delta SeenA '@' = Trans FindA '@' Right
 
delta SeenB 'a' = Trans SeenB 'a' Right
delta SeenB 'b' = Trans SeenB 'b' Right
delta SeenB '@' = Trans FindB '@' Right
 
delta SeenN 'A' = Trans SeenN 'A' Right
delta SeenN 'B' = Trans SeenN 'B' Right
delta SeenN '_' = Trans Accepts '_' Right
 
delta FindA 'a' = Trans Back 'A' Left
delta FindA 'A' = Trans FindA 'A' Right
 
delta FindB 'b' = Trans Back 'B' Left
delta FindB 'a' = Trans FindB 'a' Right
delta FindB 'A' = Trans FindB 'A' Right
delta FindB 'B' = Trans FindB 'B' Right
 
delta Back 'A' = Trans Back 'A' Left
delta Back 'B' = Trans Back 'B' Left
delta Back 'a' = Trans Back 'a' Left
delta Back '@' = Trans BackNext '@' Left
 
delta BackNext 'a' = Trans BackNext 'a' Left
delta BackNext 'b' = Trans BackNext 'b' Left
delta BackNext 'X' = Trans NextSymbol 'X' Right
 
delta Accepts  _  = Halt
 
delta _   _  = Halt
 
-- start state 
q0 = Q0
 
-- final states
final = [Accepts]
 
-- TM as a computer : output is the tape
compute :: [G] -> IO [G]
compute input = computeIter q0 tape []
 
  where tape = '_' : (input ++ repeat '_')
        computeIter :: Q -> [G] -> [G] -> IO [G]
        computeIter q xs ys = do
            print $ (show q) ++ " : " ++ (reverse ys) ++ "." ++ (takeWhile (/='_') xs)
            let x = head xs
            --print x
            case delta q x of
              Trans q' o Left  -> if null ys
                                  then error "Halting abnormally, too far left"
                                  else computeIter q' (head ys:o:(tail xs)) (tail ys)
 
              Trans q' o Right -> computeIter q' (tail xs) (o:ys)
              Halt             -> if q `elem` final
                                  then return (reverse (init ys) ++ xs)
                                  else error ("Halting, no transition for " 
                                              ++ show q 
                                              ++ " x " ++ [x])
 
-- TM as a language acceptor
accept :: [G] -> Bool
accept = undefined
 
main = do
  input <- getLine
  compute input

Publié dans Uncategorized

Man hen corn fox

A man with a boat needs to cross a river with a hen, a fox, and some corn. He can only take one thing with him in the boat at a time. If he leaves the fox and the hen by themselves, the fox will eat the hen. If he leaves the hen and the corn, the hen will eat the corn. What should he do?

(define man 0)
(define hen 1)
(define corn 2)
(define fox 3)
(define subjects (list man hen corn fox))
 
(define start (vector 'left 'left 'left 'left))
(define goal (vector 'right 'right 'right 'right))
 
(define search
  (lambda (fringe seen)
    (if (null? fringe)
        'NO-SOLUTION
        (begin
          (display fringe)
          (newline)
          (let ((pos (car fringe))
                (fringe (cdr fringe)))
            (display pos)
            (newline)
            (if (equal? pos goal) 
                'FINISHED
                (if (member pos seen)
                    (search fringe seen)
                    (search (append fringe (next-pos pos)) 
                            (cons pos seen)))))))))
 
; next-pos : State -> [State]
(define next-pos
  (lambda (pos)
    (filter valid-state?
            (map (move-x pos) subjects))))
 
(define valid-state?
  (lambda (pos)
    (if pos ;; move-x sometimes return false when a move is impossible
        (let ((man (vector-ref pos 0))
              (hen (vector-ref pos 1))
              (corn (vector-ref pos 2))
              (fox (vector-ref pos 3)))
          (or (eq? man hen)
              (and (not (eq? hen corn))
                   (not (eq? hen fox)))))
        #f)))
 
;; helpers
(define flip-loc
  (lambda (loc)
    (if (eq? loc 'left) 
        'right 
        'left)))
 
(define filter
  (lambda (p l)
    (if (null? l)
        '()
        (if (p (car l))
            (cons (car l) 
                  (filter p (cdr l)))
                  (filter p (cdr l))))))
 
 
(define move-x
  (lambda (pos)
    (lambda (x)
      (let ((v (vector (flip-loc (vector-ref pos 0)) 
                       (vector-ref pos 1)
                       (vector-ref pos 2)
                       (vector-ref pos 3))))
        (if (not (eq? x man))
              (vector-set! v x (flip-loc (vector-ref pos x)))
              #f)
        v))))
 
 
; main
(search (list start) '())
Publié dans Uncategorized

Fork-stack

A fork-stack is allowed to grab any initial segment of the input and place it on the stack and also allowed to output any top segment. Find an unsortable arrangement of 1, 2, 3, 4, 5.

This program makes use of Norvig’s code for uninformed search
(which can be found here: http://aima-python.googlecode.com/svn/trunk/search.py)

import sys
import Queue
 
class Node:
    def __init__(self, state, action=None, parent=None, path_cost=0):
        self.state = state
        self.action = action
        self.parent = parent
        if self.parent:
            self.depth = self.parent.depth + 1
        else:
            self.depth = 0
        self.path_cost = path_cost # total past cost (g)
 
    def __repr__(self):
        return "<Node %s>" % (self.state,)
 
    def path(self):
        """Return a list of nodes from the root to this node"""
        path = [self]
        n = self
        while n.parent:
            path.append(n.parent)
            n = n.parent
        return path
 
    # expand    : Node x Problem -> [Node]  !! norvig put this in Node
    def expand(self, problem):
        """Return a list of nodes reachable from this node"""
        return [Node(result, None, self, 0) for result in problem.successor(self.state)]
 
# Uninformed Searches (AIMA code)
 
def tree_search(problem, fringe):
    fringe.put(Node(problem.init_state))
    while not fringe.empty():
        node = fringe.get()
        if problem.goaltest(node.state):
            return node
        else:
            for n in node.expand(problem):
                fringe.put(n)
    return None
 
 
def tree_dfs(problem):
    return tree_search(problem, Queue.LifoQueue())
 
 
def tree_bfs(problem):
    return tree_search(problem, Queue.Queue())
 
# Fork-stack specific code
class Problem:
    # a state is a tuple (input, stack, result)
    def __init__(self, init_state, goal_state=None):
        self.init_state = init_state
        self.goal_state = goal_state
 
    # goaltest  : Problem x State -> boolean
    def goaltest(self, state):
        inp, stack, res = state
        # goal state is reached when the input and the stack are empty
        # (we only pop from the stack if result is sorted)
        return inp == [] and stack == []
 
    # successor_fn : State -> [State]
    def successor(self, state):
        # given a sequence, choices returns a list of possible subsequences
        # (see fork-stack description above) 
        def choices(seq):
           res = []
           l = len(seq)
           for i in range(l):
              res.append(seq[:i+1])
           return res
 
        inp, stack, res = state
        successors = []
        # all possibilities for stack push
        if inp != []:
            for choice in choices(inp):
                new_inp = inp[len(choice):]
                new_stack = choice + stack
                successors.append((new_inp, new_stack, res))
 
        # all possibilities for stack pop
        if stack != []:
            for choice in choices(stack):
                choice.reverse()
                new_stack = stack[len(choice):]
                new_res = res + choice
                # checking if the choice is valid
                if new_res == sorted(new_res):
                    successors.append((inp, new_stack, new_res))
        return successors
 
    def path_cost(self, path_cost, state, action, next_state):
        return path_cost + 1 # the path does not matter
 
def main():
    # all possible permutations of 1, 2, 3, 4, 5
    init_states = [[a+1,b+1,c+1,d+1,e+1]
                   for a in range(5)
                   for b in range(5)
                   for c in range(5)
                   for d in range(5)
                   for e in range(5)
                   if a !=b and a !=c and a!=d and a!=e
                   and b!=c and b!=d and b!=e
                   and c!=d and c!=e
                   and d!=e]
 
    count = 0
    for init in init_states:  
        print count, init
        init_state = (init, [], [])
        p = Problem(init_state)
        # Breadth First Search
        n = tree_bfs(p)
        if n == None:
            print ">>>", init, " is not sortable!"
        count += 1
main()
Publié dans Uncategorized

Colonel West

The law says that it is a crime for an American to sell weapons to hostile nations. The country Nono, an enemy of America, has some missiles, and all of its missiles were sold to it by Colonel West, who is American.

american(west).
enemy(nono, america).
owns(nono, m1).
missile(m1).
 
% implicit : an enemy of America is hostile
hostile(X) :- enemy(X, america).
 
% implicit : a missile is a weapon
weapon(X) :- missile(X).
 
criminal(X) :- american(X),
               weapon(Y),
               sells(X,Y,Z),
               hostile(Z).
 
sells(west, X, nono) :- missile(X), 
                        owns(nono, X).

Publié dans Uncategorized

Evolving to 1′s

import random
 
population = 10
mutation = 0.1
 
def new_population():
    pop = []
    for i in range(population):
        duplicate = True
        while duplicate:
            nb_ones = random.randint(0,32)
            s = [1 for x in range(nb_ones)] + [0 for x in range(32-nb_ones)]
            random.shuffle(s)
            duplicate = s in pop
        pop.append(s)
    return pop
 
def fitness(x):
    return len(filter(lambda c: c == 1, x))
 
def parents_selection(pop):
    nbparents = population / 4
    k = population / nbparents
    parents = []
    for n in range(nbparents): # select nbparents
        pool = pop [n*k : n*k+4]
        best = sorted(zip(map(fitness,pool),pool), reverse=True)[0][1]
        parents.append(best)
    return parents
 
def reproduce(parents):
    pop = parents
    for i in range(population - len(parents)):
        p1 = random.choice(parents)
        p2 = random.choice(parents)
        i = random.randint(0,32) # crossover point
        child = p1[:i] + p2[i:]
        # Possibly mutate the new string 
        if random.random() > 1.0 - mutation:
            child = mutate(child)
        pop.append(child)   
    return pop
 
def mutate(child):
    i = random.randint(0,31)
    return child[:i] + [1 - child[i]] + child[i+1:]
 
def evolve(pop):
    gen = 0
    best_fitness = 0
    while best_fitness < 32:
        parents = parents_selection(pop) # [(string, string)] 
        pop = reproduce(parents) # [string]
        gen += 1
        popfit = sorted(zip(map(fitness, pop), pop), reverse=True)
        best_fitness = popfit[0][0]
        print "gen %d, fit %d, s %s" % (gen, best_fitness, popfit[0][1])
 
evolve(new_population())
Publié dans Uncategorized

Run This WordPress plugin

This is a repost from Metaprogramming: Ruby vs. Javascript and its follow-up Dynamically adding methods with metaprogramming : Ruby and Python, to test Run This plugin for WordPress. The standalone Javascript library can be found here.

Ruby

# Initial class declaration and initialisation
class Ninja
  attr_accessor :name
 
  def initialize(name)
    @name = name
  end
end
 
drew = Ninja.new("Drew")
adam = Ninja.new("Adam")
 
# Add a method to the class
class Ninja
  def battle_cry
    puts "#{name} says zing!!!"
  end
end
 
drew.battle_cry # => Drew says zing!!!
adam.battle_cry # => Adam says zing!!!
 
# Add a method to an instance
def drew.throw_star
  puts "throwing a star"
end
 
drew.throw_star # => throwing a star
 
# Invoke a method dynamically
drew.send(:battle_cry)
 
# Defining class level methods dynamically with closures
color_name = 'black'
 
Ninja.send(:define_method, 'color') do
  puts "#{name}'s color is #{color_name}"
end
 
drew.color # => Drew's color is black
adam.color # => Adam's color is black
 
# Defining instance level method dynamically with closures
class Object
  def metaclass
    class << self; self; end
  end
end
 
sword_symbol = "*********"
 
drew.metaclass.send(:define_method, 'swing') do |sound_effect|
  puts "#{name}: #{sword_symbol} #{sound_effect}"
end
 
drew.swing 'slash!!' # => Drew: ********* slash!!

Javascript

// Initial class declaration and initialisation
function Ninja(name) {
  this.name = name;
}
 
var drew = new Ninja("Drew");
var adam = new Ninja("Adam");
 
// Add a method to the class
Ninja.prototype.battleCry = function () {
  print (this.name + " says zing!!!");
}
 
drew.battleCry();
// => Drew says zing!!!
adam.battleCry();
// => Adam says zing!!!
 
// Add a method to an instance
drew.throwStar = function () {
  print ("throwing a star");
}
 
drew.throwStar(); // => throwing a star
 
// Invoke a method dynamically
drew['battleCry']();
 
// Defining class level methods dynamically with closures
var colorName = "black";
 
Ninja.prototype['color'] = function () {
  print(this.name + "'s color is " + colorName);
}
 
drew.color(); // => Drew's color is black
adam.color(); // => Adam's color is black
 
// Defining instance level method dynamically with closures
var swordSymbol = "*********"
 
drew['swing'] = function (soundEffect) {
  print(this.name + ": " + swordSymbol + " " + soundEffect);
}
 
drew.swing('slash!!'); // => Drew: ********* slash!!

Python

# Initial class declaration and initialisation
class Ninja(object):
    def __init__(self,name) :
        self.name = name
 
drew = Ninja('drew')
adam = Ninja('adam')
 
# Add a method to the class
def battle_cry(self):
    print '%s says zing!!!' % self.name
Ninja.battle_cry = battle_cry
 
drew.battle_cry() # => Drew says zing!!!
adam.battle_cry() # => Adam says zing!!!
 
# Add a method to an instance
import types
def throw_star(self):
    print 'throwing a star'
drew.throw_star = types.MethodType(throw_star,drew)
 
drew.throw_star() # => throwing a star
 
# Invoke a method dynamically
drew.__getattribute__('battle_cry')()
 
# Defining class level methods dynamically with closures
color_name = 'black'
 
def color(self):
    print "%s's color is %s" % (self.name, color_name)
Ninja.color = color
 
drew.color() # => Drew's color is black
adam.color() # => Adam's color is black
 
# Defining instance level method dynamically with closures
sword_symbol = "*********"
 
def foo(self,sound_effect):
    print "%s : %s %s" % (self.name,sword_symbol,sound_effect)
 
drew.__dict__['swing'] = types.MethodType(foo,drew)
drew.swing('slash!!') # => Drew : ********* slash!!
Publié dans Uncategorized

Integrating Rhino and JSLint with TextMate

JSLint is a great little Javascript syntax verifier (http://www.jslint.com/lint.html).
It also goes further and prescribes good coding style (like using === instead of ==, etc… )

So how do we integrate it with TextMate ?

1) Download Rhino and JSLint

Rhino : ftp://ftp.mozilla.org/pub/mozilla.org/js/rhino1_7R2.zip
JSLint : http://www.jslint.com/rhino/jslint.js

2) Set your paths

in TextMate > Preferences > Advanced > Shell Variables

set the path to Rhino : TM_JS_SHELL -> /path/to/your/Rhino1_7R2/js.jar

set the path to jslint.js : TM_JS_LINT -> /path/to/your/jslint.js

pastedgraphic1

3) Bind Rhino to a shortcut

In the Bundles Editor (Ctrl-Alt-Apple-B), under the Javascript Bundle, create a new Command, call it ‘Run’

edit the window to make it look like this :

picture-21

4) Bind JSLint to a shortcut

In the Bundles Editor, under the Javascript Bundle, create a new Command, call it ‘JSLint’

edit the window to make it look like this :

pastedgraphic2

This bind Apple-R (on Javascript document) to java -jar ‘rhino’ ‘jslint’ your-javascript-file

basically running JSLint on your javascript file (the file needs to be saved by the way)

5) Run !

now if you are writing some javascript, hit Apple-R and select ‘Run’ to execute it (the file needs to be named and saved)

picture-221

picture-24

picture-23

6) Lint !

To to check the syntax, hit Apple-R and select ‘JSLint’

pastedgraphic3
and you’ll get a report in a new TextMate document like this :

pastedgraphic4

If you want to integrate others tools, follow the same procedure.
For instance you could also integrate a Javascript beautifier (http://jsbeautifier.org/) or a minifier (http://developer.yahoo.com/yui/compressor/)…

Et voila !

Publié dans Uncategorized