[Search for users] [Overall Top Noters] [List of all Conferences] [Download this site]

Conference rusure::math

Title:Mathematics at DEC
Moderator:RUSURE::EDP
Created:Mon Feb 03 1986
Last Modified:Fri Jun 06 1997
Last Successful Update:Fri Jun 06 1997
Number of topics:2083
Total number of notes:14613

833.0. "PERMUTATION STRINGS IN PASCAL !!HELP!!" by CSCMA::PICARD () Wed Mar 02 1988 05:55

    This is my first time in this math notes file.  I'm looking for
    a pascal permutation routine that will calculate all the permutations
    of a user's string input. (e.g. 'abc')
    
    permutations:
    abc
    acb
    bac
    bca
    cab
    cba
    
    
    any help would be greatly appreciated.  I'm in desperate need of
    such a routine, or just the bare procedure.

        
    michael
T.RTitleUserPersonal
Name
DateLines
833.1'Scientific Pascal'EAGLE1::BESTR D Best, sys arch, I/OWed Mar 02 1988 17:0315
>I'm looking for
>a pascal permutation routine that will calculate all the permutations
>of a user's string input. (e.g. 'abc')
    
>any help would be greatly appreciated.  I'm in desperate need of
>such a routine, or just the bare procedure.

If I remember correctly, there is a book 'Scientific Pascal' by Harley
Flanders that has a permutation generating program in it (although it
may be for numbers; it could probably be converted without difficulty).

The book used to be available in the DEC library at LTN 1.
        
    michael

833.2recursion is good food!MTBLUE::PFISTER_ROBSteak knife, puta hole in my headWed Mar 02 1988 17:2951
This is an easy to solve problem using recursion...
 
   IF the length of the string is 1,
      THEN print it
      ELSE 
          FOR each element of the string,
               DO
                  print that element
                  Print the permutations of the string without that element
                  END


below lies sample pascal code...dont know how big a string it'll handle
before stack overflows....

-Robb

{ example of a recursive permutation routine }
Program Permutes(input,output);

TYPE
  string=varying[120] of char;

VAR
  line:STRING;

{ delete l places from starting at i }
FUNCTION sdelete(var S:string; i,l:integer):String;
BEGIN
  IF length(s)>0 
     THEN IF i=1   { if delete from start }
          THEN sdelete:=substr(s,i+l,length(s)-l)
          ELSE sdelete:=substr(s,1,i-1)+substr(s,i+l,length(s)-(i+l-1));
  END; {sdelete}

{ already is the `header' to the permutation, line is the line to `permute' }
PROCEDURE Permute(already,line:STRING);
VAR
   i:INTEGER;
BEGIN
     IF Length(line)=1
        THEN writeLn(already,Line)
        ELSE FOR i:=1 to Length(Line)
             DO Permute(already+line[i],sdelete(line,i,1));
      END;

BEGIN
  Write('Enter line ');
  readLn(line);
  Permute('',line);
  END.
833.3side noteMTBLUE::PFISTER_ROBSteak knife, puta hole in my headWed Mar 02 1988 17:3715
as a side note to -.1, this does not take into consideration duplicate
permutations...ie `ABA'  will produce

ABA
AAB
BAA
BAA
AAB
ABA

you can either ignore this, or save all the permutation's into a list, tree,
hash-table, etc. That checks for duplicates before inserting. For reasonable
sized permutations this is probably the most efficient way to go.

-Robb
833.4Here's one...AKQJ10::YARBROUGHWhy is computing so labor intensive?Fri Mar 04 1988 17:0367
Well, if you weren't so picky about the language... here's a structured 
FORTRAN version of Nijenhuis and Wilf's Algorithm, from Combinatorial 
Algorithms (Publ. 1975) that is very fast - shouldn't be too much trouble to 
convert to PASCAL if you're that desperate. To use it, set MTC to 'true' 
and 
	DO WHILE (mtc) 
	    CALL nexper (size, index-vector, mtc) 
	etc.
It always computes the next permutation in the sequence by interchanging 
just two elements, mostly just the 1st two, so it's minimum effort. The 
integer vector is the index of the elements in the current permutation.

	SUBROUTINE nexper (n, a, mtc)
C For an explanation of this algorithm, see Nijenhuis & Wilf,
C Combinatorial Algorithms, 1st Edition; Academic Press, 1975
	IMPLICIT INTEGER (A-Z)
	LOGICAL*1 mtc, odd
	INTEGER a(n)
	DATA nlast /0/
C======================================================================	 
	IF (n .NE. nlast .OR. .NOT. mtc) THEN
C	    Initialization...
	    nlast = n
	    m = 1
	    odd = .true.
C	    Compute n!, and set up result vector.
	    nf = 1
	    DO j = 1, n
		nf = nf * j
		a(j) = j
	    END DO
	    mtc = (m .NE. nf)
	    RETURN
	END IF
C
	IF (odd) THEN		! Switch the first two indices
	    t = a(2)
	    a(2) = a(1)
	    a(1) = t
C
	ELSE			! Figure out which two to switch...
	    h = 3
	    m1 = m/2
	    b = mod(m1,h)
	    DO WHILE (b .EQ. 0) 
		m1 = m1 / h
		h = h + 1
		b = mod(m1,h)
	    END DO
	    m1 = n
	    DO j = 1, h - 1
		m2 = a(j) - a(h)
		IF (m2 .LT. 0) m2 = m2 + n
		IF (m2 .LT. m1) THEN
		    m1 = m2
		    j1 = j
		END IF
	    END DO
	    t = a(h)
	    a(h) = a(j1)
	    a(j1) = t
	END IF
	odd = .NOT. odd
	m = m + 1
	mtc = (m .NE. nf)
	RETURN
	END