(defun permgr-elements (l)
  (declare (type 'list l))
  (let* ((n (length (first l)))
         (end nil)
         (rslt (list (<a-b> 1 n))))
    
    (while (not end)
      (progn
        (setf end t) 
        (mapcar #'(lambda (p)
                    (progn
                      (mapcar #'(lambda (p2)
                                  (let ((p*p2 (permgr-mult p p2))
                                        (pos -1))
                                    (do ((j 0 (1+ j)))
                                        ((or (not (equal pos -1)) (>= j (length rslt))))
                                      (if (equal (l-cmpr p*p2 (nth j rslt)) :less)
                                          (setf pos j)
                                        (if (equal (l-cmpr p*p2 (nth j rslt)) :equal)
                                            (setf pos -2)
                                          (if (and (equal j (1- (length rslt))) (equal pos -1))
                                              (setf pos (length rslt))))))
                                    (if (> pos -1)
                                        (progn
                                          (setf rslt (append (subseq rslt 0 pos) (list p*p2) (subseq rslt pos (length rslt))))
                                          (setf end nil))))
                                    
                                  (let ((p2*p (permgr-mult p2 p))
                                        (pos -1))
                                    (do ((j 0 (1+ j)))
                                        ((or (not (equal pos -1)) (>= j (length rslt))))
                                        (if (equal (l-cmpr p2*p (nth j rslt)) :less)
                                            (setf pos j)
                                          (if (equal (l-cmpr p2*p (nth j rslt)) :equal)
                                              (setf pos -2)
                                            (if (and (equal j (1- (length rslt))) (equal pos -1))
                                                (setf pos (length rslt))))))
                                      (if (> pos -1)
                                          (progn
                                            (setf rslt (append (subseq rslt 0 pos) (list p2*p) (subseq rslt pos (length rslt))))
                                            (setf end nil)))
                                  
                                  
                                  ))
                        rslt)
                      ))
      l)))
    rslt))
                
  

#|
(permgr-elements (list '(2 3 1) '(2 1 3)))
(permgr-elements (list '(2 3 4 1) '(2 1 3 4)))
(permgr-elements (list '(2 3 4 5 1) '(2 1 3 4 5)))

|#






(defun permgr-mult (p1 p2)
  (declare (type 'list p1 p2))
  (mapcar #'(lambda (i)
              (nth (1- i) p2))
    p1))

#|
(permgr-mult '(1 3 2) '(1 2 3))
(permgr-mult '(1 5 4 3 2) '(1 2 3 5 4))
|#

(defun permgr-inv (p1)
  (declare (type 'list p1))
  (mapcar #'(lambda (i)
              (1+ (position i p1)))
    (<a-b> 1 (length p1))))

#|
(permgr-inv '(1 3 2 5 4))
(permgr-mult '(1 3 2 5 4) '(1 3 2 5 4))
(permgr-mult '(1 5 2 3 4) (permgr-inv '(1 5 2 3 4)))
(permgr-mult '(5 4 3 1 2) (permgr-inv '(5 4 3 1 2)))
|#



(defun permutationgroup (l)
  (declare (type 'list l))
  (build-group :elements (permgr-elements l)
               :cmpr #'l-cmpr
               :mult #'permgr-mult
               :inv #'permgr-inv
               :nullel (<a-b> 1 (length (first l))) :orgn `(Permutation group generated by ,l)
               ))


#|
(setf s3 (permutationgroup (list '(2 3 1) '(2 1 3))))
|#



(defun symmetricgroup (n)
  (let* ((l (list (append (<a-b> 2 n) (list 1)) (append (list 2 1) (<a-b> 3 n))))
         (rslt (permutationgroup l)))
    (setf (slot-value rslt 'orgn) `(Symmetric group ,n))
    rslt)) 

#|
(cat-init)
(setf s3 (symmetricgroup 3))
(elements s3)

(setf s4 (symmetricgroup 4))
(elements s4)




|#



(defun alternatinggroup (n)
  (let* ((l (list 
            (if (or (eq n 1) (eq n 2)) nil
              (if (eq n 3) (list '(2 3 1))
                (if (oddp n) (list (append (<a-b> 2 n) (list 1)) (append (<a-b> 1 (- n 3)) (list (1- n) n (- n 2))))
                  (list (append (<a-b> 2 (1- n)) (list 1 n)) (append (<a-b> 1 (- n 3)) (list (1- n) n (- n 2)))))))))
         (rslt (permutationgroup l)))
    (setf (slot-value rslt 'orgn) `(Alternating group ,n))
    rslt))


#|
(cat-init)
(setf a3 (alternatinggroup 3))
(elements a3)

(setf a4 (alternatinggroup 4))
(elements a4)



|#