Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Challenge: Hidden Message

by Limbic~Region (Chancellor)
on May 09, 2006 at 22:57 UTC ( [id://548346]=perlmeditation: print w/replies, xml ) Need Help??

All,
I have hidden a message in the text below:
CPD6Z98SB2KQNWV0F7Y1IX4GLRA5MTOJHE3U CXZOL6SUI2WTJ30HF519YPGBRNAK48MQVD7E T8COSQU6I2FJN40DKL157WVGPYXARZ3MBHE9 KNCWVZDSR5420LP91FIQGB7Y3A6J8MOUXTEH XF9C4PSDY62TWJ0QBN17IKG3OH8ALVRM5UEZ D9QCHUSN7TW2YZL0O831FGXIR6JA4P5MVBKE ZC7ISQUPK6N20OLV4T31G9FRXBAWM5YJHED8 Z3C7SJVODL25TRQ01HPWGNKXB4UA68YMI9EF BC9OXDHS2FI5Z6U0TYL1VPGQK7ANR38MEWJ4 K4TCQBHS2ZV7FXU0P8R1YGDON3A6JILM9EW5

Your mission, should you choose to accept it, is to find the hidden message and report back on the algorithm you used. I have provided 3 clues of increasing insight to help you on your journey. They should be used only as a last resort.

Clue #1:

Clue #2:

Clue #3:

my @str = map {chomp; $_} <DATA>; print LCS(@str), "\n"; sub LCS{ my ($d,$s,%l,%t)=(0,''); my @p=map{my $i=$_;({map{substr($_[$i],$_,1),$_}0..length($_[$i])- +1})}0..$#_; my @o=map{my $l=$_;my $r=[map $p[$_]{$l},0..$#p];$l{$r}=[$r,$l];$r +}split//,$_[0]; for my $i(0..$#o){$t{$o[$i]}=[map{g($o[$i],$o[$_])?"$o[$_]":()}gre +p$_!=$i,0..$#o]} my @w=map[$_,1],grep@{$t{$_}},keys%t; while(@w){my $i=pop@w;($s,$d)=@$i if$i->[1]>$d; my @n=@{$t{(split/:/,$i->[0])[-1]}}or next;push@w,map["$i->[0]:$_" +,$i->[1]+1],@n} join'',map$l{$_}[1],split/:/,$s; } sub g{$_[1]->[$_]<=$_[0]->[$_]&&return 0 for 0..(@{$_[0]}>@{$_[1]}?$#{ +$_[1]}:$#{$_[0]});1}

While I am interested in all approaches, I am hoping that someone creates an efficient general solution to related problems. I have code to generate the hidden message so if anyone is interested in seeing how their solution works on bigger messages let me know.

Cheers - L~R

Replies are listed 'Best First'.
Re: Challenge: Hidden Message
by Limbic~Region (Chancellor) on May 10, 2006 at 14:00 UTC
    All,
    The following is an in-depth explanation of the entire challenge. For those of you who have given up or are only interested in the answer, read on. For anyone else still working on it - you have been warned. I hope that you enjoyed this challenge.

    Cheers - L~R

Re: Challenge: Hidden Message
by Unanimous Monk (Sexton) on May 11, 2006 at 01:50 UTC
    Well, here's my first crack at it.

    use strict; use Data::Dumper; my %result; { ### Populate initial tree my @prev; my $temp=<DATA>; chomp $temp; foreach my $char (split '', $temp) { foreach my $pchar (@prev) { $result{$pchar}{$char}{valid} = 1; }; push @prev, $char; }; }; { ### Prune invalid data while (<DATA>) { chomp; my @invalid; foreach my $char (split '') { foreach my $ichar (@invalid) { $result{$char}{$ichar}{valid} = 0; }; push @invalid, $char; }; }; } 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}; }; } 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; $maxdepthchar = + $key } }; }; $result{$char}{depth} = $maxdepth+1; $result{$char}{maxdepthchar} = $maxdepthchar; return $result{$char}{depth}; } else { return $result{$char}{depth}; }; }; __DATA__ CPD6Z98SB2KQNWV0F7Y1IX4GLRA5MTOJHE3U CXZOL6SUI2WTJ30HF519YPGBRNAK48MQVD7E T8COSQU6I2FJN40DKL157WVGPYXARZ3MBHE9 KNCWVZDSR5420LP91FIQGB7Y3A6J8MOUXTEH XF9C4PSDY62TWJ0QBN17IKG3OH8ALVRM5UEZ D9QCHUSN7TW2YZL0O831FGXIR6JA4P5MVBKE ZC7ISQUPK6N20OLV4T31G9FRXBAWM5YJHED8 Z3C7SJVODL25TRQ01HPWGNKXB4UA68YMI9EF BC9OXDHS2FI5Z6U0TYL1VPGQK7ANR38MEWJ4 K4TCQBHS2ZV7FXU0P8R1YGDON3A6JILM9EW5

    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.

      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

      Cheers - L~R

Re: Challenge: Hidden Message
by ysth (Canon) on May 10, 2006 at 22:22 UTC
    You may want to create separate replies for clues #2 and #3 so they can be independently spoiled.

      It probably wouldnt be too hard to make it possible to selectively display different spoilers. We already have logic along those lines for handling download links so there is at least a starting point.

      Update: And I was right, it wasn't hard. Case closed. :-)

      ---
      $world=~s/war/peace/g

        First time round, I completely overlooked that "Reveal" was a link; how about making it "Reveal this spoiler or spoilers on this page."?
      ysth,
      Unfortunately, the author is unable to actually see their own spoiler tags so I didn't know they were all being revealed at once. I am glad this is supposed to be fixed now (demerphq++) but I had to ask someone in the CB just to verify the spoiler tags even worked.

      Cheers - L~R

        Unfortunately, the author is unable to actually see their own spoiler tags

        I don't know how you jumped to that conclusion, but that doesn't match my own experience nor my impression of the implementing code, so I'm pretty certain you are wrong. You can't do much with spoiler tags during preview, of course.

        - tye        

Re: Challenge: Hidden Message
by diotalevi (Canon) on May 11, 2006 at 18:10 UTC

    I don't see how a person was supposed to solve this without doing some crypto analysis. Could you explain that please? I read your spoiler and thought it'd be trivial to write a regex to extract the solution. Here it is. It's really slow. It'd be faster if I could use backreferences in negated character classes. I could have written this using a regex that generates another regex to incorporate the negated backreference but that seemed like a whole lot of work and I guessed it wouldn't be . It's pretty as-is.

    [Updated: Added an expensive and less wasteful version. I'll be adding timing info when my computer has finished running these. They succeed within a few minutes but take a lot longer to finish failing.]

    ⠤⠤ ⠙⠊⠕⠞⠁⠇⠑⠧⠊

      diotalevi,
      You're probably right about people in general not having a clue as to the right approach without reading the spoilers. I am an avid puzzle and riddle aficionado. One kind of puzzle I see is identifying someone's ATM PIN using a constrained version of this. I incorrectly assumed people who enjoyed my challenges to have the same kind of exposure and recognize it as being similar :-(

      The more interesting problem to me is the general case which I am hoping someone provides a better solution then my own.

      Thanks for your regex solution. I am not sure I understand it but it gives me something new to work at learning.

      Cheers - L~R

        It's just making a regex like \A[^\n]*(\w)[^\n]*\n(?:[^\n]*\1[^\n]*\n)+\z which just says, I captured $1 and it has to exist on every line. Higher # versions just capture more and assert the new digits, in order. It's really very simple. rx() could be improved if you pegged certain captures with specified characters. I'm searching the entire space so I'm slower.

        What's this have to do with ATM PINs?

        ⠤⠤ ⠙⠊⠕⠞⠁⠇⠑⠧⠊

        You're probably right about people in general not having a clue as to the right approach without reading the spoilers. I am an avid puzzle and riddle aficionado. One kind of puzzle I see is identifying someone's ATM PIN using a constrained version of this. I incorrectly assumed people who enjoyed my challenges to have the same kind of exposure and recognize it as being similar :-(

        Personally, I enjoyed the challenge of trying to figure out what the message was as well as coming up with a general solution (which has now been fixed). I worked out that C,S,0,1,M,E were statistically significant, but I couldn't make heads or tails of what that could possibly mean so I did eventually have to look at the spoilers to work it out.

        I just wish I had more time to spend on things like this instead of doing actual work :)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://548346]
Approved by kvale
Front-paged by TStanley
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (5)
As of 2024-03-28 13:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found