Skip to content

Commit

Permalink
Fix
Browse files Browse the repository at this point in the history
  • Loading branch information
@privet-kitty
privet-kitty committed Nov 23, 2023
1 parent 02076ac commit d4e3a2a
Show file tree
Hide file tree
Showing 2 changed files with 58 additions and 29 deletions.
42 changes: 15 additions & 27 deletions module/lll.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,14 @@
(defpackage :cp/lll
(:use :cl)
(:import-from :cl-debug-print)
(:export #:lll-fractional #:lll))
(:export #:lll-fractional #:lll)
(:documentation "Provides an LLL algorithm for the basis reduction.
Reference:
- Hoffstein, Pipher, Silverman. An Introduction to Mathematical Cryptography,
2nd edition.
- Ulfar Erlingsson, Erich Kaltofen, David Musser. Generic Gram-Schmidt
Orthogonalization by Exact Division."))
(in-package :cp/lll)

;; TODO: handling row vectors instead of column might be better in terms of the
Expand Down Expand Up @@ -41,7 +48,7 @@
(set-dispatch-macro-character #\# #\> #'cl-debug-print:debug-print-reader))

(defun lll-fractional (mat &optional (delta 3/4))
"Applies the basis reduction to the given column vectors.
"Applies the basis reduction to the given rational column vectors.
NOTE: MAT should have full column rank. Otherwise the consequence is undefined."
(declare (optimize (speed 3))
Expand All @@ -61,19 +68,7 @@ NOTE: MAT should have full column rank. Otherwise the consequence is undefined."
(pos 0))
(declare ((simple-array rational (*)) l2s)
((simple-array rational (* *)) mat ort-mat coefs))
(labels (;; (%debug ()
;; (let ((tmp (make-array (list m (+ 1 max-pos)) :initial-element 0)))
;; (dotimes (i m)
;; (dotimes (j (+ 1 max-pos))
;; (setf (aref tmp i j) (aref mat i j))))
;; (multiple-value-bind (t-ort t-coefs t-l2s) (rational-gram-schmidt tmp)
;; (dbg mat coefs l2s)
;; (dbg t-ort t-coefs t-l2s))))
(%reduce (target-pos pivot-pos)
;; #>"red"
;; (dbg target-pos pivot-pos)
;; #>ort-mat
;; (%debug)
(labels ((%reduce (target-pos pivot-pos)
(when (> (abs (* 2 (aref coefs target-pos pivot-pos))) 1)
(let ((rounded-mu (round (aref coefs target-pos pivot-pos))))
(dotimes (i m)
Expand All @@ -82,14 +77,8 @@ NOTE: MAT should have full column rank. Otherwise the consequence is undefined."
(decf (aref coefs target-pos pivot-pos) rounded-mu)
(dotimes (j pivot-pos)
(decf (aref coefs target-pos j)
(* rounded-mu (aref coefs pivot-pos j))))
;; (dbg rounded-mu)
;; (%debug)
)))
(* rounded-mu (aref coefs pivot-pos j)))))))
(%swap (pos)
;; #>"swap"
;; (dbg pos)
;; (%debug)
(dotimes (i m)
(rotatef (aref mat i (- pos 1)) (aref mat i pos)))
(dotimes (j (- pos 1))
Expand All @@ -116,9 +105,7 @@ NOTE: MAT should have full column rank. Otherwise the consequence is undefined."
(- (aref coefs j (- pos 1)) (* old-mu mu)))
(setf (aref coefs j (- pos 1))
(+ mu (* (aref coefs pos (- pos 1))
(aref coefs j pos)))))
;; (%debug)
)))
(aref coefs j pos))))))))
(loop
(when (= pos n)
(return))
Expand Down Expand Up @@ -170,7 +157,7 @@ NOTE: MAT should have full column rank. Otherwise the consequence is undefined."
quot))

(defun lll (mat &optional (delta 3/4))
"Applies the basis reduction to the given column vectors.
"Applies the basis reduction to the given integer column vectors.
NOTE: MAT should have full column rank. Otherwise the consequence is undefined."
(declare (optimize (speed 3))
Expand Down Expand Up @@ -218,7 +205,8 @@ NOTE: MAT should have full column rank. Otherwise the consequence is undefined."
(expt det2 2)))
(new-det2 (%div (* det2 new-l2) (aref l2s (- pos 1)))))
(setf (aref coefs pos (- pos 1))
(%div (* old-mu (aref l2s (- pos 1))) new-l2))
(%div (* new-det2 old-mu (aref l2s (- pos 1)))
(* det2 new-l2)))
(setf (aref l2s pos)
(%div (* (expt new-det2 2)
(aref l2s (- pos 1))
Expand Down
45 changes: 43 additions & 2 deletions module/test/lll.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@
(setf (aref tmp i j) (aref mat i j))))
(nth-value 1 (mod-echelon! tmp #.(+ 7 (expt 10 9)))))))

(test lll-rational/hand
(test lll-fractional/hand
(is (equalp (lll-fractional #2a()) #2a()))
(is (equalp (lll-fractional #2a((-3))) #2a((-3))))
(is (equalp (lll-fractional #2a((0 1) (1 0))) #2a((0 1) (1 0))))
Expand Down Expand Up @@ -53,6 +53,47 @@
(+ l2-next (* (expt (aref coefs (+ k 1) k) 2) l2))))))))
(incf trial)))))))

(test lll/hand
(is (equalp (lll #2a()) #2a()))
(is (equalp (lll #2a((-3))) #2a((-3))))
(is (equalp (lll #2a((0 1) (1 0))) #2a((0 1) (1 0))))
(is (equalp (lll #2a((1 0) (0 1))) #2a((1 0) (0 1))))
(is (equalp (lll #2a((4 1) (1 1))) #2a((1 2) (1 -1))))
(is (equalp (lll #2a((1 4) (1 1))) #2a((1 2) (1 -1)))))

(test lll/random
(let ((*random-state* (sb-ext:seed-random-state 0))
(*test-dribble* nil))
(dolist (magnitute '(5 50))
(loop with trial = 0
for m = (+ 1 (random 6))
for n = (+ 1 (random 6))
until (= trial 20000)
when (< m n)
do (rotatef m n)
do (let ((mat (make-array (list m n) :element-type t :initial-element 0)))
(dotimes (i m)
(dotimes (j n)
(setf (aref mat i j) (- (random (* 2 magnitute)) magnitute))))
(when (= (calc-rank mat) n)
(let ((reduced (lll mat)))
(is (equalp (hnf-matrix (hnf reduced))
(hnf-matrix (hnf mat))))
(multiple-value-bind (ort coefs) (cp/lll::rational-gram-schmidt reduced)
;; Size reduction condtion
(dotimes (i n)
(dotimes (j n)
(is (<= (abs (aref coefs i j)) 1/2))))
;; Lovász condition
(dotimes (k (- n 1))
(let ((l2 (loop for i below m
sum (expt (aref ort i k) 2)))
(l2-next (loop for i below m
sum (expt (aref ort i (+ k 1)) 2))))
(is (<= (* 3/4 l2)
(+ l2-next (* (expt (aref coefs (+ k 1) k) 2) l2))))))))
(incf trial)))))))

(defun lll-single (mag size &optional (trial 1))
(declare (optimize (speed 3))
((unsigned-byte 31) size mag))
Expand All @@ -63,4 +104,4 @@
(dotimes (j size)
(setf (aref mat i j) (- (random (* 2 mag)) mag))))
(assert (= (calc-rank mat) size))
(lll-fractional mat)))))
(lll mat)))))

0 comments on commit d4e3a2a

Please sign in to comment.