#! perl -slw use strict; sub xform { my @out; for my $in ( @_ ) { $out[ $_ ] .= substr $in, $_, 1 for 0 .. length( $in ) -1; } return @out; } my @grid = ( "00CD01", "A0CDE2", "0B0D03", "AB00E4", "0BCD05", ); #my @grid=( "000DEF1", "000DEF2", "000DE03", "ABCDEF4", "ABCDEF5", "AB0DEF6", ); #my @grid=( "000DE01", "000D0F2", "0000EF3", "AB00004", "A0C0005", "AB00006", ); #my @grid=( "0B0D001", "000DE02", "0B00E03", "A0000F4", "A0C0005", "A0000F6", ); print "This input\n"; print "\t$_" for @grid; @grid = sort @grid; print "sorted\n"; print "\t$_" for @grid; my @xformed = xform @grid; print "\nTranformed looks like this\n"; print "\t$_" for @xformed; @xformed = sort @xformed; print "sorted\n"; print "\t$_" for @xformed; ## extra column label item. my( $label ) = grep /1/, @xformed; @xformed = grep !/1/, @xformed; my @subsets; while( @xformed ) { my $mask = $xformed[ 0 ] | $xformed[ 1 ]; if( $mask =~ m[(^0+)] ) { my $count = length( $1 ); ## Length of common zero prefix push @{ $subsets[ @subsets ] }, shift( @xformed ), shift( @xformed ); while( @xformed and $xformed[ 0 ] =~ m[(^0+)] and length( $1 ) == $count ) { push @{ $subsets[ -1 ] }, shift @xformed; } } else { push @subsets, []; push @{ $subsets[ -1 ] }, shift @xformed while @xformed; } } print <<'EOS'; These are the sets where the letters denote the columns of the original matrix (0 mean column not used in this set). And the numbers above, the rows they came from. EOS print join "\n", $label, @$_, "\n" for @subsets;