samer@0: 
samer@0: (define (matmult A x nm)
samer@0: 	(define y (VVector. nm (.getRowDimension A)))
samer@0: 	(addtask (seq
samer@0: 		(Ops.times y A x)
samer@0: 		(Ops.update y)))
samer@0: 	y
samer@0: )
samer@0: 
samer@0: ;;; apply function to vector
samer@0: (define (fn-vec fn in outname)
samer@0: 	(let ((out (VVector. outname (.size in))))
samer@0: 		(addtasks (Ops.apply out fn in) (Ops.update out))
samer@0: 		out))
samer@0: 
samer@0: 
samer@0: ; set up signal containing of sum_i fn(x_i)
samer@0: (define (sum-fn fn x nm)
samer@0: 	(define sig (node (.getNode x) (VDouble. nm)))
samer@0: 	(addtask (SumFnVec. fn x sig))
samer@0: 	sig
samer@0: )
samer@0: 
samer@0: ;;; power spectrum
samer@0: (define (ft-vec in)
samer@0:    (define ftv (FFTVector. in))
samer@0:    (addtask (.calcTask ftv))
samer@0:    (put "FFTVector" ftv)
samer@0:    ftv
samer@0: )
samer@0: 
samer@0: (define (ft-power ftv)
samer@0:    (define y (VVector. "ft.power" (+ 1 (/ (.size ftv) 2))))
samer@0:    (addtask (.getPower ftv y))                                
samer@0:    y                                                          
samer@0: )
samer@0:                                                               
samer@0: ;;; magnitude spectrum, ie sqrt(power)                        
samer@0: (define (ft-mag ftv)                                          
samer@0:    (define y (VVector. "ft.mag" (+ 0 (/ (.size ftv) 2))))     
samer@0:    (addtasks (.getFnPower ftv (Sqrt.) y))                     
samer@0:    y                                                          
samer@0: )                                                             
samer@0: 
samer@0: ;; log spectrum, ie log(power)                               
samer@0: (define (ft-log ftv)                                          
samer@0:    (define y (VVector. "ft.log" (+ 1 (/ (.size ftv) 2))))     
samer@0:    (addtasks (.getFnPower ftv (Log.) y))
samer@0:    y
samer@0: )
samer@0: 
samer@0: ;;; linear FT, real valued version with sin and cosine parts
samer@0: (define (ft-linear ftv)
samer@0:    (define y (VVector. "ft" (.size ftv)))
samer@0:    (addtask (.getLinearFT ftv y))
samer@0:    y
samer@0: )
samer@0: 
samer@0: ;;; creates parameter viewables for a VFunction
samer@0: ;;; vfn: the VFunction (we need the node and the observable parts)
samer@0: ;;; models: list of (String,DoubleModel) pairs: we create a
samer@0: ;;;				VParameter with the given name for each DoubleModel
samer@0: 
samer@0: (define (vfn-params vfn models)
samer@0:    (define obs (observer (.changed vfn)))
samer@0:    (node (.getNode vfn)
samer@0:       (for-each
samer@0:          (lambda (model)
samer@0: 			;; these VParameters will INITIALISE the DoubleModel with a value
samer@0: 			;; read from the environment
samer@0:             (define param (VParameter. (first model) (second model)))
samer@0:             (.addObserver param obs)
samer@0:          )
samer@0:          models)))
samer@0: 
samer@0: (define (id x) x)
samer@0: (define (vscale k) (define f (Scale. k)) (VParameter. "scale" f) f)
samer@0: (define (vpower k) (define f (Power. k)) (VParameter. "power" f) f)
samer@0: (define (vgenexp)
samer@0: 	(define genexp (samer.functions.LogGenExp.))
samer@0: 	(define vfn (VFunction. "logprior" genexp))
samer@0: 	(vfn-params vfn `( ( "quad" ,genexp ,(.getEpsModel genexp))))
samer@0: 	vfn
samer@0: )
samer@0: 
samer@0: (define-method (logcosh)
samer@0: 	(define fn (LogGenCosh.))
samer@0: 	(define vfn (VFunction. "logcosh" fn))
samer@0: 	(vfn-params vfn `(("alpha" ,fn)))
samer@0: 	fn)
samer@0: 
samer@0: (define-method (genexp alpha lin quad)
samer@0: 	(define fn (LogGenExp2.))
samer@0: 	(.set (.getAlphaModel fn) alpha)
samer@0: 	(.set (.getLinearScale fn) lin)
samer@0: 	(.set (.getQuadraticScale fn) quad)
samer@0: 	fn
samer@0: )
samer@0: 
samer@0: (define-method (genexp)
samer@0: 	(define fn (LogGenExp2.))
samer@0: 	(define vfn (VFunction. "genexp" fn))
samer@0: 	(vfn-params vfn `(
samer@0: 		("alpha" ,fn)
samer@0: 		("lin"      ,(.getLinearScale fn))
samer@0: 		("quad"  ,(.getQuadraticScale fn))
samer@0: 	))
samer@0: 	fn
samer@0: )
samer@0: 
samer@0: (define (nonneg logpr str)
samer@0: 	(define sq (ScaledFunction. (Square.) str))
samer@0: 	(define vfn (VFunction. "hybrid" (HybridFunction. sq logpr)))
samer@0: ;	(vfn-params vfn `(("strictness" ,sq)))
samer@0: 	(.getFunction vfn)
samer@0: )
samer@0: 
samer@0: 
samer@0: ; returns list of integers from start to end
samer@0: (define (range start end)
samer@0:   (define (rr l j) (if (< j start) l (rr (cons j l) (- j 1))))
samer@0:   (rr () (- end 1))
samer@0: )
samer@0: