pattern_enumerate.pl

   1 #!/usr/bin/perl
   2 # pattern_enumerate - enumerate distinct pattern features
   3 #
   4 # This makes it suitable e.g. to feed them to the MM tool.
   5 #
   6 # Example input:
   7 # (border:0 s:1234) (border:8 s:4343) (border:0 s:4343)
   8 # Example output:
   9 # (0:0 1:0) (0:1 1:1) (0:0 1:1)
  10 #
  11 # Auxiliary patterns.fdict file is created, containing the mapping
  12 # back to features, and assignment of unique number ids suitable
  13 # e.g. for MM input.
  14 #
  15 # Spatial feature is treated specially, each diameter being considered
  16 # as a separate 's.N' feature. You need to post-process the mapping
  17 # file if you want the original names.
  18
  19 my %f, %fi;
  20 my $fi = 0;
  21
  22 while (<>) {
  23         chomp;
  24         s/^\(//; s/\)$//;
  25         my @patterns = split(/\) \(/, $_);
  26         my @opatterns = ();
  27         foreach my $pat (@patterns) {
  28                 my @feats = split(/ /, $pat);
  29                 my @ofeats = ();
  30                 foreach my $feat (@feats) {
  31                         my ($fname, $fpay) = split(/:/, $feat);
  32                         if ($fname eq 's') {
  33                                 my $d = ((hex $fpay) >> 24);
  34                                 $fname = "s.$d";
  35                         }
  36                         if (not defined $fi{$fname}) {
  37                                 $fi{$fname} = $fi++;
  38                         }
  39                         if (not defined $f{$fname}->{$fpay}) {
  40                                 $f{$fname}->{$fpay} = scalar keys %{$f{$fname}}
  41                         }
  42                         push @ofeats, $fi{$fname}.':'.$f{$fname}->{$fpay};
  43                 }
  44                 push @opatterns, join(' ', @ofeats);
  45         }
  46         print "(".join(') (', @opatterns).")\n"
  47 }
  48
  49 my $pi = 0;
  50 my $df = "patterns.fdict";
  51 open D, ">$df" or die "$df: $!";
  52 foreach my $fname (sort { $fi{$a} <=> $fi{$b} } keys %f) {
  53         foreach my $fpay (sort { $f{$fname}->{$a} <=> $f{$fname}->{$b} } keys %{$f{$fname}}) {
  54                 print D $pi++." ".$fi{$fname}.':'.$f{$fname}->{$fpay}." $fname:$fpay\n";
  55         }
  56 }
  57 close D;