artist has asked for the wisdom of the Perl Monks concerning the following question:

Dear Monks
I want to find the largest block of similar items in the input. The code I have written is here. 
#!/usr/local/bin/perl -w
use strict;
my $string = 'abbbcddddfegrgrgddeeeeedd';
my @chars = split //,$string;
my $hold = '';
my $currentSequence = '';
my $longestSeq = '';
my $currentPosition = 0;
my $longestSequenceStartPosition;
foreach (@chars){
    my $currentCharacter = $_;
    $currentPosition += 1;
    if($hold eq $currentCharacter){
    $currentSequence .= $currentCharacter;
    }
    else{
    if(length($longestSeq) < length($currentSequence)){
        $longestSeq = $currentSequence;
        $longestSequenceStartPosition = ($currentPosition -1) - length
+($longestSeq);
    }
    $currentSequence = $currentCharacter;
    
   }
    $hold = $currentCharacter;
    
}
print "$string\n";
print "$longestSeq\n";
my $answer = '-' x length($string);
substr($answer,$longestSequenceStartPosition,length($longestSeq)) = $l
+ongestSeq;
print "$answer\n";

[download]
This works well if may not be efficient. It finds the first entry of largest block. 
$string = 'abbbcddddfegrgrgddeeeeedd';
$answer = '------------------eeeee--'
I want to do it in a better way, find all the blocks, starting from largest to smallest and want to extend to 2-D and 3-D and may be higher dimensions. This is not from a programming contest or a homework
Thanks,
Looking for visual solution
Artist

Edit kudra, 2002-10-04 Removed unclosed pre tag

Replies are listed 'Best First'.
Re: Block Search
by davorg (Chancellor) on Oct 04, 2002 at 16:34 UTC

    I think I'd do it something .like this. If you want all of the blocks they are in @segs.

    #!/usr/bin/perl

use strict;
use warnings;

my $string = 'abbbcddddfegrgrgddeeeeedd';

# Get repeated characters
my @segs = $string =~ /((.)\2+)/g;

# Filter to get only multi-char strings
@segs = grep { length > 1 } @segs;

# Sort
@segs = sort { length $b <=> length $a } @segs;

# Construct answer string
my $answer = '-' x index($string, $segs[0]) . $segs[0];
$answer .= '-' x (length($string) - length($answer));

print "$string\n$answer\n";

    [download]
    --
    <http://www.dave.org.uk>

    "The first rule of Perl club is you do not talk about Perl club."
    -- Chip Salzenberg

[reply]
[d/l]
      Yep,
      That is much cleaner and more informative solution.
      Getting all the blocks is nice.
      Now How I would go about 2-D and 3-D.

      Thanks,
      Extracting the visual art
      an artist.

[reply]
        As far as I understand expanding this to 2 and 3 dimensions is non trivial. Consider that video compression techniques perform this type of task. They try to find as large areas of similar color as possible. So you probably want to look into algortihms used for that. Also look in a book that has a lot of algorithm coverage of pattern matching. If the number of symbols is low then I believe there are a few useful techniques that are reasonably understandable. But unfortunately the book im thinking of isnt here. Sorry.

        --- demerphq
        my friends call me, usually because I'm late....

[reply]
Re: Block Search
by waswas-fng (Curate) on Oct 04, 2002 at 16:19 UTC
    You may want to look at the source of Algorithm::Diff it has a bunch of nifty tricks for doing the same kind of things.

    Waswas
[reply]
Re: Block Search
by meetraz (Hermit) on Oct 04, 2002 at 20:18 UTC
    My golf solution for this: 
    $s1 = 'abbbcddddfegrgrgddeeeeedd';

print"$s1\n\n";($s2=$s1)=~s/((.)\2*)/$1,/g;map{$i=index($s1,$_);$l=len
+gth;print
'-'x$i,$_,'-'x(length($s1)-$i-$l),"\n";substr($s1,$i,$l,','x$l);}sort{
+length$b
<=>length$a}split(/,/,$s2);

    [download]
    update: shorter now
[reply]
[d/l]
      fore! 136 chars 
      #!/usr/bin/perl -wT
use strict;

my $s1 = 'abbbcddddfegrgrgddeeeeedd';

#        1         2         3         4         5         6
#2345678901234567890123456789012345678901234567890123456789012345678

print$s1.$/x2;push(@;,[$+[0]-$+[1],"-"x($+[1]-1).$&."-"x(length($s1)
-$+[0])])while$s1=~/(.)\1*/g;print$$_[1].$/for sort{$$b[0]-$$a[0]}@;

      [download]

      -Blake

[reply]
[d/l]
        wow! ++blakem ... Can you break it down for me?
[reply]
Re: Block Search
by BrowserUk (Patriarch) on Oct 04, 2002 at 21:34 UTC 

    $_='abbbcddddfegrgrgddeeeeedd';
print+(@b=sort{(()=$b=~/./g)<=>(()=$a=~/./g)}/((.)\2+)/cg)[0] #62

    [download]
    Cor! Like yer ring! ... HALO dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring!
[reply]
[d/l]
      If you just want to find the longest sequence, a few tweaks will bring it down to.... 47 chars 
      #        1         2         3         4       
#2345678901234567890123456789012345678901234567
print+(sort{$b=~y///c-$a=~y///c}/((.)\2*)/g)[0]

      [download]

      -Blake

[reply]
[d/l]

Back to Seekers of Perl Wisdom