samer@0: (import "samer.models.*") samer@0: samer@0: (define vec VVector.) samer@0: samer@0: ; prior-spec: (name constructor mk-trainer batch flush-tasks) samer@0: (define (iid-spec logprior) `("iid" ,(lambda (n) (IIDPrior. n logprior)))) samer@0: (define genexp-spec `("genexp" ,samer.models.GeneralisedExponential. ,.getTrainer 128)) samer@0: (define cauchy-spec `("cauchy" ,(lambda (n) (IIDPrior. n (LogCauchy.))))) samer@0: (define gauss-spec `("gauss" ,(lambda (n) (IIDPrior. n (HalfSquare.))))) samer@0: (define laplace-spec `("laplace" ,(lambda (n) (IIDPrior. n (Abs.))))) samer@0: (define ica-spec `("ica" ,ICA. .getTrainer 512)) samer@0: (define a-gauss-spec `("gauss" ,(lambda (n) (AlignedGaussian. n)))) samer@0: samer@0: samer@0: ;;; macro for extracting things from a model-spec samer@0: (define-macro (let-model name const train spec . body) samer@0: `(let ((,name (car ,spec)) (,const (cadr ,spec)) (,train (cddr ,spec))) samer@0: . ,body)) samer@0: samer@0: samer@0: ;; what about flush tasks? samer@0: (define (maybe-train model train) samer@0: (if (not (null? train)) samer@0: (let ((trainer (BatchedTrainer. ((car train) model) (cadr train))) samer@0: (post-flush (caddr train))) samer@0: (addtask trainer) samer@0: (if (not (null? post-flush)) samer@0: (.setPostFlush trainer post-flush))))) samer@0: samer@0: ;;; this is a sort of model combinator samer@0: samer@0: (define (chain-2 x spec-1 spec-2) samer@0: (let-model name-1 cons-1 train-1 spec-1 samer@0: (let-model name-2 cons-2 train-2 spec-2 samer@0: (node name-1 samer@0: (let* ((model-1 (cons-1 x)) samer@0: (model-2 (node name-2 (cons-2 (.output model-1))))) samer@0: (.setOutputModel model-1 model-2) samer@0: (addtasks model-1 model-2) samer@0: (node name-2 (maybe-train model-2 train-2)) samer@0: (maybe-train model-1 train-1) samer@0: (list model-1 model-2)))))) samer@0: samer@0: (define (scaler-spec . training-spec) samer@0: (append `("scaler" ,Scaler.) training-spec)) samer@0: samer@0: (define (mk-scaler x prior . trainer) samer@0: (node (.getNode x) samer@0: (let ((models (chain-2 x (apply scaler-spec trainer) prior))) samer@0: (.output (car models))))) samer@0: samer@0: samer@0: (define (mk-diffscaler x prior . trainer) samer@0: (node (.getNode x) samer@0: (chain-2 x (append `("diffScaler" ,DiffScaler.) trainer) prior))) samer@0: samer@0: samer@0: ;;; these are the old methods defined in terms of the above samer@0: (define (norm in) (mk-scaler in laplace-spec .getTrainer 8)) samer@0: (define (offset in) (mk-scaler in laplace-spec .getOffsetTrainer 8)) samer@0: (define (nonorm in) (mk-scaler in laplace-spec)) samer@0: (define (diffnorm x prior) (.output (car (mk-diffscaler x prior .getTrainer 16)))) samer@0: (define (diffscale x prior) (.output (car (mk-diffscaler x prior .getScaleTrainer 16)))) samer@0: (define (diffoffset x prior) (.output (car (mk-diffscaler x prior .getOffsetTrainer 16)))) samer@0: (define (smoothscale x prior) (.output (car (mk-diffscaler x prior .getTensionedTrainer 16)))) samer@0: samer@0: samer@0: ;;;; ........... ICA ............ samer@0: samer@0: ; trainers: .getTrainer samer@0: ; trainers: .getDecayWhenActiveTrainer samer@0: (define (ica-spec . training-spec) samer@0: (let ((ica-cons samer@0: (lambda (x) samer@0: (let ((ica (ICA. (cur-node) (.size x)))) samer@0: (.setInput ica x) samer@0: (Shell.registerViewable ica) samer@0: ica)))) samer@0: `("ica" ,ica-cons . ,training-spec))) samer@0: samer@0: samer@0: (define (mk-ica x prior . trainer) samer@0: (node (.getNode x) samer@0: (if (null? trainer) samer@0: (car (chain-2 x (ica-spec) prior)) samer@0: (car (chain-2 x (ica-spec (car trainer) (.size x)) prior))))) samer@0: samer@0: samer@0: ; auto: load weights, basis rowcolumn viewer samer@0: ; (matexec (.getWeightMatrix ica) "load") samer@0: ; (matexec (.getBasisMatrix ica) "rowcolumn") samer@0: samer@0: ; flush tasks: samer@0: ; (exec ica "basis") samer@0: ; (exec ica "logdet") samer@0: ; (exec basis "save") samer@0: ; (ICAScalerSync.) (for 3 model version) samer@0: samer@0: samer@0: ; trainers: .getScaleTrainer samer@0: ; trainers: .getDiffTrainer samer@0: ; (define (mk-ica-scaler x prior trainer) samer@0: ; (node (.getNode x) samer@0: ; (let ((models (chain-2 x `("ica" ,ICAWithScaler. ,trainer ,(.size x)) prior))) samer@0: ; (Shell.registerViewable (car models)) samer@0: ; (.output (car models))))) samer@0: samer@0: ; (.diffFlush trainer) ; (more frequent) samer@0: samer@0: samer@0: samer@0: (define (histogram vec bins) samer@0: (define hist (node (.getNode vec) (Histogram. vec bins))) samer@0: ;(addtask hist) samer@0: hist) samer@0: samer@0: samer@0: (define (chain-3 x spec-1 spec-2 spec-3) samer@0: (let-model name-1 cons-1 train-1 spec-1 samer@0: (let-model name-2 cons-2 train-2 spec-2 samer@0: (let-model name-3 cons-3 train-3 spec-3 samer@0: (node name-1 samer@0: (let* ((model-1 (cons-1 x)) samer@0: (model-2 (node name-2 (cons-2 (.output model-1)))) samer@0: (model-3 (node name-2 (node name-3 (cons-3 (.output model-2)))))) samer@0: (.setOutputModel model-1 model-2) samer@0: (.setOutputModel model-2 model-3) samer@0: (addtasks (task samer@0: (.infer model-1) samer@0: (.infer model-2) samer@0: ; (.infer model-3) samer@0: ; this is wrong - only need to compute if training samer@0: (.compute model-3) samer@0: (.compute model-2))) samer@0: ; no need to compute model 1 if there is no model 0 samer@0: (maybe-train model-1 train-1) samer@0: (node name-2 (maybe-train model-2 train-2)) samer@0: (node name-2 (node name-3 (maybe-train model-3 train-3))) samer@0: (list model-1 model-2 model-3))))))) samer@0: samer@0: ;; flush tasks for model 1/2 trainers? samer@0: '(sub 32 (seq samer@0: (ICAScalerSync. ica scaler) samer@0: (task (exec ica "basis")))) samer@0: samer@0: ;;;; Mixture models samer@0: samer@0: (define (mix-2 x spec-1 spec-2) samer@0: (let-model name-1 cons-1 train-1 spec-1 samer@0: (let-model name-2 cons-2 train-2 spec-2 samer@0: (let* ((model-1 (node name-1 (cons-1 x))) samer@0: (model-2 (node name-2 (cons-2 x))) samer@0: (mixture (Mixture. x 2)) samer@0: (trainer (.getTrainer mixture))) samer@0: (.setModel M 0 model-1) samer@0: (.setModel M 1 model-2) samer@0: (.setTrainer trainer 0 (.getTrainer model-1)) samer@0: (.setTrainer trainer 0 (.getTrainer model-2)) samer@0: (addtasks samer@0: (task samer@0: (.infer model-1) (.compute model-1) samer@0: (.infer model-2) (.compute model-2) samer@0: (.infer mixture)) samer@0: (BatchedTrainer. trainer 4)))))) samer@0: samer@0: samer@0: samer@0: samer@0: ;;;; Noisy ICA samer@0: samer@0: (import "samer.maths.opt.*") samer@0: samer@0: (define (std-opt s opt) samer@0: (put "optimiser" opt) samer@0: (expose (.getViewer opt) "optimiser") samer@0: (seq (GenerateVector. s (Zero.)) opt)) samer@0: samer@0: samer@0: (define (uqn-optimiser s fn) (std-opt s (UnconstrainedMinimiser. s fn))) samer@0: (define (ucg-optimiser s fn) (std-opt s (UnconstrainedConjGrad. s fn))) samer@0: (define (pos-optimiser s fn) (std-opt s (ConstrainedMinimiser. s fn Positivity.class))) samer@0: (define (zc-optimiser s fn) samer@0: (Shell.put "ZeroCrossingSparsity.jump" (VDouble. "logprior.jump" 1.0)) samer@0: (std-opt s (ConstrainedMinimiser. s fn ZeroCrossingSparsity.class))) samer@0: samer@0: samer@0: (define (ica-cons m) (lambda (x) samer@0: (let ((ica (NoisyICA. (cur-node) (.size x) m))) samer@0: (.setInput ica x) samer@0: ica))) samer@0: samer@0: (define (noisyica input num-outs e-spec s-spec mk-optimiser) samer@0: (mk-noisyica input samer@0: `("noisyica" ,(ica-cons num-outs) ,.learnDecayWhenActive ,(.size input)) samer@0: e-spec s-spec mk-optimiser)) samer@0: samer@0: (define (noisyica-notrain input num-outs e-spec s-spec mk-optimiser) samer@0: (mk-noisyica input samer@0: `("noisyica" ,(ica-cons num-outs) ) samer@0: e-spec s-spec mk-optimiser)) samer@0: samer@0: (define (mk-noisyica input ica-spec e-spec s-spec mk-optimiser) samer@0: ; x: input vector samer@0: (let-model ica-name ica-cons ica-train ica-spec samer@0: (let-model e-name e-cons e-train e-spec samer@0: (let-model s-name s-cons s-train s-spec samer@0: (node ica-name samer@0: (letrec ( (ica (ica-cons input)) samer@0: (s-model (node "s"(s-cons (.output ica)))) samer@0: (e-model (node "e" (e-cons (.error ica))))) samer@0: samer@0: (.setSourceModel ica s-model) samer@0: (.setNoiseModel ica e-model) samer@0: (.setInferenceTask ica (mk-optimiser (.output ica) (.posterior ica))) samer@0: ; (on-change (.basisMatrix ica) samer@0: ; (.setHessian (get "optimiser") samer@0: ; (.inverse (.times (.transpose A) A)))) samer@0: samer@0: (addtasks ica e-model s-model) samer@0: (maybe-train ica ica-train) samer@0: (node "e" (node e-name (maybe-train e-model e-train))) samer@0: (node "s" (node s-name (maybe-train s-model s-train))) samer@0: samer@0: (list ica e-model s-model))))))) samer@0: