CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Perl Programming Help: Intermediate:
permutation

 



zapzap
User

Nov 4, 2013, 2:37 AM

Post #1 of 9 (1901 views)
permutation Can't Post

Greetings, I'm trying to create a list of all the permutations of a word. This may be simple for some of you but not for me. Not sure if I should use recursion but I believe this is a common approach for short strings.

I know there is a module List::Permutor but I would like to know how to do it without the module.

Struggling...


Laurent_R
Veteran / Moderator

Nov 4, 2013, 8:54 AM

Post #2 of 9 (1894 views)
Re: [zapzap] permutation [In reply to] Can't Post

I gave a very quick try, but I have no time to continue now. It is still quite buggy but it might be a basis for you to work your way through it:


Code
use strict; 
use warnings;

sub shuffle {
my $flag = shift;
my $word_ref = shift;
my @current_word = @$word_ref;
return unless scalar @_;
foreach my $idx (0..$#_) {
my @loc_array = @_;
my ($elmnt) = splice @loc_array, $idx, 1;
push @current_word, $elmnt;
if ( scalar @current_word > 4) {
print join "", @current_word, "\n" ;# if ( scalar @current_word > 4);
}
@current_word = shuffle (0, \@current_word, @loc_array);
}
}
my @word = qw /a b c d e /;
my @current_word = ();
shuffle (1, \@current_word, @word);


I might try to correct it later today, if I get the time.


Chris Charley
User

Nov 4, 2013, 9:11 AM

Post #3 of 9 (1893 views)
Re: [zapzap] permutation [In reply to] Can't Post

Here is a method taken from my textbook , 'Discrete Mathematics and Its Applications' by Kenneth H. Rosen.


Output:

Code
ABCD 
ABDC
ACBD
ACDB
ADBC
ADCB
BACD
BADC
BCAD
BCDA
BDAC
BDCA
CABD
CADB
CBAD
CBDA
CDAB
CDBA
DABC
DACB
DBAC
DBCA
DCAB
DCBA



(This post was edited by Chris Charley on Nov 4, 2013, 9:14 AM)
Attachments: t6.pl (0.51 KB)


Laurent_R
Veteran / Moderator

Nov 4, 2013, 12:05 PM

Post #4 of 9 (1872 views)
Re: [Chris Charley] permutation [In reply to] Can't Post

OK, even though Chris provided an answer in between (with an iterative approach), this is a corrected version of my recursive approach. I think it works correctly:


Code
use strict;  
use warnings;

sub shuffle {
my $ref = shift;
my @current_word = @$ref;
$ref = shift;
my @word = @$ref;
print "@current_word \n" and return unless scalar @word;
my (@new_word, @new_current);
foreach my $idx (0..$#word) {
@new_word = @word;
@new_current = @current_word;
my $elmnt = splice @new_word, $idx, 1;
push @new_current, $elmnt;
shuffle (\@new_current, \@new_word);
}
}
my @word = qw /a b c d e/;
my @current_word = ();
shuffle (\@current_word, \@word);


Output:

Code
$ perl  shuffle.pl 
a b c d e
a b c e d
a b d c e
a b d e c
a b e c d
a b e d c
a c b d e
a c b e d
a c d b e
a c d e b
a c e b d
a c e d b
a d b c e
a d b e c
a d c b e
a d c e b
a d e b c
a d e c b
a e b c d
a e b d c
a e c b d
a e c d b
a e d b c
a e d c b
b a c d e
b a c e d
b a d c e
b a d e c
b a e c d
b a e d c
b c a d e
b c a e d
b c d a e
b c d e a
b c e a d
b c e d a
b d a c e
b d a e c
b d c a e
b d c e a
b d e a c
b d e c a
b e a c d
b e a d c
b e c a d
b e c d a
b e d a c
b e d c a
c a b d e
c a b e d
c a d b e
c a d e b
c a e b d
c a e d b
c b a d e
c b a e d
c b d a e
c b d e a
c b e a d
c b e d a
c d a b e
c d a e b
c d b a e
c d b e a
c d e a b
c d e b a
c e a b d
c e a d b
c e b a d
c e b d a
c e d a b
c e d b a
d a b c e
d a b e c
d a c b e
d a c e b
d a e b c
d a e c b
d b a c e
d b a e c
d b c a e
d b c e a
d b e a c
d b e c a
d c a b e
d c a e b
d c b a e
d c b e a
d c e a b
d c e b a
d e a b c
d e a c b
d e b a c
d e b c a
d e c a b
d e c b a
e a b c d
e a b d c
e a c b d
e a c d b
e a d b c
e a d c b
e b a c d
e b a d c
e b c a d
e b c d a
e b d a c
e b d c a
e c a b d
e c a d b
e c b a d
e c b d a
e c d a b
e c d b a
e d a b c
e d a c b
e d b a c
e d b c a
e d c a b
e d c b a

