RDW #2 (Rätsel vom 16.07.2004)

Aufgabe

 RDW #2 - Rätsel der Woche Nummer 2
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


 Regeln:  * Bitte nicht vor Ablauf der ersten 72 Stunden ( = drei Tage )
 ~~~~~~~    nach Veröffentlichung Hinweise (Spoiler) oder Lösungen ver-
            öffentlichen!

          * Wenn diese Zeit abgelaufen ist, werde ich einen Thread mit
            passendem Titel erstellen, in dem die Lösungen gepostet werden
            und diskutiert werden können.

          * Die Lösungen sollten nicht nur gepostet, sondern auch an mich
            gemailt werden, damit ich sie testen, "bewerten"  und zu-
            sammenfassen kann.
            Die Adrese dafür lautet:

            crian <---AT---> perl <---MINUS---> community <---DOT---> de

            Im Betreff sollte 'RDW' und die Nummer des Rätsels stehen.
            Hilfreich wäre neben dem Quellcode der Username im Forum
            sowie Perl- und OS-Version, falls Du diese kennst.


          * Verständnisfragen dürfen in diesem Thread gestellt werden, aber
            Tipps und (Teil-) Lösungen sind hier unerwünscht.

          * Ich werde die eingeschickten Programme im Netz zur Verfügung
            stellen, so dass gerade lange Quellcodes nicht (komplett)
            gepostet werden müssen.

          * Zur Verwendung von Modulen: Ich möchte diese nicht generell
            ausschließen, aber wenn quasi die komplette Aufgabe durch
            die Verwendung eines Moduls ersetzt werden kann, ist dies
            vielleicht nicht der Sinn der Aufgabe gewesen.



 Aufgabe: Berechnung der Potenzmenge:
 ~~~~~~~~ 
          Sei A eine Menge. Die Menge aller Teilmengen von A heisst
          Potenzmenge von A.

          Beispiel: A={1, 2, 3]
                    => P(A)={{},{1},{2},{3},{1,2},{1,3},{2,3},{1,2,3}}
          Eine Menge wird in Perl durch eine Arrayreferenz repräsentiert.
          Die Menge A enthält natürlich jedes Element maximal einmal.
          Diese Eigenschaft überträgt sich natürlich auf die Teilmengen.

          Schreibe die Funktion P!

          (Diese Aufgabe stammt von kabel. Die Verwendung von Modulen
          ist dieses Mal generell untersagt.)

Forumsdiskussion

Beitrag im Forum: http://board.perl-community.de/cgi-bin/ikonboard/ikonboard.cgi?act=ST;f=6;st=0;t=901;

Lösungen

gibt's erst am Ende der Zeit...

Auswertung RDW #2

Teilnehmer (alphabetisch nach Nickname)

1. Betterworld
2. Crian
3. DS
4. Esskar
5. Ishka
6. Murphy
7. pq
8. ptk
9. Renee
10. Ronnie
11. Taulmarill

Uebersicht ueber die Algorithmen

• Algorithmus A1 Die gegebene Menge A habe N Elemente. Nun wird fuer n = 0, 1, ... , N die Menge der n-elementigen Teilmengen der N Elemente von A erzeugt und in die Potenzmenge eingefuegt.
• Algorithmus A2 Rekursiv wird ein Element aus der Menge entnommen und dann die Potenzmenge der Restmenge ohne dieses Element gebildet. Dann wird jede Menge aus dieser Potenzmenge verdoppelt und in eine Kopie das vorher herausgenommene Element eingefuegt. (Dies veranschaulicht auch sehr schoen, warum die Anzahl der Mengen in der Potenzmenge gerade zwei hoch Maechtigkeit von A ist.)

Uebersicht ueber die Loesungen

Alle getesteten Loesungen geben die Potenzmenge der leeren Menge richtig zurueck und sind auch sonst inhaltlich richtig, zumindestens mit numerischen Elementen. Einige Loesungen haben mit alphanumerischen Werten in den Mengen Porbleme. Die Behandlung von falschen Mengen (etwa mit doppelten Elementen o.ae.) habe ich nicht getestet, Garbage in Garbage out ist ok.

