diff options
| -rw-r--r-- | wolff.hs | 62 |
1 files changed, 38 insertions, 24 deletions
@@ -1,46 +1,60 @@ - {-# LANGUAGE MultiParamTypeClasses #-} -import Data.Sequence -import Data.Monoid -import Data.Monoid.Action -import Data.Group +import Control.Monad.Mersenne.Random import Data.Char import Data.Graph -import Control.Monad.Mersenne.Random +import Data.Group +import Data.Monoid +import Data.Monoid.Action +import Data.Sequence -data Z2 = E0 | E1 deriving (Eq, Show) -data Ising = Up | Down deriving (Eq, Show) +data Z2 + = E0 + | E1 + deriving (Eq, Show) + +data Ising + = Up + | Down + deriving (Eq, Show) instance Semigroup Z2 where - -- Z2 is a semigroup E0 <> a = a - E1 <> a | a == E0 = E1 - | otherwise = E0 + E1 <> a + | a == E0 = E1 + | otherwise = E0 instance Monoid Z2 where - -- Z2 is a monoid - mempty = E0 + mempty = E0 mappend a b = a <> b instance Group Z2 where - -- Z2 is a group invert = id instance Action Z2 Ising where - -- Z2 has an action on Ising spins act E0 a = a - act E1 a | a == Up = Down - | otherwise = Up + act E1 a + | a == Up = Down + | otherwise = Up -squareLatticeEdges d l = [(i, (l^j) * quot i (l^j) + mod (l^j + i + s * l^(j-1)) (l^j)) | j <- [1..d], i <- [0..(l^d)-1], s <- [-1, 1]] -ghostEdges n = [(n, i) | i <- [0..n-1]] ++ [(i, n) | i <- [0..n-1]] -squareLattice d l = buildG (0, l^d) ((squareLatticeEdges d l) ++ ghostEdges (l^d)) +squareLatticeEdges d l = + [ (i, (l ^ j) * quot i (l ^ j) + mod (l ^ j + i + s * l ^ (j - 1)) (l ^ j)) + | j <- [1 .. d] + , i <- [0 .. (l ^ d) - 1] + , s <- [-1, 1] + ] -data State r x = State { ghost :: r, spins :: Seq x } +ghostEdges n = [(n, i) | i <- [0 .. n - 1]] ++ [(i, n) | i <- [0 .. n - 1]] -j :: Ising -> Ising -> Integer -j a b | a == b = 1 - | otherwise = -1 +squareLattice d l = buildG (0, l ^ d) ((squareLatticeEdges d l) ++ ghostEdges (l ^ d)) +data State r x = + State + { ghost :: r + , spins :: Seq x + } +j :: Ising -> Ising -> Integer +j a b + | a == b = 1 + | otherwise = -1 |