module TBit.Parameterization ( loadParams
, getScalar
, getVector
, getMesh
, crunch
, primitiveLattice
, recipPrimitiveLattice) where
import TBit.Types
import Prelude hiding (map, head)
import Control.Monad.State
import Control.Monad.Except
import qualified Data.Map as M
import Data.Complex
import Data.List (map, head)
import Data.Maybe
import Numeric.LinearAlgebra.HMatrix (toColumns, fromRows, col, linearSolve, Vector)
loadParams :: [(String, a)] -> M.Map String a
loadParams = foldl (flip (uncurry M.insert)) M.empty
getScalar :: String -> Parameterized (Complex Double)
getScalar s = do p <- gets (M.lookup s . scalarParams)
if isJust p
then return $ fromJust p
else throwError
$ UnknownParameter s
realScalar :: String -> Parameterized Double
realScalar = liftM realPart . getScalar
complexScalar :: String -> Parameterized (Complex Double)
complexScalar = getScalar
getVector :: String -> Parameterized (Vector (Complex Double))
getVector s = do p <- gets (M.lookup s . vectorParams)
if isJust p
then return $ fromJust p
else throwError
$ UnknownParameter s
getMesh :: Parameterized Meshing
getMesh = gets meshingData
crunch :: Parameterized a -> Parameters -> Either TBError a
crunch pmz ps = fst $ runState (runExceptT pmz) ps
primitiveLattice :: Parameterized Lattice
primitiveLattice = gets latticeData
recipPrimitiveLattice :: Parameterized Lattice
recipPrimitiveLattice = do lat <- primitiveLattice
let l = length lat
let bs = [ linearSolve (fromRows lat)
(col $ mtx l n)
| n <- [1..l]]
if any isNothing bs
then throwError SingularLatticeError
else (return . map (head . toColumns) . catMaybes) bs
where mtx l n = [ 2.0 * pi * kd n j | j <- [1..l] ]
kd a b = if a == b then 1.0 else 0.0