How to resolve the algorithm Permutations by swapping step by step in the Common Lisp programming language

Published on 12 May 2024 09:40 PM

How to resolve the algorithm Permutations by swapping step by step in the Common Lisp programming language

Table of Contents

Problem Statement

Generate permutations of n items in which successive permutations differ from each other by the swapping of any two items. Also generate the sign of the permutation which is +1 when the permutation is generated from an even number of swaps from the initial state, and -1 for odd. Show the permutations and signs of three items, in order of generation here. Such data are of use in generating the determinant of a square matrix and any functions created should bear this in mind. Note: The Steinhaus–Johnson–Trotter algorithm generates successive permutations where adjacent items are swapped, but from this discussion adjacency is not a requirement.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Permutations by swapping step by step in the Common Lisp programming language

Source code in the common programming language

(defstruct (directed-number (:conc-name dn-))
  (number nil :type integer)
  (direction nil :type (member :left :right)))

(defmethod print-object ((dn directed-number) stream)
  (ecase (dn-direction dn)
    (:left  (format stream "<~D" (dn-number dn)))
    (:right (format stream "~D>" (dn-number dn)))))

(defun dn> (dn1 dn2)
  (declare (directed-number dn1 dn2))
  (> (dn-number dn1) (dn-number dn2)))

(defun dn-reverse-direction (dn)
  (declare (directed-number dn))
  (setf (dn-direction dn) (ecase (dn-direction dn)
                            (:left  :right)
                            (:right :left))))

(defun make-directed-numbers-upto (upto)
  (let ((numbers (make-array upto :element-type 'integer)))
    (dotimes (n upto numbers)
      (setf (aref numbers n) (make-directed-number :number (1+ n) :direction :left)))))

(defun max-mobile-pos (numbers)
  (declare ((vector directed-number) numbers))
  (loop with pos-limit = (1- (length numbers))
        with max-value and max-pos
        for num across numbers
        for pos from 0
        do (ecase (dn-direction num)
             (:left  (when (and (plusp pos) (dn> num (aref numbers (1- pos)))
                                (or (null max-value) (dn> num max-value)))
                       (setf max-value num
                             max-pos   pos)))
             (:right (when (and (< pos pos-limit) (dn> num (aref numbers (1+ pos)))
                                (or (null max-value) (dn> num max-value)))
                       (setf max-value num
                             max-pos   pos))))
        finally (return max-pos)))

(defun permutations (upto)
  (loop with numbers = (make-directed-numbers-upto upto)
        for max-mobile-pos = (max-mobile-pos numbers)
        for sign = 1 then (- sign)
        do (format t "~A sign: ~:[~;+~]~D~%" numbers (plusp sign) sign)
        while max-mobile-pos
        do (let ((max-mobile-number (aref numbers max-mobile-pos)))
             (ecase (dn-direction max-mobile-number)
               (:left  (rotatef (aref numbers (1- max-mobile-pos))
                                (aref numbers max-mobile-pos)))
               (:right (rotatef (aref numbers max-mobile-pos)
                                (aref numbers (1+ max-mobile-pos)))))
             (loop for n across numbers
                   when (dn> n max-mobile-number)
                     do (dn-reverse-direction n)))))

(permutations 3)
(permutations 4)


  

You may also check:How to resolve the algorithm Sorting algorithms/Merge sort step by step in the Unison programming language
You may also check:How to resolve the algorithm Numbers which are the cube roots of the product of their proper divisors step by step in the XPL0 programming language
You may also check:How to resolve the algorithm Heronian triangles step by step in the RPL programming language
You may also check:How to resolve the algorithm Pick random element step by step in the C programming language
You may also check:How to resolve the algorithm Sort an array of composite structures step by step in the SQL programming language