;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; 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*) )