#!/usr/bin/perl -w

use strict;
use List::MoreUtils qw(all);
use Benchmark qw(cmpthese);

#use Test::More qw(no_plan);
require Test::More;

my @shortTestCases=(
    # sentence                   wantedChars  result
    [ "abxcd zwe rrv",           "0",         0 ],
    [ "0",                       "0",         1 ],
    [ "abxcd zwe rrv",           "xxv",       1 ],
    [ "abxcd zwe rrv",           "xxvq",      0 ],
    [ "abxcd zwe rrv",           "",          1 ],
    [ "The quick brown fox jumps over the lazy dog",
                                 "abcdefghijklmnopqrstuvwxyz",
                                              1 ],
    [ "The quick brown fox jumps over the lazy dog",
                                 "abcdefghijklmnopqrstuvwxyzT",
                                              1 ],
    [ "The quick brown fox jumps over the lazy dog",
                                 "abcdefghijklmnopqrstuvwxyzTU",
                                              0 ],
    [ "The quick brown fox jumps over the lazy dog",
                                 "a",         1 ],
    [ "The quick brown fox jumps over the lazy dog",
                                 "",          1 ],
);

# Long sentence, short wantedChars
my @longShortTestCases = (
    [ "The quick brown fox jumps over the lazy dog" x 100,
                                 "",          1 ],
    [ "The quick brown fox jumps over the lazy dog" x 100,
                                 "a",          1 ],
    [ "The quick brown fox jumps over the lazy dog" x 100,
                                 "abcdefghijklmnopqrstuvwxyzT",
                                              1 ],
    [ "The quick brown fox jumps over the lazy dog" x 100,
                                 "abcdefghijklmnopqrstuvwxyzTU",
                                              0 ],
);

# Short sentence, long wantedChars
my @shortLongTestCases = (
    [ "The quick brown fox jumps over the lazy dog",
                                 "abcdefghijklmnopqrstuvwxyzT"x100,
                                              1 ],
    [ "The quick brown fox jumps over the lazy dog",
                                 "abcdefghijklmnopqrstuvwxyzTU"x100,
                                              0 ],
);

# Long sentence, long wantedChars
my @longLongTestCases = (
    [ "The quick brown fox jumps over the lazy dog" x 100,
                                 "abcdefghijklmnopqrstuvwxyzT"x100,
                                              1 ],
    [ "The quick brown fox jumps over the lazy dog" x 100,
                                 "abcdefghijklmnopqrstuvwxyzTU"x100,
                                              0 ],
);

# VERY long test case
my $alphabet=(join '' => 'a' .. 'z', 'A' .. 'Z');
my @veryLongTestCase = (
        [
            random(10000, $alphabet),
                                  $alphabet, 1 ],
);

my @testCases = (
    @shortTestCases,
    @shortLongTestCases,
    @longShortTestCases,
    @longLongTestCases,
    @veryLongTestCase
);

sub random {
   my $num = shift;
   my $wantedChars = shift;
   my @chars = ('a' .. 'z', 'A' .. 'Z');
   my $result;
   # make sure result will work
   do  {
       $result = join '' => map $chars[rand @chars], 1 .. $num;
   } until Tanktalus_AllIndex($result, $wantedChars);

   return $result;
}



sub test_routine
{
    my ($testFn, $testName)=@_;

    foreach(@testCases) {
       my ($sentence, $wantedLetters, $expectedResult) = @$_;
       ok (!!($testFn->($sentence, $wantedLetters)) == !!$expectedResult);
    }
}

sub benchmark_routine
{
    my ($testFn, $testName, $testCases)=@_;

    foreach(@$testCases) {
        my ($sentence, $wantedLetters, $expectedResult) = @$_;
        $testFn->($sentence, $wantedLetters) for 1..20;
    }
}


# [id://707122]
sub tallulah_OriginalPost
{
    my ($sentence, $wantedLetters)=@_;
    my $flag=0;
    my @a = split '',$wantedLetters;
    for( my $i=0; $i<$#a+1; $i++ ) {
        if($sentence !~ /$a[$i]/) {
            $flag=1;last;
        }
    }

    return !$flag;
}

# [id://707123]
sub moritz_BuildRegex
{
    my ($sentence, $wantedLetters)=@_;

    my $re = '^' . join '', map "(?=.*?$_)", map quotemeta, split m//,
             $wantedLetters;

    if ($sentence =~ m/$re/) {
        return 1;
    }

    return 0;
}

# [id://707123]
sub moritz_BuildRegex_WithStudy
{
    my ($sentence, $wantedLetters)=@_;

    my $re = '^' . join '', map "(?=.*?$_)", map quotemeta, split m//,
             $wantedLetters;

    study $sentence;
    if ($sentence =~ m/$re/) {
        return 1;
    }

    return 0;
}

# [id://707124]
sub RMGir_index {
    my ($sentence, $wantedLetters)=@_;

    # don't need this variable (or any of them, in
    # fact -- they're just here for clarity.
    # we could work straight out of @_ if we wanted
    # this terser
    # Also, the $[ check is just pedantic - if someone
    # changes $[, shoot them.
    my $foundLetters=scalar (grep index($sentence,$_)>=$[,
                                  split //,$wantedLetters);

    return length($wantedLetters)==$foundLetters;
}

# [id://707222]
sub Tanktalus_AllRegex {
    my ($sentence, $letters) = @_;

    return 1 unless length($letters);

    # all we're doing is checking for each letter.
    all { $sentence =~ $_ } split //, $letters;
}

# [id://707222]
sub Tanktalus_AllRegex_Study {
    my ($sentence, $letters) = @_;

    return 1 unless length($letters);

    study $sentence;

    # all we're doing is checking for each letter.
    all { $sentence =~ $_ } split //, $letters;

    # same as above, but with index which I think is less readable.
    #all { index($sentence, $_) >= $[ } split //, $letters;
}

# [id://707222]
sub Tanktalus_AllIndex {
    my ($sentence, $letters) = @_;

    return 1 unless length($letters);

    # same as above, but with index which I think is less readable.
    all { index($sentence, $_) >= $[ } split //, $letters;
}

# JavaFan's looks about equivalent to OP approach

# Doesn't have same repeated letter semantics specified in
# OP post.
# [id://707176]
sub oshalla_scan {
    my ($sentence, $wanted) = @_ ;

    while (length($wanted)) {
        return 0 if ($sentence !~ m/([$wanted])/g) ;
        $wanted =~ s/$1// ;
    } ;

    return 1;
}

# [id://707231]
sub varian_hash {
    my ($sentence, $wantedLetters)=@_;

    my %required = map {$_ => 1} split //,$wantedLetters;
    map delete $required{$_}, split //, $sentence;

    if (keys %required) {
        return 0;
    }
    else {
        return 1;
    }
}

# [id://707314]
sub RMGir_slice {
    my ($sentence, $wantedLetters)=@_;

    my %required;
    @required{split //,$wantedLetters}=();
    delete @required{split //, $sentence};

    if (keys %required) {
        return 0;
    }
    else {
        return 1;
    }
}

# [tassilo]'s test cases


sub makeSubRef {
    return @_[1,0];
}

my %testSubroutines=(
    makeSubRef(\&tallulah_OriginalPost,
        "tallulah_OriginalPost"),
    makeSubRef(\&moritz_BuildRegex,
        "moritz_BuildRegex"),
    makeSubRef(\&moritz_BuildRegex_WithStudy,
        "moritz_BuildRegex_WithStudy"),
    makeSubRef(\&RMGir_index,
        "RMGir_index"),
    makeSubRef(\&Tanktalus_AllRegex,
        "Tanktalus_AllRegex"),
    makeSubRef(\&Tanktalus_AllRegex_Study,
        "Tanktalus_AllRegex_Study"),
    makeSubRef(\&Tanktalus_AllIndex,
        "Tanktalus_AllIndex"),
    makeSubRef(\&varian_hash,
        "varian_hash"),
    makeSubRef(\&RMGir_slice,
        "RMGir_slice"),
    tassilo_listutils_r => sub {
        return 1 unless length($_[1]);

        all { rindex($_[0], $_) >= 0 } split //, $_[1];
    },

    repellent_unpack => sub {
        my ($sentence, $wantedLetters)=@_;

        my $foundLetters=scalar (grep index($sentence,$_)>=$[,
            unpack "(a)*", $wantedLetters);

        return length($wantedLetters)==$foundLetters;
    },

    repellent_unpack_opt => sub {
        length($_[1])==scalar (grep index($_[0],$_)>=$[,
            unpack "(a)*", $_[1]);
    },

    unpack_allindex => sub {
        return 1 unless length($_[1]);

        my ($sentence, $wantedLetters)=@_;

        all { index($sentence, $_) >= $[ }
                                    unpack "(a)*", $wantedLetters;
    },

    unpack_allrindex => sub {
        return 1 unless length($_[1]);

        my ($sentence, $wantedLetters)=@_;

        all { rindex($sentence, $_) >= $[ }
            unpack "(a)*", $wantedLetters;
    },


    tye2_opt => sub {
        while( $_[1] =~ /(.)/gs ) {
            return 0 if -1 == index($_[0],$1);
        }
        return 1;
    },

    tye1_opt => sub {
        -1 == index($_[0],$1) && return 0
        while( $_[1] =~ /(.)/gs );
        return 1;
    },

    tye0_opt => sub {
        -1 == index( $_[0], $1 )  &&  return 0
        while( $_[1] =~ /(.)/gs );
        return 1;
    },


    tye2 => sub {
        my( $sentence, $wantedLetters )= @_;
        while( $wantedLetters =~ /(.)/gs ) {
            return 0 if -1 == index($sentence,$1);
        }
        return 1;
    },

    tye1 => sub {
        my( $sentence, $wantedLetters )= @_;
        -1 == index($sentence,$1) && return 0
        while( $wantedLetters =~ /(.)/gs );
        return 1;
    },

    tye0 => sub {
        -1 == index( $_[0], $1 )  &&  return 0
        while( $_[1] =~ /(.)/gs );
        return 1;
    },

    # FAILS the "0" "0" test....
    buk => sub {
        my( $s, $w ) = @_;
        my $c;
        1+index $s, $c or return 0 while $c = chop $w;
        1;
    },

    buk_substr => sub {
        my( $s, $w ) = @_;
        1+index $s, substr($w,$_,1) or return 0 foreach 0..length($w);
        1;
    },

    # FAILS the "0" "0" test....
    buk2 => sub {
        local $_;
        1+index $_[0], $_ or return while $_ = chop $_[1];
        1;
    },

    buk2_len => sub {
        local $_;
        1+index $_[0], $_ or return while length($_ = chop $_[1]);
        1;
    },

    buk3 => sub {
        1+index $_[0], chop $_[ 1 ] or return for 1 .. length $_[ 1 ];
        1;
    },

    buk4 => sub {
        ( -1 != index $_[0], chop $_[ 1 ] ) || return for 1 .. length $_[ 1 ];
        1;
    },

    ysth_loookahead => sub {
        my ($sentence, $wantedLetters) = @_;
        $wantedLetters =~ s/(.)/(?=.*?\Q$1\E)/sg;
        $sentence =~ /^$wantedLetters/s;
    }

#   # These 2 routines need more debugging - they fail the tests
#   tassilo_xor => sub {
#       return 1 unless length($_[1]);
#       my $copy = $_[0];
#       for (split //, $_[1]) {
#           my $mask = ($_) x length $copy;
#           $copy ^= $mask;
#           $copy =~ tr/\000//d;
#           $copy ^= ( ($_) x length $copy );
#       };
#       length($copy) == 0;
#   },
#   tassilo_tr => sub {
#       return 1 unless length($_[1]);
#       my $copy = $_[0];
#       eval "\$copy =~ tr/$_[1]//d";
#       length($copy) == 0;
#   }

);


if(@ARGV && $ARGV[0] eq "-t") {
    use Test::More;

    plan tests => ((scalar keys %testSubroutines) * scalar @testCases);

    print "Testing routines...\n";
    foreach my $name(sort keys %testSubroutines) {
        print "Testing $name\n";
        test_routine($testSubroutines{$name}, $name);
    }

    exit(0);
}


print "Running benchmarks...\n";

my $testsRef = \@shortTestCases;

my $benchmark_routines={
       map { ($_,
              eval qq[sub { benchmark_routine(\$testSubroutines{"$_"},
                                              "$_", \$testsRef); }
              ])
           } keys %testSubroutines
    };

print "Short      \n";
cmpthese(-1, $benchmark_routines);


$testsRef = \@longShortTestCases;
print "\n\n";
print "LongShort   \n";
cmpthese(-1, $benchmark_routines);

$testsRef = \@shortLongTestCases;
print "\n\n";
print "ShortLong   \n";
cmpthese(-1, $benchmark_routines);

$testsRef = \@longLongTestCases;
print "\n\n";
print "LongLong    \n";
cmpthese(-1, $benchmark_routines);

$testsRef = \@veryLongTestCase;
print "\n\n";
print "VeryLong    \n"; 
cmpthese(-1, $benchmark_routines);