In what context did this problem come about?
- barrachois
#!/usr/bin/perl -w use strict; # Dear Monks # # I am trying to solve a permutation probelm and looking for # # pointers. The different permutation we can create by putting pair of # paranthesis before,after or in between given number. Example: for p +=2 # and n= 123, we may have: # # (1) (2) 3 # (1) 2 (3) # (1 2) (3) # (1 (2 3)) # ((1 2 3)) # 1 ((2 3)) # # etc.. # Thanks, # artist # # -------------------------------------------------------- # # Given n=3, p=2 as above, without parens we have n+1=4 # places where parens can be placed, i.e. on the dots in # # . 1 . 2 . 3 . # # Assuming that arrangements like "() 1 2 3" are illegal, # a left-paren may be placed at a dot numbered # L=0..(n-1) and its corresponding right-paren at R=(L+1)..n # # Therefore the number of ways I can place a single pair # of parens around n digits is # # 3 (1) 2 3 , (1 2) 3 , (1 2 3) L=0; R=1,2,3 # + 2 1 (2) 3 , 1 (2 3) L=1; R=2,3 # + 1 1 2 (3) L=2; R=3 # --- # total 6 = (n)(n+1)/2 # # Now let's try to place another pair of parens. # These can be put at the same dot locations; # the trick will be to avoid counting arrangements like # "(1)(2)3" twice. For visual clarity, I'll use # sqaure brackets for the second parens, working # forward from the six single paren patterns above. # # For the first pattern "(1) 2 3", adding a second # pair of brackets again gives six possibilities. # # [(1)] 2 3 , [(1) 2] 3 , [(1) 2 3] 6 new # (1) [2] 3 , (1) [2 3] # (1) 2 [3] # # However, trying the same approach to the second # pattern "(1 2) 3" starts to give arrangments that # have already been found. (Remember that the [] # and () symbols are actually identical and interchangeable.) # # Try all six combinations starting from the next # single pattern "(1 2) 3" gives # ([1] 2) 3 *OLD*, ([1 2]) 3 *NEW*, [(1 2) 3] *NEW* +5 new # (1 [2]) 3 *NEW*, (1 [2) 3] *NEW*, # (1 2) [3] *NEW* # of which the first is a repeat of "[(1) 2] 3" and # the rest are new. # # Continuing in the same vein gives # # ([1] 2 3) *OLD*, ([1 2] 3) *OLD*, [(1 2 3)] *NEW* +3 new # (1 [2] 3) *OLD*, (1 [2 3]) *NEW*, # (1 2 [3]) *NEW* # # Hmmm. I stared at this but haven't really found an obvious pattern. # # But whether there is or not, feels like its time # to write some code. If I loop over all the possible # positions of the left and right parens, as I'm doing above, # I can just remember which ones I've found already in # a hash, and keep the new ones. # # This may not be the most efficient, but it'll get the job done. # # Here's what the output look like : # # Looking for permutations of 2 pairs of parens around 3 digits. # ((1))23 # ((1)2)3 # ((1)23) # (1)(2)3 # (1)(23) # (1)2(3) # ((12))3 # ((12)3) # (1(2))3 # (1(2)3) # (12)(3) # ((123)) # (1(23)) # (12(3)) # 1((2))3 # 1((2)3) # 1(2)(3) # 1((23)) # 1(2(3)) # 12((3)) # Total number of permutations = 20 my $n; # number of digits my $p; # number of paren pairs my @leftparens; # count of left parens at each position my @rightparens; # count of right parens at each position my %seen; # permutations generated my $DEBUG = 0; init(3,2); # define n,p print " Looking for permutations of $p pairs of parens around $n digit +s. \n"; addParenPair(1); # add first pair of parens, and others recursively print " Total number of permutations = " . scalar(keys %seen) . "\n"; # ------------------------------------------------------------ sub init { ($n, $p) = @_; @leftparens = (0)x($n+1); @rightparens = (0)x($n+1); %seen = (); } # Convert current permutation as recorded in @leftparens and @rightpar +ens to a string. sub permutationAsString { my $result = "("x$leftparens[0]; for my $digit (1..$n){ $result .= $digit . ")"x$rightparens[$digit] . "("x$leftparens[$di +git]; } return $result; } # If we haven't seen this one, remember it and print it out. sub analyzePermutation { my $permutation = permutationAsString(); unless ($seen{$permutation}){ $seen{$permutation}++; print " " . $permutation . "\n"; } } # Recursive descent routine to put in next pair of parens # and analyze the result if all the parens have been placed. # If $DEBUG is true, it'll also print some progress reports. sub addParenPair { my ($whichPair) = @_; for my $left (0..($n-1)){ $leftparens[$left]++; for my $right (($left+1)..$n){ $rightparens[$right]++; if ($whichPair == $p){ analyzePermutation(); } else { if ($DEBUG){ print " "x$whichPair . "Permutation so far is " . permutationAsString() . "; adding pair " . ($whichPair+1) +. "\n"; } my $lastCount = scalar(keys %seen); addParenPair($whichPair+1); my $newPerms = scalar(keys %seen) - $lastCount; if ($DEBUG){ print " "x$whichPair . "new permutations added = $newPerms. + \n"; } } $rightparens[$right]--; } $leftparens[$left]--; } }
In reply to Re: Parens permutations
by barrachois
in thread Parens permutations
by artist
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |