Beefy Boxes and Bandwidth Generously Provided by pair Networks Frank
Perl Monk, Perl Meditation.
 
PerlMonks

treemap

by MeowChow (Vicar)
 | Log in | Create a new user | The Monastery Gates | Super Search | 
 | Seekers of Perl Wisdom | Meditations | PerlMonks Discussion | 
 | Obfuscation | Reviews | Cool Uses For Perl | Perl News | Q&A | Tutorials | 
 | Poetry | Recent Threads | Newest Nodes | Donate | What's New | 

on Feb 26, 2001 at 11:11 UTC ( #60829=perlcraft: print w/ replies, xml ) Need Help??

   1: #!/usr/bin/perl -w
   2: #
   3: # treemap BLOCK HASHREF
   4: # treemap BLOCK ARRAYREF
   5: #
   6: #   Works like map, for arbitrary nested data structures. Data are
   7: #   are modified in-place (unlike map). Returns the original reference.
   8: #   Hash keys are not modified.
   9: #
  10: #   UPDATE: now handles scalar references, and trimmed an unnecessary line
  11: #   as suggested by dkubb (thanks!)
  12: #
  13: #   Handles cyclical references just fine, thank you.
  14: #
  15: sub treemap (&$) { &_treemap }
  16: sub _treemap {
  17:   my ($code, $node, $refs) = @_;
  18:   if (not my $type = ref $node) {
  19:     local $_ = $node;
  20:     $node = &$code();
  21:   }
  22:   elsif (not exists $refs->{$node}) {
  23:     undef $refs->{$node};   # sneaky, eh?
  24:     if ($type eq 'HASH') {
  25:       $node->{$_} = _treemap($code, $node->{$_}, $refs) for keys %$node;
  26:     }
  27:     elsif ($type eq 'ARRAY') {
  28:       $_ = _treemap($code, $_, $refs) for @$node;
  29:     }
  30:     elsif ($type eq 'SCALAR') {
  31:       $node = \_treemap($code, $$node, $refs);
  32:     }
  33:   }
  34:   $node;
  35: }
  36: 
  37: ####################### EXAMPLE #############################
  38: 
  39: $data = {
  40:           'nums' => [
  41:                       'one',
  42:                       'two',
  43:                       'three',
  44:                       'four',
  45:                       [
  46:                         'five',
  47:                         'six',
  48:                         [
  49:                           'seven',
  50:                           'eight',
  51:                         ]]],
  52:           'two' => '2',
  53:           'doh'  => \'blah blah',
  54:           'more' => {
  55:                       'a' => 'vala',
  56:                       'b' => 'valb',
  57:                       'c' => 'valc',
  58:                       'd' => 'vald'
  59:                     }
  60:         };
  61: 
  62: use Data::Dumper;
  63: print Dumper treemap { "-=\U$_=-" } $data;
  64: print Dumper treemap { s/\W/./g; $_ } $data;
  65: print Dumper treemap { reverse lc } $data;

Comment on treemap
Download Code
Re: treemap
by TheoPetersen (Priest) on Feb 26, 2001 at 19:39 UTC
    Nice work.

    I wrote something of similar structure once for examining values in nested arrays, and found that calling the function again for scalars was very inefficient. You can save a good bit of time by checking for that in the code for each ref type.

    I changed the array case like so:

    elsif ($type eq 'ARRAY') { $_ = ref() ? _treemap($code, $_, $refs) : &$code() for @$node; }
    And verified the same output with fewer instructions.
[reply]
[d/l]
Re: treemap
by japhy (Canon) on Feb 26, 2001 at 20:34 UTC
    Why: sub treemap (&$) { &_treemap }? I've seen similar things done where the called function does some preliminary initialization, etc. But this is just creating an extra stack level.

    japhy -- Perl and Regex Hacker
[reply]
      I saw it as a way of getting the public interface to be prototyped, but the private (recursive) interface to have that extra $refs parameter.

      And then I was thinking there should be a way to do it with a coderef alias, but the prototype is hooked into the coderef, not the symbolname, so I stopped thinking about that. {grin}

      -- Randal L. Schwartz, Perl hacker

[reply]

        I'd probably just have the one entry point and call it recursively via &treemap( $code, $$node, $refs ), where the & should disable the prototype.

                - tye (but my friends call me "Tye")
[reply]
[d/l]
[select]
      It could goto &_treemap to avoid the stack level.

      Or, have sub treemap (&$) { ... &treemap(..) }
      to avoid the prototype internally

[reply]
Re: treemap
by princepawn (Parson) on Mar 01, 2001 at 22:03 UTC
    I like this, but it would be nice if the code refs could take advantage of context variables, such as current depth of recursion so that different things (such as tabbing over or enumeration) could happen at different depths of recursion.
[reply]
Re: treemap
by princepawn (Parson) on Mar 01, 2001 at 22:28 UTC
    Something else I just thought of. There is one other type of tree that people deal with in Perl: directory trees.

    If there were someway to tie a directory tree to a nested Perl data structure, then treemap would be roughly equivalent to File::Find, but this time it would require yet another set of context variables to be useful: $File::Find::name, $File::Find::directory, and $_.

[reply]
      Directory tree is an intriguing subject. It looks like an instance of the Composite pattern - nodes are simple nodes (files) and collections (directories).
      I had a go at mapping a dirtree to a tree of hashes, in How to map a directory tree to a perl hash tree and had good advice on how to improve it.
      Do you think that a Perl package would be useful? What methods would you suggest? Should it Tie to the file system?

      Rudif
[reply]
Re: treemap
by bsb (Priest) on Oct 01, 2003 at 03:36 UTC
    Very nice. I love it when I someone else has done the thinking for me.

    Another thing you might consider is using isa so that the internals of blessed data structures get traversed.

    if (UNIVERSAL::isa($node,'HASH')) { ... }
[reply]
[d/l]
Re: treemap
by bsb (Priest) on Oct 01, 2003 at 07:55 UTC
    Monkeying around further I found that adding this to the end of the example:
    $data->{numref} = \$data->{nums}->[0];
    Produces this after the first pass:
    $VAR1 = { 'nums' => [ '-=ONE=-', ...], 'numref' => \'-=-=ONE=-=-', ...
    The link is lost and the leaf is visited twice.

    Repeating the "-=\U$_=-" line, gives

    'nums' => ['-=-=ONE=-=-', ... 'numref' => \'-=-=-=ONE=-=-=-', ...
    Not likely to be a problem, but worth the note.
    Update:possible fix:
    $refs->{ref($_) ? $_: \$_} = undef;
[reply]
[d/l]
[select]

Back to Craft


Login:
Password
remember me
What's my password?
Create A New User

Node Status
node history
Node Type: perlcraft [id://60829]
Approved by root
help
Community Ads
Chatterbox
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users
Others surveying the Monastery: (22)
GrandFather
jdporter
planetscape
atcroft
johngg
herveus
Spooty
polettix
thezip
MidLifeXis
Eyck
clinton
fauria
Illuminatus
ssandv
gmargo
arbingersys
gnosti
wanradt
youwin
ranqor
im2
As of 2009-11-20 22:05 GMT
Sections
The Monastery Gates
Seekers of Perl Wisdom
Meditations
PerlMonks Discussion
Categorized Q&A
Tutorials
Obfuscated Code
Perl Poetry
Cool Uses for Perl
Perl News
Information
PerlMonks FAQ
Guide to the Monastery
What's New at PerlMonks
Voting/Experience System
Tutorials
Reviews
Library
Perl FAQs
Other Info Sources
Find Nodes
Nodes You Wrote
Super Search
List Nodes By Users
Newest Nodes
Recently Active Threads
Selected Best Nodes
Best Nodes
Worst Nodes
Saints in our Book
Leftovers
The St. Larry Wall Shrine
Offering Plate
Awards
Craft
Snippets Section
Code Catacombs
Quests
Editor Requests
Buy PerlMonks Gear
PerlMonks Merchandise
Planet Perl
Perlsphere
Use Perl
Perl.com
Perl 5 Wiki
Perl Jobs
Perl Mongers
Perl Directory
Perl documentation
CPAN
Random Node
Voting Booth

Future historians will find that the material characteristic of the current era is...

Aluminium
Plastic
Oil
Water
Carbon dioxide
Copper
Iron
Silicon
Salt
Uranium
Hydrogen
Other

Results (722 votes), past polls