Fixed error in SOFT-DELTA-CMPR
Must be L-CMPR instead of F-CMPR, since CDR returns a list.
This commit is contained in:
gheber
parent
911a74de68
commit
b82a5e6884
483
src/delta.lisp
483
src/delta.lisp
@ -7,36 +7,33 @@
|
||||
(PROVIDE "delta")
|
||||
|
||||
(DEFMETHOD PRINT-KEYCONS ((car (eql :delt)) cdr stream)
|
||||
(format stream "~A" (hyphenize-list (dlop-int-ext cdr)))
|
||||
(cons car cdr))
|
||||
(format stream "~A" (hyphenize-list (dlop-int-ext cdr)))
|
||||
(cons car cdr))
|
||||
|
||||
|
||||
(DEFUN SOFT-DELTA-CMPR (gmsm1 gmsm2)
|
||||
(f-cmpr (cdr gmsm1) (cdr gmsm2)))
|
||||
(l-cmpr (cdr gmsm1) (cdr gmsm2)))
|
||||
|
||||
|
||||
#|
|
||||
()
|
||||
(soft-delta-cmpr (d 12) (d 23))
|
||||
|#
|
||||
|
||||
(DEFUN DELTA-FACE (indx dmns gmsm)
|
||||
(declare
|
||||
(fixnum indx gmsm)
|
||||
(ignore dmns))
|
||||
(the absm
|
||||
(do ((pmark 1 (ash pmark 1))
|
||||
(bmark indx)
|
||||
(gmsm2 gmsm (ash gmsm2 -1)))
|
||||
(nil)
|
||||
(declare
|
||||
(fixnum indx gmsm)
|
||||
(ignore dmns))
|
||||
(the absm
|
||||
(do ((pmark 1 (ash pmark 1))
|
||||
(bmark indx)
|
||||
(gmsm2 gmsm (ash gmsm2 -1)))
|
||||
(nil)
|
||||
(declare (fixnum pmark bmark gmsm2))
|
||||
(when (oddp gmsm2)
|
||||
(when (minusp (decf bmark))
|
||||
(return-from delta-face (absm 0 (logxor gmsm pmark))))))))
|
||||
(when (minusp (decf bmark))
|
||||
(return-from delta-face (absm 0 (logxor gmsm pmark))))))))
|
||||
|
||||
(DEFUN SOFT-DELTA-FACE (indx dmns gmsm)
|
||||
(declare
|
||||
(fixnum indx dmns)
|
||||
(type soft-dlop gmsm))
|
||||
(absm 0 (d (gmsm (delta-face indx dmns (cdr gmsm))))))
|
||||
(declare
|
||||
(fixnum indx dmns)
|
||||
(type soft-dlop gmsm))
|
||||
(absm 0 (d (gmsm (delta-face indx dmns (cdr gmsm))))))
|
||||
|
||||
#|
|
||||
()
|
||||
@ -51,34 +48,34 @@
|
||||
|#
|
||||
|
||||
(DEFUN DELTA-BNDR (dmns gmsm)
|
||||
(declare (fixnum dmns gmsm))
|
||||
(the cmbn
|
||||
(if (zerop dmns)
|
||||
+zero-negative-cmbn+
|
||||
(make-cmbn
|
||||
(declare (fixnum dmns gmsm))
|
||||
(the cmbn
|
||||
(if (zerop dmns)
|
||||
+zero-negative-cmbn+
|
||||
(make-cmbn
|
||||
:degr (1- dmns)
|
||||
:list (do ((rslt +empty-list+)
|
||||
(gmsm2 gmsm (ash gmsm2 -1))
|
||||
(pmark 1 (ash pmark +1))
|
||||
(sign 1))
|
||||
((zerop gmsm2) rslt)
|
||||
(gmsm2 gmsm (ash gmsm2 -1))
|
||||
(pmark 1 (ash pmark +1))
|
||||
(sign 1))
|
||||
((zerop gmsm2) rslt)
|
||||
(declare
|
||||
(list rslt)
|
||||
(fixnum gmsm2 pmark sign))
|
||||
(list rslt)
|
||||
(fixnum gmsm2 pmark sign))
|
||||
(when (oddp gmsm2)
|
||||
(push (term sign (logxor gmsm pmark)) rslt)
|
||||
(setf sign (- sign))))))))
|
||||
(push (term sign (logxor gmsm pmark)) rslt)
|
||||
(setf sign (- sign))))))))
|
||||
|
||||
(DEFUN SOFT-DELTA-BNDR (dmns gmsm)
|
||||
(declare
|
||||
(fixnum dmns)
|
||||
(type soft-dlop gmsm))
|
||||
(make-cmbn
|
||||
:degr (1- dmns)
|
||||
:list (mapcar #'(lambda (term)
|
||||
(with-term (cffc gmsm) term
|
||||
(term cffc (d gmsm))))
|
||||
(cmbn-list (delta-bndr dmns (cdr gmsm))))))
|
||||
(declare
|
||||
(fixnum dmns)
|
||||
(type soft-dlop gmsm))
|
||||
(make-cmbn
|
||||
:degr (1- dmns)
|
||||
:list (mapcar #'(lambda (term)
|
||||
(with-term (cffc gmsm) term
|
||||
(term cffc (d gmsm))))
|
||||
(cmbn-list (delta-bndr dmns (cdr gmsm))))))
|
||||
|
||||
#|
|
||||
()
|
||||
@ -92,37 +89,38 @@
|
||||
|
||||
|
||||
(DEFUN DELTA-DGNL (dmns gmsm)
|
||||
(declare (fixnum dmns gmsm))
|
||||
(the cmbn
|
||||
(make-cmbn
|
||||
:degr dmns
|
||||
:list (do ((rslt +empty-list+)
|
||||
(ldegr dmns)
|
||||
(indx (1- (integer-length gmsm)) (1- indx)))
|
||||
((minusp indx))
|
||||
(declare
|
||||
(list rslt)
|
||||
(fixnum indx))
|
||||
(when (logbitp indx gmsm)
|
||||
(push (term 1 (tnpr
|
||||
ldegr (logand gmsm (mask (1+ indx)))
|
||||
(- dmns ldegr) (logandc2 gmsm (mask indx))))
|
||||
(declare (fixnum dmns gmsm))
|
||||
(the cmbn
|
||||
(make-cmbn
|
||||
:degr dmns
|
||||
:list (do ((rslt +empty-list+)
|
||||
(ldegr dmns)
|
||||
(indx (1- (integer-length gmsm)) (1- indx)))
|
||||
((minusp indx))
|
||||
(declare
|
||||
(list rslt)
|
||||
(fixnum indx))
|
||||
(when (logbitp indx gmsm)
|
||||
(push (term 1 (tnpr
|
||||
ldegr (logand gmsm (mask (1+ indx)))
|
||||
(- dmns ldegr) (logandc2 gmsm (mask indx))))
|
||||
rslt)
|
||||
(when (minusp (decf ldegr))
|
||||
(return rslt)))))))
|
||||
(when (minusp (decf ldegr))
|
||||
(return rslt)))))))
|
||||
|
||||
(DEFUN SOFT-DELTA-DGNL (dmns gmsm)
|
||||
(declare
|
||||
(fixnum dmns)
|
||||
(type soft-dlop gmsm))
|
||||
(make-cmbn :degr dmns
|
||||
:list (mapcar
|
||||
#'(lambda (term)
|
||||
(with-term (cffc tnpr) term
|
||||
(with-tnpr (degr1 gmsm1 degr2 gmsm2) tnpr
|
||||
(term cffc
|
||||
(tnpr degr1 (d gmsm1) degr2 (d gmsm2))))))
|
||||
(cmbn-list (delta-dgnl dmns (cdr gmsm))))))
|
||||
(declare
|
||||
(fixnum dmns)
|
||||
(type soft-dlop gmsm))
|
||||
(make-cmbn :degr dmns
|
||||
:list (mapcar
|
||||
#'(lambda (term)
|
||||
(with-term (cffc tnpr) term
|
||||
(with-tnpr (degr1 gmsm1 degr2 gmsm2) tnpr
|
||||
(term cffc
|
||||
(tnpr degr1 (d gmsm1)
|
||||
degr2 (d gmsm2))))))
|
||||
(cmbn-list (delta-dgnl dmns (cdr gmsm))))))
|
||||
|
||||
#|
|
||||
()
|
||||
@ -133,17 +131,17 @@
|
||||
|#
|
||||
|
||||
(DEFUN DELTA-INFINITY ()
|
||||
(the simplicial-set
|
||||
(build-smst
|
||||
:cmpr #'f-cmpr
|
||||
:basis :locally-effective
|
||||
:bspn 1
|
||||
:face #'delta-face
|
||||
:intr-dgnl #'delta-dgnl
|
||||
:dgnl-strt :gnrt
|
||||
:intr-bndr #'delta-bndr
|
||||
:bndr-strt :gnrt
|
||||
:orgn '(delta-infinity))))
|
||||
(the simplicial-set
|
||||
(build-smst
|
||||
:cmpr #'f-cmpr
|
||||
:basis :locally-effective
|
||||
:bspn 1
|
||||
:face #'delta-face
|
||||
:intr-dgnl #'delta-dgnl
|
||||
:dgnl-strt :gnrt
|
||||
:intr-bndr #'delta-bndr
|
||||
:bndr-strt :gnrt
|
||||
:orgn '(delta-infinity))))
|
||||
|
||||
#|
|
||||
()
|
||||
@ -158,15 +156,15 @@
|
||||
|#
|
||||
|
||||
(DEFUN SOFT-DELTA-INFINITY ()
|
||||
(the simplicial-set
|
||||
(build-smst
|
||||
:cmpr #'soft-delta-cmpr
|
||||
:basis :locally-effective
|
||||
:bspn (d 1)
|
||||
:face #'soft-delta-face
|
||||
:intr-dgnl #'soft-delta-dgnl :dgnl-strt :gnrt
|
||||
:intr-bndr #'soft-delta-bndr :bndr-strt :gnrt
|
||||
:orgn '(soft-delta-infinity))))
|
||||
(the simplicial-set
|
||||
(build-smst
|
||||
:cmpr #'soft-delta-cmpr
|
||||
:basis :locally-effective
|
||||
:bspn (d 1)
|
||||
:face #'soft-delta-face
|
||||
:intr-dgnl #'soft-delta-dgnl :dgnl-strt :gnrt
|
||||
:intr-bndr #'soft-delta-bndr :bndr-strt :gnrt
|
||||
:orgn '(soft-delta-infinity))))
|
||||
|
||||
#|
|
||||
()
|
||||
@ -179,36 +177,36 @@
|
||||
|#
|
||||
|
||||
(DEFUN DELTA-N-BASIS (n)
|
||||
(declare (fixnum n))
|
||||
(declare (fixnum n))
|
||||
(flet ((rslt (dmns)
|
||||
(declare (fixnum dmns))
|
||||
(when (> dmns n)
|
||||
(return-from rslt +empty-list+))
|
||||
(setf dmns (1+ dmns))
|
||||
(do ((rslt +empty-list+)
|
||||
(count (binomial-n-p (1+ n) dmns))
|
||||
(gmsm (mask (1+ n)) (1- gmsm)))
|
||||
((zerop count) rslt)
|
||||
(when (= (logcount gmsm) dmns)
|
||||
(push gmsm rslt)
|
||||
(decf count)))))
|
||||
(the basis #'rslt)))
|
||||
(declare (fixnum dmns))
|
||||
(when (> dmns n)
|
||||
(return-from rslt +empty-list+))
|
||||
(setf dmns (1+ dmns))
|
||||
(do ((rslt +empty-list+)
|
||||
(count (binomial-n-p (1+ n) dmns))
|
||||
(gmsm (mask (1+ n)) (1- gmsm)))
|
||||
((zerop count) rslt)
|
||||
(when (= (logcount gmsm) dmns)
|
||||
(push gmsm rslt)
|
||||
(decf count)))))
|
||||
(the basis #'rslt)))
|
||||
|
||||
(DEFUN SOFT-DELTA-N-BASIS (n)
|
||||
(declare (fixnum n))
|
||||
(flet ((rslt (dmns)
|
||||
(when (> dmns n)
|
||||
(return-from rslt +empty-list+))
|
||||
(setf dmns (1+ dmns))
|
||||
(do ((rslt +empty-list+)
|
||||
(count (binomial-n-p (1+ n) dmns))
|
||||
(gmsm (mask (1+ n)) (1- gmsm)))
|
||||
((zerop count) rslt)
|
||||
(when (= (logcount gmsm) dmns)
|
||||
(push (d gmsm) rslt)
|
||||
(decf count)))))
|
||||
(the basis #'rslt)))
|
||||
|
||||
(declare (fixnum n))
|
||||
(flet ((rslt (dmns)
|
||||
(when (> dmns n)
|
||||
(return-from rslt +empty-list+))
|
||||
(setf dmns (1+ dmns))
|
||||
(do ((rslt +empty-list+)
|
||||
(count (binomial-n-p (1+ n) dmns))
|
||||
(gmsm (mask (1+ n)) (1- gmsm)))
|
||||
((zerop count) rslt)
|
||||
(when (= (logcount gmsm) dmns)
|
||||
(push (d gmsm) rslt)
|
||||
(decf count)))))
|
||||
(the basis #'rslt)))
|
||||
|
||||
|
||||
#|
|
||||
()
|
||||
@ -221,18 +219,18 @@
|
||||
|#
|
||||
|
||||
(DEFUN DELTA (dmns)
|
||||
(declare (fixnum dmns))
|
||||
(the simplicial-set
|
||||
(build-smst
|
||||
:cmpr #'f-cmpr
|
||||
:basis (delta-n-basis dmns)
|
||||
:bspn 1
|
||||
:face #'delta-face
|
||||
:intr-dgnl #'delta-dgnl
|
||||
:dgnl-strt :gnrt
|
||||
:intr-bndr #'delta-bndr
|
||||
:bndr-strt :gnrt
|
||||
:orgn `(delta ,dmns))))
|
||||
(declare (fixnum dmns))
|
||||
(the simplicial-set
|
||||
(build-smst
|
||||
:cmpr #'f-cmpr
|
||||
:basis (delta-n-basis dmns)
|
||||
:bspn 1
|
||||
:face #'delta-face
|
||||
:intr-dgnl #'delta-dgnl
|
||||
:dgnl-strt :gnrt
|
||||
:intr-bndr #'delta-bndr
|
||||
:bndr-strt :gnrt
|
||||
:orgn `(delta ,dmns))))
|
||||
|
||||
#|
|
||||
()
|
||||
@ -251,17 +249,17 @@
|
||||
|#
|
||||
|
||||
(DEFUN SOFT-DELTA (dmns)
|
||||
(declare (fixnum dmns))
|
||||
(the simplicial-set
|
||||
(build-smst
|
||||
:cmpr #'soft-delta-cmpr
|
||||
:basis (soft-delta-n-basis dmns)
|
||||
:bspn (d 1)
|
||||
:face #'soft-delta-face
|
||||
:intr-dgnl #'soft-delta-dgnl :dgnl-strt :gnrt
|
||||
:intr-bndr #'soft-delta-bndr :bndr-strt :gnrt
|
||||
:orgn `(soft-delta ,dmns))))
|
||||
|
||||
(declare (fixnum dmns))
|
||||
(the simplicial-set
|
||||
(build-smst
|
||||
:cmpr #'soft-delta-cmpr
|
||||
:basis (soft-delta-n-basis dmns)
|
||||
:bspn (d 1)
|
||||
:face #'soft-delta-face
|
||||
:intr-dgnl #'soft-delta-dgnl :dgnl-strt :gnrt
|
||||
:intr-bndr #'soft-delta-bndr :bndr-strt :gnrt
|
||||
:orgn `(soft-delta ,dmns))))
|
||||
|
||||
#|
|
||||
()
|
||||
(cat-init)
|
||||
@ -274,144 +272,145 @@
|
||||
|#
|
||||
|
||||
#| For comparison with EAT.
|
||||
In
|
||||
(setf delta (delta-infinity))
|
||||
(setf d (bndr delta))
|
||||
(setf s14 (mask 15))
|
||||
(cmbn-? d (gnrt-? d 14 s14))
|
||||
(defun t1 (n)
|
||||
(time (dotimes (i n) (cmbn-? d (gnrt-? d 14 s14)))))
|
||||
(compile 't1)
|
||||
(t1 500)
|
||||
(setf +too-much-time+ -1)
|
||||
(t1 500)
|
||||
In
|
||||
(setf delta (delta-infinity))
|
||||
(setf d (bndr delta))
|
||||
(setf s14 (mask 15))
|
||||
(cmbn-? d (gnrt-? d 14 s14))
|
||||
(defun t1 (n)
|
||||
(time (dotimes (i n) (cmbn-? d (gnrt-? d 14 s14)))))
|
||||
(compile 't1)
|
||||
(t1 500)
|
||||
(setf +too-much-time+ -1)
|
||||
(t1 500)
|
||||
|#
|
||||
#|
|
||||
In EAT:
|
||||
(setf delta *delta*)
|
||||
(setf d (cc-d (ss-cc delta)))
|
||||
(setf s14 (<a-b> 0 14))
|
||||
(??? d (? d 14 s14))
|
||||
(defun t1 (n)
|
||||
(time (dotimes (i n) (??? d (? d 14 s14)))))
|
||||
(compile 't1)
|
||||
(t1 500)
|
||||
In EAT:
|
||||
(setf delta *delta*)
|
||||
(setf d (cc-d (ss-cc delta)))
|
||||
(setf s14 (<a-b> 0 14))
|
||||
(??? d (? d 14 s14))
|
||||
(defun t1 (n)
|
||||
(time (dotimes (i n) (??? d (? d 14 s14)))))
|
||||
(compile 't1)
|
||||
(t1 500)
|
||||
|#
|
||||
|
||||
(DEFUN DELTAB-CMPR (gmsm1 gmsm2)
|
||||
(declare (fixnum gmsm1 gmsm2))
|
||||
(if (= 1 (logcount gmsm1))
|
||||
(declare (fixnum gmsm1 gmsm2))
|
||||
(if (= 1 (logcount gmsm1))
|
||||
:equal
|
||||
(f-cmpr gmsm1 gmsm2)))
|
||||
|
||||
(DEFUN DELTAB-BNDR (dmns gmsm)
|
||||
(declare (fixnum dmns gmsm))
|
||||
(the cmbn
|
||||
(if (< dmns 2)
|
||||
(zero-cmbn (1- dmns))
|
||||
(make-cmbn
|
||||
(declare (fixnum dmns gmsm))
|
||||
(the cmbn
|
||||
(if (< dmns 2)
|
||||
(zero-cmbn (1- dmns))
|
||||
(make-cmbn
|
||||
:degr (1- dmns)
|
||||
:list (do ((rslt +empty-list+)
|
||||
(gmsm2 gmsm (ash gmsm2 -1))
|
||||
(pmark 1 (ash pmark +1))
|
||||
(sign 1))
|
||||
((zerop gmsm2) rslt)
|
||||
(gmsm2 gmsm (ash gmsm2 -1))
|
||||
(pmark 1 (ash pmark +1))
|
||||
(sign 1))
|
||||
((zerop gmsm2) rslt)
|
||||
(declare
|
||||
(list rslt)
|
||||
(fixnum gmsm2 pmark sign))
|
||||
(list rslt)
|
||||
(fixnum gmsm2 pmark sign))
|
||||
(when (oddp gmsm2)
|
||||
(push (term sign (logxor gmsm pmark)) rslt)
|
||||
(setf sign (- sign))))))))
|
||||
(push (term sign (logxor gmsm pmark)) rslt)
|
||||
(setf sign (- sign))))))))
|
||||
|
||||
(DEFUN DELTAB2-FACE (indx dmns gmsm)
|
||||
(declare
|
||||
(fixnum indx dmns gmsm))
|
||||
(the absm
|
||||
(progn
|
||||
(when (= 2 dmns)
|
||||
(declare
|
||||
(fixnum indx dmns gmsm))
|
||||
(the absm
|
||||
(progn
|
||||
(when (= 2 dmns)
|
||||
(return-from deltab2-face (absm 1 1)))
|
||||
(do ((pmark 1 (ash pmark 1))
|
||||
(bmark indx)
|
||||
(gmsm2 gmsm (ash gmsm2 -1)))
|
||||
(nil)
|
||||
(declare (fixnum pmark bmark gmsm2))
|
||||
(when (oddp gmsm2)
|
||||
(when (minusp (decf bmark))
|
||||
(return-from deltab2-face (absm 0 (logxor gmsm pmark)))))))))
|
||||
(do ((pmark 1 (ash pmark 1))
|
||||
(bmark indx)
|
||||
(gmsm2 gmsm (ash gmsm2 -1)))
|
||||
(nil)
|
||||
(declare (fixnum pmark bmark gmsm2))
|
||||
(when (oddp gmsm2)
|
||||
(when (minusp (decf bmark))
|
||||
(return-from deltab2-face (absm 0 (logxor gmsm pmark)))))))))
|
||||
|
||||
(DEFUN DELTAB2-DGNL (dmns gmsm)
|
||||
(declare (fixnum dmns gmsm))
|
||||
(the cmbn
|
||||
(make-cmbn
|
||||
:degr dmns
|
||||
:list (if (zerop dmns)
|
||||
(list (term 1 (tnpr 0 gmsm 0 gmsm)))
|
||||
(do ((rslt +empty-list+)
|
||||
(ldegr dmns)
|
||||
(indx (1- (integer-length gmsm)) (1- indx)))
|
||||
((minusp indx))
|
||||
(declare (list rslt) (fixnum indx))
|
||||
(when (logbitp indx gmsm)
|
||||
(push (term 1 (tnpr
|
||||
ldegr (logand gmsm (mask (1+ indx)))
|
||||
(- dmns ldegr) (logandc2 gmsm (mask indx))))
|
||||
rslt)
|
||||
(when (minusp (decf ldegr))
|
||||
(setf rslt (delete 1 rslt :key #'caaddr))
|
||||
(setf (gnrt1 (gnrt (first rslt)))
|
||||
(setf (gnrt2 (gnrt (car (last rslt))))
|
||||
1))
|
||||
(return (delete 1 rslt :key #'cadddr)))))))))
|
||||
(make-cmbn
|
||||
:degr dmns
|
||||
:list (if (zerop dmns)
|
||||
(list (term 1 (tnpr 0 gmsm 0 gmsm)))
|
||||
(do ((rslt +empty-list+)
|
||||
(ldegr dmns)
|
||||
(indx (1- (integer-length gmsm)) (1- indx)))
|
||||
((minusp indx))
|
||||
(declare (list rslt) (fixnum indx))
|
||||
(when (logbitp indx gmsm)
|
||||
(push (term 1 (tnpr
|
||||
ldegr (logand gmsm (mask (1+ indx)))
|
||||
(- dmns ldegr)
|
||||
(logandc2 gmsm (mask indx))))
|
||||
rslt)
|
||||
(when (minusp (decf ldegr))
|
||||
(setf rslt (delete 1 rslt :key #'caaddr))
|
||||
(setf (gnrt1 (gnrt (first rslt)))
|
||||
(setf (gnrt2 (gnrt (car (last rslt))))
|
||||
1))
|
||||
(return (delete 1 rslt :key #'cadddr)))))))))
|
||||
|
||||
#|
|
||||
()
|
||||
(dotimes (i 7)
|
||||
(print (deltab2-dgnl i (mask (1+ i)))))
|
||||
|#
|
||||
|
||||
|
||||
|
||||
(DEFUN DELTAB2-BNDR (dmns gmsm)
|
||||
(declare (fixnum dmns gmsm))
|
||||
(the cmbn
|
||||
(if (< dmns 3)
|
||||
(zero-cmbn (1- dmns))
|
||||
(make-cmbn
|
||||
(declare (fixnum dmns gmsm))
|
||||
(the cmbn
|
||||
(if (< dmns 3)
|
||||
(zero-cmbn (1- dmns))
|
||||
(make-cmbn
|
||||
:degr (1- dmns)
|
||||
:list (do ((rslt +empty-list+)
|
||||
(gmsm2 gmsm (ash gmsm2 -1))
|
||||
(pmark 1 (ash pmark +1))
|
||||
(sign 1))
|
||||
((zerop gmsm2) rslt)
|
||||
(gmsm2 gmsm (ash gmsm2 -1))
|
||||
(pmark 1 (ash pmark +1))
|
||||
(sign 1))
|
||||
((zerop gmsm2) rslt)
|
||||
(declare
|
||||
(list rslt)
|
||||
(fixnum gmsm2 pmark sign))
|
||||
(list rslt)
|
||||
(fixnum gmsm2 pmark sign))
|
||||
(when (oddp gmsm2)
|
||||
(push (term sign (logxor gmsm pmark)) rslt)
|
||||
(setf sign (- sign))))))))
|
||||
(push (term sign (logxor gmsm pmark)) rslt)
|
||||
(setf sign (- sign))))))))
|
||||
|
||||
#|
|
||||
(deltab-bndr 1 5)
|
||||
(deltab-bndr 3 15)
|
||||
(deltab-bndr 1 5)
|
||||
(deltab-bndr 3 15)
|
||||
|#
|
||||
|
||||
(DEFUN DELTAB ()
|
||||
(the simplicial-set
|
||||
(build-smst
|
||||
:cmpr #'deltab-cmpr
|
||||
:basis :locally-effective
|
||||
:bspn 1
|
||||
:face #'delta-face
|
||||
:intr-dgnl #'delta-dgnl
|
||||
:dgnl-strt :gnrt
|
||||
:orgn '(deltab))))
|
||||
(build-smst
|
||||
:cmpr #'deltab-cmpr
|
||||
:basis :locally-effective
|
||||
:bspn 1
|
||||
:face #'delta-face
|
||||
:intr-dgnl #'delta-dgnl
|
||||
:dgnl-strt :gnrt
|
||||
:orgn '(deltab))))
|
||||
|
||||
(DEFUN DELTAB2 ()
|
||||
(the simplicial-set
|
||||
(build-smst
|
||||
:cmpr #'f-cmpr
|
||||
:basis :locally-effective
|
||||
:bspn 1
|
||||
:face #'deltab2-face
|
||||
:intr-dgnl #'deltab2-dgnl
|
||||
:dgnl-strt :gnrt
|
||||
:orgn '(deltab2))))
|
||||
(build-smst
|
||||
:cmpr #'f-cmpr
|
||||
:basis :locally-effective
|
||||
:bspn 1
|
||||
:face #'deltab2-face
|
||||
:intr-dgnl #'deltab2-dgnl
|
||||
:dgnl-strt :gnrt
|
||||
:orgn '(deltab2))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user