levmar-chart 0.1 → 0.2
raw patch · 3 files changed
+36/−31 lines, 3 filesdep ~levmar
Dependency ranges changed: levmar
Files
- LevMar/Chart.hs +16/−15
- example.hs +17/−13
- levmar-chart.cabal +3/−3
LevMar/Chart.hs view
@@ -9,15 +9,16 @@ , Graphics.Rendering.Chart.PlotValue ) where -import Data.Accessor ((^=), (.>))-import Data.Colour (withOpacity, opaque)-import Data.Colour.Names (red, blue)+import Control.Monad ( fmap )+import Data.Accessor ( (^=), (.>) )+import Data.Colour ( withOpacity, opaque )+import Data.Colour.Names ( red, blue ) import Graphics.Rendering.Chart-import Graphics.Rendering.Chart.Gtk (renderableToWindow)+import Graphics.Rendering.Chart.Gtk ( renderableToWindow ) import LevMar.Fitting-import NFunction (($*))-import Text.Printf (printf)-import System.IO (FilePath)+import NFunction ( ($*) )+import Text.Printf ( printf )+import System.IO ( FilePath ) data FileType = PDF -- ^Portable Document Format | PNG -- ^Portable Network Graphics@@ -28,7 +29,7 @@ -- |Apply the Levenbarg-Marquardt algorithm and plot the results in a -- window. levmarChart :: forall n k r a.- ( Nat n, ComposeN n+ ( Nat n , Nat k , PlotValue r, LevMarable r , PlotValue a, Fractional a@@ -60,7 +61,7 @@ -- |Apply the Levenbarg-Marquardt algorithm and plot the results in a -- file. levmarChartFile :: forall n k r a.- ( Nat n, ComposeN n+ ( Nat n , Nat k , PlotValue r, LevMarable r , PlotValue a, Fractional a@@ -131,13 +132,13 @@ -> (SizedList n r, Info r, CovarMatrix n r) -> Renderable () renderResults model samples (params, info, _) = toRenderable r- where xs = map fst samples+ where xs = fmap fst samples r :: Layout1 a r r = layout1_title ^= title- $ layout1_plots ^= map (Left) [samplePts, fitted]- $ layout1_left_axis .> laxis_title ^= "x-axis"- $ layout1_bottom_axis .> laxis_title ^= "y-axis"+ $ layout1_plots ^= fmap Left [samplePts, fitted]+ $ layout1_left_axis .> laxis_title ^= "y-axis"+ $ layout1_bottom_axis .> laxis_title ^= "x-axis" $ defaultLayout1 title :: String@@ -158,13 +159,13 @@ $ defaultPlotPoints fitted = toPlot- $ plot_lines_values ^= [zip fittedXs $ map (model $* params) fittedXs]+ $ plot_lines_values ^= [zip fittedXs $ fmap (model $* params) fittedXs] $ plot_lines_style .> line_color ^= (red `withOpacity` 0.5) $ defaultPlotLines fittedXs :: [a] fittedXs | null xs = []- | otherwise = [ minX + (fromIntegral i / fromIntegral lenXs) * (abs $ maxX - minX)+ | otherwise = [ minX + (fromIntegral i / fromIntegral lenXs) * abs (maxX - minX) | i <- [0 .. lenXs] ] where minX = minimum xs
example.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+ module Main where import Control.Monad (sequence_)@@ -21,39 +23,40 @@ ------------------------------------------------------------------------------- -- Model functions -constant :: Num r => Model N1 r r-linear :: Num r => Model N2 r r-quadratic :: Num r => Model N3 r r-cubic :: Num r => Model N4 r r+constant :: Num r => SimpleModel N1 r+linear :: Num r => SimpleModel N2 r+quadratic :: Num r => SimpleModel N3 r+cubic :: Num r => SimpleModel N4 r constant a _ = a linear b a x = b * x + constant a x quadratic c b a x = c * x*x + linear b a x cubic d c b a x = d * x*x*x + quadratic c b a x -trig :: Floating r => Model N2 r r+trig :: Floating r => SimpleModel N2 r trig a b x = a * cos x + b * sin x ------------------------------------------------------------------------------- -- Jacobians -constantJacob :: Num r => Jacobian N1 r r-linearJacob :: Num r => Jacobian N2 r r-quadraticJacob :: Num r => Jacobian N3 r r-cubicJacob :: Num r => Jacobian N4 r r+constantJacob :: Num r => SimpleJacobian N1 r+linearJacob :: Num r => SimpleJacobian N2 r+quadraticJacob :: Num r => SimpleJacobian N3 r+cubicJacob :: Num r => SimpleJacobian N4 r constantJacob _ _ = 1 ::: Nil linearJacob _ a x = x ::: constantJacob a x quadraticJacob _ b a x = x*x ::: linearJacob b a x cubicJacob _ c b a x = x*x*x ::: quadraticJacob c b a x -trigJacob :: Floating r => Jacobian N2 r r+trigJacob :: Floating r => SimpleJacobian N2 r trigJacob _ _ x = cos x ::: sin x ::: Nil ------------------------------------------------------------------------------- -- Test utility function -testChart :: ( ComposeN n+testChart :: forall n r a.+ ( Nat n , PlotValue r, Fractional r, LevMarable r, Random r , PlotValue a, Fractional a )@@ -63,7 +66,8 @@ -> [a] -> r -> IO ()-testChart f j ps xs noise = levmarChart f j+testChart f j ps xs noise = levmarChart f+ j initPs samples' 1000@@ -75,7 +79,7 @@ >> return () where ns = take (length xs) $ randoms $ mkStdGen rndGenSeed- initPs = (SL.replicate (SL.length ps) 0)+ initPs = SL.replicate 0 :: SizedList n r samples = zip xs $ map (f $* ps) xs samples' = zipWith (\(x, y) n -> (x, y + (n - 0.5) * 2 * noise)) samples ns rndGenSeed = 123456
levmar-chart.cabal view
@@ -1,5 +1,5 @@ name: levmar-chart-version: 0.1+version: 0.2 cabal-version: >= 1.6 build-type: Simple stability: experimental@@ -28,7 +28,7 @@ , Chart == 0.11.* , colour == 2.3.* , data-accessor == 0.2.*- , levmar == 0.1.*+ , levmar == 0.2.* exposed-modules: LevMar.Chart ghc-options: -Wall -O2 @@ -37,7 +37,7 @@ , Chart == 0.11.* , colour == 2.3.* , data-accessor == 0.2.*- , levmar == 0.1.*+ , levmar == 0.2.* , random == 1.0.* other-modules: LevMar.Chart ghc-options: -Wall -O2