Permutations()

Post your working scripts, libraries and tools for AHK v1.1 and older
wolf_II
Posts: 2688
Joined: 08 Feb 2015, 20:55

Permutations()

09 Jul 2017, 07:13

Hi all, :)

while I was writing a script for finding real-word anagrams of an arbitrary string of characters, I wrote the following helper function.
Forum user Helgef encouraged me enough to present my function as a stand-alone in this sub-forum. (Thank you)
Permutations() uses recursion to produce n! elements stored in an array, where n equals the length of the input.
E.g. you input "EASTERN" (n=7), and you get back an array with 5040 (n!) elements.

Code: Select all

;-------------------------------------------------------------------------------
Permutations(Word) { ; return an unsorted array with all permutations of Word
;-------------------------------------------------------------------------------
    If (Len := StrLen(Word)) = 1
        Return, [Word]

    Result := []
    Loop, %Len% {

        Split1 := SubStr(Word, 1, A_Index - 1)      ; before pos
        Split2 := SubStr(Word, A_Index, 1)          ; at pos
        Split3 := SubStr(Word, A_Index + 1)         ; after pos

        For each, Perm in Permutations(Split1 Split3)
            Result.Push(Split2 Perm)
    }

    Return, Result
}
This is a simple recursion without any sorting of the result or detection of any duplicates.
Recursion is a very powerful technique, but this one calls itself from inside a nested loop, and is too slow for my anagrams script that I was working on.
I could use Permutations() on up to 8 letters input comfortably (8! = 40,320), on 9 letters input (362,880) it is painfully slow.
Performance on 10 letters input (3,628,800) was unacceptable for my purpose.

However, the function may still be useful for other scripts. Enjoy :D

EDIT: removed a surplus line of code
more edits: I changed all occurrences of Permutation() to Permutations() to match the name of the function in the post.
Last edited by wolf_II on 12 Jul 2017, 09:20, edited 3 times in total.
Helgef
Posts: 4709
Joined: 17 Jul 2016, 01:02
Contact:

Re: Permutation()

09 Jul 2017, 11:03

Cheers! :beer:
And next the anagram script...
wolf_II
Posts: 2688
Joined: 08 Feb 2015, 20:55

Re: Permutation()

09 Jul 2017, 12:08

I was thinking about the limiting conditions:
When called with an empty string, then Len = 0, the Loop gets skipped, and the empty array [] is returned. OK.
Maybe I could use <= 1 in the first line? But I see no reason for that, the recursive calls never use an empty string.

When called with a single character, the character is the only element in the returned array, also OK.

When called with longer strings, a single character gets taken out, and the string (Split1 Split3) is never empty.
We can safely remove the line If StrLen(Split1 Split3), I think. Am I overlooking something?
I can see reason for this, saving a lot of concatenations, calls to StrLen and If. They all add up.

Btw, Anagrams
Helgef
Posts: 4709
Joined: 17 Jul 2016, 01:02
Contact:

Re: Permutation()

09 Jul 2017, 13:24

I think it would be safe to remove If StrLen(Split1 Split3), I think it will have minimal impact on performance though.
Found it!
carno
Posts: 265
Joined: 20 Jun 2014, 16:48

Re: Permutations()

25 Jul 2017, 12:35

Any real examples?
wolf_II
Posts: 2688
Joined: 08 Feb 2015, 20:55

Re: Permutations()

25 Jul 2017, 12:46

Code: Select all

; simple example with string of length 4 gives back (4! = 24) permutations
; use with care (5! = 120) permutations don't even fit in a MsgBox


For each, Perm in Permutations("abcd")
    MSG .= A_Index ".`t" Perm "`n"
MsgBox, %MSG%
ExitApp


;-------------------------------------------------------------------------------
Permutations(Word) { ; return an unsorted array with all permutations of Word
;-------------------------------------------------------------------------------
    If (Len := StrLen(Word)) = 1
        Return, [Word]

    Result := []
    Loop, %Len% {

        Split1 := SubStr(Word, 1, A_Index - 1)      ; before pos
        Split2 := SubStr(Word, A_Index, 1)          ; at pos
        Split3 := SubStr(Word, A_Index + 1)         ; after pos

        For each, Perm in Permutations(Split1 Split3)
            Result.Push(Split2 Perm)
    }

    Return, Result
}
wolf_II
Posts: 2688
Joined: 08 Feb 2015, 20:55

Re: Permutations()

23 Mar 2019, 11:45

I improved the speed of the function by memoizing.
Probably there might be a need for thinking about memory management.
current function creates massive dynamically increasing in size memo-array.

Code: Select all


;-------------------------------------------------------------------------------
Permutations(Word) { ; return an unsorted array with all permutations of Word
;-------------------------------------------------------------------------------
    static memo := []
    if memo.hasKey(Word)
        return memo[Word]

    if (Len := StrLen(Word)) = 1
        return (memo[Word] := [Word])

    Result := []
    Loop, %Len% {

        Split1 := SubStr(Word, 1, A_Index - 1)      ; before pos
        Split2 := SubStr(Word, A_Index, 1)          ; at pos
        Split3 := SubStr(Word, A_Index + 1)         ; after pos

        for each, Perm in Permutations(Split1 Split3)
            Result.Push(Split2 Perm)
    }

    return (memo[Word] := Result)
}
DRocks
Posts: 565
Joined: 08 May 2018, 10:20

Re: Permutations()

23 Mar 2019, 16:46

Hi wolf, this is quite interesting.. I've tested with the 4 letter example.

Is this the kind of things that are used to find secret codes / passwords ?
Lets say this thing would try all alphabet and numbers it could potentially contain the right password?
I'm not even thinking about doing this but its cool like in movies when they try to unlock a door with what looks like this kind of permutations.
wolf_II
Posts: 2688
Joined: 08 Feb 2015, 20:55

Re: Permutations()

23 Mar 2019, 17:00

No way. It would be that kind of thing. or something similar lets say. The universe may not be around for long enough, who knows. :D
What you can do is: stress-test your PC. potential running time for the number of permutation of a 20-letter word is too high for resonable result.
Based on my belief, not knowledge. I only tested with 8, 9, and 10 for a anagram-searcher.
DRocks
Posts: 565
Joined: 08 May 2018, 10:20

Re: Permutations()

23 Mar 2019, 21:36

Its very cool. I liked. But the 12 number attempt never ended I did ctrl alt delete out of it lol... I thought my 5ghz cpu would do it in 2 seconds but not even in 5minutes lol
wolf_II
Posts: 2688
Joined: 08 Feb 2015, 20:55

Re: Permutations()

24 Mar 2019, 03:14

Just for fun, and a bit to help myself visualizing, I wrote one more little demo. (code is still messy)
It shows me what a "CodeCracker 2000" would look like, and how much time needed ...

CodeCracker 2000.zip
(2.75 KiB) Downloaded 115 times
DRocks
Posts: 565
Joined: 08 May 2018, 10:20

Re: Permutations()

24 Mar 2019, 14:55

This is very nice I have experimented with the code
SundayProgrammer
Posts: 143
Joined: 25 Dec 2020, 12:26

Re: Permutations()

25 Dec 2020, 12:37

here is my go.

Code: Select all

s = Auto;Hot;Key;Permu;Sample
a := strsplit(s,";")
loop % a.maxindex()
	r .= pf(a,a_index)
goto display_result

pf(a,n,i:=1,c:="")
{	loop % a.maxindex()
	{	z := a[a_index]
		if !instr(c,z)
			if (i < n)
				r .= pf(a,n,i+1,c z)
			else r .= c z "`r`n"
	}return r
}

display_result:
	gui, font, s20 bold, courier new
	bh := a_screenheight - 100
	gui, add, edit, readonly h%bh% vscroll, % r
	gui, show
	return
	guiclose:
		exitapp
Eureka
Posts: 65
Joined: 03 Apr 2018, 13:31

Re: Permutations()

26 Dec 2020, 17:52

A "shooting from the hip" suggestion:

Sort all characters first
If character = previous character: skip.

Return to “Scripts and Functions (v1)”

Who is online

Users browsing this forum: gwarble and 121 guests