never executed always true always false
1 -- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
2 -- Edit the ORIGNAL .chs file instead!
3
4
5 module QuantLib.Math
6 (
7 RoundingType(..)
8 , Rounding(..)
9 , applyRounding
10 , optimize
11
12 , EndCriteriaType(..)
13 , HistogramAlgorithm(..)
14
15 , Approximation(..)
16 , Interpolation(..)
17 , Interpolation2D(..)
18
19 , RngTrait(..)
20 , StatisticsTrait(..)
21 , BinomialTree(..)
22 , BoundaryConditionSide(..)
23 , FdmSchemeType(..)
24 , FdmScheme(..)
25 , PolynomialType(..)
26 , ComplexLogFormula(..)
27 , CmsMarketCalibrationType(..)
28 , EndCriteria(..)
29 , OptimizationMethod(..)
30 , Constraint(..)
31 , SobolDirectionIntegers(..)
32
33 , Matrix(..)
34 , realMatrix
35 , objectMatrix
36
37 , TimeGrid
38 , timeGrid
39 , timeGridFromList
40 , timeGridFromList'
41 , timeAt
42 , size
43 , points
44 , points'
45 ) where
46 import qualified Foreign.C.Types as C2HSImp
47 import qualified Foreign.ForeignPtr as C2HSImp
48 import qualified Foreign.Ptr as C2HSImp
49 import qualified System.IO.Unsafe as C2HSImp
50
51
52 import QuantLib.Internal
53 import QuantLib.Internal.Common
54 import QuantLib.Internal.Type
55 import Foreign.C.Types(CDouble)
56 import Foreign.Marshal.Alloc(alloca)
57 import Data.Vector.Storable(Vector)
58 import Data.List.NonEmpty(NonEmpty)
59
60
61
62
63
64
65
66 data EndCriteriaType = EndNone
67 | MaxIterations
68 | StationaryPoint
69 | StationaryFunctionValue
70 | StationaryFunctionAccuracy
71 | ZeroGradientNorm
72 | Unknown
73 deriving (Enum,Show,Eq,Read)
74
75
76 data HistogramAlgorithm = HistogramNone
77 | Sturges
78 | FD
79 | Scott
80 deriving (Enum,Show,Eq,Read)
81
82
83 data RngTrait = PseudoRandom
84 | PoissonPseudoRandom
85 | LowDiscrepancy
86 | Ziggurat
87 deriving (Show,Eq,Read)
88 instance Enum RngTrait where
89 succ PseudoRandom = PoissonPseudoRandom
90 succ PoissonPseudoRandom = LowDiscrepancy
91 succ LowDiscrepancy = Ziggurat
92 succ Ziggurat = error "RngTrait.succ: Ziggurat has no successor"
93
94 pred PoissonPseudoRandom = PseudoRandom
95 pred LowDiscrepancy = PoissonPseudoRandom
96 pred Ziggurat = LowDiscrepancy
97 pred PseudoRandom = error "RngTrait.pred: PseudoRandom has no predecessor"
98
99 enumFromTo from to = go from
100 where
101 end = fromEnum to
102 go v = case compare (fromEnum v) end of
103 LT -> v : go (succ v)
104 EQ -> [v]
105 GT -> []
106
107 enumFrom from = enumFromTo from Ziggurat
108
109 fromEnum PseudoRandom = 0
110 fromEnum PoissonPseudoRandom = 1
111 fromEnum LowDiscrepancy = 2
112 fromEnum Ziggurat = 3
113
114 toEnum 0 = PseudoRandom
115 toEnum 1 = PoissonPseudoRandom
116 toEnum 2 = LowDiscrepancy
117 toEnum 3 = Ziggurat
118 toEnum unmatched = error ("RngTrait.toEnum: Cannot match " ++ show unmatched)
119
120
121 data StatisticsTrait = Statistics
122 | GaussianStatistics
123 | GeneralStatistics
124 | IncrementalStatistics
125 deriving (Show,Eq,Read)
126 instance Enum StatisticsTrait where
127 succ Statistics = GaussianStatistics
128 succ GaussianStatistics = GeneralStatistics
129 succ GeneralStatistics = IncrementalStatistics
130 succ IncrementalStatistics = error "StatisticsTrait.succ: IncrementalStatistics has no successor"
131
132 pred GaussianStatistics = Statistics
133 pred GeneralStatistics = GaussianStatistics
134 pred IncrementalStatistics = GeneralStatistics
135 pred Statistics = error "StatisticsTrait.pred: Statistics has no predecessor"
136
137 enumFromTo from to = go from
138 where
139 end = fromEnum to
140 go v = case compare (fromEnum v) end of
141 LT -> v : go (succ v)
142 EQ -> [v]
143 GT -> []
144
145 enumFrom from = enumFromTo from IncrementalStatistics
146
147 fromEnum Statistics = 0
148 fromEnum GaussianStatistics = 1
149 fromEnum GeneralStatistics = 2
150 fromEnum IncrementalStatistics = 3
151
152 toEnum 0 = Statistics
153 toEnum 1 = GaussianStatistics
154 toEnum 2 = GeneralStatistics
155 toEnum 3 = IncrementalStatistics
156 toEnum unmatched = error ("StatisticsTrait.toEnum: Cannot match " ++ show unmatched)
157
158
159 data BinomialTree = JarrowRudd
160 | CoxRossRubinstein
161 | AdditiveEQPBinomialTree
162 | Trigeorgis
163 | Tian
164 | LeisenReimer
165 | Joshi4
166 | ExtendedJarrowRudd
167 | ExtendedCoxRossRubinstein
168 | ExtendedAdditiveEQPBinomialTree
169 | ExtendedTrigeorgis
170 | ExtendedTian
171 | ExtendedLeisenReimer
172 | ExtendedJoshi4
173 deriving (Show,Eq,Read)
174 instance Enum BinomialTree where
175 succ JarrowRudd = CoxRossRubinstein
176 succ CoxRossRubinstein = AdditiveEQPBinomialTree
177 succ AdditiveEQPBinomialTree = Trigeorgis
178 succ Trigeorgis = Tian
179 succ Tian = LeisenReimer
180 succ LeisenReimer = Joshi4
181 succ Joshi4 = ExtendedJarrowRudd
182 succ ExtendedJarrowRudd = ExtendedCoxRossRubinstein
183 succ ExtendedCoxRossRubinstein = ExtendedAdditiveEQPBinomialTree
184 succ ExtendedAdditiveEQPBinomialTree = ExtendedTrigeorgis
185 succ ExtendedTrigeorgis = ExtendedTian
186 succ ExtendedTian = ExtendedLeisenReimer
187 succ ExtendedLeisenReimer = ExtendedJoshi4
188 succ ExtendedJoshi4 = error "BinomialTree.succ: ExtendedJoshi4 has no successor"
189
190 pred CoxRossRubinstein = JarrowRudd
191 pred AdditiveEQPBinomialTree = CoxRossRubinstein
192 pred Trigeorgis = AdditiveEQPBinomialTree
193 pred Tian = Trigeorgis
194 pred LeisenReimer = Tian
195 pred Joshi4 = LeisenReimer
196 pred ExtendedJarrowRudd = Joshi4
197 pred ExtendedCoxRossRubinstein = ExtendedJarrowRudd
198 pred ExtendedAdditiveEQPBinomialTree = ExtendedCoxRossRubinstein
199 pred ExtendedTrigeorgis = ExtendedAdditiveEQPBinomialTree
200 pred ExtendedTian = ExtendedTrigeorgis
201 pred ExtendedLeisenReimer = ExtendedTian
202 pred ExtendedJoshi4 = ExtendedLeisenReimer
203 pred JarrowRudd = error "BinomialTree.pred: JarrowRudd has no predecessor"
204
205 enumFromTo from to = go from
206 where
207 end = fromEnum to
208 go v = case compare (fromEnum v) end of
209 LT -> v : go (succ v)
210 EQ -> [v]
211 GT -> []
212
213 enumFrom from = enumFromTo from ExtendedJoshi4
214
215 fromEnum JarrowRudd = 0
216 fromEnum CoxRossRubinstein = 1
217 fromEnum AdditiveEQPBinomialTree = 2
218 fromEnum Trigeorgis = 3
219 fromEnum Tian = 4
220 fromEnum LeisenReimer = 5
221 fromEnum Joshi4 = 6
222 fromEnum ExtendedJarrowRudd = 7
223 fromEnum ExtendedCoxRossRubinstein = 8
224 fromEnum ExtendedAdditiveEQPBinomialTree = 9
225 fromEnum ExtendedTrigeorgis = 10
226 fromEnum ExtendedTian = 11
227 fromEnum ExtendedLeisenReimer = 12
228 fromEnum ExtendedJoshi4 = 13
229
230 toEnum 0 = JarrowRudd
231 toEnum 1 = CoxRossRubinstein
232 toEnum 2 = AdditiveEQPBinomialTree
233 toEnum 3 = Trigeorgis
234 toEnum 4 = Tian
235 toEnum 5 = LeisenReimer
236 toEnum 6 = Joshi4
237 toEnum 7 = ExtendedJarrowRudd
238 toEnum 8 = ExtendedCoxRossRubinstein
239 toEnum 9 = ExtendedAdditiveEQPBinomialTree
240 toEnum 10 = ExtendedTrigeorgis
241 toEnum 11 = ExtendedTian
242 toEnum 12 = ExtendedLeisenReimer
243 toEnum 13 = ExtendedJoshi4
244 toEnum unmatched = error ("BinomialTree.toEnum: Cannot match " ++ show unmatched)
245
246
247 data BoundaryConditionSide = BoundaryNone
248 | Upper
249 | Lower
250 deriving (Enum,Show,Eq,Read)
251
252
253 data PolynomialType = Monomial
254 | Laguerre
255 | Hermite
256 | Hyperbolic
257 | Legendre
258 | Chebyshev
259 | Chebyshev2nd
260 deriving (Enum,Show,Eq,Read)
261
262
263 data ComplexLogFormula = Gatheral
264 | BranchCorrection
265 | AndersenPiterbarg
266 | AndersenPiterbargOptCV
267 | AsymptoticChF
268 | OptimalCV
269 deriving (Enum,Show,Eq,Read)
270
271
272 data CmsMarketCalibrationType = OnSpread
273 | OnPrice
274 | OnForwardCmsPrice
275 deriving (Enum,Show,Eq,Read)
276
277
278 data SobolDirectionIntegers = Unit
279 | Jaeckel
280 | SobolLevitan
281 | SobolLevitanLemieux
282 | JoeKuoD5
283 | JoeKuoD6
284 | JoeKuoD7
285 | Kuo
286 | Kuo2
287 | Kuo3
288 deriving (Enum,Show,Eq,Read)
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303 -- |rounds a value to the precision and rule carried by the given 'Rounding'
304 applyRounding :: (Rounding) -- ^rounding
305 -> (Double) -- ^value
306 -> (Double)
307 applyRounding a1 a2 =
308 C2HSImp.unsafePerformIO $
309 withRounding a1 $ \a1' ->
310 let {a2' = realToFrac a2} in
311 applyRounding'_ a1' a2' >>= \res ->
312 let {res' = realToFrac res} in
313 return (res')
314
315
316
317 -- |Minimizes an arbitrary Haskell-defined cost function via QuantLib's general-purpose
318 -- 'Problem'\/'OptimizationMethod' machinery -- unlike 'QuantLib.Model.calibrate', which drives a
319 -- 'QuantLib.Model.CalibratedModel''s own built-in calibration error against bound
320 -- 'QuantLib.Model.CalibrationHelper's, this takes any @[Double] -> Double@ objective. The cost
321 -- function crosses back into Haskell once per outer optimizer iteration, over the whole parameter
322 -- vector, not once per component -- see CLAUDE.md's "coarsen the language-boundary crossing"
323 -- bullet and 'QuantLib.Internal.Type.withCostFunction'.
324 optimize :: ([Double] -> Double) -- ^cost function
325 -> ([Double]) -- ^initial guess
326 -> (Maybe Constraint) -> (OptimizationMethod) -> (EndCriteria) -> IO (([Double]), (Double), (EndCriteriaType))
327 optimize a1 a2 a3 a4 a5 =
328 withCostFunction a1 $ \a1' ->
329 withDoubleArray a2 $ \(a2'1, a2'2) ->
330 withMaybeConstraint a3 $ \a3' ->
331 withOptimizationMethod a4 $ \a4' ->
332 withEndCriteria a5 $ \a5' ->
333 preArray $ \(a6'1, a6'2) ->
334 alloca $ \a7' ->
335 alloca $ \a8' ->
336 preErrorCheck $ \a9' ->
337 optimize'_ a1' a2'1 a2'2 a3' a4' a5' a6'1 a6'2 a7' a8' a9' >>
338 peekDoubleArray a6'1 a6'2>>= \a6'' ->
339 peekDouble a7'>>= \a7'' ->
340 peekEnum a8'>>= \a8'' ->
341 errorCheck a9'>>
342 return (a6'', a7'', a8'')
343
344
345
346 -- |Regularly spaced time-grid.
347 timeGrid :: (Double) -- ^end
348 -> (Word) -- ^steps
349 -> IO ((TimeGrid))
350 timeGrid a1 a2 =
351 let {a1' = realToFrac a1} in
352 let {a2' = fromIntegral a2} in
353 preErrorCheck $ \a3' ->
354 timeGrid'_ a1' a2' a3' >>= \res ->
355 peekTimeGrid res >>= \res' ->
356 errorCheck a3'>>
357 return (res')
358
359
360
361 -- |Time grid with mandatory time points.
362 -- Mandatory points are guaranteed to belong to the grid. No additional points are added.
363 timeGridFromList :: (NonEmpty Double) -> IO ((TimeGrid))
364 timeGridFromList a1 =
365 withNonEmptyDoubleArray a1 $ \(a1'1, a1'2) ->
366 preErrorCheck $ \a2' ->
367 timeGridFromList'_ a1'1 a1'2 a2' >>= \res ->
368 peekTimeGrid res >>= \res' ->
369 errorCheck a2'>>
370 return (res')
371
372
373
374 -- |Time grid with mandatory time points.
375 -- Mandatory points are guaranteed to belong to the grid. Additional points are then added with regular spacing between pairs of mandatory times in order to reach the desired number of steps.
376 timeGridFromList' :: (NonEmpty Double) -> (Word) -> IO ((TimeGrid))
377 timeGridFromList' a1 a2 =
378 withNonEmptyDoubleArray a1 $ \(a1'1, a1'2) ->
379 let {a2' = fromIntegral a2} in
380 preErrorCheck $ \a3' ->
381 timeGridFromList''_ a1'1 a1'2 a2' a3' >>= \res ->
382 peekTimeGrid res >>= \res' ->
383 errorCheck a3'>>
384 return (res')
385
386
387
388 -- |returns the number of times on the grid
389 size :: (TimeGrid) -> (Word)
390 size a1 =
391 C2HSImp.unsafePerformIO $
392 withTimeGrid a1 $ \a1' ->
393 size'_ a1' >>= \res ->
394 let {res' = fromIntegral res} in
395 return (res')
396
397
398
399 -- |returns the time at the given index of the grid
400 timeAt :: (TimeGrid) -- ^grid
401 -> (Word) -- ^index
402 -> IO ((Double))
403 timeAt a1 a2 =
404 withTimeGrid a1 $ \a1' ->
405 let {a2' = fromIntegral a2} in
406 preErrorCheck $ \a3' ->
407 timeAt'_ a1' a2' a3' >>= \res ->
408 let {res' = realToFrac res} in
409 errorCheck a3'>>
410 return (res')
411
412
413
414 -- |returns all the times on the grid, as a list
415 points :: (TimeGrid) -> IO (([Double]))
416 points a1 =
417 withTimeGrid a1 $ \a1' ->
418 preArray $ \(a2'1, a2'2) ->
419 preErrorCheck $ \a3' ->
420 points'_ a1' a2'1 a2'2 a3' >>
421 peekDoubleArray a2'1 a2'2>>= \a2'' ->
422 errorCheck a3'>>
423 return (a2'')
424
425
426
427 -- |returns all the times on the grid, as a vector
428 points' :: (TimeGrid) -> IO ((Vector CDouble))
429 points' a1 =
430 withTimeGrid a1 $ \a1' ->
431 preArray $ \(a2'1, a2'2) ->
432 preErrorCheck $ \a3' ->
433 points''_ a1' a2'1 a2'2 a3' >>
434 peekDoubleVector a2'1 a2'2>>= \a2'' ->
435 errorCheck a3'>>
436 return (a2'')
437
438
439
440 -- vim: set ff=unix ts=8 sts=2 sw=2 et:
441
442 foreign import ccall safe "QuantLib/Math.chs.h qlRound"
443 applyRounding'_ :: ((C2HSImp.Ptr (CRounding)) -> (C2HSImp.CDouble -> (IO C2HSImp.CDouble)))
444
445 foreign import ccall safe "QuantLib/Math.chs.h qlOptimize"
446 optimize'_ :: ((C2HSImp.FunPtr ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CUInt -> (IO C2HSImp.CDouble)))) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr (CConstraint)) -> ((C2HSImp.Ptr (COptimizationMethod)) -> ((C2HSImp.Ptr (CEndCriteria)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CDouble)) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO ()))))))))))))
447
448 foreign import ccall safe "QuantLib/Math.chs.h qlTimeGrid1"
449 timeGrid'_ :: (C2HSImp.CDouble -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CTimeGrid))))))
450
451 foreign import ccall safe "QuantLib/Math.chs.h qlTimeGrid2"
452 timeGridFromList'_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CTimeGrid))))))
453
454 foreign import ccall safe "QuantLib/Math.chs.h qlTimeGrid3"
455 timeGridFromList''_ :: (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr (CTimeGrid)))))))
456
457 foreign import ccall safe "QuantLib/Math.chs.h qlTimeGridSize"
458 size'_ :: ((C2HSImp.Ptr (CTimeGrid)) -> (IO C2HSImp.CUInt))
459
460 foreign import ccall safe "QuantLib/Math.chs.h qlTimeGridAt"
461 timeAt'_ :: ((C2HSImp.Ptr (CTimeGrid)) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO C2HSImp.CDouble))))
462
463 foreign import ccall safe "QuantLib/Math.chs.h qlTimeGridPoints"
464 points'_ :: ((C2HSImp.Ptr (CTimeGrid)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CDouble)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO ())))))
465
466 foreign import ccall safe "QuantLib/Math.chs.h qlTimeGridPoints"
467 points''_ :: ((C2HSImp.Ptr (CTimeGrid)) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CDouble)) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO ())))))