%include lhs2TeX.fmt
%align 33

\begin{code}
module Tcsa (Sector(NS,R),Params(..),Chiral(..),BaseVector(..),Operator,getStates) where
import Complex

data Sector                     =  NS | R deriving (Eq,Show,Read)

data Params                     =  Params { cut::Rational, rs::[Float], sector::Sector, spin::Int,
                                            radius::Rational, topCharge::Int, prefac::Float, delta::Float }

type Operator a                 =  a -> a -> Complex Float

class Chiral a where
    weight                      :: a -> Rational
    norm'                       :: a -> Float

class BaseVector a where
    scaleDimension              :: a -> Rational
    spinOf                      :: a -> Int
    norm                        :: a -> Float
    energy                      :: a -> Float
    baseLevels                  :: Params -> [[a]]
    showParams                  :: Operator a -> Params -> String -- dummy operator
\end{code}
Here we select the vectors with scaling dimension not greater than
|cut|.  The minimal scaling dimensions in the sublists must form a
nondecreasing series.
\begin{code}
cutAbove                        :: BaseVector a => Rational -> [[a]] -> [a]
cutAbove limit (level:levels)
    | null level                =  {-# SCC "cutAbove1" #-} cutAbove limit levels
    | null filtered             =  {-# SCC "cutAbove2" #-} []
    | otherwise                 =  {-# SCC "cutAbove3" #-} filtered ++ cutAbove limit levels
    where filtered = {-# SCC "cutAbove4" #-} filter ((limit>=).scaleDimension) level
\end{code}
It's vital to perform the cut before the spin selection: that can ruin
the monotonicity required above.
\begin{code}
spinSelect                      :: BaseVector a => Int -> [a] -> [a]
spinSelect s vects              =  filter ((s==).spinOf) vects

getStates                       :: BaseVector a => Params -> [a]
getStates params                =  spinSelect (spin params) $ cutAbove (cut params) (baseLevels params)
\end{code}

% Local Variables:
% mode: latex
% mode: auto-fill
% eval: (local-set-key "\C-C\C-c" 'compile)
% TeX-master: "Fermion"
% mmm-classes: literate-haskell
% End: