Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Random Path Through Your Data

by MeowChow (Vicar)
on Apr 16, 2002 at 00:28 UTC ( #159378=perlcraft: print w/replies, xml ) Need Help??

   1: #!/usr/bin/perl
   2: use strict;
   3: #
   4: # random_path REF
   5: #
   6: #   Finds a random path through an arbitrary data structure. Returns the path
   7: #   as a list of visited hash keys, array indexes, and the leaf node. Call in
   8: #   scalar context to get back just the leaf node.
   9: #
  10: #   Does not support cyclical data structures.
  11: #
  12: sub random_path {
  13:   my $node = shift;
  14:   if (ref $node eq 'HASH') {
  15:     my @keys = keys %$node;
  16:     my $choice = $keys[rand @keys];
  17:     return $choice, random_path( $node->{$choice} );
  18:   }
  19:   elsif (ref $node eq 'ARRAY') {
  20:     my $choice =  int rand @$node;
  21:     return $choice, random_path( $node->[$choice] );
  22:   }
  23:   return $node;
  24: }
  25: 
  26: ##### EXAMPLES #####
  27: 
  28: my %places = (
  29:   CA => { 
  30:     90210 => 'Beverly Hills',
  31:     90003 => 'Los Angeles'
  32:   },
  33:   IL => { 
  34:     60610 => 'Chicago', 
  35:     61820 => 'Champaign',
  36:     60024 => 'Perlville',
  37:   },
  38:   NY => { 
  39:     10001 => 'New York', 
  40:     10013 => 'Chinatown',
  41:   },
  42:   Cananda => [
  43:     [qw/Ontario Manitoba Quebec Alberta/], 
  44:     [qw/Toronto Montreal/]
  45:   ],
  46: );
  47: 
  48: print "### Grab the entire random path as a list ###";
  49: print "\n", join ' -> ', random_path \%places for 1..10;
  50: 
  51: print "\n\n\n### Or just pick off the leaf node ###";
  52: print "\n", scalar random_path \%places for 1..10;

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlcraft [id://159378]
Approved by redsquirrel
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (4)
As of 2017-11-18 01:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:













    Results (277 votes). Check out past polls.

    Notices?