
Hello, I would like to use hmatrix to do some function fitting with the Levenberg Marquardt algorithm. As an example I would like to fit the very simple function "f x = a*x + b" on some data points. The problem is that executing the 'fitModel' function crashes GHC(i) with a segmentation fault. This makes debugging difficult. Can anyone spot what I am doing wrong? Given all the lists of Double's it seems very easy to make an error regarding the number of arguments with the model function or the derivative. Try to evaluate the 'test' function in the small program listed below. I would expect an output of [1, 0] (y = 1*x + 0) instead of a segmentation fault. Relevant versions: - hmatrix-0.10.0.0 - gsl-1.14 - ghc-6.12.3 (64 bit) Small program: module Test where -- from base: import Control.Arrow ( second ) import Control.Applicative ( pure ) -- from hmatrix: import Data.Packed.Matrix ( Matrix ) import Numeric.GSL.Fitting ( FittingMethod(LevenbergMarquardt), fitModel ) -- input list of (x, y) pairs, output coefficients of "f x = a x * b" fitLinear :: [(Double, Double)] -> ([Double], Matrix Double) fitLinear samples = fitModel 1 1 10 (linearModel, linearDer) (map (second pure) samples) [0, 0] linearModel :: [Double] -> Double -> [Double] linearModel [a, b] x = [a*x + b, 0] linearModel _ x = error "wrong arguments" linearDer :: [Double] -> Double -> [[Double]] linearDer [_, _] x = [[x, 0]] linearDer _ _ = error "wrong arguments" test = fitLinear [(0,0), (1,1), (2,2)]