Robert Smith avatar Robert Smith committed 8bfa442

Add TRANSVERSAL-DECOMPOSITION.

Comments (0)

Files changed (2)

 (defpackage #:cl-permutation
   (:use #:cl)
   (:nicknames #:perm)
+
+  ;; permutation.lisp
   (:export
-   ;; permutation.lisp
    #:perm                               ; Type, Structure
    #:enable-perm-reader
    #:list-to-perm
    #:normalize-cycles
    #:to-cycles
    #:from-cycles
-   #:cycles-to-one-line                 ; Possibly will be removed.
-   
-   ;; permutation-generation.lisp
+   #:cycles-to-one-line)                ; Possibly will be removed.
+  
+  ;; permutation-generation.lisp
+  (:export
    #:make-perm-generator
-   #:doperms
-   
-   ;; permutation-group.lisp
+   #:doperms)
+  
+  ;; permutation-group.lisp
+  (:export
    #:perm-group
    #:generate-perm-group
    #:group-from
    #:group-from-cycles
    #:group-order
    #:group-element-p
-   #:random-group-element))
+   #:random-group-element
+   #:transversal-decomposition))
 

permutation-group.lisp

 (defun safe-sigma (trans k j)
   (safe-gethash j (safe-gethash k trans)))
 
+(defun trans-decomposition (perm trans &optional (k (perm-size perm)))
+  (labels ((next (perm k decomp)
+             (if (= 1 k)
+                 decomp
+                 (let ((j (perm-eval perm k)))
+                   (multiple-value-bind (k-val k-exists-p) (gethash k trans)
+                     (when k-exists-p
+                       (multiple-value-bind (j-val j-exists-p) (gethash j k-val)
+                         (when j-exists-p
+                           (next (perm-compose (perm-inverse j-val) perm) 
+                                 (1- k)
+                                 (acons k j decomp))))))))))
+    (next perm k nil)))
+
 (defun trans-element-p (perm trans &optional (k (perm-size perm)))
-  (or (= 1 k)
-      (let ((j (perm-eval perm k)))
-        (multiple-value-bind (k-val k-exists-p) (gethash k trans)
-          (when k-exists-p
-            (multiple-value-bind (j-val j-exists-p) (gethash j k-val)
-              (when j-exists-p
-                (trans-element-p (perm-compose (perm-inverse j-val) perm) 
-                                 trans 
-                                 (1- k)))))))))
+  (not (null (trans-decomposition perm trans k))))
 
 (defun add-generator (perm sgs trans &optional (k (perm-size perm)))
   (declare (special *product-membership*))
                            (reduce 'perm-compose (mapcar (lambda (s)
                                                            (perm-compose (perm-identity maxlen) s))
                                                          random-sigmas))))))
+
+(defun transversal-decomposition (perm group &key remove-identities)
+  "Decompose the permutation PERM into transversal sigmas of the group
+  GROUP."
+  (let ((decomp
+          (trans-decomposition perm (perm-group.transversal-system group))))
+    (if remove-identities
+        (delete-if (lambda (sigma)
+                     (= (car sigma)
+                        (cdr sigma)))
+                   decomp)
+        decomp)))
+
+;;;; Debug Routines
+
+(defun print-trans (group)
+  (loop
+    :with trans := (perm-group.transversal-system group)
+    :for k :being :the :hash-keys :in trans
+    :for vk := (gethash k trans)
+    :do (progn
+          (format t "~D:~%" k)
+          (loop :for j :being :the :hash-keys :in vk
+                :for vj := (gethash j vk)
+                :do (format t "    ~D: ~A~%" j vj)))))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.