levmar-chart (empty) → 0.1
raw patch · 5 files changed
+389/−0 lines, 5 filesdep +Chartdep +basedep +coloursetup-changed
Dependencies added: Chart, base, colour, data-accessor, levmar, random
Files
- LICENSE +32/−0
- LevMar/Chart.hs +178/−0
- Setup.hs +2/−0
- example.hs +129/−0
- levmar-chart.cabal +48/−0
+ LICENSE view
@@ -0,0 +1,32 @@+Copyright (c) 2009 Roel van Dijk, Bas van Dijk++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * The name of Roel van Dijk and Bas van Dijk and the names of+ contributors may NOT be used to endorse or promote products+ derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ LevMar/Chart.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE ScopedTypeVariables #-}++module LevMar.Chart+ ( FileType(..)+ , levmarChart+ , levmarChartFile+ , plotResults+ , plotToFile+ , Graphics.Rendering.Chart.PlotValue+ ) where++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 LevMar.Fitting+import NFunction (($*))+import Text.Printf (printf)+import System.IO (FilePath)++data FileType = PDF -- ^Portable Document Format+ | PNG -- ^Portable Network Graphics+ | PS -- ^Postscript+ | SVG -- ^Scalable Vector Graphics+ deriving (Show)++-- |Apply the Levenbarg-Marquardt algorithm and plot the results in a+-- window.+levmarChart :: forall n k r a.+ ( Nat n, ComposeN n+ , Nat k+ , PlotValue r, LevMarable r+ , PlotValue a, Fractional a+ )+ => (Model n r a) -- ^ Model+ -> Maybe (Jacobian n r a) -- ^ Optional jacobian+ -> SizedList n r -- ^ Initial parameters+ -> [(a, r)] -- ^ Samples+ -> Integer -- ^ Maximum number of iterations+ -> Options r -- ^ Minimalization options+ -> Maybe (SizedList n r) -- ^ Optional lower bounds+ -> Maybe (SizedList n r) -- ^ Optional upper bounds+ -> Maybe (LinearConstraints k n r) -- ^ Optional linear+ -> Maybe (SizedList n r) -- ^ Optional weights+ -> IO (Either LevMarError (SizedList n r, Info r, CovarMatrix n r))+levmarChart model mJac params ys itMax opts mLowBs mUpBs mLinC mWghts =+ let results = levmar model+ mJac+ params+ ys+ itMax+ opts+ mLowBs+ mUpBs+ mLinC+ mWghts+ in withRightM (plotResults model ys) results++-- |Apply the Levenbarg-Marquardt algorithm and plot the results in a+-- file.+levmarChartFile :: forall n k r a.+ ( Nat n, ComposeN n+ , Nat k+ , PlotValue r, LevMarable r+ , PlotValue a, Fractional a+ )+ => (Model n r a) -- ^ Model+ -> Maybe (Jacobian n r a) -- ^ Optional jacobian+ -> SizedList n r -- ^ Initial parameters+ -> [(a, r)] -- ^ Samples+ -> Integer -- ^ Maximum number of iterations+ -> Options r -- ^ Minimalization options+ -> Maybe (SizedList n r) -- ^ Optional lower bounds+ -> Maybe (SizedList n r) -- ^ Optional upper bounds+ -> Maybe (LinearConstraints k n r) -- ^ Optional linear+ -> Maybe (SizedList n r) -- ^ Optional weights+ -> FileType -- ^ Type of image file to produce+ -> FilePath -- ^ Destination path (must include extension)+ -> Int -- ^ Width of the image+ -> Int -- ^ Height of the image+ -> IO (Either LevMarError (SizedList n r, Info r, CovarMatrix n r))+levmarChartFile model mJac params ys itMax opts mLowBs mUpBs mLinC mWghts ft path width height =+ let results = levmar model+ mJac+ params+ ys+ itMax+ opts+ mLowBs+ mUpBs+ mLinC+ mWghts+ in withRightM (\r -> plotToFile model ys r ft path width height) results++-------------------------------------------------------------------------------++-- |Plots the results of the Levenberg-Marquardt algorithm in a window.+plotResults :: forall n r a. (PlotValue r, Fractional a, PlotValue a)+ => (Model n r a)+ -> [(a, r)]+ -> (SizedList n r, Info r, CovarMatrix n r)+ -> IO ()+plotResults model samples result = renderableToWindow (renderResults model samples result) 800 600++-- |Plots the results of the Levenberg-Marquardt algorithm in a file.+plotToFile :: forall n r a. (PlotValue r, Fractional a, PlotValue a)+ => (Model n r a)+ -> [(a, r)]+ -> (SizedList n r, Info r, CovarMatrix n r)+ -> FileType+ -> FilePath+ -> Int -- width+ -> Int -- height+ -> IO ()+plotToFile model samples result ft path width height = renderToFile ft renderable+ width height path+ where+ renderable = renderResults model samples result++ renderToFile PDF = renderableToPDFFile+ renderToFile PNG = renderableToPNGFile+ renderToFile PS = renderableToPSFile+ renderToFile SVG = renderableToSVGFile++-------------------------------------------------------------------------------++renderResults :: forall n r a. (PlotValue r, Fractional a, PlotValue a)+ => (Model n r a)+ -> [(a, r)]+ -> (SizedList n r, Info r, CovarMatrix n r)+ -> Renderable ()+renderResults model samples (params, info, _) = toRenderable r+ where xs = map 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"+ $ defaultLayout1++ title :: String+ title = printf ( "LevMar Fit - "+ ++ "%d iters - %d func evals - "+ ++ "%d jacob evals - %d lin systems solved - "+ ++ "stop reason: %s"+ )+ (infNumIter info)+ (infNumFuncEvals info)+ (infNumJacobEvals info)+ (infNumLinSysSolved info)+ (show $ infStopReason info)++ samplePts = toPlot+ $ plot_points_values ^= samples+ $ plot_points_style ^= filledCircles 2 (opaque blue)+ $ defaultPlotPoints++ fitted = toPlot+ $ plot_lines_values ^= [zip fittedXs $ map (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)+ | i <- [0 .. lenXs]+ ]+ where minX = minimum xs+ maxX = maximum xs+ lenXs = length xs++-------------------------------------------------------------------------------++withRightM :: Monad m => (r -> m ()) -> Either l r -> m (Either l r)+withRightM _ e@(Left _) = return e+withRightM f e@(Right y) = f y >> return e
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example.hs view
@@ -0,0 +1,129 @@+module Main where++import Control.Monad (sequence_)+import LevMar.Chart (PlotValue, levmarChart)+import LevMar.Fitting+import NFunction (($*))+import System.Random (Random, mkStdGen, randoms)++import qualified SizedList as SL++-------------------------------------------------------------------------------+-- Some handy type level naturals++type N0 = Z+type N1 = S N0+type N2 = S N1+type N3 = S N2+type N4 = S N3+type N5 = S N4++-------------------------------------------------------------------------------+-- 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 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 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 _ _ = 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 _ _ x = cos x ::: sin x ::: Nil++-------------------------------------------------------------------------------+-- Test utility function++testChart :: ( ComposeN n+ , PlotValue r, Fractional r, LevMarable r, Random r+ , PlotValue a, Fractional a+ )+ => (Model n r a)+ -> Maybe (Jacobian n r a)+ -> SizedList n r+ -> [a]+ -> r+ -> IO ()+testChart f j ps xs noise = levmarChart f j+ initPs+ samples'+ 1000+ opts+ Nothing+ Nothing+ noLinearConstraints+ Nothing+ >> return ()+ where+ ns = take (length xs) $ randoms $ mkStdGen rndGenSeed+ initPs = (SL.replicate (SL.length ps) 0)+ samples = zip xs $ map (f $* ps) xs+ samples' = zipWith (\(x, y) n -> (x, y + (n - 0.5) * 2 * noise)) samples ns+ rndGenSeed = 123456+ opts = defaultOpts { optStopNormInfJacTe = 1e-15+ , optStopNorm2Dp = 1e-15+ , optStopNorm2E = 1e-20+ }++-------------------------------------------------------------------------------+-- Examples++testConstant :: IO ()+testConstant = testChart constant (Just constantJacob)+ (42 ::: Nil)+ [-100 .. 100]+ (10 :: Double)++testLinear :: IO ()+testLinear = testChart linear (Just linearJacob)+ (3.14 ::: -8 ::: Nil)+ [-100 .. 100]+ (300 :: Double)++testQuadratic :: IO ()+testQuadratic = testChart quadratic (Just quadraticJacob)+ (0.2 ::: 8 ::: 23 ::: Nil)+ [-100 .. 100]+ (1000 :: Double)++testCubic :: IO ()+testCubic = testChart cubic (Just cubicJacob)+ (-0.05 ::: 0.5 ::: -12 ::: 10 ::: Nil)+ [-100 .. 100]+ (8000 :: Double)++testTrig :: IO ()+testTrig = testChart trig (Just trigJacob)+ (100 ::: 102 ::: Nil)+ (map (/4) [0..400])+ (50 :: Double)++-------------------------------------------------------------------------------+-- Main++main :: IO ()+main = sequence_ [ testConstant+ , testLinear+ , testQuadratic+ , testCubic+ , testTrig+ ]
+ levmar-chart.cabal view
@@ -0,0 +1,48 @@+name: levmar-chart+version: 0.1+cabal-version: >= 1.6+build-type: Simple+stability: experimental+author: Roel van Dijk & Bas van Dijk+maintainer: vandijk.roel@gmail.com, v.dijk.bas@gmail.com+copyright: (c) 2009 Roel van Dijk & Bas van Dijk+license: BSD3+license-file: LICENSE+category: numerical+synopsis: Plots the results of the Levenberg-Marquardt algorithm in a chart+description:+ This package contains a few functions to quicky visualize the+ fitting of a model function on some data with the+ Levenberg-Marquardt algorithm.+ .+ Plots can either be shown in a window or written to a file.++Extra-Source-Files: example.hs++flag example+ description: Build an example program+ default: False++library+ build-depends: base >= 3 && < 4.2+ , Chart == 0.11.*+ , colour == 2.3.*+ , data-accessor == 0.2.*+ , levmar == 0.1.*+ exposed-modules: LevMar.Chart+ ghc-options: -Wall -O2++executable example+ build-depends: base >= 3 && < 4.2+ , Chart == 0.11.*+ , colour == 2.3.*+ , data-accessor == 0.2.*+ , levmar == 0.1.*+ , random == 1.0.*+ other-modules: LevMar.Chart+ ghc-options: -Wall -O2+ main-is: example.hs+ if flag(example)+ buildable: True+ else+ buildable: False