I haven't checked in details, but the number of output records is consistent with the theory. So, I think it is correct.


Kenosis
User

Nov 5, 2013, 1:31 PM

Post #5 of 9 (1851 views)
Re: [zapzap] permutation [In reply to] Can't Post

Here's an option using glob:

Code
use strict; 
use warnings;

my $word = 'ABCD';
my @chars = split '', $word;
my $regex = join '', map "(?=.*$_)", @chars;
my $string = ( '{' . ( join ',', @chars ) . '}' ) x @chars;
print "$_\n" for grep /$regex/, glob $string;

Output:

Code
ABCD 
ABDC
ACBD
ACDB
ADBC
ADCB
BACD
BADC
BCAD
BCDA
BDAC
BDCA
CABD
CADB
CBAD
CBDA
CDAB
CDBA
DABC
DACB
DBAC
DBCA
DCAB
DCBA

And in a more compact sub:

Code
use strict; 
use warnings;

print "$_\n" for permute('ABCD');

sub permute {
my @chars = split '', $_[0];
my $regex = join '', map "(?=.*$_)", @chars;
grep /$regex/, glob( ( '{' . ( join ',', @chars ) . '}' ) x @chars );
}



(This post was edited by Kenosis on Nov 5, 2013, 10:00 PM)


zapzap
User

Nov 6, 2013, 1:27 AM

Post #6 of 9 (1824 views)
Re: [Laurent_R] permutation [In reply to] Can't Post

Thanks Laurent. I'm going to have to spend some time to go through this. I was hoping that you would add some notes to help me walk through it. I don't know why I have difficulty with this topic.

zap


zapzap
User

Nov 6, 2013, 1:30 AM

Post #7 of 9 (1823 views)
Re: [Kenosis] permutation [In reply to] Can't Post

Thanks Kenosis. But I think your approach is a little too cute for me. I have enough difficulty with the topic as it is but having to decipher your approach makes it much more challenging. My hope one day is to understand your approach. Again, thank you for your contribution. I really do appreciate any assistance


Laurent_R
Veteran / Moderator

Nov 6, 2013, 10:20 AM

Post #8 of 9 (1815 views)
Re: [zapzap] permutation [In reply to] Can't Post

Feel free to ask.

OK, trying to explain it without currently seeing my code, I hope I don't make a mistake compared to the code. You should get the idea anyhow.

Basically, @word contain thez original list of characters. I basically have to go each letter, and, for each letter thus found find all combinations of the other letters (4 in my example). @new_word contains the 4 remaining letters. I pair the first letter picked up with each of the remaining letters. I then proceed recursively the same approach, so that I will associate each pair found at the previous recursion level with each of the remaining letters (3 in the example) and so one. @current_word contains the permutation being built, so that it will have one letter at the first recursion level, 2 at the second level, etc. On the other hand, @new_word has its number of letters decreasing as we go to the next recursion level. When @new_word is empty, I have used all the available letters and can print the permutation and stop the recursive descent, go up one level to descend the next available candidate.

Please be careful, do not use this recursive procedure with too many letters, it might take ages to complete (or blow up your memory).

Also note that if there are some duplicate letters in your input word, you will have a number of duplicates in the output. This can be solved, but nothing is done about it so far.

I hope this helps, but, again, feel free to ask if you need further advice.


Laurent_R
Veteran / Moderator

Nov 9, 2013, 4:15 PM

Post #9 of 9 (1754 views)
Re: [zapzap] permutation [In reply to] Can't Post

I thought that you might have thanked me for the explanations. But maybe I am too old style, maybe it is no longer fashioned to thank people who try to help you. Oh, well...

 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives