treemap

   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

Replies are listed 'Best First'.
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; }` [download] 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]
Re: Re: treemap by merlyn (Sage) on Feb 26, 2001 at 20:56 UTC
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]
(tye)Re: treemap by tye (Sage) on Feb 26, 2001 at 21:42 UTC
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]
Re: Re: treemap by bsb (Priest) on Oct 01, 2003 at 02:01 UTC
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]
Re: Re: treemap by Rudif (Hermit) on Mar 11, 2001 at 02:05 UTC
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')) { ... }` [download]	[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];` [download] Produces this after the first pass: `$VAR1 = { 'nums' => [ '-=ONE=-', ...], 'numref' => \'-=-=ONE=-=-', ...` [download] The link is lost and the leaf is visited twice. Repeating the "-=\U$_=-" line, gives `'nums' => ['-=-=ONE=-=-', ... 'numref' => \'-=-=-=ONE=-=-=-', ...` [download] Not likely to be a problem, but worth the note. Update:possible fix: $refs->{ref($_) ? $_: \$_} = undef;	[reply] [d/l] [select]


laziness, impatience, and hubris
	PerlMonks