comment on

Note: Please ignore the code listed here as it is buggy inside the while loop. Sorry for the noise.

First thing I thought of after reading OP was Algorithm::Permute module. (That led me to search for other permutations related modules. Now, I am more in favor of Math::Combinatorics and Algorithm::Combinatorics.)

I did not spend much time on thinking of a regex as that would have been hairy, though I liked BrowserUk's regex (which could get unwieldy if needs to be modified).

Below is the version which checks for overlapping strings ("abcXa" is ok, "abca" not). As it is, the program below uses &A::C::permutations. Feel free to exercise any of the other two modules. Basically, the big idea is ...

sub find_once
{
  my ( $str , ... ) = @_ ;
  ...
  my ( $pos , $once ) = ( 0 ) x2;
  while ( my $p = get_permutation_string() )
  {
    last if $once > 1;
    ( $pos = index $str , $p , $pos ) >= 0 and $once++ ;
  }
  return $once == 1;
}
[download]

Update: I just noticed that "once" specification is in the title, but missing from the body.

#!/usr/local/bin/perl

use warnings; use strict;

use Algorithm::Permute;
use Algorithm::Combinatorics qw/ permutations /;
use Math::Combinatorics;

my @in =
  qw(
   abc
   cab
   bac
   acba
   acbac
   acbacb
   acbXa
   acbXac
   acbXacb
   acbaXc
   acbaXcb
   acbacXb
   acbacbX
  ) ;

my @need = qw( a b c );

printf "%10s ok? %s\n"
  , "'$_'"
  #  Feel free to switch to any other function.
  , !!find_once_AC( $_ , @need )  ? 'yes' : 'no'
    for @in ;

exit;

#  Using Algorithm::Permute.
sub find_once_AP
{
  my ( $str , @char ) = @_;

  my $permute = Algorithm::Permute->new( [ @char ] );

  my ( $pos , $once ) = ( 0 ) x 2;
  while ( my $p = join '' , $permute->next )
  {
    last if $once > 1;
    ( $pos = index $str , $p , $pos ) >= 0 and $once++ ;
  }
  return $once == 1;
}

#  Using Math::Combinatorics.
sub find_once_MC
{
  my ( $str , @char ) = @_;

  my $permute = Math::Combinatorics->new( 'data' => [ @char ] );

  my ( $pos , $once ) = ( 0 ) x 2;
  while ( my $p = join '' , $permute->next_permutation )
  {
    last if $once > 1;
    ( $pos = index $str , $p , $pos ) >= 0 and $once++ ;
  }
  return $once == 1;
}

#  Using Algorithm::Combinatorics.
sub find_once_AC
{
  my ( $str , @char ) = @_;

  my $permute = permutations( [ @char ] );

  my ( $pos , $once ) = ( 0 ) x 2;
  while ( my $p = $permute->next )
  {
    $p = join '' , @{ $p };
    last if $once > 1;
    ( $pos = index $str , $p , $pos ) >= 0 and $once++ ;
  }
  return $once == 1;
}
[download]

In reply to Re: REgular expression to check the string that allows "a","b" and "c" to occur only once in any order. by parv
in thread REgular expression to check the string that allows "a","b" and "c" to occur only once in any order. by isha

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


laziness, impatience, and hubris
	PerlMonks