-- |-- Module : GenProg.GenExpr.Data-- Copyright : (c) 2010 Jan Snajder-- License : BSD-3 (see the LICENSE file)---- Maintainer : Jan Snajder <jan.snajder@fer.hr>-- Stability : experimental-- Portability : non-portable---- Implementation of the @GenProg.GenExpr@ interface for members of-- the 'Data' typeclass. The implementation is based on SYB and SYZ-- generic programming frameworks (see-- <http://hackage.haskell.org/package/syb> and-- <http://hackage.haskell.org/package/syz> for details).---- NB: Subexpressions that are candidates for crossover points or-- mutation must be of the same type as the expression itself, and-- must be reachable from the root node by type-preserving traversal.-- See below for an example.-------------------------------------------------------------------------------{-# LANGUAGE ScopedTypeVariables, FlexibleInstances, Rank2Types,
UndecidableInstances, DeriveDataTypeable #-}moduleGenProg.GenExpr.Data(-- | This module re-exports @GenExpr@ typeclass.GenExpr(..)-- * Example-- $Example)whereimportData.GenericsimportData.Generics.ZipperimportData.MaybeimportControl.MonadimportGenProg.GenExprmoduleName="GenProg.GenExpr.Data"instance(Dataa)=>GenExprawhere-- | Exchanges two expression nodes. Works by using two generic-- zippers and exchanging their holes.exchangee1n1e2n2=(fromZippery1,fromZippery2)wherez1=typeMoveForUnsafen1$toZippere1z2=typeMoveForUnsafen2$toZippere2(y1,y2)=exchangeHolesz1z2-- | Adjust an expression node. Works by applying a monadic-- tranformation on a zipper hole.adjustMfen=fromZipper`liftM`transM(mkMf)zwherez=typeMoveForUnsafen(toZippere)nodeMapMf=gmapM(mkMf)nodeMapQq(x::a)=concat$gmapQ([]`mkQ`(\(y::a)->[qy]))xnodeIndices=index0[][].toZipper-- Zipper movestypeMovea=Zippera->Maybe(Zippera)backtrack::(Typeablea)=>Moveabacktrackz=doz2<-upzrightz2`mplus`backtrackz2repeatM::(Monadm)=>Int->(a->ma)->a->marepeatM0_x=returnxrepeatMnfx=fx>>=repeatM(n-1)f-- Moves zipper to next node in DFS order, but does not move down the-- zipper if node satisfies query 'q'.nextDfsQ::Typeablea=>GenericQBool->MoveanextDfsQqz=(ifqueryqzthenNothingelsedown'z)`mplus`rightz`mplus`backtrackz-- Moves the zipper to node 'n' from current position in DFS order,-- skipping nodes not satisfying query 'q2' and descending only down-- the nodes satisfying query 'q1'.moveForQ::(Typeablea)=>GenericQBool->GenericQBool->Int->MoveamoveForQ__0z=JustzmoveForQq1q2nz=doz2<-nextDfsQq1zmoveForQq1q2(ifqueryq2z2thenn-1elsen)z2-- Moves the zipper to node 'n' from current position in DFS order,-- counting only nodes of type 'a', and not descending down the nodes-- of other type.typeMoveFor::(Typeablea)=>Int->MoveatypeMoveForn(z::Zippera)=moveForQ(True`mkQ`(\(_::a)->False))(False`mkQ`(\(_::a)->True))nz-- | Same as typeMoveFor, but throws an error if node index is out of-- bound.typeMoveForUnsafe::(Typeablea)=>Int->Zippera->ZipperatypeMoveForUnsafenz=fromMaybe(error$moduleName++".typeMoveForUnsafe: Nonexisting node.")(typeMoveFornz)-- | Exchanges two zipper holes.exchangeHoles::(Dataa)=>Zippera->Zippera->(Zippera,Zippera)exchangeHoles(z1::Zippera)(z2::Zippera)=(y1,y2)whereJusth1=getHolez1::MaybeaJusth2=getHolez2::Maybeay1=setHoleh2z1y2=setHoleh1z2index::(Dataa)=>Int->[Int]->[Int]->Zippera->([Int],[Int])indexiises(z::Zippera)=maybe(is2,es2)(index(i+1)is2es2)(typeMoveFor1z)whereJusth=getHolez::Maybea(is2,es2)=ifterminalQhthen(is,i:es)else(i:is,es)terminalQ::(Dataa)=>a->BoolterminalQ=null.nodeMapQid{- $Example
Suppose you have a datatype defined as
@
data E = A E E
| B String [E]
| C
deriving (Eq,Show,Typeable,Data)
@
and an expression defined as
@
e = A (A C C) (B \"abc\" [C,C])
@
The subexpressions of a @e@ are considered to be only the subvalues of
@e@ that are of the same type as @e@. Thus, the number of nodes of
expression @e@ is
>>> nodes e
5
because subvalues of node @B@ are of different type than expression
@e@ and therefore not considered as subexpressions.
Consequently, during a genetic programming run, subexpressions that
are of a different type than the expression itself, or subexpression
that cannot be reached from the root node by a type-preserving
traversal, cannot be chosen as crossover points nor can they be
mutated.
-}