«

Hello,

i want to write a subroutine, that creates something like an
"brute-force-array" (i don't know a better name for this).

It should work like this: the subroutine gets a parameter e.g. "3".

Then the subroutine returns an Array with a,bc....aa,ab,ac....aaa,aab.....

Does someone have an idea how to solve this?

Susanne

On Thu, 29 Jul 2004, Susanne wrote:

> Hello,
>
> i want to write a subroutine, that creates something like an
> "brute-force-array" (i don't know a better name for this).

Coming up with one would help define your problem.

> It should work like this: the subroutine gets a parameter e.g. "3".
>
> Then the subroutine returns an Array with a,bc....aa,ab,ac....aaa,aab.....
>
> Does someone have an idea how to solve this?

Solve what? You have not at all defined your problem statement. You've
shown input, you've shown something resembling output, but you haven't
come close to telling us how one relates to the other.

What does '3' have to do with what you showed us? Is it the number of
letters used in the resulting data? Is it the maximum length of the
string in the resulting data? Is it the maxium length of a subset in the
resulting data?

And what exactly *is* the output? A series of strings? A collection of
arrays of strings?

You need to be a lot more precise with what you're trying to do before
you'll get any helpful advise.

While you're at it, check out the FAQ answer to "How do I permute N
elements of a list?" to see if that gives you any ideas.
perldoc -q permute


Paul Lalli

ok...sorry:

i have got this:

my @test = (a,b,c);
my $length = 4;

foreach $letter(@test){
for (my $i =0; $i<=3; $i++){
$out = $letter.$test[$i];
push (my @array, $out);
}
}
return @array;


but this way i only got [a, aa, ab, ac, ad, ae....] but nothing over two
letters. but i also want the values "aaa, aab, aac, aba...." in my array.
The length should be given bei the $length-String.

I hope it's more clear now.


Susanne

On Thu, 29 Jul 2004, Susanne wrote:

> ok...sorry:
>
> i have got this:
>
> my @test = (a,b,c);
> my $length = 4;
>
> foreach $letter(@test){
> for (my $i =0; $i<=3; $i++){
> $out = $letter.$test[$i];
> push (my @array, $out);
> }
> }
> return @array;
>

No you don't. This produces no output, as @array is completely empty when
you leave the for loops. Post real code.

>
> but this way i only got [a, aa, ab, ac, ad, ae....]

No you didn't. There's no way to produce ad or ae with that code. Post
real results.

> but nothing over two
> letters. but i also want the values "aaa, aab, aac, aba...." in my array.
> The length should be given bei the $length-String.

1) I ask again - the length of what? The maximum length of the string in
the resulting array? Or the maximum size of the array itself?

2) You're not using $length anywhere after declaring it. How are you
expecting it to work?

> I hope it's more clear now.

Mildly. Did you look at the "permute" documentation I posted earlier? It
should be possible to do this fairly easily using the List:ermutor
module it refers to...

Paul Lalli

P.S. When replying, please include the text you're replying to, above
your reply. Thanks.

On Thu, 29 Jul 2004, Paul Lalli wrote:

> > ok...sorry:
> >
> > i have got this:
> >
> > my @test = (a,b,c);
> > my $length = 4;
> >
> > foreach $letter(@test){
> > for (my $i =0; $i<=3; $i++){
> > $out = $letter.$test[$i];
> > push (my @array, $out);
> > }
> > }
> > return @array;
> >
> > I hope it's more clear now.
>
> Mildly. Did you look at the "permute" documentation I posted earlier? It
> should be possible to do this fairly easily using the List:ermutor
> module it refers to...

I got bored while waiting for some clients at work... This is my first
attempt. It's not at all efficient, and I'm sure others here would be
able to make it much cleaner. But it does produce (what I believe to be)
your desired output:

#!/usr/bin/env perl
use strict;
use warnings;
use List:ermutor;

my @data = qw/a b c d/;

my %results; #where we'll store each string we find

sub perm {
return unless @_; #base case for recursion is just to exit

my $perm = new List:ermutor @_;
while (my @tempresults = $perm->next){
#join each subset into a string, and record it
$results{join '', @tempresults}++;
}

#remove one element at a time from data, and permute the result
for my $i (0 .. $#_){
my @temp = @_;
splice @temp, $i, 1;
perm(@temp);
}
}

#start everything off
perm (@data);

#Get one copy each of each string found.
my @results = sort keys %results;
print "@results\n";
__END__

a ab abc abcd abd abdc ac acb acbd acd acdb ad adb adbc adc adcb b ba bac
bacd bad badc bc bca bcad bcd bcda bd bda bdac bdc bdca c ca cab cabd cad
cadb cb cba cbad cbd cbda cd cda cdab cdb cdba d da dab dabc dac dacb db
dba dbac dbc dbca dc dca dcab dcb dcba

"Susanne" <> writes:

> ok...sorry:
>
> i have got this:
>
> my @test = (a,b,c);
> my $length = 4;
>
> foreach $letter(@test){
> for (my $i =0; $i<=3; $i++){
> $out = $letter.$test[$i];
> push (my @array, $out);
> }
> }
> return @array;
>
>
> but this way i only got [a, aa, ab, ac, ad, ae....] but nothing over two
> letters. but i also want the values "aaa, aab, aac, aba...." in my array.
> The length should be given bei the $length-String.
>
sub brute_array {
my $length = shift;
my $test = shift;


my $combo = sub {
my ($a,$b) = @_;
my @r = ();
for (@$a) {
my $s = $_;
for (@$b) {
push (@r, $s . $_);
};
};
return \@r;
};


my $s = [""];
my @r = ();
for (1 .. $length) {
$s = &$combo ($s, $test);
push (@r, @$s);
};
return \@r;
};



Klaus Schilling

bowsayge <> wrote in comp.lang.perl.misc:
> Susanne said to us:
>
> [...]
> > but this way i only got [a, aa, ab, ac, ad, ae....] but nothing over two
> > letters.
> [...]
>
> Is something like this what you want to do?
>
> #!/usr/bin/perl
> use strict;
> use warnings;
>
> my ($length, @test) = (4, 'a'..'c');
>
> sub func {
> my ($bref, $depth) = (@_);
> if ($depth >= $length) {
> print "$bref\n";
> return;
> }
> foreach my $var (@test) {
> func("$bref$var", $depth + 1);
> }
> }
>
> func '', 0;
>
>
> The length of the string is always 4 chars with this program.
> Bowsayge doesn't know how to include the shorter strings such
> as "aa, ab, ... abc". Perhaps someone can modify the program
> to get those too?

Very easy. Just call the function with different values in the
global $length:

for ( 1 .. 4 ) (
$length = $_; # loop var would have been aliased
func '', 0;
}

But the length and also the alphabet (@test) should really be
function parameters, not globals.

sub func {
my ($bref, $depth, $length, @alphabet) = (@_);
if ($depth >= $length) {
print "$bref\n";
return;
}
foreach my $var (@alphabet ) {
func("$bref$var", $depth + 1, $length, @alphabet);
}
}

func( '', 0, $_, 'a' .. 'c') for 1 .. 4;

This still isn't very pretty. The first two parameters are only
needed to start the recursion off, the user (of func()) shouldn't
have to deal with them. The standard solution is to make func() an
internal routine "_func_recurs" (say) and give the user (untested):

sub func {
my ( $length, @alphabet) = @_;
_func_recurs( '', 0, $length, @alphabet);
}

There may be better ways to integrate the call.

Anno