Black-Scholes Option Pricing Model in Scheme

black.scm

(define new-pi 3.1415926)

(define days-in-year 365)

(define (sqrt-t days-to-expiration)
  (sqrt (/ days-to-expiration days-in-year)))

(define (normal-dist zz)
  (if (= zz 0) 0.5
      [let ((p 0.2316419) (b1 0.31938153) (b2 -0.356563782) 
                          (b3 1.781477937) (b4 -1.821255978) 
                          (b5 1.330274428) (f (/ 1 (sqrt (* 2 new-pi)))) 
                          (abszz (abs zz)))
        [let ((ff (* f (exp (/ (- (expt abszz 2)) 2))))
              (s1 (/ b1 (+ 1 (* p abszz)))) 
              (s2 (/ b2 (expt (+ 1 (* p abszz)) 2))) 
              (s3 (/ b3 (expt (+ 1 (* p abszz)) 3))) 
              (s4 (/ b4 (expt (+ 1 (* p abszz)) 4))) 
              (s5 (/ b5 (expt (+ 1 (* p abszz)) 5))))
          [let ((sz (* ff (+ s1 s2 s3 s4 s5))))
            [if (< zz 0) 
                sz 
                (- 1 sz)]]]]))

(define (N strike stock standard-deviation risk-free-return days-to-expiration)
  (let [(ls (log stock)) (lx (log strike)) 
                         (t (/ days-to-expiration days-in-year))
                         (sd2 (expt standard-deviation 2))]
    (+ (- ls lx) 
       (* risk-free-return t) 
       (* sd2 (/ t 2)))))

(define (delta2 n standard-deviation days-to-expiration)
  (let [(sqT (sqrt-t days-to-expiration))]
    (let [(d (* standard-deviation sqT))]
      (let [(d1 (/ n d))]
        (normal-dist d1)))))

(define (ND2 n standard-deviation days-to-expiration)
  (let [(sqT (sqrt-t days-to-expiration))]
    (let [(d (* standard-deviation sqT))]
      (let [(d1 (/ n d))]
        (let [(d2 (- d1 (* standard-deviation sqT)))]
          (normal-dist d2))))))

(define (bond strike stock standard-deviation risk-free-return days-to-expiration)
  (let [(n (N strike stock standard-deviation risk-free-return days-to-expiration)) 
        (t (/ days-to-expiration days-in-year))]
    (let [(nd1 (delta2 n standard-deviation days-to-expiration)) 
          (nd2 (ND2 n standard-deviation days-to-expiration))]
      (* (* (exp (* (- risk-free-return) t)) nd2) 
         (- strike)))))

(define (delta strike stock standard-deviation risk-free-return days-to-expiration)
  (let [(n (N strike stock standard-deviation risk-free-return days-to-expiration)) 
        (sqT (sqrt-t days-to-expiration))]
    (let [(d (* standard-deviation sqT))]
      (let [(d1 (/ n d))]
        (normal-dist d1)))))

(define (callValue strike stock standard-deviation risk-free-return days-to-expiration)
  (let [(n (N strike stock standard-deviation risk-free-return days-to-expiration))
        (t (/ days-to-expiration days-in-year))]
    (let [(nd1 (delta2 n standard-deviation days-to-expiration)) 
          (nd2 (ND2 n standard-deviation days-to-expiration)) 
          (b (bond strike stock standard-deviation risk-free-return days-to-expiration))]
      (+ (* stock nd1) b))))

(define (putValue strike stock standard-deviation risk-free-return days-to-expiration)
  (let [(t (/ days-to-expiration days-in-year)) 
        (call (callValue strike stock standard-deviation risk-free-return days-to-expiration))]
    (+ (- (* (exp (* (- risk-free-return) t)) strike) stock) call)))

(define (black-scholes strike stock standard-deviation risk-free-return days-to-expiration)
    (list (putValue strike stock standard-deviation risk-free-return days-to-expiration)
          (callValue strike stock standard-deviation risk-free-return days-to-expiration)
          (delta strike stock standard-deviation risk-free-return days-to-expiration)
          (bond strike stock standard-deviation risk-free-return days-to-expiration)))

(define (black-scholes-list ls) (apply black-scholes ls))