DZone Snippets: Cratylus's Code Snippets

How to parse a little language in Prolog

cratylus (crat) — Sun, 22 Apr 2007 01:44:35 GMT

How to parse a token list into functors (structured terms) in Prolog.
The book "Logic in Prolog" by Gibbins has some good example code
See http://www.ddj.com/184404172, listing 9 for the little language



%

% This is a simple (nay,trivial!)  "dialect" 

% with only two commands.

 

% Obviously only scratches the surface - 

% Written as a learning exercise!

% First define a grammar using prolog's Definite 

% Clause Grammar (DCG) notation

% DCG is a bit like a macro system - 

% the grammar rules are expanded into

% ordinary prolog clauses  before execution:

% Thanks to prolog unification, the Cmd variable

% will end up being instantiated to a functor like

% sell(abc,10,5) or buy(xyz,55):



cmd(Cmd) --> sell,!,amount(Amount),of,stock(Stock),at,price(Price), 

             { Cmd = sell(Stock,Amount,Price) }.

cmd(Cmd) --> buy,!,amount(Amount),of,stock(Stock), 

             {Cmd = buy(Stock,Amount)}.

sell --> [sell].

of --> [of].

at --> [at].

buy --> [buy].

amount(Amount) --> [Amount].

stock(Stock)   --> [Stock].

price(Price)   --> [Price].



% mini-evaluator:



eval(sell(Stock,Amount,Price)) :- 

 format('Sold ~d ~a shares at $~d.~n',[Amount,Stock,Price]).

eval(buy(Stock,Amount)) :- 

 format('Bought ~d ~a shares.~n',[Amount,Stock]).



% parse a statement, if it's a command, 

% evaluate it, otherwise write an error

% (NB.  ";" is prolog's % "or".)



interp(Statement) :- cmd(Cmd,Statement,[]),

             eval(Cmd);write('Unrecognised command!').



% Examples: 

% ( First two match , the last fails.)



test :-

    interp([sell,100,of,xyx,at,50]),

    interp([buy,45,of,abc]),

    interp([not,accepted]).

genetic algorithm in J

cratylus (crat) — Sun, 15 Oct 2006 17:33:01 GMT



-------------  Beginning of class  pga.ijs   -------------------

coclass'pga'

create=:3 : 0

genes=: ? 4 $ 100  NB. 4 random integers 0-99

)

getgenes =: 3 : 'genes'

setgenes =: 3 : 'genes=:y.'

matewith=: 3 : 0

other=. y.

mine=. ((#genes) % 2) ? (#genes) NB. crossover

childgene=. getgenes__other '' NB. copy others intially

child=. conew 'pga'

setgenes__child ((mine { genes) (mine }) childgene)

child

)

perform =: 3 : 0 NB. dummy problem

+/ genes

)

destroy=:codestroy

-------------  End of of class  pga.ijs   ----------------------

-------------  beginning of script ga.ijs ----------------------

NB. genetic algorithm 

NB. needs pga class

NB. define a dummy target to measure fitness against

targetvalue =:  500  

fitness=: 3 : 0

object=. y.

1000 * %(targetvalue - perform__object '')

)



load jpath '~user\classes\pga.ijs'





top =: 4 : '(i.y.) { \: (fitness each x.)'  NB. pop top 10 returns the 10 fittest



pair=: 3 : 0  NB. pick two random ga objects, mate them, and return the child

pop=. y.

mom=. > (?#pop) { pop NB. must unbox!

dad=. > (?#pop) { pop NB.  # is length of boxed list

matewith__mom dad

)



NB.  pop evolve generations returns the fittest ga after 

NB. sifting the top 25 ga's

evolve=: 4 : 0

pop=. x.

n=. y.

for_k. i.n do.

kpop=.  3 : 'pop' NB. not sure if necessary to do here

newgen=.  (pair@kpop) each i.100  NB. create 100 children

best=.  (newgen top 25) { newgen NB. find the indices of the best, then select the corresponding objects

pop=. best,best,best,best  NB. not really necessary?

end.

>0{best  NB. return best

)

NB. usage  

load jpath '~user\ga.ijs'

average =: +/%#

pop=: conew&'pga' each i.100   NB. create 100 boxed ga objects

fitness each pop  NB. should show a boxed list of fitness values

average ; fitness each pop  NB. shows average fitness



fred=: pop evolve 100

fitness fred

uberfred=: pop evolve 1000



NB. the fitness values increase pretty slowly which is disappointing

NB. probably needs some mutation :)

-------------    end of script ga.ijs     ----------------------

each with bind

cratylus (crat) — Sat, 30 Sep 2006 15:47:42 GMT

using bind again ..



here's a version of a ruby/smalltalk-like each in rebol:



in smalltalk you can write:



collectionObject each: [:thing | thing printName ]

ruby used the same idea etc

- a  code block is passed to an object



here's a rebol version



collection: make object! [

 data: copy []



 each: func [blk [block!] 

             /local iterator statement ][

             iterator:  to word! first blk

             statement:  copy skip blk 1

             foreach item data [

                set iterator item

                do bind statement iterator

             ]

        ]

]



This works by taking an input block of the form :

  [ :x   print x ]

or

[ :num  add total num ] etc



iterator: to word! first blk

just sets up iterator to be a work like a or x ( not a get-word like :a or :x )



I use a get-word just as a smalltalkish reminder that this is a

dummy variable ( [ a print a] would work too)



statement: copy skip blk 1 

just makes a copy of the rest of input block

ie statement would be [print x] say , i suppose chopping off the first would work too..



within the loop we set the value of this word ( say x) to 

successive items  in the internal datablock, so the word we indirectly talking about has a different value each time round.



do bind statement iterator



interprets the statement using the current value of the word and do executes it.



people: make collection [

 data: ["fred" "george" "mary" "jane"]

]



people/each [:person print rejoin ["Hello " person]]

Hello fred

Hello george

Hello mary

Hello jane

>>



I guess there might be probs if the "dummy" variable was

also a word used internally by the object containing the each method .

script an object using bind

cratylus (crat) — Sat, 30 Sep 2006 15:34:28 GMT

Suppose you have a robot object with methods like
move , attack etc. You can store a "script" in a block to automate the object



rebol []



robot: make object! [

move: func [amount] [...] ; whatever

turn: func [angle][..] 

fire: func [] [...]

run: func [code][

                   do bind code 'self

]

]



script: [

           move 100

           turn 45

           fire

           turn 23

           move 34

]

; etc



robbie: make robot []



robbie/run script