57 lines
2.0 KiB
Scheme
57 lines
2.0 KiB
Scheme
(module fit-low-level mzscheme
|
|
(require (lib "foreign.ss") (lib "etc.ss"))
|
|
(unsafe!)
|
|
|
|
(define libfit
|
|
(ffi-lib (build-path (this-expression-source-directory)
|
|
"compiled" "native" (system-library-subpath #f)
|
|
"libfit")))
|
|
|
|
(define do-fit-int
|
|
(get-ffi-obj "do_fit" libfit
|
|
(_fun (func : (_fun _int _pointer -> _double))
|
|
(val-num : _int = (length x-values))
|
|
(x-values : (_list i _double*))
|
|
(y-values : (_list i _double*))
|
|
(z-values : (_list i _double*))
|
|
(errors : (_list i _double*))
|
|
(param-num : _int = (length params))
|
|
(params : (_list i _double*))
|
|
-> (_list o _double* param-num))))
|
|
|
|
(define (do-fit callback x-vals y-vals z-vals errors params)
|
|
(do-fit-int (lambda (argc argv)
|
|
(let ([args (cblock->list argv _double argc)])
|
|
(apply callback args)))
|
|
x-vals y-vals z-vals errors params))
|
|
|
|
(define get-asym-error
|
|
(get-ffi-obj "get_asym_error" libfit
|
|
(_fun (len : _?) ; len is only used for list conversion
|
|
-> (_list o _double* len))))
|
|
|
|
(define get-asym-error-percent
|
|
(get-ffi-obj "get_asym_error_percent" libfit
|
|
(_fun (len : _?) ; len is only used for list conversion
|
|
-> (_list o _double* len))))
|
|
|
|
(define get-rms
|
|
(get-ffi-obj "get_rms" libfit
|
|
(_fun -> _double*)))
|
|
|
|
(define get-varience
|
|
(get-ffi-obj "get_varience" libfit
|
|
(_fun -> _double*)))
|
|
|
|
(define (fit-internal f-of-x-y x-vals y-vals z-vals err-vals params)
|
|
|
|
(let* ([len (length params)]
|
|
[fit-result (do-fit f-of-x-y x-vals y-vals z-vals err-vals params)]
|
|
[asym-error (get-asym-error len)]
|
|
[asym-error-percent (get-asym-error-percent len)]
|
|
[rms (get-rms)]
|
|
[varience (get-varience)])
|
|
(list fit-result asym-error asym-error-percent rms varience)))
|
|
|
|
(provide fit-internal))
|