mmarco/kenzo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixed error in SOFT-DELTA-CMPR

Browse Source 
Must be L-CMPR instead of F-CMPR, since CDR returns a list.
This commit is contained in:
gheber 2015-07-08 06:42:31 -05:00
parent 911a74de68
commit b82a5e6884
1 changed files with 241 additions and 242 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
src/delta.lisp
View File

@ -10,13 +10,10 @@
(format stream "~A" (hyphenize-list (dlop-int-ext cdr))) (format stream "~A" (hyphenize-list (dlop-int-ext cdr)))
(cons car cdr)) (cons car cdr))
(DEFUN SOFT-DELTA-CMPR (gmsm1 gmsm2)
(f-cmpr (cdr gmsm1) (cdr gmsm2)))
#| (DEFUN SOFT-DELTA-CMPR (gmsm1 gmsm2)
() (l-cmpr (cdr gmsm1) (cdr gmsm2)))
(soft-delta-cmpr (d 12) (d 23))
|#
(DEFUN DELTA-FACE (indx dmns gmsm) (DEFUN DELTA-FACE (indx dmns gmsm)
(declare (declare
@ -121,7 +118,8 @@
(with-term (cffc tnpr) term (with-term (cffc tnpr) term
(with-tnpr (degr1 gmsm1 degr2 gmsm2) tnpr (with-tnpr (degr1 gmsm1 degr2 gmsm2) tnpr
(term cffc (term cffc
(tnpr degr1 (d gmsm1) degr2 (d gmsm2)))))) (tnpr degr1 (d gmsm1)
degr2 (d gmsm2))))))
(cmbn-list (delta-dgnl dmns (cdr gmsm)))))) (cmbn-list (delta-dgnl dmns (cdr gmsm))))))
#| #|
@ -274,28 +272,28 @@
|# |#
#| For comparison with EAT. #| For comparison with EAT.
In In
(setf delta (delta-infinity)) (setf delta (delta-infinity))
(setf d (bndr delta)) (setf d (bndr delta))
(setf s14 (mask 15)) (setf s14 (mask 15))
(cmbn-? d (gnrt-? d 14 s14)) (cmbn-? d (gnrt-? d 14 s14))
(defun t1 (n) (defun t1 (n)
(time (dotimes (i n) (cmbn-? d (gnrt-? d 14 s14))))) (time (dotimes (i n) (cmbn-? d (gnrt-? d 14 s14)))))
(compile 't1) (compile 't1)
(t1 500) (t1 500)
(setf +too-much-time+ -1) (setf +too-much-time+ -1)
(t1 500) (t1 500)
|# |#
#| #|
In EAT: In EAT:
(setf delta *delta*) (setf delta *delta*)
(setf d (cc-d (ss-cc delta))) (setf d (cc-d (ss-cc delta)))
(setf s14 (<a-b> 0 14)) (setf s14 (<a-b> 0 14))
(??? d (? d 14 s14)) (??? d (? d 14 s14))
(defun t1 (n) (defun t1 (n)
(time (dotimes (i n) (??? d (? d 14 s14))))) (time (dotimes (i n) (??? d (? d 14 s14)))))
(compile 't1) (compile 't1)
(t1 500) (t1 500)
|# |#
(DEFUN DELTAB-CMPR (gmsm1 gmsm2) (DEFUN DELTAB-CMPR (gmsm1 gmsm2)
@ -354,7 +352,8 @@
(when (logbitp indx gmsm) (when (logbitp indx gmsm)
(push (term 1 (tnpr (push (term 1 (tnpr
ldegr (logand gmsm (mask (1+ indx))) ldegr (logand gmsm (mask (1+ indx)))
(- dmns ldegr) (logandc2 gmsm (mask indx)))) (- dmns ldegr)
(logandc2 gmsm (mask indx))))
rslt) rslt)
(when (minusp (decf ldegr)) (when (minusp (decf ldegr))
(setf rslt (delete 1 rslt :key #'caaddr)) (setf rslt (delete 1 rslt :key #'caaddr))
@ -390,8 +389,8 @@
(setf sign (- sign)))))))) (setf sign (- sign))))))))
#| #|
(deltab-bndr 1 5) (deltab-bndr 1 5)
(deltab-bndr 3 15) (deltab-bndr 3 15)
|# |#
(DEFUN DELTAB () (DEFUN DELTAB ()