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