Function: calc-curve-fit
calc-curve-fit is an autoloaded, interactive and byte-compiled
function defined in calcalg3.el.gz.
Signature
(calc-curve-fit ARG &optional CURVE-MODEL CURVE-COEFNAMES CURVE-VARNAMES)
Key Bindings
Source Code
;; Defined in /usr/src/emacs/lisp/calc/calcalg3.el.gz
(defun calc-curve-fit (arg &optional curve-model
curve-coefnames curve-varnames)
(interactive "P")
(calc-slow-wrapper
(setq calc-aborted-prefix nil)
(let ((calc-curve-model curve-model)
(calc-curve-coefnames curve-coefnames)
(calc-curve-varnames curve-varnames)
(func (if (calc-is-inverse) 'calcFunc-xfit
(if (calc-is-hyperbolic) 'calcFunc-efit
'calcFunc-fit)))
key (which 0)
(nonlinear nil)
(plot nil)
n calc-curve-nvars data ;; temp
(homog nil)
(msgs '( "(Press ? for help)"
"1 = linear or multilinear"
"2-9 = polynomial fits; i = interpolating polynomial"
"p = a x^b, ^ = a b^x"
"e = a exp(b x), x = exp(a + b x), l = a + b ln(x)"
"E = a 10^(b x), X = 10^(a + b x), L = a + b log10(x)"
"q = a + b (x-c)^2"
"g = (a/b sqrt(2 pi)) exp(-0.5*((x-c)/b)^2)"
"s = a/(1 + exp(b (x - c)))"
"b = a exp(b (x - c))/(1 + exp(b (x - c)))^2"
"o = (y/x) = a (1 - x/b)"
"h prefix = homogeneous model (no constant term)"
"P prefix = plot result"
"' = alg entry, $ = stack, u = Model1, U = Model2")))
(while (not calc-curve-model)
(message
"Fit to model: %s:%s%s"
(nth which msgs)
(if plot "P" " ")
(if homog "h" ""))
(setq key (read-char))
(cond ((= key ?\C-g)
(keyboard-quit))
((= key ??)
(setq which (% (1+ which) (length msgs))))
((memq key '(?h ?H))
(setq homog (not homog)))
((= key ?P)
(if plot
(setq plot nil)
(let ((data (calc-top 1)))
(if (or
(calc-is-hyperbolic)
(calc-is-inverse)
(not (= (length data) 3)))
(setq plot "Can't plot")
(setq plot data)))))
((progn
(if (eq key ?\$)
(setq n 1)
(setq n 0))
(cond ((null arg)
(setq n (1+ n)
data (calc-top n)))
((or (consp arg) (eq arg 0))
(setq n (+ n 2)
data (calc-top n)
data (if (math-matrixp data)
(append data (list (calc-top (1- n))))
(list 'vec data (calc-top (1- n))))))
((> (setq arg (prefix-numeric-value arg)) 0)
(setq data (cons 'vec (calc-top-list arg (1+ n)))
n (+ n arg)))
(t (error "Bad prefix argument")))
(or (math-matrixp data) (not (cdr (cdr data)))
(error "Data matrix is not a matrix!"))
(setq calc-curve-nvars (- (length data) 2)
calc-curve-coefnames nil
calc-curve-varnames nil)
nil))
((= key ?1) ; linear or multilinear
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 0))
(setq calc-curve-model
(math-mul calc-curve-coefnames
(cons 'vec (cons 1 (cdr calc-curve-varnames))))))
((and (>= key ?2) (<= key ?9)) ; polynomial
(calc-get-fit-variables 1 (- key ?0 -1) (and homog 0))
(setq calc-curve-model
(math-build-polynomial-expr (cdr calc-curve-coefnames)
(nth 1 calc-curve-varnames))))
((= key ?i) ; exact polynomial
(calc-get-fit-variables 1 (1- (length (nth 1 data)))
(and homog 0))
(setq calc-curve-model
(math-build-polynomial-expr (cdr calc-curve-coefnames)
(nth 1 calc-curve-varnames))))
((= key ?p) ; power law
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 1))
(setq calc-curve-model
(math-mul
(nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
(calcFunc-map
'(var pow var-pow)
calc-curve-varnames
(cons 'vec (cdr (cdr calc-curve-coefnames))))))))
((= key ?^) ; exponential law
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 1))
(setq calc-curve-model
(math-mul (nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
(calcFunc-map
'(var pow var-pow)
(cons 'vec (cdr (cdr calc-curve-coefnames)))
calc-curve-varnames)))))
((= key ?s)
(setq nonlinear t)
(setq calc-curve-model t)
(require 'calc-nlfit)
(calc-fit-s-shaped-logistic-curve func))
((= key ?b)
(setq nonlinear t)
(setq calc-curve-model t)
(require 'calc-nlfit)
(calc-fit-bell-shaped-logistic-curve func))
((= key ?o)
(setq nonlinear t)
(setq calc-curve-model t)
(require 'calc-nlfit)
(if (and plot (not (stringp plot)))
(setq plot
(list 'vec
(nth 1 plot)
(cons
'vec
(math-map-binop 'calcFunc-div
(cdr (nth 2 plot))
(cdr (nth 1 plot)))))))
(calc-fit-hubbert-linear-curve func))
((memq key '(?e ?E))
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 1))
(setq calc-curve-model
(math-mul (nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
(calcFunc-map
(if (eq key ?e)
'(var exp var-exp)
'(calcFunc-lambda
(var a var-a)
(^ 10 (var a var-a))))
(calcFunc-map
'(var mul var-mul)
(cons 'vec (cdr (cdr calc-curve-coefnames)))
calc-curve-varnames))))))
((memq key '(?x ?X))
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 0))
(setq calc-curve-model
(math-mul calc-curve-coefnames
(cons 'vec (cons 1 (cdr calc-curve-varnames)))))
(setq calc-curve-model (if (eq key ?x)
(list 'calcFunc-exp calc-curve-model)
(list '^ 10 calc-curve-model))))
((memq key '(?l ?L))
(calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 0))
(setq calc-curve-model
(math-mul calc-curve-coefnames
(cons 'vec
(cons 1 (cdr (calcFunc-map
(if (eq key ?l)
'(var ln var-ln)
'(var log10
var-log10))
calc-curve-varnames)))))))
((= key ?q)
(calc-get-fit-variables calc-curve-nvars
(1+ (* 2 calc-curve-nvars)) (and homog 0))
(let ((c calc-curve-coefnames)
(v calc-curve-varnames))
(setq calc-curve-model (nth 1 c))
(while (setq v (cdr v) c (cdr (cdr c)))
(setq calc-curve-model (math-add
calc-curve-model
(list '*
(car c)
(list '^
(list '- (car v) (nth 1 c))
2)))))))
((= key ?g)
(setq
calc-curve-model
(math-read-expr
"(AFit / BFit sqrt(2 pi)) exp(-0.5 * ((XFit - CFit) / BFit)^2)")
calc-curve-varnames '(vec (var XFit var-XFit))
calc-curve-coefnames '(vec (var AFit var-AFit)
(var BFit var-BFit)
(var CFit var-CFit)))
(calc-get-fit-variables 1 (1- (length calc-curve-coefnames))
(and homog 1)))
((memq key '(?\$ ?\' ?u ?U))
(let* (;; (defvars nil)
(record-entry nil))
(if (eq key ?\')
(let* ((calc-dollar-values calc-arg-values)
(calc-dollar-used 0)
(calc-hashes-used 0))
(setq calc-curve-model
(calc-do-alg-entry "" "Model formula: "
nil 'calc-curve-fit-history))
(if (/= (length calc-curve-model) 1)
(error "Bad format"))
(setq calc-curve-model (car calc-curve-model)
record-entry t)
(if (> calc-dollar-used 0)
(setq calc-curve-coefnames
(cons 'vec
(nthcdr (- (length calc-arg-values)
calc-dollar-used)
(reverse calc-arg-values))))
(if (> calc-hashes-used 0)
(setq calc-curve-coefnames
(cons 'vec (calc-invent-args
calc-hashes-used))))))
(progn
(setq calc-curve-model (cond ((eq key ?u)
(calc-var-value 'var-Model1))
((eq key ?U)
(calc-var-value 'var-Model2))
(t (calc-top 1))))
(or calc-curve-model (error "User model not yet defined"))
(if (math-vectorp calc-curve-model)
(if (and (memq (length calc-curve-model) '(3 4))
(not (math-objvecp (nth 1 calc-curve-model)))
(math-vectorp (nth 2 calc-curve-model))
(or (null (nth 3 calc-curve-model))
(math-vectorp (nth 3 calc-curve-model))))
(setq calc-curve-varnames (nth 2 calc-curve-model)
calc-curve-coefnames
(or (nth 3 calc-curve-model)
(cons 'vec
(math-all-vars-but
calc-curve-model
calc-curve-varnames)))
calc-curve-model (nth 1 calc-curve-model))
(error "Incorrect model specifier")))))
(or calc-curve-varnames
(let ((with-y
(eq (car-safe calc-curve-model) 'calcFunc-eq)))
(if calc-curve-coefnames
(calc-get-fit-variables
(if with-y (1+ calc-curve-nvars) calc-curve-nvars)
(1- (length calc-curve-coefnames))
(math-all-vars-but
calc-curve-model calc-curve-coefnames)
nil with-y)
(let* ((coefs (math-all-vars-but calc-curve-model nil))
(vars nil)
(n (-
(length coefs)
calc-curve-nvars
(if with-y 2 1)))
p)
(if (< n 0)
(error "Not enough variables in model"))
(setq p (nthcdr n coefs))
(setq vars (cdr p))
(setcdr p nil)
(calc-get-fit-variables
(if with-y (1+ calc-curve-nvars) calc-curve-nvars)
(length coefs)
vars coefs with-y)))))
(if record-entry
(calc-record (list 'vec calc-curve-model
calc-curve-varnames calc-curve-coefnames)
"modl"))))
(t (beep))))
(unless nonlinear
(let ((calc-fit-to-trail t))
(calc-enter-result n (substring (symbol-name func) 9)
(list func calc-curve-model
(if (= (length calc-curve-varnames) 2)
(nth 1 calc-curve-varnames)
calc-curve-varnames)
(if (= (length calc-curve-coefnames) 2)
(nth 1 calc-curve-coefnames)
calc-curve-coefnames)
data))
(if (consp calc-fit-to-trail)
(calc-record (calc-normalize calc-fit-to-trail) "parm"))))
(when plot
(if (stringp plot)
(message "%s" plot)
(let ((calc-graph-no-auto-view t))
(calc-graph-delete t)
(calc-graph-add-curve
(calc-graph-lookup (nth 1 plot))
(calc-graph-lookup (nth 2 plot)))
(unless (math-contains-sdev-p (nth 2 data))
(calc-graph-set-styles nil nil)
(calc-graph-point-style nil))
(setq plot (cdr (nth 1 plot)))
(setq plot
(list 'intv
3
(math-sub
(math-min-list (car plot) (cdr plot))
'(float 5 -1))
(math-add
'(float 5 -1)
(math-max-list (car plot) (cdr plot)))))
(calc-graph-add-curve (calc-graph-lookup plot)
(calc-graph-lookup (calc-top-n 1)))
(calc-graph-plot nil)))))))