#!/usr/bin/perl use decrement_count; sub interesting_shape { # return 1; my $s = shift; length($s) > 1 || $s eq 'j'; } my $THRESHHOLD = shift || 1; my %shapes; my @blocks; while (<>) { chomp; my ($block, $shapes) = split /: /; $shapes{$block} = $shapes; push @blocks, $block; } for my $i (0 .. $#blocks) { my @similar; for my $j (0 .. $#blocks) { next if $i == $j; push @similar, $blocks[$j] if difference($shapes{$blocks[$i]}, $shapes{$blocks[$j]}, ) >= $THRESHHOLD; } if (@similar) { print "$blocks[$i] @similar\n"; } } sub difference { my ($b1, $b2) = @_; my %b; my $common = 0; for my $shape (grep interesting_shape($_), split m{/}, $b1) { $b{$shape}++; } for my $shape (grep interesting_shape($_), split m{/}, $b2) { eval { decrement_count(%b, $shape) }; $common++ unless $@; } $common; }