NB: The type I define below is just a convenient example for the purposes of this question; I'm sure there's no any need for me to roll my own definition of complex numbers in Haskell.
I don't know if I'm using the right terminology here, but the selector r below is ane example of what I mean by a "partial" record selector:
data Complex = Polar { r :: Float, y :: Float }
| Rectangular { x :: Float, y :: Float }
deriving Show
r is "partial" because it cannot be applied to all Complex values; e.g.
r $ Polar 3 0
-- 3.0
...but
r $ Rectangular 3 0
-- *** Exception: No match in record selector r
In this case, however, there's a sensible definition for r $ Rectangular x y, namely:
-- assuming {-# LANGUAGE RecordWildCards #-}
r :: Complex -> Float
r Rectangular { .. } = sqrt $ (x * x) + (y * y)
GHCi rejects this definition of r, with a multiple declarations of ‘r’ error.
Is there a way to extend r so that it can be applied to any Complex value?
Of course, I realize that I can define something like
-- assuming {-# LANGUAGE RecordWildCards #-}
modulus :: Complex -> Float
modulus Polar { .. } = r
modulus Rectangular { .. } = sqrt $ (x * x) + (y * y)
...but I want to know if it is possible to extend the already existing selector r.
No, and IMO such record selectors should never be introduced in the first place. I'd write this as
type ℝ = Float -- Note that Double is usually more sensible
newtype S¹ = S¹ {ϑ :: ℝ} -- in [-π, π[
newtype ℝPlus = ℝPlus {posℝ :: ℝ} -- in [0, ∞[
data Complex = Polar ℝPlus S¹
| Rectangular ℝ ℝ
deriving Show
This way, there is no error potential in form of partial record selectors, and also no confusion what to unpack etc.. Even for such a “non-record type”, you can write your own accessors, preferrably in lens form:
import Control.Lens
r :: Lens' Complex ℝPlus
r = lens get set
where get (Polar r _) = r
get (Rectangular x y) = ℝPlus . sqrt $ x^2 + y^2
set (Polar _ θ) r = Polar r θ
set (Rectangular x y) (ℝPlus r) = Rectangular (x * η) (y * η)
where η = r / sqrt (x^2 + y^2)
Related
How to derive a parameterized similarity in a way that it would be convenient to use in Haskell?
The class should be such that the domain can be numeric or text (and possibly something else), and the parameter controlling the internals of comparison function can also be of several types.
Below, you may find the one approach that uses two class parameters. What implications this design entails if the goal is to define several "similarity or equality groups"? (What kind of use cases would be hard to implement compared to some alternative implementation?) In this example, the similarity groups of words could be defined to be edit distances of one, two etc. and in double to be different precisions.
Some of the methods take both numeric and textual inputs like the "quiteSimilar"-method. Why not use just some distance? Some of the similarities should be able to be defined by the user of the parameterized equality, e.g. on text (words) they could be based on synonyms.
And on doubles, well, I don't know yet, what kind of comparisons will be needed. (Suggestions are welcome.) After equalities comes the question, how to compare the order of items so that similar items will be deemed to be equal and not the larger and smaller, see the last line of the output.
{-# LANGUAGE MultiParamTypeClasses #-}
import Data.Array
import qualified Data.Text as T
-- parameterized eq
class Peq a b where peq :: a -> b -> b -> Bool
instance Peq Double Double where peq = almostEqRelPrec
instance Peq Int T.Text where peq = editDistance
class Comment a where
quiteSimilar :: a -> a -> T.Text
instance Comment Double where
quiteSimilar a b = if peq (epsilon * 100::Double) a b then T.pack "alike" else T.pack "unalike"
instance Comment T.Text where
quiteSimilar a b = if peq (1::Int) a b then T.pack "alike" else T.pack "unalike"
x1' x = quiteSimilar 0.25 (0.25 - x * epsilon :: Double)
x1 = quiteSimilar 0.25 (0.25 - 25 * epsilon :: Double)
x2 = quiteSimilar 0.25 (0.25 - 26 * epsilon :: Double)
x3' x = quiteSimilar 1e12 (1e12 - x * ulp 1e12 :: Double)
x3 = quiteSimilar 1e12 (1e12 - 181 * ulp 1e12 :: Double)
x4 = quiteSimilar 1e12 (1e12 - 182 * ulp 1e12 :: Double)
u181 = 181 * ulp 1e12 :: Double
main = do
let a = 0.2 + 0.65 :: Double
b = 0.85 :: Double
s = T.pack "trial"
t = T.pack "tr1al"
putStrLn $ "0.2 + 0.65 = " ++ show a ++ " and compared to " ++ show b ++ ", it is " ++ T.unpack (quiteSimilar a b)
putStrLn $ "Texts " ++ T.unpack s ++ " and " ++ T.unpack t ++ " are " ++ T.unpack (quiteSimilar s t)
putStrLn $ "Note that " ++ show a ++ " > " ++ show b ++ " is " ++ show (a > b)
-- packege Numeric.Limits contains this one
epsilon :: RealFloat a => a
epsilon = r
where r = 1 - encodeFloat (m-1) e
(m, e) = decodeFloat (1 `asTypeOf` r)
ulp :: RealFloat a => a -> a
ulp a = r
where r = a - encodeFloat (m-1) e
(m, e) = decodeFloat (a `asTypeOf` r)
almostEqRelPrec :: (RealFloat a) => a -> a -> a -> Bool
almostEqRelPrec maxRelPrec a b = d <= (largest * maxRelPrec)
where
d = abs $ a - b
largest = max (abs a) (abs b)
editDistance :: Int -> T.Text -> T.Text -> Bool
editDistance i a b = i == editDistance' (show a) (show b)
-- from https://wiki.haskell.org/Edit_distance
-- see also https://hackage.haskell.org/package/edit-distance-0.2.2.1
editDistance' :: Eq a => [a] -> [a] -> Int
editDistance' xs ys = table ! (m,n)
where
(m,n) = (length xs, length ys)
x = array (1,m) (zip [1..] xs)
y = array (1,n) (zip [1..] ys)
table :: Array (Int,Int) Int
table = array bnds [(ij, dist ij) | ij <- range bnds]
bnds = ((0,0),(m,n))
dist (0,j) = j
dist (i,0) = i
dist (i,j) = minimum [table ! (i-1,j) + 1, table ! (i,j-1) + 1,
if x ! i == y ! j then table ! (i-1,j-1) else 1 + table ! (i-1,j-1)]
On my machine, the output is:
0.2 + 0.65 = 0.8500000000000001 and compared to 0.85, it is alike
Texts trial and tr1al are alike
Note that 0.8500000000000001 > 0.85 is True
Edit:
Trying to rephrase the question: could this be achieved more elegantly with a similarity class that has only one parameter a and not two (a and b)? I have a feeling that multiparameter classes may turn out to be difficult later on. Is this a needless fear? First solution along this line that came to my mind was to define similarity class with one parameter a and a class for functions having two parameters. And on instances constraint other type to be similarity class parameter and the other would be for actual method returning Bool.
Are there some benefits of using the latter approach to the one presented? Or actually what are the possible trade-offs between these approaches? And if there are still more ways to make achieve this kind of things, how do they compare?
could this be achieved more elegantly with a similarity class that has only one parameter a and not two (a and b)
Yes. Many MultiParamTypeClasses can be rewritten quite easily to single-param ones... by simply degrading the second parameter to an associated type family:
{-# LANGUAGE TypeFamilies #-}
class Peq b where
type SimilarityThreshold b :: *
peq :: SimilarityThreshold b -> b -> b -> Bool
instance Peq Double where
type SimilarityThreshold Double = Double
peq = almostEqRelPrec
instance Peq T.Text where
type SimilarityThreshold T.Text = Int
peq = editDistance
This is quite a bit more verbose, but indeed I tend to favour this style. The main difference is that the associated type family always assigng each type of values to be compared unambiguously a threshold-type. This can save you some could not deduce... type inference trouble, however it also means that you can't use two different metric-types for a single type (but why would you, anyway).
Note that you can achieve exactly the same semantics by simply adding a fundep to your original class:
{-# LANGUAGE FunctionalDependencies #-}
class Peq a b | b -> a where
peq :: a -> b -> b -> Bool
This is just a bit different in usage – again I tend to favour the type families approach: it is more explicit in what the parameters are for, while at the same time avoiding the second parameter to turn up in the constraints to any Peq-polymorphic function.
How do I optimize numerical integration routine (comparing to C)?
What has been done to the moment:
I replaced lists with unboxed vectors (obvious).
I applied profiling techniques described in the book "Read World Haskell" http://book.realworldhaskell.org/read/profiling-and-optimization.html.
I have inlined some trivial functions and inserted a lot of bangs everywhere.
That gave about 10x speedup.
I refactored the code (i.e. extracted iterator function). That gave 3x speedup.
I tried to replace polymorphic signatures with Floats
as in the answer to this question
Optimizing numerical array performance in Haskell.
That gave almost 2x speedup.
I compile like this
cabal exec ghc -- Simul.hs -O2 -fforce-recomp -fllvm -Wall
UPDATE As suggested by cchalmers, type Sample = (F, F) was replaced with
data Sample = Sample {-# UNPACK #-} !F {-# UNPACK #-} !F
The performance now is almost as good as C code. Can we do better?
{-# LANGUAGE BangPatterns #-}
module Main
where
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import qualified Control.Monad.Primitive as PrimitiveM
import Dynamics.Nonlin ( birefrP )
type F = Float
type Delay = U.Vector F
type Input = U.Vector F
-- Sample can be a vector of any length (x, y, z, ...)
data Sample = Sample {-# UNPACK #-} !F {-# UNPACK #-} !F
-- Pair is used to define exactly a pair of values
data Pair = Pair {-# UNPACK #-} !F {-# UNPACK #-} !F
type ParametrizedDelayFunction = (Sample, F) -> Sample
getX :: Sample -> F
getX (Sample a _) = a
{-# INLINE getX #-}
toDelay :: [F] -> Delay
toDelay = U.fromList
stepsPerNode :: Int
stepsPerNode = 40 -- Number of integration steps per node
infixl 6 ..+..
(..+..) :: Sample -> Sample -> Sample
(..+..) (Sample x1 y1) (Sample x2 y2) = Sample (x1 + x2) (y1 + y2)
{-# INLINE (..+..) #-}
infixl 7 .*..
(.*..) :: F -> Sample -> Sample
(.*..) c (Sample x2 y2) = Sample (c * x2) (c * y2)
{-# INLINE (.*..) #-}
-- | Ikeda model (dynamical system, DDE)
ikeda_model2
:: (F -> F) -> (Sample, F) -> Sample
ikeda_model2 f (!(Sample x y), !x_h) = Sample x' y'
where
! x' = recip_epsilon * (-x + (f x_h))
y' = 0
recip_epsilon = 2^(6 :: Int)
-- | Integrate using improved Euler's method (fixed step).
--
-- hOver2 is already half of step size h
-- f is the function to integrate
-- x_i is current argument (x and y)
-- x_h is historical (delayed) value
-- x_h2 it the value after x_h
heun2 :: F -> ParametrizedDelayFunction
-> Sample -> Pair -> Sample
heun2 hOver2 f !x !(Pair x_h x_h2) = x_1
where
! f1 = f (x, x_h)
! x_1' = x ..+.. 2 * hOver2 .*.. f1
! f2 = f (x_1', x_h2)
! x_1 = x ..+.. hOver2 .*.. (f1 ..+.. f2)
initialCond :: Int -> (Sample, Delay, Int)
initialCond nodesN = (initialSampleXY, initialInterval, samplesPerDelay)
where cdi = 1.1247695e-4 :: F -- A fixed point for birefrP
initialInterval = U.replicate samplesPerDelay cdi
samplesPerDelay = nodesN * stepsPerNode
initialSampleXY = Sample 0.0 0.0
integrator
:: PrimitiveM.PrimMonad m =>
(Sample -> Pair -> Sample)
-> Int
-> Int
-> (Sample, (Delay, Input))
-> m (Sample, U.Vector F)
integrator iterate1 len total (xy0, (history0, input)) = do
! v <- UM.new total
go v 0 xy0
history <- U.unsafeFreeze v
-- Zero y value, currently not used
let xy = Sample (history `U.unsafeIndex` (total - 1)) 0.0
return (xy, history)
where
h i = history0 `U.unsafeIndex` i
go !v !i !xy
-- The first iteration
| i == 0 = do
let !r = iterate1 xy (Pair (h 0) (h 1))
UM.unsafeWrite v i (getX r)
go v 1 r
| i < len - 1 = do
let !r = iterate1 xy (Pair (h i) (h $ i + 1))
UM.unsafeWrite v i (getX r)
go v (i + 1) r
| i == total = do
return ()
-- Iterations after the initial history has been exhausted
| otherwise = do
! newX0 <- if i == len - 1
then return (getX xy0)
else UM.unsafeRead v (i - len - 1)
! newX <- UM.unsafeRead v (i - len)
let !r = iterate1 xy (Pair newX0 newX)
UM.unsafeWrite v i (getX r)
go v (i + 1) r
-- Not used in this version
zero :: Input
zero = U.fromList []
nodes :: Int
nodes = 306
main :: IO ()
main = do
let delays = 4000
(sample0, hist0, delayLength) = initialCond nodes
-- Iterator implements Heun's schema
iterator = heun2 (recip 2^(7::Int) :: F) (ikeda_model2 birefrP)
totalComputedIterations = delayLength * delays
-- Calculates all the time trace
(xy1, history1) <- integrator iterator delayLength totalComputedIterations (sample0, (hist0, zero))
putStrLn $ show $ getX xy1
return ()
The nonlinear function (imported) can look like this:
data Parameters = Parameters { beta :: Float
, alpha :: Float
, phi :: Float } deriving Show
paramA :: Parameters
paramA = Parameters { beta = 1.1
, alpha = 1.0
, phi = 0.01 }
birefr :: Parameters -> Float -> Float
birefr par !x = 0.5 * beta' * (1 - alpha' * (cos $ 2.0 * (x + phi')))
where
! beta' = beta par
! alpha' = alpha par
! phi' = phi par
birefrP :: Float -> Float
birefrP = birefr paramA
I'm trying to use different data types in a list. e.g:
data Shape = Square Int
| Circle Int
| Rectangle Int Int
| Triangle Int Int Int
deriving (Show)
shapes = [Square 5, Circle 2, Rectangle 10 5]
showShapes :: [Shape] -> [Int]
showShapes [] = []
showShapes (s:xs) = getArea (s : xs)
However I'm struggling to create the method "getArea" as I need one for each different type. I don't know a way to do this using parameter pattern matching. Is there a way to do this or am I tackling this problem the wrong way?
Edit
How would you do it using an if statement and "typeOf" function
I tried changing Shape to this:
data Shape = Square Int
| Rectangle Int Int
| Triangle Int Int Int
deriving (Show, Typeable)
But I get a compile time error!
For your simple case, just use pattern matching in getArea, but you'll have to convert your values to Doubles since the area of a circle is never going to be an integer when you have an integer radius:
getArea :: Shape -> Double
getArea (Square l) = fromIntegral $ l * l
getArea (Circle r) = pi * fromIntegral r ^ 2
getArea (Rectangle l w) = fromIntegral $ l * w
-- assuming the constructor takes the 3 side lengths
getArea (Triangle a b c) = sqrt $ p * (p - a') * (p - b') * (p - c')
where
[a', b', c'] = map fromIntegral [a, b, c]
p = (a' + b' + c') / 2
Although I don't know what you want to do in showShapes. Usually the word show in Haskell means the same thing as toString in other languages, but you're trying to apply getArea inside it. Regardless, your pattern matching for showShapes is off, you need parentheses around s:xs or you'll get a syntax error, and you can't prepend a number on front of a list of Shapes as with getArea s : xs. Instead you might be wanting to calculate the area for each shape in a list? For that you can use map:
getAreas :: [Shape] -> [Double]
getAreas shapes = map getArea shapes
Note, that you don't need to store all figures in one datatype in this case. You can use existential quantification instead:
{-# LANGUAGE ExistentialQuantification #-}
data Square = Square Int
data Circle = Circle Int
data Rectangle = Rectangle Int Int
class HasArea a where
area :: a -> Double
instance HasArea Square where
area (Square n) = fromIntegral n * fromIntegral n
instance HasArea Circle where
area (Circle r) = pi * fromIntegral r ^ 2
instance HasArea Rectangle where
area (Rectangle n m) = fromIntegral n * fromIntegral m
data Shape = forall s. HasArea s => Shape s
shapes :: [Shape]
shapes = [Shape (Square 5), Shape (Circle 2), Shape (Rectangle 10 5)]
shapeArea :: Shape -> Double
shapeArea (Shape s) = area s
main = print $ map shapeArea shapes
You can read about existential quantification here: http://en.wikibooks.org/wiki/Haskell/Existentially_quantified_types
Existential quantification itself is weaker, than generalized algebraic datatypes. You can read about them here: http://en.wikibooks.org/wiki/Haskell/GADT
I need to find the closest color in a palette ps to a given color p. How do I make the function nearestColor as fast as possible, without changing the type of
Pixel8 or PixelRGB8. So far I have tried inlining.
import qualified Data.Vector as V
type Pixel8 = Word8
data PixelRGB8 = PixelRGB8 {-# UNPACK #-} !Pixel8 -- Red
{-# UNPACK #-} !Pixel8 -- Green
{-# UNPACK #-} !Pixel8 -- Blue
deriving (Eq, Ord, Show)
nearestColor :: PixelRGB8 -> Vector PixelRGB8 -> PixelRGB8
nearestColor p ps = snd $ V.minimumBy comp ds
where
ds = V.map (\px -> (dist2Px px p, px)) ps
comp a b = fst a `compare` fst b
dist2Px :: PixelRGB8 -> PixelRGB8 -> Int
dist2Px (PixelRGB8 r1 g1 b1) (PixelRGB8 r2 g2 b2) = dr*dr + dg*dg + db*db
where
(dr, dg, db) =
( fromIntegral r1 - fromIntegral r2
, fromIntegral g1 - fromIntegral g2
, fromIntegral b1 - fromIntegral b2 )
If you want to use a single palette and request different colours, I'd first flip your signature:
type Palette = V.Vector PixelRGB8
nearestColor :: Palette -> PixelRGB8 -> PixelRGB8
That facilitates partial application, and allows the palette configuration to be memoised.
Next, you want to do that: re-store the palette in a data structure suitable for fast lookup. Since you're basically interested in Euclidean distance in ℝ3 (BTW not really ideal for colour comparison), this is a very common problem. A classic structure is the k-d tree, which has long been used for such a nearest-neighbour search. There's sure enough a Haskell library available, which quite a convenient interface for you:
import qualified Data.Trees.KdTree a s KD
instance KD.Point PixelRGB where
dimension _ = 3
coord 0 (PixelRGB r _ _) = fromIntegral r
coord 1 (PixelRGB _ g _) = fromIntegral g
coord 2 (PixelRGB _ _ b) = fromIntegral b
dist2 = fromIntegral . dist2Px
Then we can transform a palette into such a tree:
type FastPalette = KD.KdTree PixelRGB8
accelPalette :: Palette -> FastPalette
accelPalette = KD.fromList . V.toList
And finally just use the library-provided next neighbour search:
nearestColor palette = fromJust . KD.nearestNeighbor fpal
where fpal = accelPalette palette
I have a data type Polynomial r for polynomials in Haskell and a Ring instance for it. (The class Ring r where plus :: r -> r -> r ; times :: r -> r -> r ; negative :: r -> r ; zero :: r ; one :: r -- it's just a simplified version of Num).
Now I could define a polynomial such as gauss = x^2 + 1 or eisenstein = x^2 + x + 1 and then work in "Polynomial Integer/(gauss)" for the Gaussian integers or "Polynomial Integer/(eisenstein)" for the Eisenstein integers. That's the problem, I wrote it in quotes because it's not a real data type, and I can't figure out how to define it.
I first tried to do something like data Quotient p = Quot p p and then for example we would have plus (Quot a i) (Quot b i') | i == i' = Quot (plus a b) i Of course this is pretty bad already but it's not even possible to define one and zero. So I changed it to data Quotient p = Quot p (Maybe p) and I think I have a working implementation using that but you never know for sure if plus will work (it needs at least one Just, and if there are two they must be the same).
Is there any type safe (I mean not using unsafe functions) way to program this in haskell? I am pretty stumped. Thanks!
Perhaps you could augment your polynomial type with an index or tag? If I understand correctly, your normal module would be something like:
data Poly r = Poly r
class Ring r where
plus :: r -> r -> r
times :: r -> r -> r
instance Ring (Poly Integer) where
plus (Poly x) (Poly y) = Poly (x + y)
times (Poly x) (Poly y) = Poly (x * y)
gauss :: Poly Integer
gauss = Poly 1
eins :: Poly Integer
eins = Poly 2
And you want to be able to safely differential between the two "sub-types" of the rings. Perhaps you could tag them as so:
newtype PolyI i r = PolyI r
instance Show r => Show (PolyI i r) where
show (PolyI p) = show p
instance Ring (PolyI i Integer) where
plus (PolyI x) (PolyI y) = PolyI (x + y)
times (PolyI x) (PolyI y) = PolyI (x * y)
Our instances of the Ring now require an extra type-argument i, which we can create by having simple no-constructor types.
data Gauss
data Eins
Then we just create the specific polynomials with the index as an argument:
gaussI :: PolyI Gauss Integer
gaussI = PolyI 11
einsI :: PolyI Eins Integer
einsI = PolyI 20
With the Show instance above, we get the following output:
*Poly> plus einsI einsI
40
and then
*Poly> plus einsI gaussI
Couldn't match expected type `Eins' with actual type `Gauss'
Expected type: PolyI Eins Integer
Actual type: PolyI Gauss Integer
In the second argument of `plus', namely `gaussI'
Is that something like what you were looking for?
Edit: after a comment to the question about newtype, I think this may also an elegant solution if you use NewtypeDeriving to ease the burden of re-implementing the Poly Integer instance. I think in the end it would be similar, if slightly more elegant than this approach.
The implicit configurations paper (cabalized here) uses quotients of Z as an example; it should be straightforward to adapt it to polynomial rings (unless I'm missing something).
Edit: Not saying implicit configurations themselves are straightforward, far from it ;) - just the modification.