Jump to content

Sky Slate Blueberry Blackcurrant Watermelon Strawberry Orange Banana Apple Emerald Chocolate
Photo

Lexicographical next permutation in O(1) time


  • Please log in to reply
6 replies to this topic
nimda
  • Members
  • 4368 posts
  • Last active: Aug 09 2015 02:36 AM
  • Joined: 26 Dec 2010
Note: I'm looking for a nice stdlib-compliant name to package this all under.
Note also: these functions are published under the WTFPL v2


What is a permutation?
   A permutation is a re-ordering of a set, such as (1,2,3) , (1,3,2) , (2,1,3) ...
A lexicographic permutation is a special type which involves the order of the set. The next lexicographic permutation of '32541' is '34125'. Numerically, it is simply the smallest set larger than the current one. This technique also works when there are repeated numbers; the next lexicographic permutation of '32127' is '32172'.

What do these functions do?
   I'm providing one function which works on characters (suitable for numbers and permutations of words) and one which works on arrays (AHK_L required) within the following examples:

Strings:
#NoEnv
StringCaseSense On

o := str := "adimn" ; You will see my name 'nimda' near the bottom of the permutations list

Loop
{
	str := perm_next(str)
	If !str
	{
		MsgBox % o
		break
	}
	o.= "`n" . str
}

perm_Next(str){
	p := 0, sLen := StrLen(str)
	Loop % sLen
	{
		If A_Index=1
			continue
		t := SubStr(str, sLen+1-A_Index, 1)
		n := SubStr(str, sLen+2-A_Index, 1)
		If ( t < n )
		{
			p := sLen+1-A_Index, pC := SubStr(str, p, 1)
			break
		}
	}
	If !p
		return false
	Loop
	{
		t := SubStr(str, sLen+1-A_Index, 1)
		If ( t > pC )
		{
			n := sLen+1-A_Index, nC := SubStr(str, n, 1)
			break
		}
	}
	return SubStr(str, 1, p-1) . nC . Reverse(SubStr(str, p+1, n-p-1) . pC .  SubStr(str, n+1))
}

Reverse(s){
	Loop Parse, s
		o := A_LoopField o
	return o
}

Objects:
#NoEnv
StringCaseSense On

obj := [1, 3, 20, 52.5], output := ObjDisp(obj)

Loop
{
	obj := perm_NextObj(Obj)
	If !obj
	{
		MsgBox % output
		break
	}
	output .= "`n" ObjDisp(obj)
}

perm_NextObj(obj){
	p := 0, objM := ObjMaxIndex(obj)
	Loop % objM
	{
		If A_Index=1
			continue
		t := obj[objM+1-A_Index]
		n := obj[objM+2-A_Index]
		If ( t < n )
		{
			p := objM+1-A_Index, pC := obj[p]
			break
		}
	}
	If !p
		return false
	Loop
	{
		t := obj[objM+1-A_Index]
		If ( t > pC )
		{
			n := objM+1-A_Index, nC := obj[n]
			break
		}
	}

	obj[n] := pC, obj[p] := nC
	return ObjReverse(obj, objM-p)
}

ObjReverse(Obj, tail){
 o := ObjClone(Obj), ObjM := ObjMaxIndex(O)
 Loop % tail
	o[ObjM-A_Index+1] := Obj[ObjM+A_Index-tail]
 return o
}

ObjDisp(obj){
	s := "["
	For k, v in obj
		s .= v ", "
	return SubStr(s, 1, strLen(s)-2) . "]"
}

Here is sample output for the second when the array is initialised to [10, 20, 30, 400]:
[10, 20, 30, 400]
[10, 20, 400, 30]
[10, 30, 20, 400]
[10, 30, 400, 20]
[10, 400, 20, 30]
[10, 400, 30, 20]
[20, 10, 30, 400]
[20, 10, 400, 30]
[20, 30, 10, 400]
[20, 30, 400, 10]
[20, 400, 10, 30]
[20, 400, 30, 10]
[30, 10, 20, 400]
[30, 10, 400, 20]
[30, 20, 10, 400]
[30, 20, 400, 10]
[30, 400, 10, 20]
[30, 400, 20, 10]
[400, 10, 20, 30]
[400, 10, 30, 20]
[400, 20, 10, 30]
[400, 20, 30, 10]
[400, 30, 10, 20]
[400, 30, 20, 10]
Note that the final permutation is the array in descending order (reversed from the start.)

Finding the next permutation happens in O(1) time, since generating all permutations is O(n log n) time. This approach is suitable for large sets, since the set is held in O(n) memory, permutations are generated one at a time, and no recursion is used.

