I am trying to use gnuplot package for Haskell (https://hackage.haskell.org/package/gnuplot) for building a 4D plot as described here (4D plot with gnuplot). But I cann't figure out how to set appropriate 3DGraph type.
My problem is to draw a function like A = f(x,y,z) and A should be encoded with the color.
After few days I find the solution that is suit for my purpose. Maybe someone will find it useful:
module PrintToGraph where
import qualified Graphics.Gnuplot.Advanced as GP
import qualified Graphics.Gnuplot.Frame as Frame
import qualified Graphics.Gnuplot.Frame.OptionSet as OptsSet
import qualified Graphics.Gnuplot.Plot.ThreeDimensional as Plot3D
import qualified Graphics.Gnuplot.Graph.ThreeDimensional as Graph3D
import qualified Graphics.Gnuplot.LineSpecification as LineSpec
import GHC.Exts (groupWith )
import qualified Graphics.Gnuplot.Value.Atom as Atom
import Graphics.Gnuplot.ColorSpecification ( paletteFrac )
import Data.Foldable ( Foldable(foldMap') )
import Data.List ( elemIndex )
import Data.Maybe ( fromJust )
defltOpts :: OptsSet.T (Graph3D.T Double Double Double)
defltOpts = OptsSet.key False OptsSet.deflt
waveFuncVis :: (Double -> (Double, Double, Double) -> Double) -> Double -> Double -> Frame.T (Graph3D.T Double Double Double)
waveFuncVis func depth precision =
let x = Plot3D.linearScale 100 (-10, 10)
testedRange = (groupWith (\(x,y,z) -> test func (x,y,z) depth precision) . filter (\(x,y,z) -> funcWrapper func x y z^2 >= precision)) [(x1,y1,z1) | x1<-x, y1<-x, z1<-x]
range = [(x1,y1,z1) | x1<-x, y1<-x, z1<-x]
calcColor :: [(Double,Double,Double)] -> Double
calcColor array = fromIntegral (fromJust (elemIndex array testedRange)) / fromIntegral (length testedRange)
linespec array = Graph3D.lineSpec $ LineSpec.lineColor (paletteFrac (calcColor array)) LineSpec.deflt
graph array = linespec array <$> Plot3D.cloud Graph3D.points array
in Frame.cons defltOpts $ foldMap' graph testedRange
test :: (Double -> (Double, Double, Double) -> Double)
-> (Double, Double, Double) -> Double -> Double -> Integer
test func (x, y , z) depth precision
| funcWrapper func x y z^2 >= precision = round $ funcWrapper func x y z^2 * depth
| otherwise = 0
funcWrapper :: (Double -> (Double, Double, Double) -> Double) -> Double -> Double -> Double -> Double
funcWrapper func x' y' z' = func 1.0 (toR x' y' z', toTau x' y' z', toPhi x' y' z')
--2pz Hydrogen function
waveHfunc2pz :: Double -> (Double, Double, Double) -> Double
waveHfunc2pz z (r, tau, phi) = a * b * c* e
where a,b,c,e :: Double
a = 1.0/(4.0*sqrt (2.0*pi))
b = (z/aBohr)**2.5
c = pureTrig cos tau
e = r*exp(-1.0 * (z*r/(2.0*aBohr)))
main :: IO ()
main = sequence_ [GP.plotDefault (waveFuncVis waveHfunc2pz 10000 0.0005)]
Briefly:
We throw away function's values that less, than precision. (I use filter in testedRange for this purpose)
Thanks to the groupWith we receive list of the coordinates' lists - [[(x,y,z)]]. Each sublist here contains coordinates which gives the same function value.
To colorize them we convert sublist's index to the Double value and use it as an argument for PaletteFrac.
As a result we receive cloud of colored dots, where each color correspond to the one function value.
Example picture for 2pz hydrogen atom.
Related
I have a function ascArr :: String -> BigData for parsing some big strict data from a string and another one, altitude :: BigData -> Pt -> Maybe Double, for getting something useful from the parsed data. I want to parse the big data once and then use the altitude function with the first argument fixed and the second one varying. Here's the code (TupleSections are enabled):
exampleParseAsc :: IO ()
exampleParseAsc = do
asc <- readFile "foo.asc"
let arr = ascArr asc
print $ map (altitude arr . (, 45)) [15, 15.01 .. 16]
This is all ok. Then I want to connect the two functions together and to use partial application for caching the big data. I use three versions of the same function:
parseAsc3 :: String -> Pt -> Maybe Double
parseAsc3 str = altitude d
where d = ascArr str
parseAsc4 :: String -> Pt -> Maybe Double
parseAsc4 str pt = altitude d pt
where d = ascArr str
parseAsc5 :: String -> Pt -> Maybe Double
parseAsc5 = curry (uncurry altitude . first ascArr)
And I call them like this:
exampleParseAsc2 :: IO ()
exampleParseAsc2 = do
asc <- readFile "foo.asc"
let alt = parseAsc5 asc
print $ map (alt . (, 45)) [15, 15.01 .. 16]
Only the parseAsc3 works like in the exampleParseAsc: Memory usage rises at the beginning (when allocating memory for the UArray in the BigData), then it is constant while parsing, then altitude quickly evaluates the result and then everything is done and the memory is freed. The other two versions are different: The memory usage rises multiple times until all the memory is consumed, I think that the parsed big data is not cached inside the alt closure. Could someone explain the behaviour? Why are the versions 3 and 4 not equivalent? In fact I started with something like parseAsc2 function and just after hours of trial I found out the parseAsc3 solution. And I am not satisfied without knowing the reason...
Here you can see all my effort (only the parseAsc3 does not consume whole the memory; parseAsc is a bit different from the others - it uses parsec and it was really greedy for memory, I'd be glad if some one explained me why, but I think that the reason is different than the main point of this question, you may just skip it):
type Pt = (Double, Double)
type BigData = (UArray (Int, Int) Double, Double, Double, Double)
parseAsc :: String -> Pt -> Maybe Double
parseAsc str (x, y) =
case parse ascParse "" str of
Left err -> error "no parse"
Right (x1, y1, coef, m) ->
let bnds = bounds m
i = (round $ (x - x1) / coef, round $ (y - y1) / coef)
in if inRange bnds i then Just $ m ! i else Nothing
where
ascParse :: Parsec String () (Double, Double, Double, UArray (Int, Int) Double)
ascParse = do
[w, h] <- mapM ((read <$>) . keyValParse digit) ["ncols", "nrows"]
[x1, y1, coef] <- mapM ((read <$>) . keyValParse (digit <|> char '.'))
["xllcorner", "yllcorner", "cellsize"]
keyValParse anyChar "NODATA_value"
replicateM 6 $ manyTill anyChar newline
rows <- replicateM h . replicateM w
$ read <$> (spaces *> many1 digit)
return (x1, y1, coef, listArray ((0, 0), (w - 1, h - 1)) (concat rows))
keyValParse :: Parsec String () Char -> String -> Parsec String () String
keyValParse format key = string key *> spaces *> manyTill format newline
parseAsc2 :: String -> Pt -> Maybe Double
parseAsc2 str (x, y) = if all (inRange bnds) (is :: [(Int, Int)])
then Just $ (ff * (1 - px) + cf * px) * (1 - py)
+ (fc * (1 - px) + cc * px) * py
else Nothing
where (header, elevs) = splitAt 6 $ lines str
header' = map ((!! 1) . words) header
[w, h] = map read $ take 2 header'
[x1, y1, coef, _] = map read $ drop 2 header'
bnds = ((0, 0), (w - 1, h - 1))
arr :: UArray (Int, Int) Double
arr = listArray bnds (concatMap (map read . words) elevs)
i = [(x - x1) / coef, (y - y1) / coef]
[ixf, iyf, ixc, iyc] = [floor, ceiling] >>= (<$> i)
is = [(ix, iy) | ix <- [ixf, ixc], iy <- [iyf, iyc]]
[px, py] = map (snd . properFraction) i
[ff, cf, fc, cc] = map (arr !) is
ascArr :: String -> BigData
ascArr str = (listArray bnds (concatMap (map read . words) elevs), x1, y1, coef)
where (header, elevs) = splitAt 6 $ lines str
header' = map ((!! 1) . words) header
[w, h] = map read $ take 2 header'
[x1, y1, coef, _] = map read $ drop 2 header'
bnds = ((0, 0), (w - 1, h - 1))
altitude :: BigData -> Pt -> Maybe Double
altitude d (x, y) = if all (inRange bnds) (is :: [(Int, Int)])
then Just $ (ff * (1 - px) + cf * px) * (1 - py)
+ (fc * (1 - px) + cc * px) * py
else Nothing
where (arr, x1, y1, coef) = d
bnds = bounds arr
i = [(x - x1) / coef, (y - y1) / coef]
[ixf, iyf, ixc, iyc] = [floor, ceiling] >>= (<$> i)
is = [(ix, iy) | ix <- [ixf, ixc], iy <- [iyf, iyc]]
[px, py] = map (snd . properFraction) i
[ff, cf, fc, cc] = map (arr !) is
parseAsc3 :: String -> Pt -> Maybe Double
parseAsc3 str = altitude d
where d = ascArr str
parseAsc4 :: String -> Pt -> Maybe Double
parseAsc4 str pt = altitude d pt
where d = ascArr str
parseAsc5 :: String -> Pt -> Maybe Double
parseAsc5 = curry (uncurry altitude . first ascArr)
Compiled with GHC 7.10.3, with -O optimization.
Thank you.
You can figure out what's happening by looking at the generated core from GHC. The evaluation semantics of optimized core are very predictable (unlike Haskell itself) so it is often a useful tool for performance analysis.
I compiled your code with ghc -fforce-recomp -O2 -ddump-simpl file.hs with GHC 7.10.3. You can look at the full output yoursefl but I've extracted the relevant bits:
$wparseAsc2
$wparseAsc2 =
\ w_s8e1 ww_s8e5 ww1_s8e6 ->
let { ...
parseAsc2 =
\ w_s8e1 w1_s8e2 ->
case w1_s8e2 of _ { (ww1_s8e5, ww2_s8e6) ->
$wparseAsc2 w_s8e1 ww1_s8e5 ww2_s8e6
}
The code above looks a little funny but is essentially Haskell. Note that the first thing parseAsc2 does is force its second argument to be evaluated (the case statement evaluates the tuple, which corresponds to the pattern match) - but not the string. The string won't be touched until deep inside $wParseAsc2 (definition omitted). But the part of the function that computes the "parse" is inside the lambda - it will be recomputed for every invocation of the function. You don't even have to look at what it is - the rules for evaluating core expressions are very prescriptive.
$wparseAsc
$wparseAsc =
\ w_s8g9 ww_s8gg ww1_s8gi -> ...
parseAsc
parseAsc =
\ w_s8g9 w1_s8ga ->
case w1_s8ga of _ { (ww1_s8gd, ww2_s8gi) ->
case ww1_s8gd of _ { D# ww4_s8gg ->
$wparseAsc w_s8g9 ww4_s8gg ww2_s8gi
}
}
The situation with parseAsc has little to do with Parsec*. This is much like version two - now both arguments are evaluated, however. This has little effect, however, on the performance, because the same problem is there - $wparseAsc is just a lambda, meaning all the work it does is done at every invocation of the function. There can be no sharing.
parseAsc3 =
\ str_a228 ->
let {
w_s8c1
w_s8c1 =
case $wascArr str_a228
of _ { (# ww1_s8gm, ww2_s8gn, ww3_s8go, ww4_s8gp #) ->
(ww1_s8gm, ww2_s8gn, ww3_s8go, ww4_s8gp)
} } in
\ w1_s8c2 ->
case w1_s8c2 of _ { (ww1_s8c5, ww2_s8c6) ->
$waltitude w_s8c1 ww1_s8c5 ww2_s8c6
}
Here is the "good" version. It takes a string, applies $wascArr to it, and then the string is never used again. This is crucial - if this function is partially applied to a string, you are left with let w_s = .. in \w1 -> ... - none of this mentions the string, so it can be garbage collected. The long lived reference is to w_s which is your "big data". And note: even if a reference to the string was maintained, and it could not be garbage collected, this version would still be substantially better - simply because it does not recompute the "parse" at each invocation of the function. This is the critical flaw - the fact that the string can be garbage collected immediately is extra.
parseAsc4 =
\ str_a22a pt_a22b ->
case pt_a22b of _ { (ww1_s8c5, ww2_s8c6) ->
$waltitude (ascArr str_a22a) ww1_s8c5 ww2_s8c6
}
Same issue as version two. Unlike version three, if you partially apply this, you get \w1 -> altitude (ascArr ...) ..., so ascArr is recomputed for every invocation of the function. It doesn't matter how you use this function - it simply won't work the way you want.
parseAsc5 = parseAsc4
Amazingly (to me), GHC figures out that parseAsc5 is precisely the same as parseAsc4! Well this one should be obvious then.
As for why GHC generates this particular core for this code, it really isn't easy to tell. In many cases the only way to guarantee sharing is to have explicit sharing in your original code. GHC does not do common subexpression elimination - parseAsc3 implements manual sharing.
*Maybe the parser itself has some performance issues too, but that isn't the focus here. If you have question about your Parsec parser (performance wise, or otherwise) I encourage you to ask a separate question.
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 solve a competitive programming challenge problem in Haskell.
This is my code:
module Main (main) where
import System.IO
import Text.Printf
getInt :: IO Int
getInt = readLn
getDouble :: IO Double
getDouble = readLn
getCoordinate :: (IO Double, IO Double, IO Double)
getCoordinate = (getDouble, getDouble, getDouble)
readCoordinates :: Int -> [(IO Double, IO Double, IO Double)] -> [(IO Double, IO Double, IO Double)]
readCoordinates 0 list = list
readCoordinates a list = readCoordinates (a - 1) list ++ [getCoordinate]
main :: IO ()
main = do
limit <- getInt
coordinates <- (readCoordinates limit [])
printf "%.2f\n" (run 0.0 (head coordinates) (tail coordinates))
run :: Double -> (Double, Double, Double) -> [(Double, Double, Double)] -> Double
run curr c1 (c2:cs) = run (curr + (d c1 c2)) c2 cs
run curr c1 [] = curr
d :: (Double, Double, Double) -> (Double, Double, Double) -> Double
d (x1, y1, z1) (x2, y2, z2) = sqrt (sas x1 x2) + (sas y1 y2) + (sas z1 z2)
sas :: Double -> Double -> Double
sas a1 a2 = (a1 - a2) ** 2
So as you might guess I'm reading an integer, which denotes how many 3d coordinates I should read in. Then I try to read all of these and calculate the distance.
I get a lot of errors, here are the error log:
Akvariet.hs:22:19:
Couldn't match type `[]' with `IO'
Expected type: IO (IO Double, IO Double, IO Double)
Actual type: [(IO Double, IO Double, IO Double)]
In the return type of a call of `readCoordinates'
In a stmt of a 'do' block:
coordinates <- (readCoordinates limit [])
In the expression:
do { limit <- getInt;
coordinates <- (readCoordinates limit []);
printf "%.2f" (run 0.0 (head coordinates) (tail coordinates)) }
Akvariet.hs:23:34:
Couldn't match expected type `[(Double, Double, Double)]'
with actual type `(IO Double, IO Double, IO Double)'
In the first argument of `head', namely `coordinates'
In the second argument of `run', namely `(head coordinates)'
In the second argument of `printf', namely
`(run 0.0 (head coordinates) (tail coordinates))'
Akvariet.hs:23:53:
Couldn't match expected type `[(Double, Double, Double)]'
with actual type `(IO Double, IO Double, IO Double)'
In the first argument of `tail', namely `coordinates'
In the third argument of `run', namely `(tail coordinates)'
In the second argument of `printf', namely
`(run 0.0 (head coordinates) (tail coordinates))'
I can't really wrap my head around the IO type actually, I get that it is impure and doesn't return the same thing every time but how do I use it in my program?
I don't understand how the readCoordinates method doesn't compile and why it can't cast IO Double to Double when main still is of type IO ().
Cheers!
First, I recommend you don't read in a number and then cumbersomely input each coordinate seperately. It's easier to read all input in one go (resulting in a string), and then parse it to coordinates without bothering about how it came from IO. This looks something like
main = do
allInput <- getContents
let coordinates = parseCoords $ lines allInput
printf ...
with
type Vect = (Double, Double, Double)
parseCoords :: [String] -> [Vect]
parseCoords (x:y:z:cs) = (read x, read y, read z) : parseCoords cs
parseCoords _ = []
If you prefer to manually read everything, to get precise control over the order or whatever, then you need to properly use IO as a monad. It's little use to combine three getDoubles to a tuple of IO actions; what you really want is a single IO action which yields a pure coordinate tuple.
getCoordinate :: IO Vect
getCoordinate = do
x <- getDouble
y <- getDouble
z <- getDouble
return (x,y,z)
Actually this could be written nicer with Applicative, though I suspect you find the above do writing easier to understand:
getCoordinate' = liftA3 (,,) getDouble getDouble getDouble
Again I'm requesting comments about how a given design should be implemented in Haskell.
Thanks in advance to everyone providing helpful comments. Also I hope this could be an aid to other Haskell novices like me, having a practical sample code.
This time, we have a polymorphic function doSampling (in module Samples) that takes a generic function f and
a list of reals (indexes) and returns a Samples (indexes, values=f(indexes)). We want implement doSampling only once, as it doesn't matter if is f is a Polynomial or a Sinus. For that,
we have introduced an interface Function, and have Polynomial and Sinus types implement it.
The following is the design being implemented:
Edit 1:
There is a debate on the Function interface (class in Haskell). It has been suggested it is not actually necessary, as doSampling may take a "nude" function (Double -> Double) instead.
But, how to do it, if you need some extra state within the nude function (coeffs for a polynomial, amp+freq+phase for a sinus?
Edit 2:
Very good answers by kosmikus and by Chris Taylor. Thanks.
A key idea in both: have
doSampling :: (Double -> Double) -> [Double] -> Samples
This is: it takes a function (Double -> Double) (instead of Function) and list and returns samples.
My intention was to keep the state of Polynomials and Sinuses. That is not regarded in Chris answer, but it is in kosmikus'. On the other hand, the weak point in kosmikus version could be how to extend its Function definition if you don't have access to the source code.
I would also point out:
Chris' idea of encapsulating a polynomial or a sinus into a function (Double -> Double) by means of a factory function mkPolynomial or mkSinus that generates (using currying?) the desired function taking the apropriate parameters. (Although you can't consult the parameters later).
kosmikous' idea of using value to transform (also using currying?) a Function into a (Double -> Double)
Both answers are worth reading as they have other little Haskell tricks to reduce and simplify code.
In sum
Chris answers does not support keeping the state of a Polynomial or of a Sinus
kosmikus answers is not extensible: adding new type of functions (Cosinus ...)
my answer (being verbose) does overcome the previous downsides, and it would allow (this not necessary for the problem) impose Function types to have more associated-functions apart of value (in the sense of how an java-interfaces work).
My own approach
main (usage)
import Polynomial
import Sinus
import Function
import Samples
-- ...............................................................
p1 = Polynomial [1, 0, 0.5] -- p(x) = 1 + 0.5x^2
s1 = Sinus 2 0.5 3 -- f(x) = 2 sin(0.5x + 3)
-- ...............................................................
-- sample p1 from 0 to 5
m1 = doSampling p1 [0, 0.5 .. 5]
m2 = doSampling s1 [0, 0.5 .. 5]
-- ...............................................................
-- main
-- ...............................................................
main = do
putStrLn "Hello"
print $ value p1 2
print $ value s1 (pi/2)
print $ pairs m1
print $ pairs m2
Function
module Function where
-- ...............................................................
-- "class type" : the types belonging to this family of types
-- must implement the following functions:
-- + value : takes a function and a real and returns a real
-- ...............................................................
class Function f where
value :: f -> Double -> Double
-- f is a type variable, this is:
-- f is a type of the Function "family" not an actual function
Samples
module Samples where
import Function
-- ...............................................................
-- Samples: new data type
-- This is the constructor and says it requieres
-- two list, one for the indexes (xs values) and another
-- for the values ( ys = f (xs) )
-- this constructor should not be used, instead use
-- the "factory" function: new_Samples that performs some checks
-- ...............................................................
data Samples = Samples { indexes :: [Double] , values :: [Double] }
deriving (Show)
-- ...............................................................
-- constructor: it checks lists are equal size, and indexes are sorted
new_Samples :: [Double] -> [Double] -> Samples
new_Samples ind val
| (length ind) /= (length val) = samplesVoid
| not $ isSorted ind = samplesVoid
| otherwise = Samples ind val
-- ...............................................................
-- sample a funcion
-- it takes a funcion f and a list of indexes and returns
-- a Samples calculating the values array as f(indexes)
doSampling :: (Function f) => f -> [Double] -> Samples
doSampling f ind = new_Samples ind vals
where
vals = [ value f x | x <- ind ]
-- ...............................................................
-- used as "error" in the construction
samplesVoid = Samples [] []
-- ...............................................................
size :: Samples -> Int
size samples = length (indexes samples)
-- ...............................................................
-- utility function to get a pair (index,value) out of a Samples
pairs :: Samples -> [(Double, Double)]
pairs samples = pairs' (indexes samples) (values samples)
pairs' :: [Double] -> [Double] -> [(Double, Double)]
pairs' [] [] = []
pairs' [i] [v] = [(i,v)]
pairs' (i:is) (v:vs) = (i,v) : pairs' is vs
-- ...............................................................
-- to check whether a list is sorted (<)
isSorted :: (Ord t) => [t] -> Bool
isSorted [] = True
isSorted [e] = True
isSorted (e1:(e2:tail))
| e1 < e2 = isSorted (e2:tail)
| otherwise = False
Sinus
module Sinus where
-- ...............................................................
import Function
-- ...............................................................
-- Sinus: new data type
-- This is the constructor and says it requieres
-- a three reals
-- ...............................................................
data Sinus = Sinus { amplitude :: Double, frequency :: Double, phase :: Double }
deriving (Show)
-- ...............................................................
-- we say that a Sinus is a Function (member of the class Function)
-- and then, how value is implemented
instance Function Sinus where
value s x = (amplitude s) * sin ( (frequency s)*x + (phase s))
Polynomial
module Polynomial where
-- ...............................................................
import Function
-- ...............................................................
-- Polynomial: new data type
-- This is the constructor and says it requieres
-- a list of coefficients
-- ...............................................................
data Polynomial = Polynomial { coeffs :: [Double] }
deriving (Show)
-- ...............................................................
degree :: Polynomial -> Int
degree p = length (coeffs p) - 1
-- ...............................................................
-- we say that a Polynomial is a Function (member of the class Function)
-- and then, how value is implemented
instance Function Polynomial where
value p x = value' (coeffs p) x 1
-- list of coeffs -> x -> pw (power of x) -> Double
value' :: [Double] -> Double -> Double -> Double
value' (c:[]) _ pw = c * pw
value' (c:cs) x pw = (c * pw) + (value' cs x x*pw)
You certainly don't need the Function class. All this heavyweight class, instance, member variable fluff is one of the things that Haskell is designed to avoid. Pure functions can be much more flexible.
Here's a simple way of doing what you want.
type Sample = ([Double], [Double])
newSample xs vs
| isSorted xs && length xs == length vs = (indices, values)
| otherwise = ([], [])
pairs = uncurry zip
doSampling :: (Double -> Double) -> [Double] -> Sample
doSampling f xs = newSample xs (map f xs)
mkPolynomial :: [Double] -> (Double -> Double)
mkPolynomial coefs x = go coefs
where
go [] = 0
go (c:cs) = c + x * go cs
mkSinus :: Double -> Double -> Double -> (Double -> Double)
mkSinus amp freq phase x = amp * sin (freq * x + phase)
p1 = mkPolynomial [1, 0, 0.5] -- 1 + 0.5x^2
s1 = mkSinus 2 0.5 3 -- 2 sin(0.5x + 3)
m1 = doSampling p1 [0, 0.5 .. 5]
m2 = doSampling s1 [0, 0.5 .. 5]
main :: IO ()
main = do
print $ p1 2
print $ s1 (pi/2)
print $ pairs m1
print $ pairs m2
[Expanded my comment on request.]
I'd probably do this roughly as follows:
import Data.Functor
-- Use a datatype rather than a class. Yes, this makes it harder to
-- add new types of functions later, and in turn easier to define new
-- operations. ("expression problem")
data Function =
Sinus { amplitude :: Double, frequency :: Double, phase :: Double }
| Polynomial { coeffs :: [Double] }
deriving (Show)
-- Interpreting a Function as an actual function.
value :: Function -> (Double -> Double)
value (Sinus amp freq ph) x = amp * sin (freq * x + ph)
value (Polynomial cs) x = value' cs x
-- Rewrite value' to not require non-empty lists. This can also be
-- nicely written as a fold.
value' :: [Double] -> Double -> Double
value' [] _ = 0
value' (c:cs) x = c + x * value' cs x
data Samples = Samples { indexes :: [Double] , values :: [Double] }
deriving (Show)
-- Use Maybe to detect error conditions, instead of strange values
-- such as voidSamples.
newSamples :: [Double] -> [Double] -> Maybe Samples
newSamples ind val
| length ind /= length val = Nothing
| not $ isSorted ind = Nothing
| otherwise = Just (Samples ind val)
doSampling :: (Double -> Double) -> [Double] -> Maybe Samples
doSampling f ind = newSamples ind (map f ind)
isSorted :: (Ord t) => [t] -> Bool
isSorted [] = True
isSorted [e] = True
isSorted (e1:e2:es)
| e1 < e2 = isSorted (e2:es)
| otherwise = False
-- This is just zip.
pairs :: Samples -> [(Double, Double)]
pairs (Samples idxs vals) = zip idxs vals
p1 = Polynomial [1, 0, 0.5] -- p(x) = 1 + 0.5x^2
s1 = Sinus 2 0.5 3 -- f(x) = 2 sin(0.5x + 3)
m1 = doSampling (value p1) [0, 0.5 .. 5]
m2 = doSampling (value s1) [0, 0.5 .. 5]
-- The <$> maps over a Maybe.
main = do
putStrLn "Hello"
print $ value p1 2
print $ value s1 (pi/2)
print $ pairs <$> m1
print $ pairs <$> m2
Could someone please help me with this? I'm kinda stuck and don't know why i get this error message :
not in scope type constructor or class 'Point'
--import Haste hiding (eval)
--import Haste.Graphics.Canvas
import Data.Maybe
import Expr
-- calculates all points of the graph in pixels
points :: Expr -> Double -> (Int,Int) -> [Point]
points exp sca (w,h) = [(x,realToPix(eval exp(pixToReal x))) | x<- [0..w]]
where
pixToReal :: Int -> Double
pixToReal x = sca*((fromIntegral x)-(fromIntegral w)/2)
realToPix :: Double -> Int
realToPix x = round ((x/sca) + ((fromIntegral w)/2))
-- calculates the lines that are going to be drawn between the points
linez :: Expr -> Double -> (Int,Int) -> [(Point,Point)]
linez exp sca (w,h) = zip (points exp sca (w,h)) (drop 1 (points exp sca (w,h)))
-- width and height of the window
sizeX, sizeY :: Int
sizeX = 300
sizeY = 300
--main :: IO ()
--main = do
--Just can <- getCanvasById "canvas"
--Just canElem <- elemById "canvas"
--Just func <- elemById "formula"
--Just d <- elemById "draw"
--onEvent d OnClick $ \_ (x,y) -> do
--f <- getProp func "value"
--w <- getProp canElem "width"
--h <- getProp canElem "height"
--render can (stroke (path (points (fromJust (readExpr f)) 0.04 (read w,read h))))
--return()
You have to import "Haste.Graphics.Canvas" which defines type alias for "Point".