{-# LANGUAGE ForeignFunctionInterface #-}-- |-- Module : Math.Sym.Internal-- Copyright : (c) Anders Claesson 2012-- License : BSD-style-- Maintainer : Anders Claesson <anders.claesson@gmail.com>-- -- An internal module used by the sym package.-- -- A Lehmercode is a vector of integers @w@ such @w!i <= length w - 1 - i@-- for each @i@ in @[0..length w - 1]@; such a vector encodes a permutation.-- This module implements /O(n)/ algorithms for unranking Lehmercodes and-- permutations; the algorithms are due to W. Myrvold and F. Ruskey-- [Ranking and Unranking Permutations in Linear Time, Information Processing-- Letters, 79 (2001) 281-284].-- -- In addition, this module implements sorting operators, the-- symmetries in D8 acting on permutations, as well as most of the-- common permutation statistics.moduleMath.Sym.Internal(Lehmercode,Perm0-- * Lehmercodes,unrankLehmercode,fromLehmercode,randomLehmercode,lehmercodes-- * Permutations,size,toList,fromList,act,unrankPerm,randomPerm,sym,idperm,revIdperm,sti,st,ordiso,simple,copies,avoiders-- * Permutation symmetries,reverse,complement,inverse,rotate-- * Permutation statistics,asc,des,exc,fp,cyc,inv,maj,comaj,peak,vall,dasc,ddes,lmin,lmax,rmin,rmax,head,last,lir,ldr,rir,rdr,comp,scomp,ep,dim,asc0,des0-- * Left-to-right maxima, etc,lMaxima,rMaxima-- * Components,components-- * Sorting operators,stackSort,bubbleSort-- * Single point deletions,del-- * Bitmasks,onesCUInt,nextCUInt,nextIntegral)whereimportPreludehiding(reverse,head,last)importqualifiedPrelude(head)importSystem.Random(getStdRandom,randomR)importControl.Monad(forM_,liftM)importControl.Monad.ST(runST)importData.List(group)importData.Bits(Bits,shiftR,(.|.),(.&.),popCount)importqualifiedData.Vector.StorableasSV(Vector,toList,fromList,length,(!),thaw,unsafeFreeze,unsafeWith,enumFromN,enumFromStepN,head,last,filter,maximum,minimum,null,reverse,map)importqualifiedData.Vector.Storable.MutableasMV(unsafeNew,unsafeWrite,unsafeWith,unsafeSlice,swap,replicate)importForeign(Ptr,castPtr)importSystem.IO.Unsafe(unsafePerformIO)importForeign.C.Types(CLong(..),CInt(..),CUInt(..))importForeign.Marshal.Utils(toBool)-- | A Lehmercode is a vector of integers @w@ such @w!i <= length w - 1 - i@-- for each @i@ in @[0..length w - 1]@.typeLehmercode=SV.VectorInt-- | By convention, a member of @Perm0@ is a permutation of some-- finite subset of @[0..]@.typePerm0=SV.VectorInt-- Lehmercodes-- ------------- | @unrankLehmercode n rank@ is the @rank@-th Lehmercode of length @n@.unrankLehmercode::Int->Integer->LehmercodeunrankLehmercodenrank=runST$dov<-MV.unsafeNewnitervnrank(toIntegern)SV.unsafeFreezevwhere{-# INLINE iter #-}iter_0__=return()itervirm=dolet(r',j)=quotRemrmMV.unsafeWritev(n-i)(fromIntegralj)iterv(i-1)r'(m-1)-- | Build a permutation from its Lehmercode.fromLehmercode::Lehmercode->Perm0fromLehmercodecode=runST$doletn=SV.lengthcodev<-MV.unsafeNewnforM_[0..n-1]$\i->MV.unsafeWriteviiforM_[0..n-1]$\i->MV.swapvi(i+(SV.!)codei)SV.unsafeFreezev-- | A random Lehmercode of the given length.randomLehmercode::Int->IOLehmercoderandomLehmercoden=unrankLehmercoden`liftM`getStdRandom(randomR(0,factorialn-1))-- | The list of Lehmercodes of a given length.lehmercodes::Int->[Lehmercode]lehmercodesn=map(unrankLehmercoden)[0..factorialn-1]-- Permutations-- -------------- | The size of a permutation; the number of elements.size::Perm0->Intsize=SV.length-- | The list of images of a permutation.toList::Perm0->[Int]toList=SV.toList-- | Make a permutation from a list of images.fromList::[Int]->Perm0fromList=SV.fromList-- | @act u v@ is the permutation /w/ defined by /w(u(i)) = v(i)/.act::Perm0->Perm0->Perm0actuv=runST$doletn=SV.lengthuw<-MV.unsafeNewnforM_[0..n-1]$\i->MV.unsafeWritewi((SV.!)v((SV.!)ui))SV.unsafeFreezewfactorial::Integrala=>a->Integerfactorial=product.enumFromTo1.toInteger-- | @unrankPerm n rank@ is the @rank@-th (Myrvold & Ruskey) permutation of length @n@.unrankPerm::Int->Integer->Perm0unrankPermn=fromLehmercode.unrankLehmercoden-- | A random permutation of the given length.randomPerm::Int->IOPerm0randomPermn=fromLehmercode`liftM`randomLehmercoden-- | @sym n@ is the list of permutations of @[0..n-1]@ (the symmetric group).sym::Int->[Perm0]symn=map(unrankPermn)[0..factorialn-1]-- | The identity permutation of the given length.idperm::Int->Perm0idperm=SV.enumFromN0-- | The reverse of the identity permutation.revIdperm::Int->Perm0revIdpermn=SV.enumFromStepN(n-1)(-1)n-- | @sti w@ is the inverse of the standardization of @w@ (a-- permutation on @[0..length w-1]@). E.g., @sti \<4,9,2\> ==-- \<2,0,1\>@.sti::Perm0->Perm0stiw=runST$doleta=ifSV.nullwthen0elseSV.minimumwletb=ifSV.nullwthen0elseSV.maximumwletn=SV.lengthwv<-MV.replicate(1+b-a)(-1)forM_[0..n-1]$\i->MV.unsafeWritev((SV.!)wi-a)iSV.filter(>=0)`liftM`SV.unsafeFreezev-- | The standardization map.st::Perm0->Perm0st=inverse.stiforeignimportccallunsafe"ordiso.h ordiso"c_ordiso::PtrCLong->PtrCLong->PtrCLong->CLong->CInt-- | @ordiso u v m@ determines whether the subword in @v@ specified by-- @m@ is order isomorphic to @u@.ordiso::Perm0->Perm0->SV.VectorInt->Boolordisouvm=letk=fromIntegral(SV.lengthu)inunsafePerformIO$SV.unsafeWithu$\u'->SV.unsafeWithv$\v'->SV.unsafeWithm$\m'->return.toBool$c_ordiso(castPtru')(castPtrv')(castPtrm')kforeignimportccallunsafe"simple.h simple"c_simple::PtrCLong->CLong->CInt-- | @simple w@ determines whether @w@ is simplesimple::Perm0->Boolsimplew=letn=fromIntegral(SV.lengthw)inunsafePerformIO$SV.unsafeWithw$\w'->return.toBool$c_simple(castPtrw')n-- | @copies subsets p w@ is the list of bitmasks that represent copies of @p@ in @w@.copies::(Int->Int->[SV.VectorInt])->Perm0->Perm0->[SV.VectorInt]copiessubsetspw=filter(ordisopw)$subsetsnkwheren=SV.lengthwk=SV.lengthpavoiders1::(Int->Int->[SV.VectorInt])->(a->Perm0)->Perm0->[a]->[a]avoiders1subsetsfpws=letws0=mapfwsws2=zipws0wsincasegroup(mapSV.lengthws0)of[]->[][_]->letk=SV.lengthpn=SV.length(Prelude.headws0)in[v|(v0,v)<-ws2,not$any(ordisopv0)(subsetsnk)]_->[v|(v0,v)<-ws2,null$copiessubsetspv0]-- | @avoiders subsets st ps ws@ is the list of permutations in @ws@-- avoiding the patterns in @ps@.avoiders::(Int->Int->[SV.VectorInt])->(a->Perm0)->[Perm0]->[a]->[a]avoiders__[]ws=wsavoiderssubsetsf(p:ps)ws=avoiderssubsetsfps$avoiders1subsetsfpws-- Permutation symmetries-- ------------------------ | @reverse \<a_1,...,a_n\> == \<a_n,,...,a_1\>@. E.g., @reverse-- \<9,3,7,2\> == \<2,7,3,9\>@.reverse::Perm0->Perm0reverse=SV.reverse-- | @complement \<a_1,...,a_n\> == \<b_1,,...,b_n\>@, where @b_i = n - a_i - 1@.-- E.g., @complement \<3,4,0,1,2\> == \<1,0,4,3,2\>@.complement::Perm0->Perm0complementw=SV.map(\x->SV.lengthw-x-1)w-- | @inverse w@ is the group theoretical inverse of @w@. E.g.,-- @inverse \<1,2,0\> == \<2,0,1\>@.inverse::Perm0->Perm0inversew=runST$doletn=SV.lengthwv<-MV.unsafeNewnforM_[0..n-1]$\i->MV.unsafeWritev((SV.!)wi)iSV.unsafeFreezev-- | The clockwise rotatation through 90 degrees. E.g.,-- @rotate \<1,0,2\> == \<1,2,0\>@.rotate::Perm0->Perm0rotatew=runST$doletn=SV.lengthwv<-MV.unsafeNewnforM_[0..n-1]$\i->MV.unsafeWritev((SV.!)w(n-1-i))iSV.unsafeFreezev-- Permutation statistics-- ----------------------foreignimportccallunsafe"stat.h asc"c_asc::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h des"c_des::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h exc"c_exc::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h fp"c_fp::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h cyc"c_cyc::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h inv"c_inv::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h maj"c_maj::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h comaj"c_comaj::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h peak"c_peak::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h vall"c_vall::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h dasc"c_dasc::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h ddes"c_ddes::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h lmin"c_lmin::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h lmax"c_lmax::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h lir"c_lir::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h ldr"c_ldr::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h comp"c_comp::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h ep"c_ep::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h dim"c_dim::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h asc0"c_asc0::PtrCLong->CLong->CLongforeignimportccallunsafe"stat.h des0"c_des0::PtrCLong->CLong->CLong-- Marshal a permutation statistic defined in C to on in Haskell.stat::(PtrCLong->CLong->CLong)->Perm0->Intstatfw=unsafePerformIO$SV.unsafeWithw$\ptr->return.fromIntegral$f(castPtrptr)(fromIntegral(SV.lengthw))-- | First (left-most) value of a permutation.head::Perm0->Inthead=SV.head-- | Last (right-most) value of a permutation.last::Perm0->Intlast=SV.last-- | The number of left-to-right minima.rmin::Perm0->Intrmin=lmin.SV.reverse-- | The number of left-to-right maxima.rmax::Perm0->Intrmax=lmax.SV.reverse-- | The right-most increasing run.rir::Perm0->Intrir=ldr.SV.reverse-- | The right-most decreasing run.rdr::Perm0->Intrdr=lir.SV.reverse-- | The number of ascents.asc::Perm0->Intasc=statc_asc-- | The number of descents.des::Perm0->Intdes=statc_des-- | The number of inversions.inv::Perm0->Intinv=statc_inv-- | The major index.maj::Perm0->Intmaj=statc_maj-- | The co-major index.comaj::Perm0->Intcomaj=statc_comaj-- | The number of peaks.peak::Perm0->Intpeak=statc_peak-- | The number of valleys.vall::Perm0->Intvall=statc_vall-- | The number of double ascents.dasc::Perm0->Intdasc=statc_dasc-- | The number of double descents.ddes::Perm0->Intddes=statc_ddes-- | The number of left-to-right minima.lmin::Perm0->Intlmin=statc_lmin-- | The number of left-to-right maxima.lmax::Perm0->Intlmax=statc_lmax-- | The left-most increasing run.lir::Perm0->Intlir=statc_lir-- | The left-most decreasing run.ldr::Perm0->Intldr=statc_ldr-- | The number of excedances.exc::Perm0->Intexc=statc_exc-- | The number of fixed points.fp::Perm0->Intfp=statc_fp-- | The number of cycles.cyc::Perm0->Intcyc=statc_cyc-- | The number of components.comp::Perm0->Intcomp=statc_comp-- | The number of skew components. scomp::Perm0->Intscomp=comp.complement-- | Rank as defined by Elizalde & Pak.ep::Perm0->Intep=statc_ep-- | Dimension (largest non-fixed-point).dim::Perm0->Intdim=statc_dim-- | The number of small ascents.asc0::Perm0->Intasc0=statc_asc0-- | The number of small descents.des0::Perm0->Intdes0=statc_des0-- Left-to-right maxima, etc-- --------------------------- | The set of indices of left-to-right maxima.lMaxima::Perm0->SV.VectorIntlMaximaw=runST$dov<-MV.unsafeNewnk<-itervn0(-1)SV.unsafeFreeze$MV.unsafeSlice0kvwheren=sizew{-# INLINE iter #-}iter_0j_=returnjitervijm=doletm'=(SV.!)w(n-i)ifm'>mthendoMV.unsafeWritevj(n-i)iterv(i-1)(j+1)m'elseiterv(i-1)jm-- | The set of indices of right-to-left maxima.rMaxima::Perm0->SV.VectorIntrMaximaw=SV.reverse.SV.map(\x->SV.lengthw-x-1).lMaxima$reversew-- Components-- ------------ | The set of indices of components.components::Perm0->SV.VectorIntcomponentsw=runST$dov<-MV.unsafeNewnk<-itervn0(-1)SV.unsafeFreeze$MV.unsafeSlice0kvwheren=sizew{-# INLINE iter #-}iter_0j_=returnjitervijm=doletm'=maxm$(SV.!)w(n-i)ifm'==n-ithendoMV.unsafeWritevj(n-i)iterv(i-1)(j+1)m'elseiterv(i-1)jm'-- Sorting operators-- -----------------foreignimportccallunsafe"sortop.h stacksort"c_stacksort::PtrCLong->CLong->IO()foreignimportccallunsafe"sortop.h bubblesort"c_bubblesort::PtrCLong->CLong->IO()-- Marshal a sorting operator defined in C to on in Haskell.sortop::(PtrCLong->CLong->IO())->Perm0->Perm0sortopfw=unsafePerformIO$dov<-SV.thawwMV.unsafeWithv$\ptr->dof(castPtrptr)(fromIntegral(SV.lengthw))SV.unsafeFreezev-- | One pass of stack-sort.stackSort::Perm0->Perm0stackSort=sortopc_stacksort-- | One pass of bubble-sort.bubbleSort::Perm0->Perm0bubbleSort=sortopc_bubblesort-- Single point deletions-- ------------------------ | Delete the element at a given positiondel::Int->Perm0->Perm0deliu=runST$doletn=SV.lengthuletj=(SV.!)uiv<-MV.unsafeNew(n-1)forM_[0..i-1]$\k->doletm=(SV.!)ukMV.unsafeWritevk(ifm<jthenmelsem-1)forM_[i+1..n-1]$\k->doletm=(SV.!)ukMV.unsafeWritev(k-1)(ifm<jthenmelsem-1)SV.unsafeFreezev-- Bitmasks-- --------foreignimportccallunsafe"bit.h next"c_next::CUInt->CUInt-- | Lexicographically, the next 'CUInt' with the same Hamming weight.nextCUInt::CUInt->CUIntnextCUInt=c_nextforeignimportccallunsafe"bit.h ones"c_ones::PtrCUInt->CUInt->IO()-- | @onesCUInt k m@ gives the @k@ smallest indices whose bits are set in @m@.onesCUInt::CUInt->SV.VectorIntonesCUIntm=SV.mapfromIntegral.unsafePerformIO$dov<-MV.unsafeNew(popCountm)MV.unsafeWithv$\ptr->doc_onesptrmSV.unsafeFreezev-- | Lexicographically, the next integral number with the same Hamming weight.nextIntegral::(Integrala,Bitsa)=>a->anextIntegrala=letb=(a.|.(a-1))+1inb.|.((((b.&.(-b))`div`(a.&.(-a)))`shiftR`1)-1)