Re: Challenge: Hidden Message

[Unanimous Monk]

Well, here's my first crack at it.

<Reveal this spoiler or all spoilers in this node or all in this thread>

and a few modifications to allow for multiple longest strings, and repeated chars (although, the output still only outputs one of the longest string, but the hash contains the info for each longest string).

use strict;
use Data::Dumper;
my %result;

{ ### Populate initial tree
  my @prev;
  my %charcount;

  my $temp=<DATA>;
  chomp $temp;

  foreach my $char (split '', $temp) {
    $charcount{$char}++;
    foreach my $pchar (@prev) {
      $result{$pchar}{$char.$charcount{$char}}{valid} = 1;
    };
    push @prev, $char.$charcount{$char};
  };
};

{ ### Prune invalid data

  while (<DATA>) {
    chomp;
    my %charcount;
    my @invalid;
    foreach my $char (split '') {
      $charcount{$char}++;
      foreach my $ichar (@invalid) {
        $result{$char.$charcount{$char}}{$ichar}{valid} = 0;
      };
      push @invalid, $char.$charcount{$char};
    };

    # Prune branches that weren't in the string this time around.
    foreach my $key1 (keys %result) {
      foreach my $key2 (keys %{$result{$key1}}) {
        my $found = 0;
        foreach my $inv (@invalid) {
          next if $found;
          $found = ($inv eq $key2);
        };
        if (!$found) { $result{$key1}{$key2}{valid} = 0 };
      };
    };

    # Prune roots that weren't in the string this time around.
    foreach my $key1 (keys %result) {
      my $found = 0;
      foreach my $inv (@invalid) {
        next if $found;
        $found = ($inv eq $key1);
      };
      if (!$found) { 
        foreach my $key2 (%{$result{$key1}}) {
          $result{$key1}{$key2}{valid} = 0;  
        };
      };
    };

  };
}

my $maxdepthchar;

{ ### Determine depth of each tree
  my $maxdepth;
  foreach my $char (keys %result) {
    getdepth(\%result, $char);
    if ($result{$char}{depth} > $maxdepth) { $maxdepth = $result{$char
+}{depth}; $maxdepthchar = $char };
  };
}

{ ### Output longest string
  while ($maxdepthchar ne '') {
    print substr($maxdepthchar,0,1);
    $maxdepthchar = @{$result{$maxdepthchar}{maxdepthchar}}->[0];
  };
}

sub getdepth{
my ($ref, $char) = @_;
my %result = %{$ref};

my $maxdepth;
my @maxdepthchar;

  if ($result{$char}{depth} eq undef) {
    foreach my $key (keys %{$result{$char}}) {
      if ($result{$char}{$key}{valid}) {
        my $depth = getdepth(\%result, $key);
        if    ($depth  > $maxdepth) { $maxdepth = $depth; @maxdepthcha
+r = ($key) }
        elsif ($depth == $maxdepth) { $maxdepth = $depth; push @maxdep
+thchar, $key };
      };
    };
    $result{$char}{depth} = $maxdepth+1;
    $result{$char}{maxdepthchar} = \@maxdepthchar;
    return $result{$char}{depth};
  } else {
    return $result{$char}{depth};
  };

};

__DATA__
HOUSEBOAT
COMPUTER
DOUBT

It ain't pritty, but it works (I think?).

Update:Oops! Fixed general soultion. Needed to trim roots as well as branches. Thanks LR.

[Limbic~Region]

Unanimous Monk,
I am still working on my general purpose solution, but yours does not appear to work with the following:

__DATA__
HOUSEBOAT
COMPUTER
DOUBT