common-stalingrad.vlad

(define (car (cons x y)) x)

(define (cdr (cons x y)) y)

(define (sqr x) (* x x))

(define (length l) (if (null? l) 0 (+ (length (cdr l)) 1)))

(define (list-ref l i) (if (zero? i) (car l) (list-ref (cdr l) (- i 1))))

(define ((map f) l) (if (null? l) '() (cons (f (car l)) ((map f) (cdr l)))))

(define ((map2 f) l1 l2)
 (if (null? l1)
     '()
     (cons (f (car l1) (car l2)) ((map2 f) (cdr l1) (cdr l2)))))

(define ((map-n f) n)
 (letrec ((loop (lambda (i) (if (= i n) '() (cons (f i) (loop (+ i 1)))))))
  (loop 0)))

(define ((reduce f i) l) (if (null? l) i (f (car l) ((reduce f i) (cdr l)))))

(define (v+ u v) ((map2 +) u v))

(define (v- u v) ((map2 -) u v))

(define (k*v k v) ((map (lambda (x) (* k x))) v))

(define (magnitude-squared x) ((reduce + (real 0)) ((map sqr) x)))

(define (magnitude x) (sqrt (magnitude-squared x)))

(define (distance-squared u v) (magnitude-squared (v- v u)))

(define (distance u v) (sqrt (distance-squared u v)))

(define (e i n) ((map-n (lambda (j) (if (= j i) (real 1) (real 0)))) n))

(define (j* x) (bundle x (zero (perturb x))))

(define ((gradient f) x)
 (let ((n (length x)))
  ((map-n
    (lambda (i) (unperturb (tangent ((j* f) (bundle x (perturb (e i n))))))))
   n)))

(define (multivariate-argmin f x)
 (let ((g (gradient f)))
  (letrec ((loop
	    (lambda (x fx gx eta i)
	     (cond ((<= (magnitude gx) (real 1e-5)) x)
		   ((= i (real 10)) (loop x fx gx (* (real 2) eta) (real 0)))
		   (else
		    (let ((x-prime (v- x (k*v eta gx))))
		     (if (<= (distance x x-prime) (real 1e-5))
			 x
			 (let ((fx-prime (f x-prime)))
			  (if (< fx-prime fx)
			      (loop x-prime fx-prime (g x-prime) eta (+ i 1))
			      (loop x fx gx (/ eta (real 2)) (real 0)))))))))))
   (loop x (f x) (g x) (real 1e-5) (real 0)))))

(define (multivariate-argmax f x)
 (multivariate-argmin (lambda (x) (- (real 0) (f x))) x))

(define (multivariate-max f x) (f (multivariate-argmax f x)))