[Haskell] Some help in operator precedence
Edgar Z. Alvarenga
edgar at ymonad.com
Sun Mar 7 19:54:40 EST 2010
I created a simple program in Haskell to simulate the Physics Ising model
(http://en.wikipedia.org/wiki/Ising_model) with Metropolis algorithm:
http://haskell.pastebin.com/Zt0gguEa
And used Data.Vector.Unboxed.Mutable to model de 2D grid. To this a used
a unidimensional vector, but created a operator to write and other to read
the vector using a tuple to specify the position:
newtype Grid = Grid { unG :: (Int, MVector (PrimState IO) Int) }
newtype Ising = Ising { unI :: (M.MTGen, Grid) }
type Pos = (Int, Int)
(|>) :: Grid -> Pos -> IO Int
(Grid (n,g)) |> (x,y) | x == n = U.unsafeRead g (y*n)
| x == -1 = U.unsafeRead g (y*n + n - 1)
| y == n = U.unsafeRead g x
| y == -1 = U.unsafeRead g ((n - 1)*n + x)
| otherwise = U.unsafeRead g (y*n + x)
(<==) :: Pos -> Int -> (Pos, Int)
pos <== val = (pos,val)
(<|) :: Grid -> (Pos, Int) -> IO ()
Grid (n,g) <| ((x,y), val) = U.unsafeWrite g (y*n + x) val
infixr 1 <==
infixr 0 <|
With this I can write expressions like:
s <- g |> (x,y)
grid <| (i,j) <== spin (rnumber `mod` 2)
my problem is with the (<==) and (<|) operators, because in the way I defined
I can't use:
grid <| (i,j) <== spin $ rnumber `mod` 2
Is there way to solve this and don't have to use the parenthesis on the right expression?
And I really would like to now with this approach to the 2D vector is a good idea
or is better to use another data structur instead of the mutable vector.
Comments about the code are really welcome.
Edgar
More information about the Haskell
mailing list