tebdol

commit 43e837ff846bd38b7766877c64515bc8fa8efd9e
parent 93185eb0dc2356dce5638a94a564361cca852158
Author: Miroslav Urbanek <mu@miroslavurbanek.com>
Date:   Wed, 28 Jun 2017 16:02:06 +0200

Improve index truncation

Control truncation with a list (EPSILON MIN MAX). Discard the smallest
singular values whose squared and normalized sum is less than or equal
EPSILON while keeping at least MIN and at most MAX of them.

Diffstat:
examples/balancer.lisp
 | 
2
+-
examples/revivals.lisp
 | 
2
+-
examples/trotzky.lisp
 | 
2
+-
states/revivals.lisp
 | 
2
+-
tebdol/tensor.lisp
 | 
27
+++++++++++++++++++++++++--

5 files changed, 29 insertions(+), 6 deletions(-)
diff --git a/examples/balancer.lisp b/examples/balancer.lisp
@@ -6,7 +6,7 @@
 
 (defparameter *j* 1/25) ;; *u* = 1
 
-(defparameter *maxdim* 100)
+(defparameter *maxdim* '(nil nil 100))
 
 ;; libraries
 
diff --git a/examples/revivals.lisp b/examples/revivals.lisp
@@ -6,7 +6,7 @@
 
 (defparameter *j* 1/25) ;; *u* = 1
 
-(defparameter *maxdim* 100)
+(defparameter *maxdim* '(nil nil 100))
 
 ;; libraries
 
diff --git a/examples/trotzky.lisp b/examples/trotzky.lisp
@@ -7,7 +7,7 @@
 (defparameter *j* 4.1d-1)
 (defparameter *k* 4.1d-3)
 
-(defparameter *maxdim* 100)
+(defparameter *maxdim* '(nil nil 100))
 
 ;; libraries
 
diff --git a/states/revivals.lisp b/states/revivals.lisp
@@ -3,7 +3,7 @@
 (defparameter *dimension* 15) ;; physical dimension
 (defparameter *length* 11)
 (defparameter *particles* 11)
-(defparameter *maxdim* 100)
+(defparameter *maxdim* '(nil nil 100))
 
 ;; libraries
 
diff --git a/tebdol/tensor.lisp b/tebdol/tensor.lisp
@@ -608,8 +608,31 @@
 		unless (essentially-zerop i)
 		do (push (cons i x) sl)))))
     (loop
-       repeat maxdim
-       for (s . x) in (sort sl #'> :key #'car)
+       with r = (sort sl #'> :key #'car)
+       with l = (length r)
+       with e = (car maxdim)
+       with m = (cadr maxdim)
+       with n = (caddr maxdim)
+       with u = (and e (* (- 1 e)
+			  (loop
+			     for (s . x) in r
+			     sum (* s s))))
+       with c = (if u
+		    (loop
+		       for (s . x) in r
+		       count s
+		       sum (* s s) into v
+		       until (> v u))
+		    l)
+       with k = (cond ((and m (< c m) (/= c l))
+		       ;; (format *error-output* "hit mindim (~D)~%" c)
+		       (min l m))
+		      ((and n (> c n))
+		       ;; (format *error-output* "hit maxdim (~D/~D)~%" c l)
+		       n)
+		      (t c))
+       repeat k
+       for (s . x) in r
        do (if (gethash x sh)
 	      (incf (gethash x sh))
 	      (setf (gethash x sh) 1)))