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;

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]
      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')) { ... }

    [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]

Back to Craft