regularized logistic regression in emacs lisp

logreg.el

;; -*- lexical-binding: t -*-

(eval-when-compile
  (require 'cl))

(defun rnd (from to)
  (let ((r (/ (random 10000) 10000.0)))
    (+ (* r (- to from)) from)))

(defun init-weights (n-inputs n-outputs)
  (loop for i below n-outputs
        collect (loop for j below n-inputs
                      collect (rnd -0.01 0.01))))

(defun train (input-list output-list n-inputs n-outputs n-iter learning-rate reg)
  (let ((weights (init-weights n-inputs n-outputs)))
    (loop for i below n-iter
          do (loop for j below (length input-list)
                   for inputs = (elt input-list j)
                   for outputs = (elt output-list j)
                   do (setq weights (iterate inputs outputs weights n-inputs n-outputs learning-rate reg))))
    weights))

(defun init-weight-updates (n-inputs n-outputs)
  (loop for i below n-outputs
        collect (loop for j below n-inputs
                      collect 0)))

(defun elt2d (x i j)
  (elt (elt x i) j))

(defun predict (inputs weights n-inputs n-outputs)
  (let* ((o (loop for i below n-outputs
                  collect (loop for j below n-inputs
                                sum (* (elt2d weights i j) (elt inputs j)))))
         (exp-o (loop for i below n-outputs
                      collect (exp (elt o i))))
         (sum-exp-o (loop for i below n-outputs
                          sum (elt exp-o i))))
    (loop for i below n-outputs
          collect (/ (elt exp-o i) sum-exp-o))))

(defun weight-update (weight input pred output reg)
  (let ((grad (- (* (- output pred) input) (* reg weight))))
    (+ weight grad)))

(defun iterate (inputs outputs weights n-inputs n-outputs learning-rate reg)
  (let ((preds (predict inputs weights n-inputs n-outputs)))
    (loop for i below n-outputs
          for output = (elt outputs i)
          for pred = (elt preds i)
          collect (loop for j below n-inputs
                        for input = (elt inputs j)
                        for weight = (elt2d weights i j)
                        for update = (weight-update weight input pred output reg)
                        for new-weight = (+ weight (* learning-rate update))
                        collect new-weight))))

(defun argmax (xs)
  (loop with max = 0
        with max-i = 0
        for x being the elements of xs
        using (index i)
        when (> x max)
        do (setq max x max-i i)
        finally (return max-i)))

(defun accuracy (input-list output-list weights n-inputs n-outputs)
  (loop for inputs in input-list
      for outputs in output-list
      when (= (argmax (predict inputs weights n-inputs n-outputs))
              (argmax outputs))
      sum (/ 1.0 (length output-list))))


;;; TEST

(let* ((n-inputs 4)
       (n-outputs 2)
       (n-iter 4)
       (learning-rate 0.1)
       (regularization .2)
       (input-list  '((1 1 0 0) (1 1 1 0) (1 0 1 0) (1 0 0 1))) ;; first element is bias, always 1
       (output-list '((1 0)     (1 0)     (0 1)     (0 1)))
       (weights (train input-list output-list n-inputs n-outputs n-iter learning-rate regularization)))
  (accuracy input-list output-list weights n-inputs n-outputs))