diff --git a/module/lll.lisp b/module/lll.lisp index 9f81174..3d6360c 100644 --- a/module/lll.lisp +++ b/module/lll.lisp @@ -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 @@ -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)) @@ -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) @@ -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)) @@ -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)) @@ -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)) @@ -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)) diff --git a/module/test/lll.lisp b/module/test/lll.lisp index 95b872a..164312e 100644 --- a/module/test/lll.lisp +++ b/module/test/lll.lisp @@ -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)))) @@ -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)) @@ -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)))))