module TBit.Hamiltonian.Builder.Examples where
import Data.Graph.Inductive.Graph
import Numeric.LinearAlgebra.HMatrix
import TBit.Types
import Data.Monoid
ring :: Int -> CellGraph
ring n = hermitize $ mkGraph vs es
where vs = [ (j, ScalarSite j) | j <- [1..n] ]
es = (n, 1, unit 1 unit n)
: [ (j, j+1, unit (j+1) unit j) | j <- [1..pred n]]
m = fromIntegral n
unit :: Int -> Vector Double
unit j' = let j = fromIntegral j'
in vector [ cos $ 2*pi*j/m , sin $ 2*pi*j/m ]
squareLattice :: CellGraph
squareLattice = mkGraph vs es
where vs = [ (1, ScalarSite 1) ]
es = [ (1, 1, vector [0,1])
, (1, 1, vector [1,0])
, (1, 1, vector [0,1])
, (1, 1, vector [1,0]) ]
hexLattice :: CellGraph
hexLattice = hermitize $ mkGraph vs es
where vs = [ (1, ScalarSite 1)
, (2, ScalarSite 2)]
es = [ (1, 2, vector [cos $ 2*pi/3, sin $ 2*pi/3])
, (1, 2, vector [cos $ 4*pi/3, sin $ 4*pi/3])
, (1, 2, vector [1,0]) ]
kagomeLattice :: CellGraph
kagomeLattice = hermitize $ mkGraph vs (map (fmap (scale 0.5)) es)
where vs = [ (1, VectorSite 1 delta1)
, (2, VectorSite 2 delta2)
, (3, VectorSite 3 delta3)]
es = [ (1, 2, vector [1,0])
, (1, 2, negate $ vector [1,0])
, (2, 3, vector [cos $ 4*pi/3, sin $ 4*pi/3])
, (2, 3, negate $ vector [cos $ 4*pi/3, sin $ 4*pi/3])
, (3, 1, vector [cos $ 2*pi/3, sin $ 2*pi/3])
, (3, 1, negate $ vector [cos $ 2*pi/3, sin $ 2*pi/3]) ]
delta1 = vector [ cos $ pi/6, sin . negate $ pi/6 ]
delta2 = vector [ cos $ 7*pi/6 , sin $ 7*pi/6 ]
delta3 = vector [ 0 , 1 ]
instance Graph g => Monoid (g a b) where
mempty = empty
mappend g g' = mkGraph (labNodes g ++ labNodes g')
(labEdges g ++ labEdges g')
kagomeRibbon :: Int -> CellGraph
kagomeRibbon = hermitize . kagomeRibbon'
kagomeRibbon' :: Int -> CellGraph
kagomeRibbon' 0 = hermitize $ mkGraph vs es
where vs = [ (1, VectorSite 1 delta1)
, (2, VectorSite 2 delta2) ]
es = [ (1, 2, vector [0.5, 0]) ]
delta1 = vector [ cos $ pi/6, sin . negate $ pi/6 ]
delta2 = vector [ cos $ 7*pi/6 , sin $ 7*pi/6 ]
kagomeRibbon' n = (mkGraph vs es) `mappend` (boost $ kagomeRibbon (pred n))
where vs = [ (1, VectorSite 1 delta1)
, (2, VectorSite 2 delta2)
, (3, VectorSite 3 delta3) ]
es = [ (1, 2, e12)
, (2, 3, e23)
, (3, 1, e31)
, (2, 1, e12)
, (3, 4, negate e31)
, (3, 5, e23)]
e12 = vector [0.5, 0]
e23 = vector [cos $ 4*pi/3, sin $ 4*pi/3]
e31 = vector [cos $ 2*pi/3, sin $ 2*pi/3]
delta1 = vector [ cos $ pi/6, sin . negate $ pi/6 ]
delta2 = vector [ cos $ 7*pi/6 , sin $ 7*pi/6 ]
delta3 = vector [ 0 , 1 ]
boost g = let (e,v) = ( labEdges g , labNodes g )
in mkGraph ( map (\(nd, VectorSite _ dt)
-> (nd + 3, VectorSite (nd + 3) dt)) v )
( map (\(src, tgt, dlt)
-> (src + 3, tgt + 3, dlt)) e )
hermitize :: CellGraph -> CellGraph
hermitize g = insEdges (map (\(x,y,r) -> (y,x,negate r)) $ labEdges g) g