Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Allgemeines zu Perl
[thread]12655[/thread]

Pythagorische Tripel (Seite 2)

Leser: 5


<< |< 1 2 >| >> 19 Einträge, 2 Seiten
LanX-
 2008-10-29 20:22
#115834 #115834
User since
2008-07-15
1000 Artikel
BenutzerIn

user image
zum Vergleich Lösungen mit map und grep

Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

use Data::Dumper;

print Dumper
    map { my $a=$_;
          map { my $b=$_;
                map { $a**2 == $b **2 + $_ **2
                        ?  [ $_, $b, $a ]
                        :  ()
                } (1..$b)
            } (1..$a)
        } (1..10);


print Dumper
    grep { $_->[0]**2 == $_->[1] **2 + $_->[2] **2 }
        map { my $a=$_;
            map { my $b=$_;
                map {
                    [ $a, $b, $_ ]
                } (1..$b)
            } (1..$a)
        } (1..10);


die letzte Variante ist extrem fleißig!
me and my writeups
MatthiasW
 2008-10-29 23:13
#115839 #115839
User since
2008-01-27
367 Artikel
BenutzerIn
[default_avatar]
LanX-+2008-10-29 17:26:00--
BTW: Auch kann man es so (noch) NICHT schachteln!

Aber wenigstens untereinander verwenden ;)
Möchte man es noch verschachteln, kann man für jedes gather eine eigene Liste verwenden:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

{
        my @list;

        sub gather (&)
        {
                my( $sub ) = @_;

                push @list, [];
                $sub->();

                return @{ pop @list };
        } # gather

        sub take { push @{ $list[-1] }, @_ }
}

LanX-+2008-10-29 17:26:00--
Danke, trotz googeln übersehen ... aber es ist AFAIS zu billig um auf Ronnies Problem angesetzt zu werden, man übergibt fixe Arrayrefs, d.h. $j kann nicht dynamisch bis (1..$i) laufen.

Bei meienm Ansatz kann das ganze semantische Spektrum von Python abgedeckt werden.

Auf den ersten Blick sah das Modul ganz gut aus, und auch der Name hat so schön gepasst ;) Aber hast Recht, ist tatsächlich nicht gerade toll..

Hier mein Ansatz:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;

sub comp
{
        my( $sub, $var, $list, @x ) = @_;

        my @l;

        no strict 'refs';
        for ( $list->() )
        {
                ${"::$var"} = $_;
                push @l, @x ? comp( $sub, @x ) : $sub->();
        } # for

        return @l;
} # comp

my @tripel = comp sub{
        $::i**2 == $::j**2 + $::k**2
                ? [$::k, $::j, $::i]
                : ()
},      'i' => sub{ 1..  10 },
        'j' => sub{ 1..$::i },
        'k' => sub{ 1..$::j };

print Dumper( \@tripel ), "\n";

Besonders störend finde ich die ::, mir ist nur nichts besseres eingefallen, was halbwegs sauber wäre.

Lagert man die comp-Funktion jedoch in ein Modul aus, dann kann man auch mit package-Variablen arbeiten.
Comp.pm:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

package Comp;

use strict qw( vars subs );
use warnings;

sub import
{
        my( $class ) = caller();

        my $comp;
        $comp = sub {
                my( $sub, $var, $list, @x ) = @_;

                my @l;

                for ( $list->() )
                {
                        ${$class.'::'.$var} = $_;
                        push @l, @x ? $comp->( $sub, @x ) : $sub->();
                } # for

                return @l;
        };

        *{$class.'::comp'} = $comp;
} # import

1;

Hier ein Beispiel zu dem Modul:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

#!/usr/bin/perl

use strict;
use warnings;

use Comp;
use Data::Dumper;

our( $i, $j, $k );
my @tripel = comp sub{
        $i**2 == $j**2 + $k**2
                ? [$k, $j, $i]
                : ()
},      'i' => sub{ 1..10 },
        'j' => sub{ 1..$i },
        'k' => sub{ 1..$j };

print Dumper( \@tripel ), "\n";

MfG
perl -E'*==*",s;;%ENV=~m,..$,,$&+42;e,$==f;$"++for+ab..an;@"=qw,u t,,print+chr;sub f{split}say"@{=} me"'
Ronnie
 2008-10-29 23:44
#115840 #115840
User since
2003-08-14
2022 Artikel
BenutzerIn
[default_avatar]
Hallo zusammen,

sehr schick was ihr da gemacht habt. Die Lösung mit der while-Schleife und dem Closure habe ich erstmal 'ne Weile angestarrt, bis ich endlich die Curlies (und damit das Closure) außenrum wahrgenommen habe. Das gefällt mir sehr gut. Den Rest muss ich mir morgen nochmal in Ruhe betrachten, aber ich finde es schon jetzt sehr spannend.

Gruß und vielen Dank,
Ronnie

PS.: @Rolf, wir sollten mal schauen, das wir einen Termin für das nächste darmstadt.pm finden. Ich kann positives von meiner Rolle als Don Quijote berichten (und was das CPAN damit zu tun hat).
LanX-
 2008-10-30 00:44
#115848 #115848
User since
2008-07-15
1000 Artikel
BenutzerIn

user image
Hi Matthias,

MatthiasW+2008-10-29 22:13:33--
LanX-+2008-10-29 17:26:00--
BTW: Auch kann man es so (noch) NICHT schachteln!

Aber wenigstens untereinander verwenden ;)
Möchte man es noch verschachteln, kann man für jedes gather eine eigene Liste verwenden:


statt einen Stack zu bauen kann man auch einfach die Liste "local"isieren. Da local mit lexicals nicht erlaubt ist muss mans manuell swappen.

Aber deine Lösung bietet auch Möglichkeiten an, auf übergeordnete "gathers" zu "taken" , sofern man das jemals braucht. ;)

Schon beim verschachteln fällt es mir schwer eine sinnvolle Anwendung zu finden...

Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

### gather schachteln?

{
    my $list_ref=[];

    sub gather (&){
        my $code_ref=shift;

        my @list=();
        my $safe=$list_ref;
        $list_ref=\@list;

        &$code_ref;

        $list_ref=$safe;

        return @list;
    }

    sub take  {
        push @$list_ref, @_;
        return;
    }
}


#-  simple test

@x= gather{ take [$_] for (1..3) };

print Dumper \@x;
   
#-  nested test

@x=();

@x= gather{
    take
        gather{ my $x=$_;
                take [$_,$x] for (1..$x)
            } for (1..5);
   };

print Dumper \@x;

me and my writeups
LanX-
 2008-10-30 01:36
#115849 #115849
User since
2008-07-15
1000 Artikel
BenutzerIn

user image
MatthiasW+2008-10-29 22:13:33--
Besonders störend finde ich die ::, mir ist nur nichts besseres eingefallen, was halbwegs sauber wäre.


nimm einfach Lexicals aus dem umliegenden Scope, also sowas

Code (perl): (dl )
1
2
3
4

{
   my ($x,$j);
   aufruf ( sub { $x... }, sub { $j ...} );
}


viel störender finde ich dass man in perl für anonyme subs (fast) auch immer sub schreiben muss um die Verwechslung mit Hashes auszuschließen!

Sogar wenn man mit Prototypes arbeitet, kann man sichs nur für den ersten Parameter sparen!

8 ( Ich wünschte man hätte den Per6-Syntax schon längst auf dem Perl5 Compiler aufgebockt und wäre dafür Parrot erst später angegangen! ) 8

Aber wie gesagt, nur um ein paar Klammerpaare zu sparen lohnt der Aufwand IMHO nicht, eine so eine starre Speziallösung zu bauen.

Viel interessanter fände ich einen schönen Syntax für eine lazy-Lösung zu finden.
me and my writeups
LanX-
 2008-10-30 04:20
#115850 #115850
User since
2008-07-15
1000 Artikel
BenutzerIn

user image
Ronnie+2008-10-29 22:44:08--
sehr schick was ihr da gemacht habt. Die Lösung mit der while-Schleife und dem Closure habe ich erstmal 'ne Weile angestarrt, bis ich endlich die Curlies (und damit das Closure) außenrum wahrgenommen habe. Das gefällt mir sehr gut. Den Rest muss ich mir morgen nochmal in Ruhe betrachten, aber ich finde es schon jetzt sehr spannend.


Starr mal weiter, die Lazy-Version ist leider fehlerhaft... man muss die Inkrementierungen an die Schleifenenden setzen ... vielleicht mit do-while!

ich hadere ob sowas mit foreach machbar ist ...grübel.
me and my writeups
LanX-
 2008-10-30 18:04
#115862 #115862
User since
2008-07-15
1000 Artikel
BenutzerIn

user image
so hier ein funktionierender lazy-iterator, allerdings schon recht Tricky eine Schleife fortzusetzen.

Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

                  
{
    my ($c,$b,$a)=(1,1,1);

    sub lazy {
        for ( ; $c <=  $max ; $c++  ) {
            for ( ;  $b <= $c  ;  $b++ ) {
                for ( ;  $a <= $b  ; $a++ ) {
                  return [$c,$b,$a++] if $c**2 == $b**2 + $a**2;
                };
                $a=1; #reset
            };
            $b=1; #reset
        }
       $c=1;
        return;
    }
}





while ( $triple = lazy() ) {
    print Dumper $triple;
}
me and my writeups
MatthiasW
 2008-10-31 19:20
#115889 #115889
User since
2008-01-27
367 Artikel
BenutzerIn
[default_avatar]
Mit nachfolgendem Modul gehts auch so:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

my( $i, $j, $k );
my $li = lazy { ${$_[0]}++ } 1;
my $lj = lazy { ${$_[0]} > $i ? undef : ${$_[0]}++ } 1;
my $lk = lazy { ${$_[0]} > $j ? undef : ${$_[0]}++ } 1;

my $iterator = sub {
        lcomp { $i**2 == $j**2 + $k**2 ? [$k,$j,$i] : undef }
                \$i => $li,
                \$j => $lj,
                \$k => $lk;
};

while ( defined( my $elem = $iterator->() ) ) {
        print Dumper( $elem );
        <STDIN> eq "q\n" and exit;
} # while

Wobei $iterator eigentlich überflüssig ist. lazy() spart im Prinzip nur Tipparbeit, beim erstellen einer Closure und lcomp() funktioniert fast genauso wie comp(), nur dass die einzelnen Funktionen undef zurückgeben um zu signalisieren, dass sie keine weiteren Werte mehr liefern.

Hier das Modul:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

package Comp;

use strict qw( vars subs );
use warnings;

sub import
{
        my( $class, $file, $line ) = caller();

        #
        # comp { ... } ?VAR? => SUB, ...
        #
        my $comp;
        $comp = sub (&;@) {
                my( $sub, $var, $list, @x ) = @_;

                if ( my $r = ref($var) )
                {
                        if ( $r eq 'CODE' )
                        {
                                push @x, $list;
                                $list = $var;
                                $var  = undef;
                        } # if
                        elsif ( $r ne 'SCALAR' )
                        {
                                die
"Neither a SCALAR nor a CODE reference in comp() in file '$file' at line $line.\n";
                        } # elsif
                } # if
                else
                {
                        $var = \${$class.'::'.$var};
                } # else

                my @l;

                for ( $list->() )
                {
                        $$var = $_ if defined $var;
                        push @l, @x ? $comp->( $sub, @x ) : $sub->();
                } # for

                return @l;
        };

        #
        # lcomp { ... } ?VAR? => LAZYSUB, ...
        #
        my $lcomp;
        $lcomp = sub (&;@) {
                my( $sub, $var, $list, @x ) = @_;

                if ( my $r = ref($var) )
                {
                        if ( $r eq 'CODE' )
                        {
                                push @x, $list;
                                $list = $var;
                                $var  = undef;
                        } # if
                        elsif ( $r ne 'SCALAR' )
                        {
                                die
"Neither a SCALAR nor a CODE reference in comp() in file '$file' at line $line.\n";
                        } # elsif
                } # if
                else
                {
                        $var = \${$class.'::'.$var};
                } # else

                while ( defined( my $elem = $list->() ) )
                {
                        $$var = $elem if defined $var;

                        my($res) = @x ? $lcomp->( $sub, @x ) : $sub->();
                        return $res if defined $res;
                } # for

                return undef;
        };

        #
        # lazy { ... } START
        #
        my $lazy = sub (&$) {
                my( $sub, $val ) = @_;

                my $start = $val;

                return sub{
                        my($res) = $sub->(\$val);
                        $val = $start if ! defined $res;
                        return $res;
                };
        };

        *{$class.'::comp' } = $comp ;
        *{$class.'::lcomp'} = $lcomp;
        *{$class.'::lazy' } = $lazy ;
} # import

1;

__END__

Falls man die Werte der Listen bei comp() / lcomp() in Variablen speichern möchte, kann man jetzt anstatt eines Strings eine Skalar-Referenz übergeben, in die geschrieben wird.
Ein String ist immer noch möglich, dann wird die jeweilige package-Variable verändert.

edit: Die Fehlermeldung der beiden die()s in die nächste Zeile geschoben.

MfG
perl -E'*==*",s;;%ENV=~m,..$,,$&+42;e,$==f;$"++for+ab..an;@"=qw,u t,,print+chr;sub f{split}say"@{=} me"'
LanX-
 2008-10-31 23:32
#115890 #115890
User since
2008-07-15
1000 Artikel
BenutzerIn

user image
also ich weiß nicht ...
Quote
Perl programmers are obsessed with syntax!
--- M.J.Dominus


Ehrlich gesagt eine allgemeine Lösung mit Continuations wär mir eigentlich lieber!

Moritz hat sich schon daran versucht, allerdings erscheint mir CPAN:Coro ziemlich gewaltig...

CPAN:gather-take


Schade dass es für Perl keinen verlässlichen Macromechanismus gibt bzw. mir aufdrängt.

Sonst ginge nämlich sowas:

Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

{
    my $j=0;
    my $resume=0;
    my $db=0;                         # Debugflag

    sub gather {
        goto $resume if $resume;      # Dispatcher

        while (++$j<=5) {

            $resume="rein", goto raus
                unless  ( $j%2 );     # Take
          rein:


            print "$j\n" if $db;
        }


        $resume=0;                    # Ausgang
        return;

      raus:
        print "-" if $db;
        return $j;
    }
}


while ( my $a=gather() ) {
    print "<<$a>>";
}


Syntaktisch müsste es allerdings so aussehen, um akzeptabel zu sein

Code (perl): (dl )
1
2
3
4
5

gather {   
        while ( $j = iter (1,5) ) {
                take($j) if  ( $j%2 );
        }
}


Ich bin am überlegen ob man sowas mit B::Deparse und anschließendem eval des veränderten Codes umsetzen könnte/sollte ... naja irgendwie können auf jeden Fall !

Ne Alternative wäre wenn man den Callstack um eine Ebene poppen könnte, sodass ein return auf den drüberliegende Ebene greifen würde... dann bräuchte man keinen Codefilter mehr und man könnte echte foreach-Schleifen nehmen.

Schwierig schwierig ...
me and my writeups
<< |< 1 2 >| >> 19 Einträge, 2 Seiten



View all threads created 2008-10-19 15:57.