Racket/Neural
Från Täpp-Anders
Hoppa till navigeringHoppa till sök
#lang racket
;;;;;
;; Neuralt nät implementerad i Racket
;; Täpp-Anders Sikvall 2026-04-03 anders@sikvall.se
;;;;;
;;;;; NEURALT NÄT
;;;
;; Detta program implementerar ett litet neuralt nät och tränar det på sannings-
;; tabellen för XOR. Efter några tusen epoker ska prediktionerna ligga extremt nära
;; följande:
;;
;; a,b → a XOR b
;; 0,0 → 0
;; 0,1 → 1
;; 1,0 → 1
;; 1,1 → 0
;;
;; Implementationen har två input-neuroner för a och b
;; det finns 5 interna (dolda neuroner) som tränas av indatat
;; det finns 1 output-neuron som ger svaret
;;
;;;;; Kodens uppbyggnad och de olika funktionernas användning
;;
;; sigmoid, sigmoid-deriv Sigmoid-kurva och derivata för backpropagation
;;
;; random-matrix, met-vec-mul Grundläggande linalg
;; outer-product; vec-add
;;
;; struct nn Nätverksstruktur, lagrar vikter och bias
;;
;; forward Beräknar prediktion
;;
;; train-step En iteration av backpropagation
;;
;; train Kör många epoker av in och förväntat utdata för
;; att träna modellen
;;
;; predict Använder nätverket på ny data!
;;
;;
;;;;; Viktiga delar
;;
;; * sigmoid mappar alla värden steglöst till intervallet (0,1)
;; * derivatan används i backpropagation för att räkna ut gradienten
;;
;; w1: vikter mellan input och hidden layer (5x2 matris)
;; b1: bias för hidden layer (5-vektor)
;; w2: viktar mellan hidden och output (1x5 matris)
;; b2: bias för output (1-vektor)
;;
;; Forward pass
;;
;; 1. Beräkna aktivering i hidden layer
;; z1 = W1 * input + b1
;; h = rho z1
;; 2. Beräkna output
;; z2 = W2 * h +b2
;; output = rho(z2)
;;
;; Backpropagation (uppdatering av viktningen)
;;
;; Hjärtat i träningen av ett neuralt nät. Algorimen är "gradient descent" med batch-
;; storlek 1.
;;
;; 1. Forward pass hidden → output
;; 2. Output-felet
;; delta = (output - target) X rho' (output)
;; 3. Hidden-felet
;; delta hidden = (W2/T * delta out) X rho' (hidden)
;; 4. Uppdatera vikternas gradienter
;; W2 ← W2 - nabla * delta out * h^T
;; W1 ← W1 - nabla * delta hidden * input^T
;; 5. Bias uppdateras på samma sätt (jo det är en genväg)
;;
(require math/base)
;; ========================================
;; Aktiveringsfunktioner
;; ========================================
(define (sigmoid x)
(/ 1.0 (+ 1.0 (exp (- x)))))
(define (sigmoid-deriv y) ; y måste redan vara sigmoid(x)
(* y (- 1.0 y)))
;; ========================================
;; Matris-/vektorhjälp (enkel version)
;; ========================================
(define (random-matrix rows cols)
(build-vector rows
(λ (_) (build-vector cols (λ (_) (- (* 2.0 (random)) 1.0))))))
(define (vec-add v1 v2) ; elementvis addition av två vektorer
(build-vector (vector-length v1)
(λ (i) (+ (vector-ref v1 i) (vector-ref v2 i)))))
(define (scalar-mul s v)
(build-vector (vector-length v) (λ (i) (* s (vector-ref v i)))))
(define (outer-product v1 v2) ; v1 kolumn × v2 rad → matris
(build-vector (vector-length v1)
(λ (i)
(build-vector (vector-length v2)
(λ (j) (* (vector-ref v1 i) (vector-ref v2 j)))))))
(define (mat-vec-mul M v) ; M (rows×cols) × v (cols)
(build-vector (vector-length M)
(λ (i)
(for/sum ([j (in-range (vector-length v))])
(* (vector-ref (vector-ref M i) j)
(vector-ref v j))))))
(define (transpose M)
(build-vector (vector-length (vector-ref M 0))
(λ (j)
(build-vector (vector-length M)
(λ (i) (vector-ref (vector-ref M i) j))))))
;; ========================================
;; Neuralt nätverk
;; ========================================
(struct nn (w1 b1 w2 b2) #:transparent)
(define (make-nn in-size hidden-size out-size)
(nn (random-matrix hidden-size in-size)
(make-vector hidden-size 0.0)
(random-matrix out-size hidden-size)
(make-vector out-size 0.0)))
(define (forward net input) ; input är en vektor t.ex. #(0 0)
(let* ([z1 (vec-add (mat-vec-mul (nn-w1 net) input)
(nn-b1 net))]
[h (build-vector (vector-length z1) (λ (i) (sigmoid (vector-ref z1 i))))]
[z2 (vec-add (mat-vec-mul (nn-w2 net) h)
(nn-b2 net))]
[o (build-vector (vector-length z2) (λ (i) (sigmoid (vector-ref z2 i))))])
(values o h)))
(define (train-step net input target lr)
(let-values ([(output hidden) (forward net input)])
(let* ([out-err (build-vector (vector-length output)
(λ (i) (- (vector-ref output i)
(vector-ref target i))))]
[out-delta (build-vector (vector-length output)
(λ (i) (* (vector-ref out-err i)
(sigmoid-deriv (vector-ref output i)))))]
[hidden-err (mat-vec-mul (transpose (nn-w2 net)) out-delta)]
[hidden-delta (build-vector (vector-length hidden)
(λ (i) (* (vector-ref hidden-err i)
(sigmoid-deriv (vector-ref hidden i)))))]
;; Uppdateringar
[dw2 (outer-product out-delta hidden)]
[new-w2 (build-vector (vector-length (nn-w2 net))
(λ (i)
(build-vector (vector-length (vector-ref (nn-w2 net) i))
(λ (j) (- (vector-ref (vector-ref (nn-w2 net) i) j)
(* lr (vector-ref (vector-ref dw2 i) j)))))))]
[new-b2 (build-vector (vector-length (nn-b2 net))
(λ (i) (- (vector-ref (nn-b2 net) i)
(* lr (vector-ref out-delta i)))))]
[dw1 (outer-product hidden-delta input)]
[new-w1 (build-vector (vector-length (nn-w1 net))
(λ (i)
(build-vector (vector-length (vector-ref (nn-w1 net) i))
(λ (j) (- (vector-ref (vector-ref (nn-w1 net) i) j)
(* lr (vector-ref (vector-ref dw1 i) j)))))))]
[new-b1 (build-vector (vector-length (nn-b1 net))
(λ (i) (- (vector-ref (nn-b1 net) i)
(* lr (vector-ref hidden-delta i)))))])
(nn new-w1 new-b1 new-w2 new-b2))))
;; ========================================
;; Skriv ut vikter och bias – snygg tabell (fixad version)
;; ========================================
(define (print-nn net)
(printf "\n=== NEURALT NÄTVERK - VIKTER OCH BIAS ===\n\n")
;; Hjälpfunktion för att formatera tal snyggt (med minustecken på rätt plats)
(define (fmt x)
(~r x
#:min-width 10
#:precision '(= 4)
#:sign #f)) ; #f = visa minus för negativa, inget tecken för positiva
;; W1: Vikter från input till hidden (5×2)
(printf "W1 (Hidden × Input):\n")
(printf " Input0 Input1\n")
(for ([i (in-range (vector-length (nn-w1 net)))])
(printf "Hidden~a " i)
(for ([j (in-range 2)])
(printf "~a " (fmt (vector-ref (vector-ref (nn-w1 net) i) j))))
(printf "\n"))
(printf "\n")
;; b1: Bias för hidden layer
(printf "b1 (Bias hidden layer):\n")
(for ([i (in-range (vector-length (nn-b1 net)))])
(printf "~a " (fmt (vector-ref (nn-b1 net) i))))
(printf "\n\n")
;; W2: Vikter från hidden till output (1×5)
(printf "W2 (Output × Hidden):\n")
(printf " Hidden0 Hidden1 Hidden2 Hidden3 Hidden4\n")
(printf "Output ")
(for ([j (in-range 5)])
(printf "~a " (fmt (vector-ref (vector-ref (nn-w2 net) 0) j))))
(printf "\n\n")
;; b2: Bias för output
(printf "b2 (Bias output):\n")
(printf "~a\n" (fmt (vector-ref (nn-b2 net) 0)))
(printf "\n========================================\n"))
;; Träna nätverket
(define (train net data epochs lr)
(for ([ep (in-range epochs)])
(for ([sample data])
(set! net (train-step net (car sample) (cadr sample) lr)))
(when (zero? (modulo ep 500)) ; oftare än var 1000:e
(let ([loss (for/sum ([sample data])
(let-values ([(output _) (forward net (car sample))])
(let ([target (vector-ref (cadr sample) 0)]
[pred (vector-ref output 0)])
(sqr (- target pred)))))])
(printf "Epoch ~a Loss: ~a\n" ep (/ loss (length data))))))
(print-nn net)
net)
;; Prediktera
(define (predict net input)
(let-values ([(output _) (forward net input)])
output))
;; ========================================
;; XOR-exempel
;; ========================================
(define xor-data
(list (list #(0 0) #(0))
(list #(0 1) #(1))
(list #(1 0) #(1))
(list #(1 1) #(0))))
(define net (make-nn 2 5 1)) ; 2 input, 5 dolda neuroner, 1 output
(define rounds 8000) ; 2000 är i minsta laget, 5000 eller hellre 8000 är bättre
(define backpr 0.7)
(printf "Tränar XOR-problemet i ~a rundor med backprop styrka ~a\n" rounds backpr)
(set! net (train net xor-data rounds backpr))
(printf "\n=== Testresultat ===\n")
(for ([sample xor-data])
(let ([pred (vector-ref (predict net (car sample)) 0)])
(printf "Input ~a → Förväntat: ~a Predikterat: ~a\n"
(car sample)
(vector-ref (cadr sample) 0)
(if (> pred 0.5) 1.0 0.0))))
