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

use Data::Dumper;


my $A = [ 'a', 'b', 'c', 'd', 'e' ];
my $P = P($A);

print "A = {", join(', ', @$A), "}\n";
print "P(A) = {\n";
for my $p (@$P) {
    print "         {", join(', ', @$p), "},\n";
}
print "       }\n";


sub P {
    my ($A) = @_;
    my $P   = [];

    for my $anzahl_elemente (0 .. scalar @$A) {
        push @$P, teilmengen($A, $anzahl_elemente);
    }

    return $P;
}


sub teilmengen {
    my ($A, $n) = @_;

    my @T = ();
    my $N = scalar @$A;

    if (0 == $n) {
        push @T, [];
    }
    else {
        # $n Elemente aus $N Elementen auswaehlen:
        my @Mengen; # Menge mit Nummermengen
        for my $element (1..$n) {
            my @M;

            # Moegliche Nummern fuer Element $element berechnen:
            for my $nummer ($element..$N-($n-$element)) {
                push @M, $nummer-1;
            }

            # Bei einelementigen Mengen Mengen mit nur diesem Element
            # erzeugen:
            unless (@Mengen) {
                push @Mengen, [ $_ ] for @M
            }

            # Anderenfalls Jede bisherige Nummernmenge aus @Mengen
            # vervielfachen und an jede Kopie eine der neuen
            # moeglichen Nummern anhaengen:
            else {
                my @TM = @Mengen;
                @Mengen = ();
                for my $tm (@TM) {
                    for my $m (@M) {
                        unless (grep { $_ >= $m } @$tm) {
                            push @Mengen, [ @$tm, $m ];
                        }
                    }
                }
            }
        }

        # Umsetzen der Nummern auf die Elemente der Menge:
        for my $menge (@Mengen) {
            push @T, [ map { $_ = $A->[$_] } @$menge ];
        }
    }

    return @T;
}

#!/usr/local/bin/perl

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

my @maengeA = qw/1 2 3/;

print Dumper funcP(@maengeA);

sub funcP {
    return () unless @_;
    return ( [ $_[0] ] ) unless @_ >= 1;

    map {
        my $first = shift @_;
        [$first], map { [ $first, @$_ ] } funcP(@_)
    } @_;
}

#!/usr/bin/perl

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

sub potset {
    my @set = @{shift(@_)};

    if (@set == 0) {
    return [[]];
    }
    else {
    my @ps = @{potset([@set[1..$#set]])};

    return [(map { my @l = @$_; push @l, $set[0]; [@l]; } @ps), @ps];
    }
}

print Dumper(potset(\@ARGV));

(define (potset s)
      (if (eqv? s '())
       '(())
       (let ((ls (potset (cdr s))))
        (append ls (map (lambda (l) (cons (car s) l)) ls)))))

#!/usr/bin/perl

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

print Dumper P(\@ARGV);

sub P {
   my($m,$e,$p)=(@_,[],[]);
   !@{$m}and push@{$p},$e or
   P(@_=@{$m}and pop and[@_],[@{$e}],$p)and
   P(@_=@{$m}and pop and[@_],[sort@{$e},$m->[-1]],$p);
   [sort{@{$a}<=>@{$b}}@{$p}]
}

#!perl

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

print Dumper [sort { @$a <=> @$b } &p(@ARGV ? @ARGV : (0,'',undef))];

sub p { my @p = ([]); push @p, map [@$_,$_[0]], @p and shift while @_; @p }
#sub p { @_ || return []; my $e = shift; p(@_),map [@$_,$e], p(@_) }

### Eingabe-Menge ausgeben
	print "Eingabe-Menge: {"
	set S0, ""
	set I4, 0
	set I5, P5
_print_em:
	inc I4
	eq I4, I5, _print_em_ende
	set S5, P5[I4]
	print S0
	set S0, ","
	print S5
	bsr _print_em
_print_em_ende:
	print "}\n"

### Programm initialisieren
	new P1, .PerlArray	# Potenzmenge
	new P2, .PerlArray	# wird initislisiert mit der "leeren Menge" als einziges Element
	set P1[0], P2

### Potenzmenge berechnen
	set I4, 0		# aktueller Index für P5
	set I5, P5		# Elemente in P5
_p:	# while
	inc I4
	eq I4, I5, _p_ende
	set P0, P5[I4]		# aktuelles Element der Eingabe-Menge

	set I0, 0		# aktueller Index für P1
	set I1, P1		# Elemente in P1
_p_map:	# map
	set P2, P1[I0]
	clone P3, P2		# aktuelle Teilmenge aus P1 kopieren,
	push P3, P0		# um aktuelles Element der Eingabe-Menge erweitern
	push P1, P3		# und wiederum an P1 anhängen

	inc I0
	ne I0, I1, _p_map
	bsr _p
_p_ende:
	
### Potenzmenge ausgeben
	print "Potenzmenge:   {"
	set S0, ""
	set I0, 0
	set I1, P1
_print_pm:
	print S0
	set S0, ","
	set P8, P1[I0]

	print "{"
	set S1, ""
	set I7, 0
	set I8, P8
	unless I8, _print_pm_tm_ende
_print_pm_tm:
	set S8, P8[I7]
	print S1
	set S1, ","
	print S8
	inc I7
	ne I7, I8, _print_pm_tm
_print_pm_tm_ende:
	print "}"

	inc I0
	ne I0, I1, _print_pm
	print "}\n"

### Programm beenden
	end