|
|
|
|
|
|
|
|
| (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))
|
|
|
| (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)
|
|
|
| (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))
|
|
|
| (let ((amp (complex (/ 1.0d0 (sqrt (coerce n 'double-float))) 0.0d0)))
|
| (dotimes (x n) (setf (aref psi (+ (* x 2) 1)) amp)))
|
|
|
| (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)
|
|
|
| (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)))
|
|
|
| (setf (aref psi1 1) #C(1.0d0 0.0d0))
|
| (setf (aref psi2 (1- dim)) #C(1.0d0 0.0d0))
|
|
|
| (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)))))
|
|
|
