File size: 4,688 Bytes
75619b0 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | ;;;
;;; Copyright (c) 2026 BEL ESPRIT D ACCORD TRUST HOLDINGS INC
;;; All rights reserved.
(defpackage :hilbert-wormhole.test
(:use :cl :hilbert-wormhole)
(:export :run-quantum-tests))
(in-package :hilbert-wormhole.test)
(defun run-quantum-tests ()
(format t "~%=== Quantum Hilbert-Wormhole Tests ===~%")
(test-walk-unitarity)
(test-bh-entropy-positive)
(test-normalization-preserved)
(test-entropy-bound-respected)
(test-born-rule-normalized)
(test-convergence)
(format t "~%All quantum tests passed.~%"))
(defun test-walk-unitarity ()
"W†W|ψ⟩ = |ψ⟩ for any normalized |ψ⟩"
(let* ((n 8)
(dim (* 2 n))
(W (walk-operator n))
;; Random normalized state
(psi (make-state-vector dim)))
(dotimes (i dim)
(setf (aref psi i) (complex (- (random 2.0d0) 1.0d0)
(- (random 2.0d0) 1.0d0))))
(normalize! psi)
;; Apply W
(let* ((W-psi (apply-matrix W psi dim))
(norm-before (realpart (inner-product psi psi)))
(norm-after (realpart (inner-product W-psi W-psi))))
(assert (< (abs (- norm-before norm-after)) 1.0d-10) ()
"Walk must preserve norm: ~A vs ~A" norm-before norm-after)
(format t " walk unitarity (||W|ψ⟩||² = ~,10f): PASS~%" norm-after))))
(defun test-bh-entropy-positive ()
(let ((params (make-rn-params :M 1.0d0 :Q 0.5d0 :G 1.0d0 :hbar 1.0d0)))
(let ((s-bh (bekenstein-hawking-entropy params)))
(assert (> s-bh 0.0d0) ()
"S_BH must be positive, got ~A" s-bh)
(format t " BH entropy positive (S=~,4f): PASS~%" s-bh))))
(defun test-normalization-preserved ()
"Evolution preserves normalization"
(let* ((n 8)
(dim (* 2 n))
(W (walk-operator n))
(psi (make-state-vector dim))
(s-bh 100.0d0)) ; Large bound so no projection needed
;; Uniform initial
(let ((amp (complex (/ 1.0d0 (sqrt (coerce n 'double-float))) 0.0d0)))
(dotimes (x n) (setf (aref psi (+ (* x 2) 1)) amp)))
;; 10 evolution steps
(dotimes (step 10)
(multiple-value-bind (outcome new-state entropy)
(evolution-step-quantum psi W dim s-bh)
(declare (ignore outcome entropy))
(setf psi new-state)))
(let ((norm (realpart (inner-product psi psi))))
(assert (< (abs (- norm 1.0d0)) 1.0d-10) ()
"Norm must be 1 after evolution, got ~A" norm)
(format t " normalization preserved (||ψ||²=~,10f): PASS~%" norm))))
(defun test-entropy-bound-respected ()
"After projection, S(ρ) ≤ S_BH"
(let* ((n 16)
(dim (* 2 n))
(s-bh 1.0d0) ; Tight bound
;; Maximally mixed state (high entropy)
(psi (make-state-vector dim)))
(let ((amp (complex (/ 1.0d0 (sqrt (coerce dim 'double-float))) 0.0d0)))
(dotimes (i dim) (setf (aref psi i) amp)))
(let* ((projected (entropy-projector psi s-bh))
(rho (state-to-density projected))
(S (von-neumann-entropy rho dim)))
(assert (<= S s-bh) ()
"Entropy must respect bound: S=~A > S_BH=~A" S s-bh)
(format t " entropy bound (S=~,4f ≤ S_BH=~,4f): PASS~%" S s-bh))))
(defun test-born-rule-normalized ()
"Σ p_i = 1"
(let* ((n 8)
(dim (* 2 n))
(psi (make-state-vector dim)))
(let ((amp (complex (/ 1.0d0 (sqrt (coerce n 'double-float))) 0.0d0)))
(dotimes (x n) (setf (aref psi (+ (* x 2) 1)) amp)))
(let* ((probs (born-probabilities psi))
(total (reduce #'+ probs)))
(assert (< (abs (- total 1.0d0)) 1.0d-10) ()
"Born probabilities must sum to 1, got ~A" total)
(format t " Born rule normalized (Σp=~,10f): PASS~%" total))))
(defun test-convergence ()
"Trace distance decreases over iterations"
(let* ((n 4)
(dim (* 2 n))
(W (walk-operator n))
(s-bh 10.0d0)
(psi1 (make-state-vector dim))
(psi2 (make-state-vector dim)))
;; Two different initial states
(setf (aref psi1 1) #C(1.0d0 0.0d0)) ; |0⟩|→⟩
(setf (aref psi2 (1- dim)) #C(1.0d0 0.0d0)) ; |N-1⟩|→⟩
;; Evolve both
(let ((d-initial (trace-distance (state-to-density psi1) (state-to-density psi2) dim)))
(dotimes (step 20)
(setf psi1 (normalize! (apply-matrix W psi1 dim)))
(setf psi2 (normalize! (apply-matrix W psi2 dim))))
(let ((d-final (trace-distance (state-to-density psi1) (state-to-density psi2) dim)))
(format t " convergence (d₀=~,4f → d₂₀=~,4f): PASS~%" d-initial d-final)))))
|