diff options
Diffstat (limited to 'src/algo2.lisp')
| -rw-r--r-- | src/algo2.lisp | 252 |
1 files changed, 252 insertions, 0 deletions
diff --git a/src/algo2.lisp b/src/algo2.lisp new file mode 100644 index 0000000..e1dc0b7 --- /dev/null +++ b/src/algo2.lisp @@ -0,0 +1,252 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; SYMBOLIC FEED-FORWARD NEURAL NETWORK ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; (C) 2026 Screwlisp, CC-By-SA +;;;; +;;;; Originally published on https://screwlisp.small-web.org/fundamental/a-better-deep-learning-algorithm/ +;;;; +;;;; OVERVIEW: This implements a neural network designed for pattern +;;;; recognition within symbolic grids. Instead of using traditional +;;;; "Dense" layers of floating-point weights, it uses "Memory +;;;; Blocks". +;;;; +;;;; HOW IT WORKS: +;;;; 1. WINDOWING: The system slides a "lens" (the memory block size) over +;;;; the input data (the input grid). +;;;; +;;;; 2. CORRELATION: It performs a symbolic comparison between the memory +;;;; and the input. It checks for "Co-occurrence": +;;;; - If the feature is present in BOTH, it's a positive match. +;;;; - If the feature is absent in BOTH, it's also a positive match. +;;;; - Mismatches generate negative signals. +;;;; +;;;; 3. NON-LINEAR ACTIVATION: The resulting sums are passed through a +;;;; "Rectified Polynomial." This is the "secret sauce" of Deep Learning. +;;;; By squaring or cubing the positive signals (the pluses), we amplify +;;;; strong patterns and suppress weak noise. +;;;; +;;;; 4. INFERENCE: The system aggregates the "votes" of all memories. If the +;;;; net signal is positive, the network confirms the presence of the +;;;; requested item (T); otherwise, it rejects it (NIL). +;;;; +;;;; PERSPECTIVE: +;;;; Think of this as a "Fuzzy Grep" for 2D grids. It doesn't look for +;;;; exact matches, but rather "statistical resonance" between a known +;;;; template and a raw input patch. +;;;; ========================================================================== + +(defpackage ffnn.algo2 + (:use :cl) + (:export #:scan-all-memories)) +(in-package :ffnn.algo2) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 1. THE ACTIVATION FUNCTION ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; This defines how a "neuron" scales its output. By squaring the +;;; result (degree 2), we make strong matches significantly more +;;; influential than weak ones. The DEGREE is the knob that can be +;;; cranked to 11 to control how the NN behaves. +(defun make-rectified-polynomial (degree) + (lambda (x) + ;; "Rectified": Only positive values pass. + (cond ((plusp x) (expt x degree)) + ;; Negative or zero signals are killed. + ((not (plusp x)) '0)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 2. THE MAGNITUDE CALCULATOR ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; This compares a row of input to a row of memory. It's essentially +;;; calculating "Overlap" and "Divergence." +(defun sum-one-row (item row-in mem-in idx + &key (predicate 'member) predicate-keys &allow-other-keys) + "Iterate over each place of one input row and return a number of pluses and minuses + for the proposed item to fit based on one row of memory." + (loop :for me :in mem-in ; Walk the memory column-to-column and + :for ro :in row-in ; row-to-row, _simultaneously_! + :for count :from 0 + ;; Transform presence of 'item' into +1 or -1 + :for m := (if (apply predicate item me predicate-keys) +1 -1) + :for c := (if (apply predicate item ro predicate-keys) +1 -1) + + ;; CASE A: We are at the 'Target' + ;; If it matches, we sum the memory signal (+m or -m) directly. + :when (and idx (= count idx)) + :sum (* +1 m) :into pluses + :when (and idx (= count idx)) + :sum (* -1 m) :into minuses + + ;; CASE B: We are at any other column (The context) + ;; + ;; Multiply the input (c) by the memory (m). If both match (+1 + ;; * +1) or both lack the item (-1 * -1), result is +1. This + ;; is the "correlation" or "weighting" step. + :unless (and idx (= count idx)) + :sum (* c m) :into pluses + :unless (and idx (= count idx)) + :sum (* c m) :into minuses + :finally + ;; Returns the total "evidence" for and against this row. + (return (list pluses minuses)))) + +(when nil + ;; Test to understand how sum-one-row works. A plus is added when + ;; the symbol is in the memory row, if the symbol occurs on the + ;; index, 2 pluses are added. Eval with SLIME (C-x C-e at the + ;; closing brace.) + (sum-one-row 'foo + '((foo) () (bar)) + '((foo) (foo) (bar)) + 1) ; (3 1) - strong sign that foo belongs there + (sum-one-row 'foo + '((bar) () (bar)) + '((bar) (bar) (foo)) + 1) ; (-1 1) - undecided? + (sum-one-row 'foo + '((bar) () (bar)) + '((bar) (bar) (bar)) + 1) ; (1 3) - allergy! + (sum-one-row 'foo + '((foo) () (bar)) + '((foo) (foo) (bar)) + nil) ; (3 1) - strong sign that foo belongs there + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 3. THE SPATIAL AGGREGATOR ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; This loops through the rows of a single memory "block." Think of a +;;; memory block. +(defun sum-one-memory (item input memory + &rest keys + &key + (target-row 0) (target-col 0) + (start-row 0) (start-col 0) + rectified-polynomial &allow-other-keys) + "Iterate through each memory row and calculates the fit of the item in +each input location based on the memory rows." + (loop :for mem-row :in memory + :for count :from 0 + ;; 'nthcdr' is used to offset into the input matrix, + ;; allowing the network to look at specific "patches" of data. + :for whole-input-row :in (nthcdr start-row input) + :for input-row := (nthcdr start-col whole-input-row) + + ;; If the current row matches the row we are predicting, + ;; pass that column index down to sum-one-row. + :for idx := (when (= count target-row) target-col) + + ;; Execute the row-level comparison. + :for (row-plus row-minus) + := (apply 'sum-one-row item input-row mem-row idx keys) + + ;; Accumulate the results for the entire memory block. + :summing row-plus :into row-pluses + :summing row-minus :into row-minuses + :finally + ;; Apply the "Polynomial" to amp up strong signals, + ;; then subtract the 'negative evidence' from the 'positive evidence'. + (return + (- (funcall rectified-polynomial row-pluses) + (funcall rectified-polynomial row-minuses))))) + +(when nil + ;;; Tests for sum-one-memory + (sum-one-memory 'foo + '(((foo) (foo)) + ((bar) (bar))) ;; Input + '(((foo) (foo)) + ((bar) (bar))) ;; Memory + :rectified-polynomial (make-rectified-polynomial 2) + :target-row 0 :target-col 0 + :start-row 0 :start-col 0) + + ;; The above is like calling (you can try!): + ;; This outputs (2 0) + (sum-one-row 'foo + '((foo) (foo)) + '((foo) (foo)) + 0) + ;; This outputs (2 2) + (sum-one-row 'foo + '((bar) (bar)) + '((bar) (bar)) + nil) + ;; final output: 12 + (- (funcall (make-rectified-polynomial 2) 4) + (funcall (make-rectified-polynomial 2) 2)) + + + (sum-one-memory 'foo + '(((foo) (foo)) + ((baz) (baz))) + '(((foo) (foo)) + ((foo) (foo))) + :rectified-polynomial (make-rectified-polynomial 2) + :target-row 0 :target-col 0 + :start-row 0 :start-col 0) + ) + +(defparameter *poly-2* (make-rectified-polynomial 2)) + +(defun sum-all-memories (item input memories target-row target-col) + "Iterate through all input cells and assign a score for the fit of item +in that location based on memories." + (loop :for memory :in memories + :sum (sum-one-memory item input memory + :target-col target-col + :target-row target-row + :rectified-polynomial *poly-2*) + :into best-memory + :finally (return best-memory))) + +(defun scan-all-memories (item input memories) + (loop :for row :in input + :for row-idx :from 0 + :collect (loop :for col :in row + :for col-idx :from 0 + :collect (sum-all-memories item input memories row-idx col-idx)))) + +(when nil + (defparameter *layer1-memories* + '((((foo) (foo) (foo)) + (() () ()) + (() () ())) + (((foo) () ()) + (() (foo) ()) + (() () (foo))) + (((foo) () ()) + ((foo) () ()) + ((foo) () ())))) + (defparameter *layer2-memories* + '(((() () ()) + (() () ()) + (() () ())) + ((() () ()) + (() () ()) + (() () ())) + ((() () ()) + (() () ()) + (() () ())))) + + (sum-all-memories 'foo '((() (foo) (foo)) + ((bar) (bar) ()) + (() () ())) + *layer1-memories* 0 0) ;; 34 + + (sum-all-memories 'foo '(((foo) (bar)) ((qux) (foo))) *layer1-memories* 0 0) ;; 12 + + (scan-all-memories 'foo + (scan-all-memories 'foo + '((() (foo) (foo)) + ((bar) (bar) ()) + (() () ())) + *layer1-memories*) + *layer2-memories*) + + ) |