Golf: Embedded In Order

[Masem]

Given a (long) string $s, and a test string $t.

Find for perl golf a subroutine to determine if the characters of $t are in $s, not necessarily consecutive but in order, returning true if so, false if not. For example, if $s = "abcdefghijklmnopqrstuvwxyz", then the sub should return true for $t = "for", but not $t = "perl".

For extra credit, have the sub return undef if the string isn't found, and the remainder of $s minus those characters of $t that were matched, with the remaining characters in the same order, if $t was in $s.

---

Dr. Michael K. Neylon - [e-mail] || "You've left the lens cap of your mind on again, Pinky" - The Brain

[japhy]

Here's mine. It's très cool.

# 37 chars (between the {...})
sub seq{shift=~join'.*',map"\Q$_",split//,pop}

Update -- after seeing chipmunk's code, which beats mine, I offer one minor adjustment:

sub seq{($t=pop)=~s/./$&.*/sg;pop=~/$t/s}

Although, should the $t by my()ed? I'm all for strict-compliant golf. Anyway, I changed the @_ access to pop, and added a needed /s modifier to both regexes. It makes it longer than chipmunk's, but doesn't break on cases involving newlines.

japhy -- Perl and Regex Hacker

[chipmunk]

Since the goal of Perl Golf is to make the code as short as possible, it seems to me that making the code strict-compliant is a waste of characters. Especially since one could just do something like:

sub seq{
($~=pop)=~s/./$&.*/sg;pop=~/$~/s
}

:)

I do try to avoid warnings in my Golf solutions, though.

[petral]

But you don't need the $t! 27 chars:

seq{shift=~join".*",split//,pop}

Or 25 using /./g:

seq{shift=~join".*",pop=~/./g}

Or 33 with pathological protection:

seq{shift=~join"\E.*\Q","",pop=~/./gs}

  p

[chipmunk]

I'll get things started here. I don't have time for the extra credit, but this solves the first part:

sub t_in_s {
($t=pop)=~s/./$&.*/g;$_[0]=~$t
}

t_in_s('abcdefghijklmnopqrstuvwxyz', 'for');

Although, if $t may contain non-word characters, that becomes:

sub t_in_s {
($t=pop)=~s/./\Q$&\E.*/g;$_[0]=~$t
}

[tilly]

If $s or $t can contain \n, you need a /s on both matches. But your $_[0] can be replaced with pop.

That makes your solution turn into the 36 character:

sub t_in_s {
($t=pop)=~s/./\Q$&\E.*/gs;pop=~/$t/s
}

or 38 if you wish to add my to make it strict compliant.

[chipmunk]

I realized later that I had the replacement in the wrong order, and I could save two characters:

sub t_in_s {
($t=pop)=~s/./.*\Q$&/gs;pop=~/$t/s
}

So that's 34 characters.

[japhy]

Extra Credit:

sub seq {
my($s,$r)=shift;
$s=~/\Q$_/?($r.=$`,$s=$'):return for split//,pop;
$r.$s
}



japhy -- Perl and Regex Hacker

[turnstep]

This was fun. :)

82 with extra credit, does it in a clever way

#!/usr/bin/perl

use strict;
my $t = shift || "gttb";
my $s = shift || "gattacababy";

my $return = &PopPopChopChop($s,$t);
print "Original: $s\n";
$return = "UNDEF" unless defined $return;
print "Returned: $return\n";
exit;

sub PopPopChopChop {
$a=reverse pop;$_=pop;$b=chop$a;
s!(.)!$b and$1=~/$b/and$b=chop$a;$1!eg;$b?undef:$_
}

[petral]

35 chars:

sub seq{!grep{$_[0]!~/\G.*?$_/g}split//,pop}


update: And now what everyone's been waiting for:

The longest word(s) with all letters in alphabetical order:

solaris /usr/dict/words:  almost biopsy
linux    /usr/dict/words:  abhors almost begins biopsy chintz

The longest word(s) with all letters in reverse alphabetical order:

sol:  sponge
lun:  sponged wronged

The word(s) with the most letters in alphabetical order:

sol: condemnatory 8
lun: administratively antidisestablishmentarianism behavioristic
        demonstratively incomprehensibility 8
shortest: behavioristic

update oopsdate: Removed words w/ most letters in order. It was wrong, though noone remarked on it (if you were being polite, thank you). Will re-post when, if I get it right. Anyone else care to try?
update 3: maybe the above are right now. The code is:

sub seq{
  my @x=split"",pop;
  my $s=pop;
  my $cc=0;
  for my $k (0..$#x-1) {
    $c = seq1($cc, $s, @x[$k..$#x]);
    $cc = ($c, $cc)[ $c < $cc ]
  }
  $cc
}
sub seq1 {
  my($cc, $s, @x) = @_;
  my $c=pos($s)=0;
  my $op=0; my $cy=0;

  for my $k (0..$#x) {

    $s =~ /$x[$k]/gc or next;

    if ($cc <= @x - $k) {       # what if we skip this char?

      my $cx = $c + seq1( $cy, substr($s, $op), @x[$k+1 .. $#x]);

      $cy = ($cx, $cy)[$cx < $cy];
    }
    $op = pos($s);
    $c++;
  }
  $c = ($cy, $c)[ $cy < $c ];
}

Update the last:  Actually, this one can be done in 27 chars:

sub seq{!grep$_[0]!~/$_/g,pop=~/./g}

  ...or 30 with provision for strange_chars/newlines:

sub seq{!grep$_[0]!~/\Q$_/g,pop=~/./gs}

But see my trimming of japhy's above.

  p

[boo_radley]

42 chars in the sub.

use strict;
my $s = "abcdefghijklmnopqrstuvwxyz";
my $t = "for";
print x($s,$t),"\n";
$t="perl";
print x($s,$t),"\n";

sub x{
my($s,$t)=@_;
eval"\$s=~tr/$t//cd";
$s eq$t;
}

update
one less:

sub x{
eval"\$_[0]=~tr/$_[1]//cd";$_[0]eq$_[1];
}

[MeowChow]

Interesting method, but it doesn't properly handle:

my $s = "abcfoforrxyz";
my $t = "for";

There are also serious escaping issues with the interpolated code inside the eval :)

   MeowChow                                   
               s aamecha.s a..a\u$&owag.print

[jynx]

Yet Another Attempt. Hefty though, weighs in at 110 characters, is strict and warnings compliant and solves extra credit though...

sub x{
   my($s,$t,$p)=(@_,0);
   (join'',map{$s=~/$_/g?($p<pos$s?($p=pos$s and$s=~s/$_//and$_):''):'
+'}split//,$t)eq$t?$s:undef
}

i'd be delighted to see someone trim it down...

nuf evah,
jynx

[premchai21]

# Another way -- long, but another way:
sub z(){my($s,$t,$x,$y))=($s,$t,'','');($x=chop$s,($y=chop$t)eq$x||($t
+.=$y))while$s;return!$t;}

hey! What's going on? Why am I being so vigorously downvoted all of a sudden? Please explain what is wrong with my post, and I'll do my best to correct it.