Teilnehmer	Algorithmus	P() vorhanden	mit alphanum. Werten ok	Reihenfolge schoen	Code kommentiert
Betterworld	??	nein	ja	nein	ja
Crian	A1	ja	ja	ja	ja
DS	A2	ja	ja	nein	ja
Esskar	A2	ja	ja	ja	ja
Ishka	A2?	nein	ja	nein	nein
Murphy	??	ja	ja	nein	nein
pq	A2	ja	ja	nein	ja
ptk	??	nein	ja	ja	ja
Renee	??	ja	nein	ja	nein
Ronnie	??	nein	nein	nein	nein
Taulmarill	A2	ja	ja	nein	nein

Diese Tabelle spiegelt natuerlich nur wieder, was mir u.a. wichtig war, deshalb erfuellt meine Loesung diese Punkte natuerlich. Insofern ist die Tabelle etwas unfair. Bitte nicht aergern =)

Interessanter Weise hat ausser mir nienmand den Algorithmus A1 gewaehlt. Dafuer liefert meine Loesung jetzt den Code fuer die Erzeugung aller Mengen mit k aus n Elementen.

Betterworld

Diese Loesung braucht Perl Version 5.8.1 oder groesser. Braucht bei 15 Elementen sehr sehr lange. (Kommentar von betterworld: Es geht schon ab 5.8.0, dazu einfach die require-Zeile entfernen. Fiel mir zu spaet auf.)

#!/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; # fuer [: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";

Crian

#!/usr/bin/perl
# Autor: Crian
# RDW 02 - Berechnung der Potenzmenge einer Menge
# Variante 2

use strict;
use warnings;


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


sub print_A_und_P {
    my ($A, $P) = @_;

    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   = [[]];
    my $N   = scalar @$A;

    # In jedem Schleifendurchlauf der folgenden for-Schleife wird
    # die Menge der $n elementigen Mengen aus $N Elementen gebildet:
    for my $n (1..$N) {
        # $n Elemente aus $N Elementen auswaehlen:
        my @Mengen; # Menge mit Nummermengen
        for my $element (1..$n) {
            # Moegliche Nummern fuer Element $element belegen:
            my @M = $element-1 .. $N-($n-$element)-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
        # und Abspeichern der sich ergebenden Mengen:
        for my $menge (@Mengen) {
            push @$P, [ map { $_ = $A->[$_] } @$menge ];
        }
    }

    return $P;
}

DS

#!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(@_) }

Esskar

Braucht bei 15 Elementen sehr sehr lange.

#!/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}]
}

Erklärung (nach umschreiben in lesbarere Form):

#!/usr/bin/perl

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

print Dumper P(\@ARGV);

# Die Potenzmenge einer Menge ist die Menge aller möglichen Teilmengen.
# Beispielsweise ist die Potenzmenge von {a,b,c} = {{},{a},{b},{c},{a,b},{b,c},{a,c},{a,b,c}}.
# Um die Potenzmenge zu bestimmen, nimmt man sich das letzte Element der
# Menge heraus. Man unterscheidet dann die Teilmengen ohne dieses und die mit
# ihm. Erstere sind die Potenzmenge der übrigen Elemente, letztere auch,
# nur das das herausgegriffene noch vor jede dazu gestellt wird. Also:
# P(abc) = P(ab) + P(ab) mit jeweils c dazu.
# Alles klar? Hatte ich auch nicht mit gerechnet... :)
# Man kann es auch umgekehrt machen in dem man beim Rest nicht das letzte,
# sondern das erste Element entfernt (shift anstatt pop) und dann das erste
# Element dazu stellt ( $m->[0] anstatt $m->[-1]) ; ändert eben nur die
# Reihenfolge bei der Darstellung

sub P {
   my($m, $e, $p) =(@_, [], []); # $e und $p werden mit [] aufgefüllt
                                 # falls $#_ < 2
                                 # stellt die Menge da, deren Potenzmenge
                                 # gebildet werden soll
                                 # $e ist ein Akkumulator
                                 # $p die Potenzmenge selbst

   if(!@{$m}) # wir haben nix mehr zu tun
   {
      push@{$p}, $e; # füge den Akkumulator zur Potenzmenge
   }
   else
   {
      P(Rest($m), [@{$e}], $p); # Bilde die Potenzmenge des Rests von M
      P(Rest($m), [sort@{$e}, Last($m)], $p); # Bilde die Potenzmenge des Rests von M
                           # jedoch Merke dir das letzte Element der Menge
                           # im Akkumulator
                           # sortieren ist unnötig, dient später nur der
                           # 'sauberen' Darstellung
   }
   return [ sort { @{$a} <=> @{$b} } @{$p} ]; # Gebe immer schon mal die
                        # Potenzmenge der Teilmengen zurück
                        # sort dient wieder nur der Schönheit
}

sub Rest { # Liefert eine Teilmenge von $m; $m ohne das letzte Element
   my @m = @{(shift)};
   pop @m;
   return [@m];
}

sub Last { # Liefert das letzte Element der Menge $m
   my $m = shift;
   return $m->[-1];
}

Grüße, SaschaKieferAkaEsskar

Ishka

Funktioniert in meiner Testumgebung leider nicht, da keine Mengen von Mengen (also Arrays of Arrays) erzeugt werden. Dies ist aber mein Fehler, da das eingereichte Skript funktioniert.

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

my %pot=();

$"=';';
for(@ARGV){if(m#$"#){$".=int rand 10;redo}}# Damit der Inhalt von $" in keinem Element vorkommt

sub add
{
$pot{"@_"}=\@_;
for my $n(0..$#_){
my @n=@_;
splice @n,$n,1;
add(@n) unless exists $pot{"@n"}}
}

add(@ARGV);
$"=', ';# Fuer die Ausgabe wollen wir das schoener joinen
print "P(@ARGV) = {";
my $i=0;
for(values %pot){
 print ", " unless 0==$i++;
 print "{@$_}"}
print "}\n";

Murphy

#!/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));

pq

#!/usr/bin/perl
# RDW 2
# 18.07.2004
# author: pq
# usage: skript.pl 1 2 3 4 ...
package main;
use strict;
use warnings;
my @a = @ARGV;
my @res =  p(@a);
print "Die Potenzmenge von (@a):\n";

for (sort {
       @$a <=> @$b
   } @res) {
   print "(@$_)\n";
}

sub p {
   my @m = @_;
   unless (@m) {
      # die Potenzmenge der leeren Menge ist die leere Menge
      return [];
   }
   else {
      my $el = shift @m;
      # um die Potenzmenge einer Menge M herauszufinden,
      # nimmt man sich ein Element e und bildet die Potenzmenge PR
      # der Restmenge R
      # jede Untermenge U in PR verdoppelt man und fuegt
      # dem Duplikat das Element e hinzu
      my @p = map {([@$_, $el], $_)} p(@m);
      return @p;
   }
}

ptk

#!/usr/bin/perl

use strict;

# Eingabe
my @array = (1..9);

my %res;
warn time;
oneless(@array);
warn time;

# Formatierung der Ausgabe
# Key als Array umschreiben
my @res;
while(my($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 Data::Dumper;
print Data::Dumper->new([\@res],['res'])->Indent(0)->Dump, "\n";

sub oneless {
   my @array = @_;
   $res{ join",",@array } = 1;
   return if !@array;
   for my $i (0 .. $#array) {
       oneless(map { $array[$_] } 0 .. $i-1, $i+1 .. $#array);
   }
}

Renee

#! /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;
} 

Ronnie

#!/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;

Taulmarill

#!/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(@_)
    } @_;
}

Golf-Auswertung

Auf der Webseite http://pepe.is-a-geek.org/potenzmengengolf.html

Downloads

Alle Dateien in einem Archiv:

• rdw02_stuff.tgz

Aufgabenstellung, Auswertung etc:

• Aufgabenstellung rdw02.txt
• Auswertung rdw02_auswertung.pl
• Auswertungstextgrundlage rdw02_auswertung.wiki

Einzelne Loesungen:

• rdw02_betterworld.pl
• rdw02_crian.pl
• rdw02_crian2.pl
• rdw02_ds.pl
• rdw02_ds.pasm
• rdw02_esskar.pl
• rdw02_esskar2.pl
• rdw02_esskar3.pl
• rdw02_ishka.pl
• rdw02_murphy.pl
• rdw02_pq.pl
• rdw02_pq_golf.pl
• rdw02_pq_golf_2_59.pl
• rdw02_ptk.pl
• rdw02_renee.pl
• rdw02_ronnie.pl
• rdw02_taulmarill1.pl
• rdw02_taulmarill2.pl
• rdw02_taulmarill3.pl
• rdw02_taulmarill3.sh
• rdw02_taulmarill4.pl

-- ChristianDuehl - 16 Jul 2004

-- ChristianDuehl - 21 Jul 2004

-- ChristianDuehl - 22 Jul 2004

-- SaschaKieferAkaEsskar - 24 Jul 2004