Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Re: Build tree data structure from DB (flat) data; function golf

by stvn (Monsignor)
on Aug 30, 2006 at 19:25 UTC ( #570458=note: print w/ replies, xml ) Need Help??


in reply to Build tree data structure from DB (flat) data; function golf

Well I didn't convert the foreach to a map, but I did remove some of your repeated code (closures++), and got rid of some checks and the a tiernary.

One note, though, this is a destructive function. When I tested the deeper case, it did not work because the original data structure ($old_data) is destroyed during the building of the tree. This is kind of a gotcha.

sub tree_data { my ( $old_data, $key_name, $next_group, @remaining_keys ) = @_; # guard against bad input and serve as recursion end case return $old_data unless defined $key_name; my @new_data; my $last_key = ''; # if this is initialized, you dont have to check + below my $build_box = []; # initalize this explicity (more self documentin +g) # encapsulate code into inner sub # fortunately for us, all variables # are closed over too :) my $push_new_data = sub { return unless $last_key; push @new_data, { $key_name => $last_key, $next_group => tree_data( $build_box, @remaining_keys ) }; # re-init this $build_box = []; }; foreach ( @{ $old_data } ) { if ( $last_key ne $_->{ $key_name } ) { $push_new_data->(); } $last_key = delete $_->{ $key_name }; push @{ $build_box }, $_; } $push_new_data->(); return \@new_data; }

Here is a complete test script which compares against the old one.

#!/usr/bin/perl use strict; use warnings; use Storable 'dclone'; use Data::Dumper; use Test::More no_plan => 1; sub orig_tree_data { my ( $old_data, $key_name, $next_group, @remaining_keys ) = @_; my ( @new_data, $last_key, $build_box ); foreach ( @{ $old_data } ) { if ( $last_key and ( $last_key ne $_->{ $key_name } ) ) { push @new_data, { $key_name => $last_key, $next_group => ( @remaining_keys ) ? tree_data( $build_box, @remaining_keys ) : $build_box, }; undef $build_box; } $last_key = delete $_->{ $key_name }; push @{ $build_box }, $_; } push @new_data, { $key_name => $last_key, $next_group => ( @remaining_keys ) ? tree_data( $build_box, @remaining_keys ) : $build_box, }; return \@new_data; } sub tree_data { my ( $old_data, $key_name, $next_group, @remaining_keys ) = @_; # guard against bad input and serve as recursion end case return $old_data unless defined $key_name; my @new_data; my $last_key = ''; # if this is initialized, you dont have to check + below my $build_box = []; # initalize this explicity (more self documentin +g) # encapsulate code into inner sub # fortunately for us, all variables # are closed over too :) my $push_new_data = sub { return unless $last_key; push @new_data, { $key_name => $last_key, $next_group => tree_data( $build_box, @remaining_keys ) }; # re-init this $build_box = []; }; foreach ( @{ $old_data } ) { if ( $last_key ne $_->{ $key_name } ) { $push_new_data->(); } $last_key = delete $_->{ $key_name }; push @{ $build_box }, $_; } $push_new_data->(); return \@new_data; } my $input = [ { 'team' => 'A-Team', 'employee' => 'Face', 'work_day' => '2006-08-28', 'other_data' => '123456789', }, { 'team' => 'A-Team', 'employee' => 'Murdock', 'work_day' => '2006-08-28', 'other_data' => '123456789', }, { 'team' => 'Military', 'employee' => 'Decker', 'work_day' => '2006-08-28', 'other_data' => '123456789', }, ]; my $input2 = dclone($input); my $input3 = dclone($input); my $input4 = dclone($input); is_deeply( tree_data( $input, 'team', 'employees' ), orig_tree_data( $input2, 'team', 'employees' ), '... both the same'); is_deeply( tree_data($input3, 'team', 'employees', 'employee', 'work_days'), orig_tree_data($input4, 'team', 'employees', 'employee', 'work_day +s'), '... both the same again');

-stvn


Comment on Re: Build tree data structure from DB (flat) data; function golf
Select or Download Code
Re^2: Build tree data structure from DB (flat) data; function golf
by gryphon (Abbot) on Aug 30, 2006 at 19:59 UTC

    Greetings stvn,

    This is awesome. Thanks! I need to reprogram my brain so I'll think to use closures more readily. Maybe I need to re-read HOP. You make a great point about this being a destructive function. I think it's easy to fix, though:

    $last_key = delete $_->{ $key_name }; push @{ $build_box }, $_;

    ...becomes...

    push @{ $build_box }, $_; $last_key = delete $build_box->[-1]{$key_name};

    UPDATE: I'm a crazy idiot. This doesn't do what I claim it should do. Bad programmer. No cookie. All I'm doing is moving the reference. I need to deep copy instead.

    gryphon
    Whitepages.com Development Manager (WDDC)
    code('Perl') || die;

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://570458]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (7)
As of 2015-07-05 15:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (67 votes), past polls