From 0eb1ea06d3b9dacc19b77dd0ab7264b13bc26449 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juli=C3=A1n=20Cuevas-Rozo?= Date: Fri, 2 Aug 2019 19:52:52 +0200 Subject: [PATCH] finite topological spaces updated --- kenzo.asd | 3 +- src/finite-topological-spaces-class.lisp | 133 +++++++-- src/finite-topological-spaces-core.lisp | 46 ++- src/finite-topological-spaces-homology.lisp | 301 ++++++++++++++++++++ src/kenzo.fas | Bin 63208 -> 63208 bytes src/sage-interface.lisp | 2 +- 6 files changed, 429 insertions(+), 56 deletions(-) create mode 100644 src/finite-topological-spaces-homology.lisp diff --git a/kenzo.asd b/kenzo.asd index b01cb38..440d76b 100644 --- a/kenzo.asd +++ b/kenzo.asd @@ -61,7 +61,8 @@ (:file "sage-interface") (:file "finite-topological-spaces-aux") (:file "finite-topological-spaces-class") - (:file "finite-topological-spaces-core") + (:file "finite-topological-spaces-core") + (:file "finite-topological-spaces-homology") (:module "anromero" :components ((:file "resolutions") diff --git a/src/finite-topological-spaces-class.lisp b/src/finite-topological-spaces-class.lisp index 66e810e..3cf7ea0 100644 --- a/src/finite-topological-spaces-class.lisp +++ b/src/finite-topological-spaces-class.lisp @@ -31,35 +31,6 @@ rslt)) -(DEFUN CONVERTMATRICE (matrice) - #| Convert a 'matrice' to an 'array' |# - (let* ((numfil (nlig matrice)) - (numcol (ncol matrice)) - (rslt (make-array (list numfil numcol) :initial-element 0))) - (dotimes (i numfil) - (dotimes (j numcol) - (let ((Mij (terme matrice (1+ i) (1+ j)))) - (unless (zerop Mij) - (setf (aref rslt i j) Mij))))) - rslt)) - - -(DEFUN VER (matrix) - (let ((mat '())) - (typecase matrix - (matrice (setf mat matrix)) - (T (setf mat (convertarray matrix)))) - (format t "~%") - (format t " ========== MATRIX ~A row(s) + ~A column(s) ==========~%~%" (nlig mat) (ncol mat)) - (do ((i 1 (1+ i))) ((> i (nlig mat))) - (format t " ") - (do ((j 1 (1+ j))) ((> j (ncol mat))) - (if (< (terme mat i j) 0) - (format t " ~A " (terme mat i j)) - (format t " ~A " (terme mat i j)))) - (format t " ~%")))) - - (DEFUN EXTRACT-COLUMN2 (mtrx icol list) #| Modification of 'EXTRACT-COLUMN' in order to extract only the elements in the column 'icol' whose row indexes are in the list 'list' |# (declare (type matrice mtrx) (type fixnum icol) (type list list)) @@ -404,6 +375,110 @@ :top topogenous))) +;; +;; Barycentric subdivision +;; + + +(DEFUN RELAC (topogenous) + #| Chains of length 2 |# + (declare (type matrice topogenous)) + (let* ((dim (nlig topogenous)) + (rslt (creer-matrice dim dim))) + (declare (type fixnum dim)) + (do ((i 1 (1+ i))) ((> i dim) rslt) + (do ((j (1+ i) (1+ j))) ((> j dim)) + (if (eq (terme topogenous i j) 1) + (insert-term rslt i j (list (list i j)))))))) + + +(DEFUN BOUNDARYOPERATORS (topogenous) + (let* ((relac (relac topogenous)) + (diferenciales NIL) + (nuevo relac) + (dim (nlig topogenous)) + (parada 0) + (dim_n 0) + (Cn NIL)) + + (do ((i 1 (1+ i))) ((> i (1- dim))) + (do ((j (1+ i) (1+ j))) ((> j dim)) + (unless (eq (terme topogenous i j) 0) + (setf Cn (append Cn (list (list i j))))))) + + (setf dim_n (length Cn)) + + (push (let ((D1 (creer-matrice dim dim_n))) + (dotimes (i dim) + (dotimes (j dim_n) + (if (find (1+ i) (nth j Cn)) + (insert-term D1 (1+ i) (1+ j) 1)))) + D1) diferenciales) + + (if (> dim 1) + (do ((long 2 (1+ long))) ((or (> long dim) (eq parada 1))) + (let ((dim_n-1 dim_n) + (Cn-1 Cn) + (anterior nuevo)) + + (setf dim_n 0 Cn NIL nuevo (creer-matrice dim dim)) + + (do ((i 1 (1+ i))) ((> i (- (1+ dim) long))) + (do ((j (1+ i) (1+ j))) ((> j dim)) + (let ((cadenasij NIL)) + (do ((r i (1+ r))) ((> r j)) + (let ((termeir (terme anterior i r))) + (unless (or (eq termeir 0) (eq (terme relac r j) 0)) + (setf cadenasij (append cadenasij (mapcar #'(lambda (x) (append x (list j))) termeir)))))) + (if cadenasij + (progn (insert-term nuevo i j cadenasij) + (setf Cn (append Cn cadenasij))))))) + + (setf dim_n (length Cn)) + + (if (eq dim_n 0) + (setf parada 1) + (push (let ((Dn (creer-matrice dim_n-1 dim_n))) + (dotimes (i dim_n-1) + (dotimes (j dim_n) + (if (subsetp (nth i Cn-1) (nth j Cn)) + (insert-term Dn (1+ i) (1+ j) 1)))) + Dn) diferenciales))))) + (return-from BOUNDARYOPERATORS (reverse diferenciales)))) + + +(DEFUN BLOCKS (list) + (let ((rslt (identite (let ((suma (nlig (car list)))) + (dolist (x list) + (setf suma (+ suma (ncol x)))) + suma)))) + (do* ((lst list (cdr lst)) + (kfilas 0 (if (null lst) 0 (+ kfilas (nlig dif)))) + (kcolumnas (nlig (car list)) (if (null lst) 0 (+ kcolumnas (ncol dif)))) + (dif (car lst) (car lst))) ((endp lst)) + + (do ((i 1 (1+ i))) ((> i (nlig dif))) + (do ((j 1 (1+ j))) ((> j (ncol dif))) + (unless (eq (terme dif i j) 0) + (insert-term rslt (+ i kfilas) (+ j kcolumnas) 1))))) + rslt)) + + +(DEFMETHOD BAR_SUBDIVISION ((topogenous matrice)) + #| Topogenous matrice of the barycentric subdivision of 'topogenous' |# + (topmat (blocks (boundaryoperators topogenous)))) + + +(DEFMETHOD BAR_SUBDIVISION ((finspace finite-space)) + #| Finite-Space whose 'top' is the barycentric subdivision of (top 'finspace') |# + (let ((already (find `(BARYCENTRIC-SUBDIVISION ,finspace) *finite-space-list* :test #'equal :key #'orgn))) + (declare (type (or finite-space null) already)) + (if already + already + (build-finite-space :orgn `(BARYCENTRIC-SUBDIVISION ,finspace) + :stong (blocks (boundaryoperators (top finspace))))))) + + ;; ;; Special examples of Finite topological spaces ;; diff --git a/src/finite-topological-spaces-core.lisp b/src/finite-topological-spaces-core.lisp index ec76b09..2fc2511 100644 --- a/src/finite-topological-spaces-core.lisp +++ b/src/finite-topological-spaces-core.lisp @@ -13,7 +13,7 @@ ;; -(DEFUN DOWNBP (topogenous n list) +(DEFUN DOWNBP (topogenous n &optional (list ( 1 (nlig topogenous)))) #| T if Xn is a down beat point of the submatrix 'list'x'list' |# (the boolean (let ((maximal (loop for k in (reverse (subseq list 0 (position n list))) @@ -25,7 +25,7 @@ +TRUE+)))) -(DEFUN UPBP (topogenous n list) +(DEFUN UPBP (topogenous n &optional (list ( 1 (nlig topogenous)))) #| T if Xn is an up beat point of the submatrix 'list'x'list' |# (the boolean (let ((minimal (loop for k in (subseq list (1+ (position n list))) @@ -36,7 +36,7 @@ +TRUE+)))) -(DEFUN BEATPOINT (topogenous n list) +(DEFUN BEATPOINT (topogenous n &optional (list ( 1 (nlig topogenous)))) #| T if Xn is a beat point of the submatrix 'list'x'list' |# (the boolean (if (< (1+ n) (/ (ncol topogenous) 2)) @@ -48,7 +48,7 @@ (downbp topogenous n list))))) -(DEFUN CORE_LIST (topogenous list) +(DEFUN CORE_LIST (topogenous &optional (list ( 1 (nlig topogenous)))) #| List of the elements of the core of the submatrix 'list'x'list' |# (let ((eliminar NIL)) (setf eliminar (loop for n in list @@ -58,33 +58,33 @@ (core_list topogenous (remove eliminar list))))) -(DEFUN Un-N (topogenous n list) +(DEFUN Un-N (topogenous n &optional (list ( 1 (nlig topogenous)))) #| List of the elements in Un-{Xn} |# (loop for i in (subseq list 0 (position n list)) when (eq (terme topogenous i n) 1) collect i)) -(DEFUN Fn-N (topogenous n list) +(DEFUN Fn-N (topogenous n &optional (list ( 1 (nlig topogenous)))) #| List of the elements in Fn-{Xn} |# (loop for j in (subseq list (1+ (position n list))) when (eq (terme topogenous n j) 1) collect j)) -(DEFUN LINK_LIST (topogenous n list) +(DEFUN LINK_LIST (topogenous n &optional (list ( 1 (nlig topogenous)))) #| List of the elements in the link of Xn |# (append (Un-N topogenous n list) (Fn-N topogenous n list))) -(DEFUN WEAKPOINT (topogenous n list) +(DEFUN WEAKPOINT (topogenous n &optional (list ( 1 (nlig topogenous)))) #| T if Xn is a weak beat point of the submatrix 'list'x'list' |# (the boolean (or (eq (length (core_list topogenous (Un-N topogenous n list))) 1) (eq (length (core_list topogenous (Fn-N topogenous n list))) 1)))) -(DEFUN WEAKCORE_LIST (topogenous list) +(DEFUN WEAKCORE_LIST (topogenous &optional (list ( 1 (nlig topogenous)))) #| List of the elements of a "weak core" of the submatrix 'list'x'list' |# (let ((eliminar NIL)) (setf eliminar (loop for n in list @@ -94,43 +94,39 @@ (weakcore_list topogenous (remove eliminar list))))) -(DEFMETHOD CORE ((topogenous matrice) &optional list) +(DEFMETHOD CORE ((topogenous matrice) &optional (list ( 1 (nlig topogenous)))) #| Matrice of the core of 'topogenous' |# (the matrice - (let* ((list2 (if list - list - ( 1 (nlig topogenous)))) - (corelist (core_list topogenous list2))) + (let ((corelist (core_list topogenous list))) (sub-matrix topogenous corelist corelist)))) (DEFMETHOD CORE ((finspace finite-space) &optional list) #| Finite-Space whose 'top' is the topogenous matrix of the core of (top 'finspace') |# - (let ((already (find `(CORE ,finspace ,list) *finite-space-list* :test #'equal :key #'orgn))) + (let ((already (find (if list `(CORE ,finspace ,list) `(CORE ,finspace)) *finite-space-list* :test #'equal :key #'orgn))) (declare (type (or finite-space null) already)) (if already already - (build-finite-space :orgn `(CORE ,finspace ,list) - :top (core (top finspace) list))))) + (let ((list2 (or list ( 1 (nlig (top finspace)))))) + (build-finite-space :orgn (if list `(CORE ,finspace ,list) `(CORE ,finspace)) + :top (core (top finspace) list2)))))) -(DEFMETHOD WEAKCORE ((topogenous matrice) &optional list) +(DEFMETHOD WEAKCORE ((topogenous matrice) &optional (list ( 1 (nlig topogenous)))) #| Matrice of a "weak core" of 'topogenous' |# (the matrice - (let* ((list2 (if list - list - ( 1 (nlig topogenous)))) - (weakcorelist (weakcore_list topogenous (core_list topogenous list2)))) + (let ((weakcorelist (weakcore_list topogenous (core_list topogenous list)))) (sub-matrix topogenous weakcorelist weakcorelist)))) (DEFMETHOD WEAKCORE ((finspace finite-space) &optional list) #| Finite-Space whose 'top' is the topogenous matrix of a "weak core" of (top 'finspace') |# - (let ((already (find `(WEAK-CORE ,finspace ,list) *finite-space-list* :test #'equal :key #'orgn))) + (let ((already (find (if list `(WEAK-CORE ,finspace ,list) `(WEAK-CORE ,finspace)) *finite-space-list* :test #'equal :key #'orgn))) (declare (type (or finite-space null) already)) (if already already - (build-finite-space :orgn `(WEAK-CORE ,finspace ,list) - :top (weakcore (top finspace) list))))) + (let ((list2 (or list ( 1 (nlig (top finspace)))))) + (build-finite-space :orgn (if list `(WEAK-CORE ,finspace ,list) `(WEAK-CORE ,finspace)) + :top (weakcore (top finspace) list2)))))) diff --git a/src/finite-topological-spaces-homology.lisp b/src/finite-topological-spaces-homology.lisp new file mode 100644 index 0000000..0c7afbd --- /dev/null +++ b/src/finite-topological-spaces-homology.lisp @@ -0,0 +1,301 @@ +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -* + +;; FINITE-TOPOLOGICAL-SPACES FINITE-TOPOLOGICAL-SPACES FINITE-TOPOLOGICAL-SPACES +;; FINITE-TOPOLOGICAL-SPACES FINITE-TOPOLOGICAL-SPACES FINITE-TOPOLOGICAL-SPACES +;; FINITE-TOPOLOGICAL-SPACES FINITE-TOPOLOGICAL-SPACES FINITE-TOPOLOGICAL-SPACES + +(IN-PACKAGE #:cat) + +(PROVIDE "finite-topological-spaces-homology") + +;; +;; Homology of h-regular spaces +;; + + +(DEFUN COLUMN-J (mtrx j) + (declare (type matrix mtrx) + (type fixnum j)) + (assert (< j (column-number mtrx))) + (the list + (let ((line-n (line-number mtrx))) + (declare (type fixnum line-n)) + (mapcar + #'(lambda (i) + (declare (type fixnum i)) + (aref mtrx i j)) + ( 0 (1- line-n)))))) + + +(DEFUN KERNEL (mtrx) + (declare (type matrix mtrx)) + (the list + (let* ((smith-list (smith mtrx)) + (m (third smith-list)) + (q (fourth smith-list)) + (min (min (line-number mtrx) (column-number mtrx))) + (rslt nil)) + (declare + (type list smith-list rslt) + (type matrix m q) + (type fixnum min)) + (progn + (do ((j (1- (column-number mtrx)) (1- j))) + ((< j min)) + (declare (type fixnum j)) + (setq rslt (nconc (list (column-j q j)) rslt))) + (do ((i (1- min) (1- i))) + ((or (< i 0) (not (eql 0 (aref m i i))))) + (declare (type fixnum i)) + (setq rslt (nconc (list (column-j q i)) rslt))) + rslt)))) + + +(DEFMETHOD H-REGULAR-DIF ((finspace finite-space)) + (let ((diferenciales NIL) + (aristas (matrice-to-lmtrx (nilpot (stong finspace)))) + (alturas (heights finspace))) + (declare (type list diferenciales)) + (dotimes (dimension (length alturas)) + (let* ((Cn (nth dimension alturas)) + (dim_n (length Cn))) + (if (zerop dimension) + (push (creer-matrice 0 (length Cn)) diferenciales) + (let* ((Cn-1 (nth (1- dimension) alturas)) + (dim_n-1 (length Cn-1)) + (rslt (creer-matrice dim_n-1 dim_n))) + (case dimension + (1 (progn (push (do ((group Cn (cdr group)) + (posicion 1 (1+ posicion))) + ((endp group) rslt) + (let ((colj (aref aristas (1- (car group))))) + (insert-term rslt (1+ (position (1+ (car (first colj))) Cn-1)) posicion -1) + (insert-term rslt (1+ (position (1+ (car (second colj))) Cn-1)) posicion 1))) + diferenciales))) + + (otherwise (push (let ((Cn-2 ( 1 (length (nth (- dimension 2) alturas)))) + (dn-1 (first diferenciales)) + (group Cn)) + (do ((posicion 1 (1+ posicion))) + ((null group) rslt) + (let* ((maxUj (mapcar #'(lambda (v) (1+ (car v))) (aref aristas (1- (pop group))))) + (cols (posiciones-1 maxUj Cn-1)) + (ker (car (kernel (make-array (list (length Cn-2) (length cols)) + :element-type 'fixnum + :initial-contents (loop for i in Cn-2 + collect (loop for j in cols + collect (terme dn-1 i j)))))))) + (do ((ker ker (cdr ker)) + (cols cols (cdr cols))) + ((endp cols)) + (insert-term rslt (car cols) posicion (car ker)))))) + diferenciales))))))) + (return-from H-REGULAR-DIF (reverse diferenciales)))) + + +(DEFMETHOD H-REGULAR-DIF ((topogenous matrice)) + (let ((finspace (build-finite-space :top topogenous))) + (H-REGULAR-DIF finspace))) + + +(DEFUN POSICIONES (pos list) + (loop for x in pos + collect (nth (1- x) list))) + + +(DEFUN POSICIONES-1 (list1 list2) ; 'list1' is a sublist of 'list2' + (loop for x in list1 + collect (1+ (position x list2 :test #'equal)))) + + +(DEFUN D21-1 (blocks size) + #| Modify 'blocks' in order to obtain an identity matrix in the submatrix 'size'x'size' |# + (declare (type fixnum size)) + (the matrice + (let ((rslt (copier-matrice blocks))) + (unless (or (< (nlig rslt) size) (< (ncol rslt) size) (= size 0)) + (loop for k from 1 to size + do (progn + ;(if (eq (terme rslt k k) 0) + ;(0column-swap rslt k (loop for j from (1+ k) to size + ; when (not (eq (terme rslt k j) 0)) + ; return j))) + (unless (eq (terme rslt k k) 1) + (0column-op rslt (1- (terme rslt k k)) k k)) + (loop for j from 1 to size + if (not (eq j k)) + do (unless (eq (terme rslt k j) 0) + (0column-op rslt (- (terme rslt k j)) k j)))))) + rslt))) + + + +(DEFUN RESTA (mtrx1 mtrx2) + (let ((rslt (creer-matrice (nlig mtrx1) (ncol mtrx2)))) + (loop for i from 1 to (nlig mtrx1) + do (loop for j from 1 to (ncol mtrx1) + do (insert-term rslt i j (- (terme mtrx1 i j) (terme mtrx2 i j))))) + rslt)) + + +(DEFUN FINAL (matrix corte) ; 'matrix' is the result of the function D21-1 and 'corte' is the 'size' in D21-1 function + (let ((d31 (sub-matrix matrix + (>a-b> corte (nlig matrix)) + ( 1 corte))) + (d23 (sub-matrix matrix + ( 1 corte ) + (>a-b> corte (ncol matrix)))) + (d33 (sub-matrix matrix + (>a-b> corte (nlig matrix)) + (>a-b> corte (ncol matrix))))) + (resta d33 (matrice-prdc d31 d23)))) + + +(DEFSTRUCT (TSC (:conc-name nil)) + name diferencial group targets sources critical) + + +(DEFMACRO DESCOMP (name) + `(setf ,name (make-TSC) + (sources ,name) (reverse (intersection sou summands)) + (targets ,name) (reverse (intersection tar summands)) + (critical ,name) (let ((cri summands)) + (dolist (x (append (targets ,name) (sources ,name))) + (setf cri (remove x cri))) + cri))) + + +(DEFMETHOD DVF-H-REGULAR-DIF ((finspace finite-space) &key sou tar) + (let* ((groups NIL) + (diferenciales NIL) + (dn-3 NIL) + (dn-2 NIL) + (dn-1 NIL) + (dn NIL) + (alturas (heights finspace)) + (height (length alturas))) + (declare (type list groups diferenciales) + (type fixnum height)) + (setf dn-3 (make-TSC)) + (dotimes (dimension height) + (let ((summands (nth dimension alturas))) + (case dimension + (0 (progn (descomp dn-2) + ;;; Computing C0': + (push (mapcar #'(lambda (u) (list (list 1 u))) summands) groups) + ;;; Computing d0: + (push (creer-matrice 0 (length (critical dn-2))) diferenciales))) + + (1 (progn (descomp dn-1) + ;;; Computing C1': + (push (loop for x in summands + collect (let* ((primer1 (find-if #'(lambda (y) (= (terme (top finspace) y x) 1)) + (a-b> primer1 (nlig (top finspace)))))) + (list (list 1 segundo1 x) (list -1 primer1 x)))) groups) + + ;;; Computing d1'': + (push (let ((rslt (creer-matrice (length (second groups)) (length summands)))) + (dolist (x (apply #'append (first groups))) + (insert-term rslt (1+ (position (second x) (first alturas) :test #'equal)) + (1+ (position (third x) (second alturas) :test #'equal)) + (first x))) + rslt) diferenciales))) + + (otherwise (progn (descomp dn) + (let ((rslt NIL) + (Cn-1 (first groups)) + (Cn-2 (second groups))) + + ;;; Cálculo de Cn' (rslt): + (dolist (x (reverse summands)) + (let ((pseudo NIL) + (list_fil NIL) + (list_col NIL) + (kernel NIL)) + + (setf list_fil (loop for k from 0 to (1- (length Cn-2)) + when (= (terme (top finspace) (car (last (first (nth k Cn-2)))) x) 1) + collect k) + list_col (loop for k from 0 to (1- (length Cn-1)) + when (= (terme (top finspace) (car (last (first (nth k Cn-1)))) x) 1) + collect k) + + kernel (car (kernel (convertmatrice (sub-matrix (first diferenciales) + (mapcar #'(lambda (x) (1+ x)) list_fil) + (mapcar #'(lambda (x) (1+ x)) list_col)))))) + + (do ((lst list_col (cdr lst)) + (ker kernel (cdr ker))) + ((endp lst)) + (unless (equal (car ker) 0) + (let ((actualizar (nth (car lst) Cn-1))) + (dolist (z actualizar) + (push (reverse (cons x (reverse (cons (* (car ker) (car z)) (cdr z))))) pseudo))))) + + (push pseudo rslt))) + + ;;; Computing dn'' (rslt2): + (push (let ((rslt2 (creer-matrice (length Cn-1) (length summands)))) + (dotimes (j (length summands) rslt2) + (let ((next-to-last 0)) + (do ((tj (nth j rslt) (remove-if #'(lambda (elto) + (equal next-to-last (second (reverse elto)))) + tj))) + ((null tj)) + + (setf next-to-last (second (reverse (first tj)))) + (let* ((g (nth (position next-to-last (nth (1- dimension) alturas)) Cn-1)) + (ui (car (last g)))) + (dolist (l tj) + (if (equal (cdr ui) (reverse (cdr (reverse (cdr l))))) + (progn + (insert-term rslt2 (1+ (position g Cn-1)) (1+ j) (* (first ui) (first l))) + (return))))))))) diferenciales) + (setf groups (list (car groups))) + (push rslt groups)) + + (unless (= dimension 2) + (setf (third diferenciales) + (final + (d21-1 + (sub-matrix (third diferenciales) + (posiciones-1 (append (sources dn-3) (critical dn-3)) (nth (- dimension 3) alturas)) + (posiciones-1 (append (targets dn-2) (critical dn-2)) (nth (- dimension 2) alturas))) + (length (targets dn-2))) + (length (targets dn-2))))) + + (setf dn-3 dn-2 + dn-2 dn-1 + dn-1 dn)))))) + + ;;; Modify the last 2 matrices + (unless (= height 1) + (unless (= height 2) + (setf (second diferenciales) + (final + (d21-1 + (sub-matrix (second diferenciales) + (posiciones-1 (append (sources dn-3) (critical dn-3)) (nth (- height 3) alturas)) + (posiciones-1 (append (targets dn-2) (critical dn-2)) (nth (- height 2) alturas))) + (length (targets dn-2))) + (length (targets dn-2))))) + + (setf (first diferenciales) + (final + (d21-1 + (sub-matrix (first diferenciales) + (posiciones-1 (append (sources dn-2) (critical dn-2)) (nth (- height 2) alturas)) + (posiciones-1 (append (targets dn-1) (critical dn-1)) (nth (- height 1) alturas))) + (length (targets dn-1))) + (length (targets dn-1))))) + + (return-from DVF-H-REGULAR-DIF (reverse diferenciales)))) + + +(DEFMETHOD DVF-H-REGULAR-DIF ((topogenous matrice) &key sou tar) + (let ((finspace (build-finite-space :top topogenous + :stong (stongmat topogenous)))) + (DVF-H-REGULAR-DIF finspace :sou sou :tar tar))) + diff --git a/src/kenzo.fas b/src/kenzo.fas index 610b7f316b86057be9367c054ed20fc65d5ec9ba..a4e252e61a8444cff6e577da40014ff04f553345 100755 GIT binary patch delta 9550 zcmeI2d3+UBmdEQ>y@W?4sZ=FMUL_%U?)*u9fKof{)h^PTsq6SHTu&+sE6G#FA z0Y!m3C}6j2qtd9rOq4-I7JFoo&4sOHNn~^kxPgw{F3>&acdOn5!EyP_zw-Ii%lX~q zoO8EYz8@MsR~kN7wwz>zc~2a^@Z`)x+j;4MuV*g0v)jkzy$?$CPoc}Ai_sNHSIsUz zla}XXpv(#}Vv`^pvQsX7eSDPm9rw5IS9>9HmBQ@WdFq)!sAyE%TjJG&QIZrr(2%4)Jf}wj-_=8H zl157QH0m5pf4q%4(jVm|ezr%lRvAMj>60l9S&lfyV@9;fdfrPSqYD)&PsWnj>J`*_ zBMwu!a)d@9x9*9`VQ}^sDwS_z`1ldQ=*<+^FO-)u%e^1gzDrj645z&oi zL4BCNJtCt?JCR7leuUCJ1F4^Knl~Dmp1x3(q(=65%$Iti5!u1V$;?rUP@ZuYmFG#y zS$=nJx|K~u-oK$*QWty3{-KUculfT8^c`f!HHCv(`MaVYn42c!mDTua0tkKRvv=d^3b{-;Ah%MShh@06Z z>a$H7jiGix9v*3z_6DyX)yn(|;nqHd9j5*rjo1B&Y_Iw*PwkZ(^93^R&h}H0@fM%h zD=pzTO_90)ZQ`fqjJj`DjZ6$P|K}98Xq!w}C(G*9eVEA!2^Yf##*ifE2COd}H zc%nPWtEk-gZ$9Mq1eVKZj%m)u@@K}hWdF|hk4ehc$!$zky9nyKnwBnRi}12kBXhgs zkk&copfJCpX^uG#Q`t&kW6mw6ZeA~^--I}ww;k(mzX?qu#N-=CU^@$8sPNL9eL>xf zDKzkywoaR6ymD-Uxf9`v#PS+N$YPvRyPIzwo6lb4-;Zq`_%jVgOI(fM@6tSJN!ww5 zL}u*sVn2Ts%l|O0W%Nwyucx&^Wj{VKuPxikpUG=ueomWLzpO;iq9m@S1oSJ)K-l&C zqr3oZBX93^EQ@FN4pbJ?aCFskv?*otb$ll@Q8 zO`Aaj(is!|w9~w6A2YU&&Xe9)6a}S}34C~;w5&38k7L4@7JpSJ+VgQ#6E9kOwNY5? zCa$+d{PjNR$&tv>CyFw){TOou`+mFx>3E|hC#CDn@yalz7v2UijanA59ca^iG+7@^BXFWT^!RsP-MeBz+ z+eI^P>hRID0p4)q)T3qx+dxC`X{V6rPWA*v@M|5p{~=ROS#xJwYByBB-rJjZdCNB2$})88Ah&Y%K}P zn`>1+(&-QRSkb-esI9q|=f zGv3fYz}oZZ0co+~AeFhf(An!Y!0h!g%|{~--Wc>L@^^GJ0$a$T6u3a%S)eoJCpQ39$e0!9?&{5lO|INbf>l~FqCXL@HUM=ky0A-4+o@a z;tW0J29M{)z`^&d!bB_&6=5wLp=cYi=1+>Td$l$YPYI!GiCEbcLin81w^9hdR>$8M zn8+6MlLON#TcFiy*RzQ12t}(x%~~1HbFXG#6zhc0HE{;l%l*X(=!ePwS22fvtts++ zR@4NwyHN9-sL9ke;$HH+d>cIsvbC?Vfi@r;K7Ej$m4OYiQ6yKO+1Pe3i1jPf_Mz8{ z@?q*#tc}N-za*NC(mvul2KiYdUN+HKm{BWT!LrlnPqCuu6Htp*| zWNW)|huSVgj+C;N$KK~|u3h1%Jm)?uR?P2T9IsN!Xi*75{vQv2{ekAreBP=!M_A0KBb3yNl97_$MRA@b;!fRFacZS_ehMLe}Atw5|xk8AxnLeXxv^?7xaH&u;okml6Ha}pr4yz|dM{-u zy;%6A7Jd2BB47Finn5E0LA~k~Iw*#3BfV?rRyCCvN#emKTf_O0A~T36MmmB7W$R-a zzF|XT%GPo^6h;stTehC#`e3tX8GLoDBVPrwb%atfvLFg&tDa`j=mb$LTOQg(Mz^-9 zbPtlP_2j^~4Y^E`t)_e|xmkuVcg&*t8rhmoH(etSVu@`16*avfR>)Q|Qp-orHL}&5 z4vx_eVuNgX`JTZ!!55Lh0~pOo+1ia4;|FV~XT5AyBY_gsG|1KqyzPS>ind}jV^QQ+ zEUcO_4#z#HSTo_dY(4eNRIG9&P!5r;SZ_m2Ma&$BGVZK9ey#rh5tG5s|X1&Xzk zzww}%R6@;+IcPjeu{I)`d5=?oNs85nUwSb8rtKKb62x4h(2Mb9da+AM;H`(aTeNq0 z3-G~1Otyhf9g>zTHb>uZ4K1M~=>A#8Um22?H5Ip$|8yIOcMwM?&XedZu}8exHte1~ zVoT!OL>HT#mf)c87aJ-lDG``T1A8b6Q}i0GV>G@AyGt>7xHrZHv9#)H{y=exc{eso z+%~MQirZVj|)=)i4LE_H8N{=atMo;zyc;BbKN@>S^in)46 zoyfl{PO+;g0k3y1brK0YLxxB|mh^=*@m?=V^bhzSN|MvNV#hqUni6X91G(MCjF(oW zQG`7h#3n?L)Ni7BRY}vB>6r9?Ly=Ftm#;4gn73l(wxT3kO~8_FgPo&}<8>toy$7RY zJ4y=G6102+cCp%t?rp|S*rU|%(PkIyNop>3$Zpuv)VWCOP1sdx1MfaGP`M7Zdr-1Q zosT2A5B3JN2uET+>@Dis*s2F$Z&OdxUEeqedzbnOq9202Pu&drFzk2KGPFMe`=r_n z5#NDbuXaIJ@4{|Suh9FY@!kjg!=Wknv_%fbQSN0{5P|;+p)>0)?E4QOe9StBno|&d zX1$1-GY~;$)zfqubr6}%YT$PdGlShRtDjz?iacg5MB~p;U%;$fEWzgxh0GempBR=? zJPHTzdlXeMYa;zIE<@BX3-7ANKOmMc>nv>&L%e{mVCf2)Id9-=Sb8VqCX4se4J`e0 z94(JfTbN`t;q8VuXLY>qaFZ!~?C?PEILuZL_8e`AMBH(Wo(x}el0N|zx$F{EM8yXr zsU=&t<}LKw$UH*d8(woC z5t7DcNBULG|F zl0tVD`e>q?Ss47BngH-~c>=(XZ{jb3pTE!(;Rf&%OT$hLgP+u23x3e;M)0$B;!lAe zO75G9F2%VX@7y}+2D~$J67bHWlYR;B;7K3CJFo@bIZfSu9`A^5A-p5{5#DJtIgEEu z6qNiE_<+g30`EB9T)g9WTf|?S9L75+3gaD!Y{~y6|6(%mPSdh5-swtv;xy7tQDtcGQY39S(71j4m5KyouOEhQ+X^sA!`?v z_h$|s2m>MhS%sNYkL|XDHKrGiF#Nel$vW^SkuB$49=d`3OnWHIe%!Y7UJ_T{L-{QV&yo|Gv)uV+6Krl4Z^lra05fU$(w&m$zl>}Ms3F#Fj=BFujFkqEP&vn0ao z2hGClN2VzYvmb~s`=MsM%T%zR5mUqL2Ytir2f@Sa2O`XVAi#chPZjLv(6k%aPtkNU z=(3+N6gA9#u&QD913~PE|7p6(*75(Cego%;m;uhydd3Z$=iV9MJX2?+Ib`@M=b=!J zP&C0l%Vh-dO4g6q&k))wreHs&U_WMO8jx%X_G1e6V>;}|A7VcXsE1aLMX!>BWJ}r< z46B;^9!_*(+f-sj<;ph5BciHGyEevt@?%tJ&7f`|~;W}3-$^oFLd z5+e(0g~;P+Au=WZVxBwm|AmC`g6`A$(arFBB!rruMnW6uF%d>Wlqmmbrk>;?A>@5M z65_G5O!g7am<9ZkKP#>0kMR#Z6?*<)CpJMtkc_^O^T$e`!^X~BI}vAHHyQj$Wui<_ z=hI3D>ZDiy4Ag1vLLFyD{%@$`FXD@;)3SaM>R^k6p$-H=9sXf;BJ0a9SNlfZ$Zu}) zQybgiH)2v`dpN#TTHqtvC)+6s2@Aq6+YZwa+fcS0rUQ{F+YZx#$d>Kr_``F|B8TbZ zlm7zQc9;%Cp=>)$2clTE9j3FA#3_)_6vOF+z#{-cWACz>F^t^ zISo*;9ex9mt=QM{8+wLNX46cn$y02H-&iCH6niHIFryWTLdEWbZ}4hhnqtMimg(5n zG99}Q`qZEqFMXuh^>AlsGOa@bf9jF646zli!W~*gN4U4$d_`<2$-jZ0d*tVUkH3uj z=cNt)ZNNwD6o(1#Rm72NUOt-W=c4PeD%E45bwdV6Yn`NFU)(e_Ac*% z3Em^m5AzM-`@SgYuA>M=5sP9pXK(L%auei1)w_@gCSA-UB_^DuzrQHM*j-d{W7<(%Kz6o@CzAX%(eq z6H3O_j@tFTw@JH-@srw>4jVUm!srUeMcZMuCHq^+{P_c4@b@DPuk)XfI<~Ln2Lon& zv~-d3!@tY)4U2z0`6W4_w*KQmikm}ixASute=jo52z8Z)jTtKpYoF1%l|A04`+4<%gpF?zg(%1A*gm=3hCdU+%rN z+*?(*s;fVThA*{-FSYdtSy79)=A(m|?VEkmXLW}U8Uh`)m2HCx{nO~N=wb9k(o<8n zk}1u*H-XKjr!_sfz25&~%drRUI9Ohk+;;7H>*aeJ`H6pi%|Cp6{Si^Z{I&V&VojWi zC>94J{Gu@O!N@B*cBq)rzxG7ra*egAou?m451GcayCPmc+Eh`Zhk6yIujt+*L2U1# zH@m{8D5@vwx@h|2jp|K*wAaMp9?AT{7_wxPQy8imaYDq5YLmT{TB@0y$)r6SOJbW1 zDD_4hBfEBxMxnONMd37bb`J`*7%s+-3P!&{jy?X~uskGIjcVTPIco1oT1$o|)e#Y0 zX%_Uw;;m7c&3ei}A`Ziq;VGkbTBC>>osqFZSClAwJmyQUk0LpEABo-da@aGkC40W2 z{a0L#AXM6Yfb^m_)fp$`%(MyDsWYC;x;!IZ@hKw(nJ;fus4 zqfNF#H0GJCy)ed@Nl&45G()$OcqB#OHKbC>b40hEW>rfXk~e`3pz=9<9nGHC&sNhi z&*ej*B(qvlYIqkKnb%_PQnkhWI9y)J4w15ypMug(Dl7T-P})mn4gVQRmQ>dB2#oGB z)<|tO@mWwhA`XwTo$nO&W7?QeoNTKeMuzFpD1ZF#BzyIGk=iRS=6hNvZ#TA^OumoA z#9nC$pVJiS^HC?RfU-fak>WA&+*m6ip9a-5>2j(OcbcZSX$poPca1ncHk(Zqski3D ztfBElcT$&=-S?vyc69FDMq302N1P4$!*N1_fj*jSI}=loGIFs1v#1CaH(_f*%@WjX9{3Dtt zp0pL>mn6nME%Q0b5PuujI(ih{G{Co z`CIW>emct*-rnt5fyn8dUNw=1W9XjuE}_!RGz6omXGQ|a0UEs#?J0o$Ti9bfM_{i* zZ`@PnR}^!kV#InrZ9&$B@Mm}eDI^c3jbkKv@|u$zh2E1rRwBu_qh$-v0?0YEghqKmFZW5*e)r|MBOua2zg$I#ttAJRN| z=-lv>Vp5-{E(~L5Iu*63RE%9{rL-9DN=%o1NvqqJlr_B@23Ut?UOGlRldyb4sKbD< zSG-wZa@lTQC>nu1EoTrsk5TK0T2k7Keg9z3gP{OLFDkTS%}t5s4e*lN_~ z<0w0gN~!qyVYt3cDgpj1(rJq9EyzDd-b{7<{70<6wt{8Vwz_Tr%e@XAY>}~Ryaax> z%4*)!kz*+Vwz+=3M#(E|4GqE1Pf_w1ud+qtA;7zez-^|Q@`QN5UwbZl+ZF0f#1&>F z%gTF0mC?Mc+g>IYo!foy^%wVU)roygHXP<@(wEie)-QTW4_8UIcOIyv$ z%dn2|Y6|upug11+rgkL7&o^Q9E>ZJI3GiKXIvNS;a8iPNBTD@0G*YtootObrR?Fd8 zSl%S{Q7Y-q?}MLYspRtntX>MLiFf+9X5GY({WG$c!(WDMTf^I6aJF>5n3rSvGo`YW ze~0vIEtQpgN$ri-H)X6+48LJEuY&VIs*^hXMdJ--ZVsk;sOmxL@MqBS78M!j=Py7R zCY1osMayET1o>-N-x3u$k;PvUeFt>s0};(=6{o`(UMH3h$Y51s#{kor*753nw8fY5 z%S6L~bau6f9+(y@H_~J`7TSAV2b#Tpp!taM;KpD~QBTv>NMBAtDCxgY?=1aFicwA9 zOLeq#obsOZ%gJ4Yk`fK)MwQyK8J)p3;*o)E6MNBQD(M5LE=!+EvYLK`MxZGvDdOnB zG%okhJ+AYh@ZC7H-!qtqB_R{m!cjE-D%SiVId(74h4Qde4Bj3qyHqNEXZJ0WN`N|b@qI(%OHn)5$762Bc=~Bvj2tzSu2ApXbH zAL>48Rm{g@&7YIi#_-ePl|ccPERGCH<8ko1D>OSIw#ZC6i4@%}>l#k*Z>dNFKV5M0 ziY!(p#ulaJ$z`r}8_G9>qqwKli?Y3!Z$L;J&h2cY+nMSW`-=RTazZxC3Rzqx?G~xz z@Etgzwo0YDlCn|6-sC3N_OMsc{U$3`&hP6^uS!azsJtmHTMp};(6F%Rj^ajlK=$h8 za;Wc0g@!8j++-%p5I&HmpcBG}Qpr+M-gw||_mqfXa~UyrS=zWGX~Y7t_~;FivOUZpu(Sk9-TXsMMYqZOmGyoh+6le&xM9NTj4 zx@x$#`jwP&kvb%;P_9dlbNg`=jbDSD%GHp1US5nNCr>Kw@!wN+>Q615FhwzXY4_8` zBA~PyCGH>M&-jIA(3b$GUOkRh)aPGIcMZc@Ocq~~e6gukh1fsD48n^q15Sdf^$iW* zXG6(St+li%d_gEVsI}Yi3e;jcQG&L)VuNWwB~CprkjHrK;5dp%tLzO4aH_ z8^?D&lr^fAAa)Mz9^8Nc24ge_Rci+>#<$c^%X-y%2mzF!q(QZ|i*~nk9I^+aDT67X zSy(mSIBfTzX5EjTC$FZKS(-Hm0aQTA(X4+#nF^oXHS0l)aN0U5$=56n2h%r`Qm9#V zV%sfd(j=QMdK|Q%@1HSi{W#zMi=8Vbg@fmE7}foQ?z$D z1;o%{Cfg>a4ogdx$>1IEq@J3j2^Z=H06XfptY;mL{q4#81w!%`R zPeILXkc;(Bbhi0kg*--&rQ4ftJLF0F^~jJNkf-T$5!P#vtM#8mx8dnkFQ9ZMEGzX# zuqEptuhGk~C3ZtzuOC4s?SZ^WKS`&)?`_E2^|#=CFXTG?4aoZ-zoXAb{r!*+>NmsV zJCN)3o{0PaI%pIf?_ahIP(4@D1K&rkCKm}1emo0 zC5NB{nN?5I={o`?i&>50x)Ek@0Qx`KNCo-KT7k-6puCV-eX#^zLMdX_bg^he_u`q@ zct5~Y&8%7U$9D!w4YP1p_5BQGF|!U+lKA8Wd@0L_LpA3HzLI71L2RnLpRQpUUt(){ zq_&B`o0h!j_hdQ`;5gSNc?MkLL`=2zN@G|))vMq$=KG*MPX@H z#6Vi&fnr{1DmyBkEN%T4qxp-`{KaVgETdub#Mp72^TyF9M5K8={YIJl>3hR#))66T zVqQ+ay4gr~<)-Eux++JT8T1=tdhp3%7Lz^JyoxM_xnBHxTxQHXvir@e>DM&(ix%T^ z*=SKb9^hxu_%Qfsr0tySf}dPEu9CkM?~e!gIXxcWCv!p={9HvKC)ou*^^jfgvz}m2 zvI~BCnIya5=K#q`68z-T`zv`Non!=l?t<)spJyo8WEcD_Od{C@Kc^tO;OD0lI$6#G zKOav3_&GBH;Kx7l_rTBV^v=2f{KV3*Q^VjV^^bxdG`kS|Y@B#8@WVQbZzsAG=X|_# z)uapX&geN1=c*p5&nfOO}81KLo#ye1Ql)%s8t8(C-OD2c$P8Z6FKZ|$JTNv*+e*Pm?O`fg# zn~7ExY4I_X?~!H=?VBjGR_>mA#7z|~n$3{A*3A$es|LZ@Yl~OuH@2e%!irFA1}sK!VsDYIBzTe197dPs)_s z^V!dYDJWPnCCq*%U@Rf_b0;Zb_OpzXF#B0YN|^oBkrHM{h)1_{lIyc{Xhw`A1GiyJEltZvv=AB>}SYyGw8CPTghvf{a{tY z><0?5AMy9;CVNS|H2nh36EOpvr|pajIL{3;zWSCm7+is*a$MQBjGSaf?q_U{rQ8F`2ZK_Ma}_#I|)1KrS!<#J>}UW7OvkxG^l zcwFS&@joG<4Rmev^NS%Nlw2GMt)n5h@EM&(;{;w@K3?a zwA^3gA9^deEXd^~boMg9D!bqqGy#j!Q*3ASGdT-_*Ktj&Ex=6^GR|#)6s!nGP z5^@;XW@lo_!LV70Y@?Vl>q7eT?5r^TksT<3MsZ}83$?=ZN5oc{L6`KLG+{i>aUuObUdK(!sFBhyf|9i{^%OSK)Q10_ebw}{*4m_r<wa;ZbwuLx)!SyuN-i1%ns~f0VwQ8>tr{^cl!MjKL!G`lap!Dj>06l?amOvgT#>DYtOrUunS>76ak zhdaZQX&u^%hwn_wl&NqQ?$9baihJx9Xfmagz&7#eoxcTq0`o;+UfR$<2Yh6vI81n# zCbwM6im^l|>!jBJcOj6>6oNqFv3aQ>-h*W)-m_<3nD=1qUETu`yhpt&%zLoD7vVjK z;C$XQ_O1}``HC7fMU^Hr`M>5pun_NAcUOq_L{Qy~5bud-Mcy3VgXWU=oVqK-dtd_Z ziJu?hJ+Op$4`lG3e)B`T2bK`;fgIvJkVCu&a)|dp4)Gqy;62aJ5AhyYLc9lZi1$Da z@gB$_-UB(rdmx8+59AQd!YE4?eHEb z0cJbA2TG9H^)#KnBT%xK-6&qE`8Dsc9o~cTLS{R>2TBpMr;A@|Lc9m2YGymU2TBdI z9o_?FF|!@s17#@-y1WP4N)~i^541Hb=<*(D4)1yFZt$KRcZ2tQe0P}l_$VckUEYI_ zI3?ZXJwvFV=`8wLLeE*=vw*boc+WKpIwjV`$!fs73jy1-b^P zPl7#5;%nm;PG)SWn0L=%R$M#s-Vc*Yf25jteBXKU=F?w1zC1P0rVBS7-x)2hoWAt% z_=ZO29j9_UJ~blGPc}ThjVv#l>f-TjV0r&XS1mlgIgxp#WGk&*xprk#WUq;3g;RQn z883cPn^rrq2_I2XIc(~fv6ZD2lS)RE)-K+fpn6NERhCYkP%^G|!z&N5X6-A-PikK} zV%*pXV=JB3?MBqzu>A*b?eN{LRq<|QoY(meNSAjI3-^3oyX5Vbrua^cV_D*b&l76v kKOdyIUTeD^pToQ(#tj=cwxY5~9Egk$x2*m2L}c{;16a6)#sB~S diff --git a/src/sage-interface.lisp b/src/sage-interface.lisp index 7d1e980..52c9072 100644 --- a/src/sage-interface.lisp +++ b/src/sage-interface.lisp @@ -102,7 +102,7 @@ #| Convert a matrix of type matrice to an array |# (let* ((numfil (nlig matrice)) (numcol (ncol matrice)) - (rslt (make-array (list numfil numcol) :initial-element 0))) + (rslt (make-array (list numfil numcol) :element-type 'fixnum :initial-element 0))) (dotimes (i numfil) (dotimes (j numcol) (let ((Mij (entry matrice (1+ i) (1+ j))))