receta.pl

use  strict;
use  warnings;

sub  generarPerm($$$){
  my $elem = shift;
  my $actual = shift;
  my $cant = shift;
  my @ret = ();
  my $used = {};
  my $retGen = 0;

  my $gen = sub{
    my $self = shift;
    my $elem = shift;
    my $actual = shift;
    my $cant = shift;
    if( $cant == 0 ){
      unless( exists $used->{$actual} ){
        $used->{$actual} = 1;
        push @ret, $actual;
        for( 0..8 ){
          push @ret, ( $_ ? substr( $actual, 0, $_ ) : '' ) . "*" .
                        substr( $actual, $_ + 1, length( $actual ) - $_ + 1 );
        }
      }
    } else {
      for my $i( 0 .. scalar(@$elem ) - 1 ){
         next unless $elem->[$i];
         my  @ee = @$elem;
         delete $ee[$i];
         $self->( $self, \@ee, $actual . $elem->[$i], $cant - 1 );
      }
    }
  };

  return  sub{
    unless( $retGen ){
      $gen->( $gen, $elem, $actual, $cant );
      $retGen = 1;
    }
    return( shift ( @ret ) );
  };

}

sub  igualConMasita($$$){
  my( $a, $b, $c ) = @_;
  $a = $b if $a eq '*';
  $b = $a if $b eq '*';
  $c = $a if $c eq '*';
  return $a == $b && $a == $c;
}



sub  esRica($){
  my  @array = split( '', shift() ) ;
  return 1 if igualConMasita( $array[0], $array[1], $array[2] );
  return 1 if igualConMasita( $array[3], $array[4], $array[5] );
  return 1 if igualConMasita( $array[6], $array[7], $array[8] );
  return 1 if igualConMasita( $array[0], $array[3], $array[6] );
  return 1 if igualConMasita( $array[1], $array[4], $array[7] );
  return 1 if igualConMasita( $array[2], $array[5], $array[8] );
  return 0;
}



my $e = [ 1, 1, 1, 2, 2, 2, 3, 3, 3 ];
my $i = generarPerm( $e, "", 9 );
my $count = 0;
my $ricas = 0;
while( my $p = $i->() ){
  my $e =  esRica($p);
  $count ++;
  $ricas ++ if $e;
  print  $p . ( $e ? '   es rica!' : '' ) . "\n";
}

print "Hay $count recetas, pero solo $ricas son ricas";