view src/scheme/functions.scm @ 8:5e3cbbf173aa tip

Reorganise some more

(define (matmult A x nm)
	(define y (VVector. nm (.getRowDimension A)))
	(addtask (seq
		(Ops.times y A x)
		(Ops.update y)))
	y
)

;;; apply function to vector
(define (fn-vec fn in outname)
	(let ((out (VVector. outname (.size in))))
		(addtasks (Ops.apply out fn in) (Ops.update out))
		out))


; set up signal containing of sum_i fn(x_i)
(define (sum-fn fn x nm)
	(define sig (node (.getNode x) (VDouble. nm)))
	(addtask (SumFnVec. fn x sig))
	sig
)

;;; power spectrum
(define (ft-vec in)
   (define ftv (FFTVector. in))
   (addtask (.calcTask ftv))
   (put "FFTVector" ftv)
   ftv
)

(define (ft-power ftv)
   (define y (VVector. "ft.power" (+ 1 (/ (.size ftv) 2))))
   (addtask (.getPower ftv y))                                
   y                                                          
)
                                                              
;;; magnitude spectrum, ie sqrt(power)                        
(define (ft-mag ftv)                                          
   (define y (VVector. "ft.mag" (+ 0 (/ (.size ftv) 2))))     
   (addtasks (.getFnPower ftv (Sqrt.) y))                     
   y                                                          
)                                                             

;; log spectrum, ie log(power)                               
(define (ft-log ftv)                                          
   (define y (VVector. "ft.log" (+ 1 (/ (.size ftv) 2))))     
   (addtasks (.getFnPower ftv (Log.) y))
   y
)

;;; linear FT, real valued version with sin and cosine parts
(define (ft-linear ftv)
   (define y (VVector. "ft" (.size ftv)))
   (addtask (.getLinearFT ftv y))
   y
)

;;; creates parameter viewables for a VFunction
;;; vfn: the VFunction (we need the node and the observable parts)
;;; models: list of (String,DoubleModel) pairs: we create a
;;;				VParameter with the given name for each DoubleModel

(define (vfn-params vfn models)
   (define obs (observer (.changed vfn)))
   (node (.getNode vfn)
      (for-each
         (lambda (model)
			;; these VParameters will INITIALISE the DoubleModel with a value
			;; read from the environment
            (define param (VParameter. (first model) (second model)))
            (.addObserver param obs)
         )
         models)))

(define (id x) x)
(define (vscale k) (define f (Scale. k)) (VParameter. "scale" f) f)
(define (vpower k) (define f (Power. k)) (VParameter. "power" f) f)
(define (vgenexp)
	(define genexp (samer.functions.LogGenExp.))
	(define vfn (VFunction. "logprior" genexp))
	(vfn-params vfn `( ( "quad" ,genexp ,(.getEpsModel genexp))))
	vfn
)

(define-method (logcosh)
	(define fn (LogGenCosh.))
	(define vfn (VFunction. "logcosh" fn))
	(vfn-params vfn `(("alpha" ,fn)))
	fn)

(define-method (genexp alpha lin quad)
	(define fn (LogGenExp2.))
	(.set (.getAlphaModel fn) alpha)
	(.set (.getLinearScale fn) lin)
	(.set (.getQuadraticScale fn) quad)
	fn
)

(define-method (genexp)
	(define fn (LogGenExp2.))
	(define vfn (VFunction. "genexp" fn))
	(vfn-params vfn `(
		("alpha" ,fn)
		("lin"      ,(.getLinearScale fn))
		("quad"  ,(.getQuadraticScale fn))
	))
	fn
)

(define (nonneg logpr str)
	(define sq (ScaledFunction. (Square.) str))
	(define vfn (VFunction. "hybrid" (HybridFunction. sq logpr)))
;	(vfn-params vfn `(("strictness" ,sq)))
	(.getFunction vfn)
)


; returns list of integers from start to end
(define (range start end)
  (define (rr l j) (if (< j start) l (rr (cons j l) (- j 1))))
  (rr () (- end 1))
)