Rseding91
  • Members
  • 703 posts
  • Last active: Apr 02 2016 05:05 AM
  • Joined: 07 Jun 2010
You asked me to find faster ways to do your functions and I found one so far.


Reverse_ByChar(ByRef String){
	If (A_IsUnicode){
		SLen := StrLen(String) * 2
		VarSetCapacity(RString,SLen)
		
		Loop,Parse,String
			NumPut(Asc(A_LoopField),RString,SLen-(A_Index * 2),"UShort")
	} Else {
		SLen := StrLen(String)
		VarSetCapacity(RString,SLen)
		
		Loop,Parse,String
			NumPut(Asc(A_LoopField),RString,SLen-A_Index,"UChar")
	}
	
	VarSetCapacity(RString,-1)
	
	Return RString
}

It will return a reversed copy of the string passed to it. (same as the reverse function you have now - but faster)

In the test I did I took a 174000 character string and ran it through both of the reverse functions. The one you have now took 12.5 seconds and the one above took 70 miliseconds.


If you want me to look into making your other ones faster you will need to comment and break them down into very simple parts so I can grasp what's going on :p

Also, if you want I can add comments as to what the function above is doing if you don't get it.

nimda
  • Members
  • 4368 posts
  • Last active: Aug 09 2015 02:36 AM
  • Joined: 26 Dec 2010
Your function makes sense, but I'll comment mine.
#NoEnv
StringCaseSense On

o := str := "adimn" ; You will see my name 'nimda' near the bottom of the permutations list

Loop ; This loop simply generates all permutations. 'o' is output
{
   str := perm_next(str)
   If !str
   {
      MsgBox % o
      break
   }
   o.= "`n" . str
}

perm_Next(str){
   p := 0, sLen := StrLen(str) ; P is the Pivot point. In 32541, the pivot point is '2' as it is directly after the 'decreasing order' part of the string
          ; Likewise, in 12354, the pivot point is 3 ('3')
   Loop % sLen
   {
      If A_Index=1 ; the pivot point is never 1
         continue    ; however this is a possible optimization as we might look backwards rather than ahead
                     ; such as '32541' looking from the 5 to the 2, rather than the 2 to the 5.
      t := SubStr(str, sLen+1-A_Index, 1)  ; current character, except the string is indexed 54321. 3 in 'abcd' is b
      n := SubStr(str, sLen+2-A_Index, 1) ; character after it (the c)
      If ( t < n ) ; pivot point found
      {
         p := sLen+1-A_Index, pC := SubStr(str, p, 1) ; pC is pivot character
         break
      }
   }
   If !p ; no pivot, string is in descending order
      return false
   Loop ; find the successor of the pivot, the smallest char larger than pC
   {
      t := SubStr(str, sLen+1-A_Index, 1)
      If ( t > pC )
      {
         n := sLen+1-A_Index, nC := SubStr(str, n, 1)
         break
      }
   }
   return SubStr(str, 1, p-1) . nC . Reverse(SubStr(str, p+1, n-p-1) . pC .  SubStr(str, n+1)) ; swap the pivot and successor, sort tail in ascending order by reversing it
}

Reverse(s){
   Loop Parse, s
      o := A_LoopField o
   return o
}


infogulch
  • Moderators
  • 717 posts
  • Last active: Jul 31 2014 08:27 PM
  • Joined: 27 Mar 2008
Very interesting, I'm not exactly sure how, but I want to find a super-practical use for this. :p

nimda
  • Members
  • 4368 posts
  • Last active: Aug 09 2015 02:36 AM
  • Joined: 26 Dec 2010

Very interesting, I'm not exactly sure how, but I want to find a super-practical use for this. :p

The main benefit of this over a recursive solution is that the whole list does NOT need to be held in memory. So it's actually possible to run 30! permutations without causing a stack overflow.

infogulch
  • Moderators
  • 717 posts
  • Last active: Jul 31 2014 08:27 PM
  • Joined: 27 Mar 2008
Hmm, I see. iirc, I had some kind of brute-force permutation chooser at one time, maybe I'll dig it up and see how it works with this.

nimda
  • Members
  • 4368 posts
  • Last active: Aug 09 2015 02:36 AM
  • Joined: 26 Dec 2010

Here's a really cool challenge that uses permutations: 24 game/Solve - Rosetta Code

Edit: I posted a solution for both generating and counting (much faster) the derangements of a certain number at Rosetta Code.

!n is easily and quickly counted by a formula from Wikipedia:

Floor(Factorial(n)/e+1/2)


Mathematically, that is:

!n = Floor(n!/e+1/2)