There must exist a good idiomatic way to express general computations in Haskell on type level. All I can come up with is this (illegal) OO imitation.
class Computation where
compute :: Computation -> Double -> Double
data Id = Id
instance Computation Id where
compute _ = id
data Square a = Computation a => Square a
instance Computation (Square a) where
compute (Square underlying) x = sqr $ compute underlying x where square x = x*x
data Scale a = Computation a => Scale a Double
compute (Scale underlying c) x = c * compute underlying x
Ideally, I would like to retain openness, so this approach doesn't appeal to me. Am I asking for too much?
You can certainly do it with the approach you have, you just need to get the syntax and some of the details right, but this certainly works:
class Computation a where
compute :: a -> Double
instance Computation Double where
compute = id
data Square a = Square a
instance Computation a => Computation (Square a) where
compute (Square underlying) = square $ compute underlying where square i = i * i
data Scale a = Scale a Double
instance Computation a => Computation (Scale a) where
compute (Scale underlying c) = c * compute underlying
data Add a = Add a Double
instance Computation a => Computation (Add a) where
compute (Add underlying c) = c + compute underlying
test :: Add (Scale (Scale (Square Double)))
test = Add (Scale (Scale (Square 2) 5) 0.5) 100
main :: IO ()
main = print $ compute test
Note that I had to add an instance of Computation for Double, which is just simply const. The test expression should be equivalent to (((2^2) * 5) * 0.5) + 100, and indeed comparing these two results I get the same value.
I'm not entirely sure this is the approach that you wanted, though. This also isn't really equivalent to the method shown in the link you posted, expressing variables would be pretty difficult with this encoding as there's no good way to feed in a map of all variable values to reduce the expression.
It depends on what you want to do with computations, but one idiomatic way is this:
data Computation = Computation { compute :: Double -> Double }
Then you can have:
idCmp :: Computation
idCmp = Computation id
squareCmp :: Computation
squareCmp = Computation (\i -> i * i)
composeCmp :: Computation -> Computation -> Computation
composeCmp b a = Computation (compute b . compute a)
scaleCmp :: Double -> Computation
scaleCmp r = Computation (r*)
etc. You could call this a kind of "computation combinators".
Related
I'm trying to get more proficient with recursion schemes as they have so far been really helpful for turning gnarly explicit recursion code into something less spike-y. One of the other tools I tend to reach for when implementing algorithms that can get really confusing with explicit recursion is monad transformers / mutability. Ideally I'd like to get comfortable enough with recursion schemes such that I can ditch statefulness altogether. An example of an algorithm I'd still reach for the transformers for is minimax with alpha beta pruning. I did normal minimax with a catamorphism and minimax f-algebra (data MinimaxF a f = MMResult a | MMState [f] Bool), but I wasn't sure how I could extend this to do alpha beta pruning. I thought maybe I could use histomorphism, or maybe there was some custom solution with comonads, but I didn't know how to approach trying a solution using either technique.
In addition to a version of alpha beta pruning with recursion schemes any general advice you have about tackling similar problems would be much appreciated. For example I've had trouble applying recursion schemes to algorithms like Dijkstra that usually are implemented in an imperative fashion.
Alpha-beta can be seen as an instance of minimax, where min and max are instantiated using a well-chosen lattice. Full gist.
We represent games as a tree, where each internal node is a position in the game, waiting for a designated player to pick a move to a child node, and each leaf is a final position with its score, or value.
-- | At every step, either the game ended with a value/score,
-- or one of the players is to play.
data GameF a r = Value a | Play Player (NonEmpty r)
deriving Functor
type Game a = Fix (GameF a)
-- | One player wants to maximize the score,
-- the other wants to minimize the score.
data Player = Mini | Maxi
minimax will work on any lattice, defined by the following class:
class Lattice l where
inf, sup :: l -> l -> l
The Lattice class is more general than Ord: and Ord instance is a Lattice with decidable equality (Eq). If we could redefine Ord, then it would be appropriate to add Lattice as a superclass. But here a newtype will have to do:
-- The Lattice induced by an Ord
newtype Order a = Order { unOrder :: a }
deriving (Eq, Ord)
instance Ord a => Lattice (Order a) where
inf = min
sup = max
Here's minimax. It is parameterized by an embedding leaf :: a -> l of final values to the chosen lattice. One player maximizes the embedded value, the other player minimizes it.
-- | Generalized minimax
gminimax :: Lattice l => (a -> l) -> Game a -> l
gminimax leaf = cata minimaxF where
minimaxF (Value x) = leaf x
minimaxF (Play p xs) = foldr1 (lopti p) xs
lopti :: Lattice l => Player -> l -> l -> l
lopti Mini = inf
lopti Maxi = sup
The "regular" minimax uses the scores of the game directly as the lattice:
minimax :: Ord a => Game a -> a
minimax = unOrder . gminimax Order
For alpha-beta pruning, the idea is that we can keep track of some bounds on the optimal score, and this allows us to short-circuit the search. So the search is to be parameterized by that interval (alpha, beta). This leads us to a lattice of functions Interval a -> a:
newtype Pruning a = Pruning { unPruning :: Interval a -> a }
An interval can be represented by (Maybe a, Maybe a) to allow either side to be unbounded. But we shall use better named types for clarity, and also to leverage a different Ord instance on each side:
type Interval a = (WithBot a, WithTop a)
data WithBot a = Bot | NoBot a deriving (Eq, Ord)
data WithTop a = NoTop a | Top deriving (Eq, Ord)
We will require that we can only construct Pruning f if f satisfies clamp i (f i) = clamp i (f (Bot, Top)), where clamp is defined below. That way, f is a search algorithm which may shortcircuit if it learns that its result lies outside of the interval, without having to find the exact result.
clamp :: Ord a => Interval a -> a -> a
clamp (l, r) = clampBot l . clampTop r
clampBot :: Ord a => WithBot a -> a -> a
clampBot Bot x = x
clampBot (NoBot y) x = max y x
clampTop :: Ord a => WithTop a -> a -> a
clampTop Top x = x
clampTop (NoTop y) x = min y x
Functions form a lattice by pointwise lifting. And when we consider only functions satisfying clamp i (f i) = clamp i (f (Bot, Top)) and equate them modulo a suitable equivalence relation (Pruning f = Pruning g if clamp <*> f = clamp <*> g), a short-circuiting definition of the lattice becomes possible.
The inf of two functions l and r, given an interval i = (alpha, beta), first runs l (alpha, beta) to obtain a value vl.
If vl <= alpha, then it must be clamp i vl == alpha == clamp i (min vl (r i)) so we can stop and return vl without looking at r. Otherwise, we run r, knowing that the final result is not going to be more than vl so we can also update the upper bound passed to r. sup is defined symmetrically.
instance Ord a => Lattice (Pruning a) where
inf l r = Pruning \(alpha, beta) ->
let vl = unPruning l (alpha, beta) in
if NoBot vl <= alpha then vl else min vl (unPruning r (alpha, min (NoTop vl) beta))
sup l r = Pruning \(alpha, beta) ->
let vl = unPruning l (alpha, beta) in
if beta <= NoTop vl then vl else max vl (unPruning r (max (NoBot vl) alpha, beta))
Thus we obtain alpha-beta as an instance of minimax. Once the lattice above is defined, we only need some simple wrapping and unwrapping.
alphabeta :: Ord a => Game a -> a
alphabeta = runPruning . gminimax constPruning
constPruning :: a -> Pruning a
constPruning = Pruning . const
runPruning :: Pruning a -> a
runPruning f = unPruning f (Bot, Top)
If all goes well, alphabeta and minimax should have the same result:
main :: IO ()
main = quickCheck \g -> minimax g === alphabeta (g :: Game Int)
My goal is to represent a set of types with a similar behaviour in a elegant and performant manner. To achieve this, I have created a solution that utilises a single type, followed by a set of functions that perform pattern matching.
My first question is: is there a way how to represent the same ideas using a single type-class and instead of having a constructor per each variation to have a type that implements said type-class?
Which of the two approaches below is:
- a better recognised design pattern in Haskell?
- more memory efficient?
- more performant?
- more elegant and why?
- easier to use for consumers of the code?
Approach 1: Single type and pattern matching
Suppose there is a following structure:
data Aggregate a
= Average <some necessary state keeping>
| Variance <some necessary state keeping>
| Quantile a <some necessary state keeping>
It's constructors are not public as that would expose the internal state keeping. Instead, a set of constructor functions exist:
newAverage :: Floating a
=> Aggregate a
newAverage = Average ...
newVariance :: Floating a
=> Aggregate a
newVariance = Variance ...
newQuantile :: Floating a
=> a -- ! important, a parameter to the function
-> Aggregate a
newQuantile p = Quantile p ...
Once the object is created, we can perform two functions: put values into it, and once we are satisfied, we can get the current value:
get :: Floating a
=> Aggregate a
-> Maybe a
get (Average <state>) = getAverage <state>
get (Variance <state>) = getVariance <state>
get (Quantile _ <state>) = getQuantile <state>
put :: Floating a
=> a
-> Aggregate a
-> Aggregate a
put newVal (Average <state>) = putAverage newVal <state>
put newVal (Variance <state>) = putVariance newVal <state>
put newVal (Quantile p <state>) = putQuantile newVal p <state>
Approach 2: Type-classes and instances
class Aggregate a where
new :: a
get :: Floating f => a f -> Maybe f
put :: Floating f =>
data Average a = Average Word64 a
data Variance a ...
instance Aggregate Average where
instance Aggregate Variance where
instance Aggregate Quantile where
The obvious problem here is the fact that new is not parametric and thus Quantile can't be initialised with the p parameter. Adding a parameter to new is possible, but it would result in all other non-parametric constructors to ignore the value, which is not a good design.
You are missing the "codata" encoding, which sounds like it might be the best fit for your problem.
data Aggregate a = Aggregate
{ get :: Maybe a
, put :: a -> Aggregate a
}
-- Use the closure to keep track of local state.
newAverage :: (Floating a) => Aggregate a
newAverage = Aggregate { get = Nothing, put = go 0 0 }
where
go n total x = Aggregate { get = Just ((total + x) / (n+1))
, put = go (n+1) (total+x)
}
-- Parameters are not a problem.
newQuantile :: (Floating a) => a -> Aggregate a
newQuantile p = Aggregate { get = ... ; put = \x -> ... }
...
For some reason this approach always slips under the radar of people with OO backgrounds, which is strange because it is a pretty close match to that paradigm.
It's hard to give a general recommendation. I tend to prefer approach 1. Note that you could use
data Aggregate a
= Average AverageState
| Variance VarianceState
| Quantile a QuantileState
and export every constructor above, keeping only the ...State types private to the module.
This might be feasible in some contexts, but not in others, so it has to be evaluated on a case by case basis.
About approach 2, this could be more convenient if you have many constructors / types around. To fix the new problem, one could use type families (or fundeps) as in
class Floating f => Aggregate a f where
type AggregateNew a f
new :: AggregateNew a f -> a f
get :: a f -> Maybe f
put :: ...
instance Floating f => Aggregate Average f where
type AggregateNew (Average a) f = ()
new () = ...
instance Floating f => Aggregate Quantile f where
type AggregateNew (Quantile a) f = a
new x = ...
The naming above is horrible, but I used it to make the point. new takes an argument of type AggregateNew k f which can be () if new needs no information, or some more informative type when it is needed, like a for creating a Quantile.
There is a third approach for defining “aggregators” that neither requires an inextensible sum type nor multiple datatypes + a typeclass.
Approach 3: Single-constructor datatype that puts state behind an existential
Consider this type:
{-# LANGUAGE ExistentialQuantification #-}
data Fold a b = forall x. Fold (x -> a -> x) x (x -> b)
It represents an aggregator that ingests values of type a and eventually "returns" a value of type b while carrying an internal state x.
The constructor has type (x -> a -> x) -> x -> (x -> b) -> Fold a b. It takes a step function, an initial state and a final "summary" function. Notice that the state is decoupled from the return value b. They can be the same, but it's not required.
Also, the state is existentially quantified. We know the type of the state when we create a Fold, and we can work with it when we pattern-match on the Fold—in order to feed it data through the step function—but it's not reflected in the Fold's type. We can put Fold values with different inner states in the same container without problems, as long as they ingest and return the same types.
This pattern is sometimes called a “beautiful fold”. There is a library called foldl that is based on it, and provides may premade folds and utility functions.
The Fold type in foldl has many useful instances. In particular, the Applicative instance lets us create composite folds that still traverse the input data a single time, instead of requiring multiple passes.
How to create particle effects in Haskell using the Gloss library? (e.g. to show an explosion)
If anyone could help me out a bit on how this is done it'd be much appreciated.
Best Regards,
Skyfe.
The comment on the question does a good job of providing a high-level solution, but I'm writing this answer to add detail.
Let's start by modeling the real-world object we want to represent. In our case, it's a particle. A particle ought to have a position, a velocity and an acceleration, all of which we can represent using 2D vectors. A reasonable way to store 2D vectors in Haskell is to use the Linear.V2 module. Next, let's think about nice additional properties we'd like a particle should have, specifically one involved in a firework or explosion. Notice how the particles in a firework burn bright for a time and then just 'fizzle out'? Let's call said time the particle's lifespan, and represent it using a Float. We can now create an appropriate representation for a Particle and a Cluster of Particles
data Particle = Particle
{ _age :: Float
, _lifespan :: Float
, _position :: V2 Float
, _velocity :: V2 Float
, _acceleration :: V2 Float }
deriving ( Show )
type Cluster = [Particle]
makeLenses ''Particle
There's an extra field called age in our datatype above. The lifespan of the particle represents the time for which the particle exists from creation to death, while its age represents the time that has passed since the Particle's creation. In other words, a Particle should disappear when its age exceeds its lifespan. Keep that in mind for later.
Next, let's write a function that helps us create a Particle. All it does is set the initial age to 0 and leave the rest up to additional arguments
makeParticle :: Float -> V2 Float -> V2 Float -> V2 Float -> Particle
makeParticle = Particle 0
Once this is done, we can write a function that helps us create a Cluster of n particles
makeCluster :: Int -> (Int -> Particle) -> Cluster
makeCluster n particleGen = map particleGen [0..(n - 1)]
After that, we create a function that will allow us to advance a Particle by dt seconds. The function advances the Particle's
age, changes its position based on its velocity and finally changes its velocity based on its acceleration. In the end, if the age of the Particle is more than its lifespan, we symbolize the deletion of the Particle by evaluating to Nothing instead of Just the changed particle.
advanceParticle :: Float -> Particle -> Maybe Particle
advanceParticle dt = hasDecayed . updateVel . updatePos . updateAge
where
r2f = realToFrac
hasDecayed p = if p^.age < p^.lifespan then Just p else Nothing
updateAge p = (age %~ (dt +)) p
updatePos p = (position %~ (r2f dt * p^.velocity +)) p
updateVel p = (velocity %~ (r2f dt * p^.acceleration +)) p
The following function advances a Cluster, and gets rid of 'dead' Particles
advanceCluster :: Float -> Cluster -> Cluster
advanceCluster dt = catMaybes . map (advanceParticle dt)
Now we can move on to the part of the code that has to do with actually drawing particles using Graphics.Gloss. We're going to use a Cluster to represent the state of the simulation, and so we start with a function that returns a Cluster representing the initial state of the program. For a simple animation we're going to simulate a firework, where all the particles start in the same position, have the same lifespan, radiate out from their central position at regular angles, and are subject to the same acceleration
initState :: Cluster
initState = makeCluster numParticles particleGen
where
numParticles = 10
particleGen :: Int -> Particle
particleGen i =
makeParticle initLifespan
initPosition
(initVelMagnitude * V2 (cos angle) (sin angle))
initAcceleration
where
fI = fromIntegral
angle = (fI i) * 2 * pi / (fI numParticles)
initLifespan = 10
initPosition = V2 0 0
initVelMagnitude = 5
initAcceleration = V2 0 (-3)
Then we write a function to draw a Cluster on to the screen
drawState :: Cluster -> Picture
drawState = pictures . map drawParticle
where
drawParticle :: Particle -> Picture
drawParticle p =
translate (p^.position._x) (p^.position._y) .
color (colorAdjust (p^.age / p^.lifespan)) .
circleSolid $ circleRadius
where
circleRadius = 3
colorAdjust a = makeColor 1 0 0 (1 - a)
Probably the only non-standard part about this is the colorAdjust function. What I was going for here was to color a Particle red and when it's created have it not be transparent at all (i.e. alpha value of 1) and keep fading out as its age approaches its lifespan (i.e. alpha value that keeps approaching 0)
We're almost done! Add a function that updates the Cluster to reflect the passage of time
stepState :: ViewPort -> Float -> Cluster -> Cluster
stepState _ = advanceCluster
Finish up the program by writing a main function that ties everything together
main :: IO ()
main =
simulate (InWindow name (windowWidth, windowHeight)
(windowLocX, windowLocY))
bgColor
stepsPerSec
initState
drawState
stepState
where
name = "Fireworks!"
windowWidth = 300
windowHeight = 300
windowLocX = 30
windowLocY = 30
stepsPerSec = 30
bgColor = white
I hope this helps!
How to numerically integrate complex, complex-valued functions in Haskell?
Are there any existing libraries for it? numeric-tools operates only on reals.
I am aware that on complex plane there's only line integrals, so the interface I am interested in is something like this:
i = integrate f x a b precision
to calculate integral along straight line from a to b of function f on point x.
i, x, a, b are all of Complex Double or better Num a => Complex a type.
Please... :)
You can make something like this yourself. Suppose you have a function realIntegrate of type (Double -> Double) -> (Double,Double) -> Double, taking a function and a tuple containing the lower and upper bounds, returning the result to some fixed precision. You could define realIntegrate f (lo,hi) = quadRomberg defQuad (lo,hi) f using numeric-tools, for example.
Then we can make your desired function as follows - I'm ignoring the precision for now (and I don't understand what your x parameter is for!):
integrate :: (Complex Double -> Complex Double) -> Complex Double -> Complex Double -> Complex Double
integrate f a b = r :+ i where
r = realIntegrate realF (0,1)
i = realIntegrate imagF (0,1)
realF t = realPart (f (interpolate t)) -- or realF = realPart . f . interpolate
imagF t = imagPart (f (interpolate t))
interpolate t = a + (t :+ 0) * (b - a)
So we express the path from a to b as a function on the real interval from 0 to 1 by linear interpolation, take the value of f along that path, integrate the real and imaginary parts separately (I don't know if this can give numerically badly behaving results, though) and reassemble them into the final answer.
I haven't tested this code as I don't have numeric-tools installed, but at least it typechecks :-)
I'm trying to implement turtle graphics in Haskell. The goal is to be able to write a function like this:
draw_something = do
forward 100
right 90
forward 100
...
and then have it produce a list of points (maybe with additional properties):
> draw_something (0,0) 0 -- start at (0,0) facing east (0 degrees)
[(0,0), (0,100), (-100,100), ...]
I have all this working in a 'normal' way, but I've failed to implement it as a Haskell Monad and use the do-notation. The basic code:
data State a = State (a, a) a -- (x,y), angle
deriving (Show, Eq)
initstate :: State Float
initstate = State (0.0,0.0) 0.0
-- constrain angles to 0 to 2*pi
fmod :: Float -> Float
fmod a
| a >= 2*pi = fmod (a-2*pi)
| a < 0 = fmod (a+2*pi)
| otherwise = a
forward :: Float -> State Float -> [State Float]
forward d (State (x,y) angle) = [State (x + d * (sin angle), y + d * (cos angle)) angle]
right :: Float -> State Float -> [State Float]
right d (State pos angle) = [State pos (fmod (angle+d))]
bind :: [State a] -> (State a -> [State a]) -> [State a]
bind xs f = xs ++ (f (head $ reverse xs))
ret :: State a -> [State a]
ret x = [x]
With this I can now write
> [initstate] `bind` (forward 100) `bind` (right (pi/2)) `bind` (forward 100)
[State (0.0,0.0) 0.0,State (0.0,100.0) 0.0,State (0.0,100.0) 1.5707964,State (100.0,99.99999) 1.5707964]
And get the expected result. However I can't make this an instance of Monad.
instance Monad [State] where
...
results in
`State' is not applied to enough type arguments
Expected kind `*', but `State' has kind `* -> *'
In the instance declaration for `Monad [State]'
And if I wrap the list in a new object
data StateList a = StateList [State a]
instance Monad StateList where
return x = StateList [x]
I get
Couldn't match type `a' with `State a'
`a' is a rigid type variable bound by
the type signature for return :: a -> StateList a
at logo.hs:38:9
In the expression: x
In the first argument of `StateList', namely `[x]'
In the expression: StateList [x]
I tried various other versions but I never got it to run as I'd like to. What am I doing wrong? What do I understand incorrectly?
The monad you're devising needs to have two type parameters. One for the saved trail (which will be fixed for a particular do sequence) and other for the results of computations.
You also need to think about how to compose two turtle-monadic values so that the binding operation is associative. For example,
right 90 >> (right 90 >> forward 100)
must be equal to
(right 90 >> right 90) >> forward 100
(and of course similarly for >>= etc.). This means that if you represent the turtle's history by a list of points, the binding operation most likely just cannot append the lists of points together; forward 100 alone will result in something like [(0,0),(100,0)] but when it's prepended with rotation, the saved points need to be rotated too.
I'd say that the simplest approach would be to use the Writer monad. But I wouldn't save the points, I'd save just the actions the turtle performs (so that we don't need to rotate the points when combining the values). Something like
data Action = Rotate Double | Forward Double
type TurtleMonad a = Writer [Action] a
(This also means that we don't need to track the current direction, it's contained in the actions.) Then each of your functions just writes its argument into the Writer. And at the end, you can extract the final list from it and make a simple function that converts all the actions into a list of points:
track :: [Action] -> [(Double,Double)]
Update: Instead of using [Action] it would be better to use Seq from Data.Sequence. It's also a monoid and concatenating two sequences is very fast, it's amortized complexity is O(log(min(n1,n2))), compared to O(n1) of (++). So the improved type would be
type TurtleMonad a = Writer (Seq Action) a