Re: Parens permutations

[barrachois]

I didn't make much progress on an analytic solution, but here's some code to traverse the permutations by brute force, and some thinking out loud. Kinda fun.

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]--;
  }
}