It's not NP-Complete, I promise.

Create a function that when given a list, returns a hash-ref based on that list's specification. A quick example: 
my $h = f(qw[ foo => zoo moo too
              bar => car far
              bar => zar tar
              qux => mux ]);

[download]
In this case, $h should be defined as: 
$h = { foo => [ 'zoo','moo','too','bar' ],
       bar => [ 'car','far','zar','tar' ],
       qux => [ 'mux' ] };

[download]
Note that the input can be anything at all, provided it is in list format, and the keys are valid keys, and that further the symbol '=>' is reserved as an identifier. There may be key conflicts with the key, in which case the new data is appended to the existing data, as shown in the example with 'bar'.

Replies are listed 'Best First'.
Re: (Golf) List to Hash
by davisagli (Scribe) on Jul 31, 2001 at 17:43 UTC

    64 characters:

    sub f{
map{/=>/?$b=$a:$a&&$a!~/=>/?push@{$x{$b}},$a:0;$a=$_}(@_,'');\%x
}

    [download]

    Update: 63 characters

    sub f {
map{/=>/?$b=$a:$a&&$a!~/=>/&&push@{$x{$b}},$a;$a=$_}(@_,'');\%x
}

    [download]

    Update: 62 characters

    sub f {
for(@_,''){/=>/?$b=$a:$a&&$a!~/=>/&&push@{$x{$b}},$a;$a=$_}\%x
}

    [download]

    -davisagli

[reply]
[d/l]
[select]
Re: (Golf) List to Hash
by Masem (Monsignor) on Jul 31, 2001 at 17:13 UTC
    Update 78 Characters (has order wrong, 2 'push'es to 'unshift's for 6 more characters): (and see note) 
    sub f {
while(@_){while(($a=pop)ne'=>'){unshift@b,$a};unshift@{$h{pop()}},@b;@
+b=()}\%h
}

    [download]
    FSR, '=>' was not being picked up by the qw function in the version of perl here (5.005); I switched to a split on a q function to test the case given: 
    
my @h = split /\s+/, 
         q[foo => zoo moo too bar => car far bar => zar tar qux => mux
+ ];

print Dumper f(@h);

# output is:
$VAR1 = {
          'foo' => [
                     'zoo',
                     'moo',
                     'too'
                   ],
          'bar' => [
                     'car',
                     'far',
                     'zar',
                     'tar'
                   ],
          'qux' => [
                     'mux'
                   ]
        };

    [download]

    -----------------------------------------------------
    Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain

[reply]
[d/l]
[select]
Re: (Golf) List to Hash
by tachyon (Chancellor) on Jul 31, 2001 at 18:56 UTC

    Here's a recursive one at 86. Hate the data structure BTW! 

    use Data::Dumper;

my $h = f(qw[ foo => zoo moo too
              bar => car far
              bar => zar tar
              qux => mux ]);


print Dumper $h;

sub f {
  $_='';my@v;{$_&&push@v,$_;$_=pop;redo until/=>/}
  $k=pop;$h{$k}=[@v,@{$h{$k}}];@_?&f:\%h
}

    [download]

    79 chars 

    sub f {
  $_=my@v;{$_&&push@v,$_;$_=pop;/=>/||redo}
  $k=pop;$h{$k}=[@v,@{$h{$k}}];@_?&f:\%h
}

    [download]

    75 chars 

    sub f {
  my@v;{$_=pop;/=>/||(push@v,$_)&&redo}
  $k=pop;$h{$k}=[@v,@{$h{$k}}];@_?&f:\%h
}

    [download]

    cheers

    tachyon

    s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

[reply]
[d/l]
[select]
(ichimunki)re: List to Hash
by ichimunki (Priest) on Jul 31, 2001 at 17:09 UTC
    It's not exactly the best golf (since I'm not much of a golfer-- I prefer readable code that passes strict), but here's the basic idea in the most concise "idiomatic" Perl I can write. You throw a wrench into the works with the list that translates to 'foo => zoo moo too bar => car far bar => zar tar qux => mux'.

    #!/usr/bin/perl -w
use strict;
use Data::Dumper;

my $h = f(qw[ foo => zoo moo too
              bar => car far
              bar => zar tar
              qux => mux ]);

print Dumper $h;

sub f {
    my( %hash, $y );
    my $key = my $x = shift;
    while($y = shift){
        if( $y eq '=>' ){
            pop( @{$hash{$key}});
            $key= $x;
            $y = shift;
        }
        push( @{$hash{$key}}, $y );
        $x = $y;
    }
    return \%hash;
}

    [download]
    condensed I get to: 
    sub f
{
my(%h,$y);my$k=my$x=shift;while($y=shift){if($y eq'=>'){pop@{$h{$k}};$
+k=$x;$y=shift;}push(@{$h{$k}},$y);$x=$y;}return\%h;
}

    [download]
    for a score of 118.
[reply]
[d/l]
[select]

Back to Meditations