{-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,FlexibleContexts,FunctionalDependencies,UndecidableInstances,RankNTypes,ExplicitForAll,ScopedTypeVariables,NoMonomorphismRestriction,OverlappingInstances,EmptyDataDecls,RecordWildCards,TypeFamilies,TemplateHaskell #-}{-
Definitions for applying the generic GTA framework to cons lists.
(we can make a concise, specialized GTA framework for cons-lists, but...)
-}{-| This module provides the GTA framework on cons lists, such as definitions of the data structure and its algebra, generators, aggregators, etc.
-}moduleGTA.Data.ConsList(ConsList(Cons,Nil),ConsListAlgebra(ConsListAlgebra,cons,nil),consize,deconsize,segs,inits,tails,subs,assigns,assignsBy,paths,mapC,count,maxsum,maxsumsolution,maxsumWith,maxsumKWith,maxsumsolutionXKWith,maxsumsolutionXWith,maxsumsolutionWith,maxsumsolutionKWith,maxprodWith,maxprodKWith,maxprodsolutionXKWith,maxprodsolutionXWith,maxprodsolutionWith,maxprodsolutionKWith,crossCons,emptyBag,bagOfNil,bagUnion,ConsSemiring,foldr',ConsListMapFs(consF))whereimportGTA.CoreimportGTA.Util.GenericSemiringStructureTemplateimportGTA.Data.BinTree(BinTree(..))-- cons list = the usual list in FPdataConsLista=Consa(ConsLista)|Nil-- deriving (Show, Eq, Ord, Read)-- to use the GTA framework-- The following definitions can be generated automatically by @genAllDecl ''ConsList@-- They are written by hand here for writing comments.-- algebra of ConsListdataConsListAlgebraba=ConsListAlgebra{cons::b->a->a,nil::a}-- a set of functions for 'map'dataConsListMapFsbb'=ConsListMapFs{consF::b->b'}-- type parameters are algebra, free algebra, and functions for 'map'instanceGenericSemiringStructure(ConsListAlgebrab)(ConsListb)(ConsListMapFsb)wherefreeAlgebra=ConsListAlgebra{..}wherecons=Consnil=NilpairAlgebracla1cla2=ConsListAlgebra{..}whereconsa(r1,r2)=(cons1ar1,cons2ar2)nil=(nil1,nil2)(cons1,nil1)=letConsListAlgebra{..}=cla1in(cons,nil)(cons2,nil2)=letConsListAlgebra{..}=cla2in(cons,nil)makeAlgebra(CommutativeMonoid{..})clafrecfsingle=ConsListAlgebra{..}whereconsar=foldroplusidentity[fsingle(cons'ar')|r'<-frecr]nil=fsinglenil'(cons',nil')=letConsListAlgebra{..}=clain(cons,nil)foldingAlgebraopiop(ConsListMapFs{..})=ConsListAlgebra{..}whereconsar=consFa`op`rnil=iophom(ConsListAlgebra{..})=hwhereh(Consar)=consa(hr)hNil=nil-- stupid consize functionconsize::foralla.[a]->ConsListaconsize=foldrConsNil-- stupid deconsize functiondeconsize::foralla.ConsLista->[a]deconsize=hom(ConsListAlgebra{cons=(:),nil=[]})--this hom is of GenericSemiringStructure, namely, foldrinstanceShowa=>Show(ConsLista)whereshowsPrecdx=showsPrecd(deconsizex)instanceReada=>Read(ConsLista)wherereadsPrecdx=map(\(y,s)->(consizey,s))(readsPrecdx)instanceEqa=>Eq(ConsLista)where(==)xy=deconsizex==deconsizeyinstanceOrda=>Ord(ConsLista)wherecomparexy=compare(deconsizex)(deconsizey)-- short-cut to ConsListAlgebrafoldr'::forallas.(a->s->s)->s->ConsListAlgebraasfoldr'fe=ConsListAlgebra{cons=f,nil=e}-- renamingtypeConsSemiringas=GenericSemiring(ConsListAlgebraa)ssegs::[a]->ConsSemiringas->ssegsx(GenericSemiring{..})=let(s,i)=foldrcons'nil'xini`oplus`swherecons'a(s,i)=(i`oplus`s,consa(nil`oplus`i))nil'=(nil,identity)ConsListAlgebra{..}=algebraCommutativeMonoid{..}=monoidinits::[a]->ConsSemiringas->sinitsx(GenericSemiring{..})=foldrcons'nilxwherecons'ai=nil`oplus`consaiConsListAlgebra{..}=algebraCommutativeMonoid{..}=monoidtails::[a]->ConsSemiringas->stailsx(GenericSemiring{..})=let(t,_)=foldrcons'nil'xintwherecons'a(t,w)=letaw=consawin(aw`oplus`t,aw)nil'=(nil,nil)ConsListAlgebra{..}=algebraCommutativeMonoid{..}=monoidsubs::[a]->ConsSemiringas->ssubsx(GenericSemiring{..})=foldrcons'nilxwherecons'ay=consay`oplus`yConsListAlgebra{..}=algebraCommutativeMonoid{..}=monoidassigns::[m]->[a]->ConsSemiring(m,a)s->sassignsmsx(GenericSemiring{..})=foldrcons'nilxwherecons'ay=foldroplusidentity[cons(m,a)y|m<-ms]ConsListAlgebra{..}=algebraCommutativeMonoid{..}=monoidassignsBy::(a->[m])->[a]->ConsSemiring(m,a)s->sassignsByfx(GenericSemiring{..})=foldrcons'nilxwherecons'ay=foldroplusidentity[cons(m,a)y|m<-fa]ConsListAlgebra{..}=algebraCommutativeMonoid{..}=monoid{- this generates lists from a tree, while CYK geenerates trees from a list -}paths::BinTreeaa->ConsSemiringas->spathsx(GenericSemiring{..})=paths'xwherepaths'(BinNodealr)=consa(paths'l`oplus`paths'r)paths'(BinLeafa)=consanilConsListAlgebra{..}=algebraCommutativeMonoid{..}=monoid-- useful function to mapmapC::forallba.(b->a)->ConsListMapFsbamapCf=ConsListMapFs{..}whereconsF=f-- ConsList-semiring for countingcount::Numa=>ConsSemiringbacount=sumproductBy(ConsListMapFs{consF=const1}){- simplified aggregators -}maxsum::(Orda,Numa)=>ConsSemiringa(AddIdentitya)maxsum=maxsumBy(ConsListMapFs{consF=addIdentity})maxsumsolution::(Orda,Numa)=>ConsSemiringa(AddIdentitya,Bag(ConsLista))maxsumsolution=maxsumsolutionBy(ConsListMapFs{consF=addIdentity})maxsumWith::(Orda,Numa)=>(b->a)->ConsSemiringb(AddIdentitya)maxsumWithf=maxsumBy(mapC(addIdentity.f))maxsumKWith::(Orda,Numa)=>Int->(b->a)->ConsSemiringb([AddIdentitya])maxsumKWithkf=maxsumKByk(mapC(addIdentity.f))maxsumsolutionXKWith::(Orda,Numa)=>ConsSemiringcb->Int->(c->a)->ConsSemiringc[(AddIdentitya,b)]maxsumsolutionXKWithskf=maxsumsolutionXKBysk(mapC(addIdentity.f))maxsumsolutionXWith::(Orda,Numa)=>ConsSemiringcb->(c->a)->ConsSemiringc(AddIdentitya,b)maxsumsolutionXWithsf=maxsumsolutionXBys(mapC(addIdentity.f))maxsumsolutionWith::(Orda,Numa)=>(b->a)->ConsSemiringb(AddIdentitya,Bag(ConsListb))maxsumsolutionWithf=maxsumsolutionBy(mapC(addIdentity.f))maxsumsolutionKWith::(Orda,Numa)=>Int->(b->a)->ConsSemiringb[(AddIdentitya,Bag(ConsListb))]maxsumsolutionKWithkf=maxsumsolutionKByk(mapC(addIdentity.f))maxprodWith::(Orda,Numa)=>(b->a)->ConsSemiringb(AddIdentitya)maxprodWithf=maxprodBy(mapC(addIdentity.f))maxprodKWith::(Orda,Numa)=>Int->(b->a)->ConsSemiringb([AddIdentitya])maxprodKWithkf=maxprodKByk(mapC(addIdentity.f))maxprodsolutionXKWith::(Orda,Numa)=>ConsSemiringcb->Int->(c->a)->ConsSemiringc[(AddIdentitya,b)]maxprodsolutionXKWithskf=maxprodsolutionXKBysk(mapC(addIdentity.f))maxprodsolutionXWith::(Orda,Numa)=>ConsSemiringcb->(c->a)->ConsSemiringc(AddIdentitya,b)maxprodsolutionXWithsf=maxprodsolutionXBys(mapC(addIdentity.f))maxprodsolutionWith::(Orda,Numa)=>(b->a)->ConsSemiringb(AddIdentitya,Bag(ConsListb))maxprodsolutionWithf=maxprodsolutionBy(mapC(addIdentity.f))maxprodsolutionKWith::(Orda,Numa)=>Int->(b->a)->ConsSemiringb[(AddIdentitya,Bag(ConsListb))]maxprodsolutionKWithkf=maxprodsolutionKByk(mapC(addIdentity.f))--- useful functions to design generators: constructors of bags of listscrossCons::a->Bag(ConsLista)->Bag(ConsLista)crossCons=cons(algebrafreeSemiring)bagOfNil::Bag(ConsLista)bagOfNil=nil(algebrafreeSemiring)emptyBag::Bag(ConsLista)emptyBag=letGenericSemiring{..}=freeSemiring::GenericSemiring(ConsListAlgebraa)(Bag(ConsLista))inidentitymonoidbagUnion::Bag(ConsLista)->Bag(ConsLista)->Bag(ConsLista)bagUnion=letGenericSemiring{..}=freeSemiring::GenericSemiring(ConsListAlgebraa)(Bag(ConsLista))inoplusmonoid