#!/usr/bin/perl
# Dieses Skript gibt die Potenzmenge der Liste seiner Parameter aus.
# Loesung von betterworld / perl-community.de

require 5.8.1; # Wegen (??{})
use strict;
use warnings;
use locale; # für [:print:]
use re 'eval';


my %hash;

sub pushit{
  my @ar = grep {defined and length } map {eval '$'.$_} 1..@ARGV;
  my $cute_list = join ",", @ar;

  # An alle Tester: Gibt das bei Euch auch einen Segfault, wenn man diese
  # Zeile durch $cute_list =~ s/\n//g ersetzt?
  # Und wenn ich beides nehme, passieren noch seltsamere Sachen...
  $cute_list =~ y/\n//d;

  $hash{$cute_list} = undef if length $cute_list;
  return qr/^.^/; # Das sollte nie matchen --> Backtracing
}

my $A = (join "\n", @ARGV)."\n";
my $re = join '(?:^.*\n)*', map {'(^.*\n)?'} 1..@ARGV;

# Hier passiert die eigentliche Arbeit
$A =~ m/$re(??{pushit()})/m;

print "{";
if ("\370" =~ /[[:print:]]/) {
  print "\370";
} else {
  print "{}";
}

# Hier benutze ich ";" statt ",", damit man durch Zaehlen der Semikola in der
# Ausgabe leicht ueberpruefen kann, dass es 2**n Elemente sind.
print "; {$_}" for sort keys %hash;

print "}\n";

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;

my @bulk = (1, 2, 3);
my @mask = map {[split '', $_]} glob "{0,1}" x @bulk;
my @resultset;

foreach my $row (@mask) {
  push @resultset, [grep {$_!=0} map {$bulk[$_] * $row->[$_]} (0..$#bulk)];
}

print Dumper \@resultset;
exit;

#! /usr/bin/perl
use strict;
use warnings;

use Data::Dumper;


my @array = qw(1 2 3 4 5);

my $potenz = P(\@array);

print Dumper($potenz);



sub P{
  my ($arrayref) = @_;
  my $potenzmenge = [];
  my $base = [[]];
  my $bool = 1;
  my $length = 0;
  while($bool){
    push(@$potenzmenge,@$base);
    $base = calc_elems($base,$arrayref,$length);
    $length++;
    $bool = 0 if($length > scalar(@$arrayref))
  }

  return $potenzmenge;
}


sub calc_elems{
  my ($base,$arrayref,$length) = @_;
  my @array = @{$arrayref};
  my @new_elems = ();

  foreach my $base_elem(@$base){
    foreach my $index($length..(scalar(@array) - 1)){
      my @tmp_elem = @{$base_elem};
      last if($tmp_elem[-1] && ($tmp_elem[-1] >= ($array[-1])) &&
$length > 0);
      next if($tmp_elem[-1] && (($tmp_elem[-1] == $array[$index]) ||
$tmp_elem[-1] > $array[$index]));
      push(@tmp_elem,$array[$index]);
      push(@new_elems,[@tmp_elem]);
    }
  }

  return \@new_elems;
}

#!/usr/bin/perl

use strict;

# Eingabe
my @array = 1..3;

my %res;
oneless@array;

# Formatierung der Ausgabe
# Key als Array umschreiben
my @res;
whilemy$k = each %res {
    push @res, split /,/, $k;
}
# Ergebnisarray schoener sortieren
@res = sort {
    my $r = @$a = @$b;
    if $r == 0 {
        join,, @$a cmp join,, @$b;
    } else {
        $r;
    }
} @res;
require DataDumper;
print DataDumper-new\<@res,'res'-Indent0-Dump, \<n;

sub oneless {
    my @array = @_;
    $res{ join,,@array } = 1;
    return if !@array;
    for my $i 0 .. $#array {
        onelessmap { $array$_ } 0 .. $i-1, $i+1 .. $#array;
    }
}