Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Recursive generation of a sorted list from a hash

by hawson (Monk)
on Mar 23, 2001 at 06:29 UTC ( #66553=perlquestion: print w/replies, xml ) Need Help??

hawson has asked for the wisdom of the Perl Monks concerning the following question:

This is, perhaps, a bit overly twisted...but that's never stopped me before. :-)

I have a hash of lists. Each key represents a software package, and the list contains the other packages that the key requires. An example:

%depend=( a => ['b','y','c'], b => [], c => ['z'], d => ['a','x','h'], );
This indicates that 'a' requires the packages 'b','y', and 'c'. Package 'b' has no dependencies, and package 'c' only requires 'z', and so on. Notice that 'y' and 'z' don't appear in keys %depend.

I want to process this hash and generate a list so that the elements are order to reduce the internal dependcies when I remove the actualy software packages. For the sample I have above, the list ('b','c','a','d') would be correct.

I have a solution that works for my test case (embedded below in the code). However, when I run it on the "real" data (a file with some 138 pakages), Perl complains about recursion limits. Also, I'm running 5.005_03 in case it matters, and it works, I think, on one machine, but not on another.

Any ideas, suggestions, or comments would be appreciated.

#!/usr/local/bin/perl -w use strict; my %depend; #this hash contains all the packages and their dependn +cies. my @pkgs; #Merely the results of keys %depend @pkgs=grep (!/^$/, keys %depend); @pkgs=grep (/\w+/, @pkgs); my %seen; my ($line,$found); #counter used later on... my @sorted; #contains the "sorted" list in order of nuking safety... # Suck in the file while (defined($_=<>)) { # print $_; @_=split (/\s/, $_); push @pkgs, @_; } # Generate the list of dependencies, stuff them into %depend # This really only applies to Solaris systems... my $basedir="/var/sadm/pkg"; my ($file,$pkg,@tmplist); foreach $pkg (@pkgs) { $file="$basedir/$pkg/install/depend"; next if (! -r $file); open (DEPEND, $file) || die "Failed to open $file for reading"; @tmplist=(); while (defined($line=&lt;DEPEND&gt;)) { chomp $line; next unless $line =~ /^P\s+(\w+)/; # skip all lines but requis +ites push @tmplist, $1; } $depend{$pkg}=[@tmplist]; } # This is my test data. # debugging data. if (1) { %depend=( a => ['b','y','c'], b => [], c => ['z'], d => ['a','x','h'], e => ['d','a'], f => ['a','b','y','c','d'], g => ['b','y'], h => ['g'], i => ['z','j'], j => ['z'], k => ['b','a','e'] ); } &PrintDepend; # Remove things in @depend not in @pkgs # i.e. if we aren't going to remove a package # then it's a non issue, and doesn't need to # be checked, or put in @sorted. my @list=(); my ($key,$item); foreach $key (keys %depend) { @list=@{$depend{$key}}; foreach $item (@list) { if (!grep(/$item/,@pkgs)) { Prune($item); } } } &PrintDepend; &PrintPkgs; #Since things can be removed at various times, # we have to process the hash until there are # no more changes, hence the do {} while loop. @list=(); do { @list=@sorted; foreach (@pkgs) { print "Recursing on $_...\n"; &Recurse($_); #&PrintDepend; } } while (!ListEqual(\@sorted, \@list)); print "The final, sorted list is: ", join " ", @sorted, "\n"; exit 0; ###################################################################### sub Recurse { my $node=shift || return undef; my @depend; my $found=0; my $result; if (defined($depend{$node})) { @depend=@{$depend{$node}} } else { @depend=(); } $found=grep(/$node/,@pkgs); # If $node is in @pkgs, then we care, otherwise, we aren't #planning on removing it, so we can pop out of the stack. #print "\nRecursing with $node => [", join " ",@depend,"]\t\t"; #print "$node not in \@pkgs, skipping." if !$found; return undef if !$found; # If @depend is not defined, or its contents # do not exist in @pkgs, then we can remove it if ( !defined(@depend)) { #print "$node doesn't require anything."; AddNode($node); } else { $found=0; # are we removing anything in @depend? i.e. does @depend inter +sect @pkgs foreach (@depend) { ++$found if grep (/$_/,@pkgs); } # are the depenedncies in @pkgs? if (!$found) { #print "Nothing in \@depend is in \@pkgs"; AddNode($node); Prune($node); } else { #nope, so we recurse foreach (@depend) { $result=&Recurse($_); #print "Depend $_ in \@pkgs\n"; AddNode($_) if (!defined($result)); } } } return 1; } #This sub just puts a scaler in a list if it's not there already. sub AddNode ($){ my $node=shift || return undef; #print "\nPushing $node\n"; if (!exists $seen{$node}) { push (@sorted, $node); $seen{$node}=1; } #print "==>", join " ", @sorted, "<==\n"; } # This sub modifies %depend. It takes a scalar, # runs through each key and removes the scaler # from the value lists. Modification is done place. sub Prune { my $node=shift || return undef; #print "Pruning $node\n"; my @temp; @temp=@{$depend{$node}} if exists $depend{$node}; #print join " ", @temp, "\n"; #print "\n\tremoving $node\n"; foreach (keys %depend) { @temp=@{$depend{$_}}; @temp=grep(!/$node/, @temp); #print join " ", @temp, "\n"; $depend{$_}=[ grep(!/$node/, @temp) ]; } #delete $depend{$node} if (exists $depend{$node}); #&PrintDepend; } # I'm lazy. :) sub PrintPkgs { print "\@pkgs = [", join "][", @pkgs,"]\n"; } #Print the dependencies. Format: # <pkg>: <req_pkg> [req_pkg] [req_pkg] ... sub PrintDepend { foreach $pkg (keys %depend) { print "$pkg: "; foreach ( @{$depend{$pkg}} ) { print "$_ "; } print "\n"; } print "\n"; } #my overly complicated routine to compare lists. :) sub ListEqual { my ($a,$b)=(@_); my (@a,@b,$i); @a=@{$a}; @b=@{$b}; my $ac=@a; my $bc=@b; return 0 if ($ac != $bc); for ($i=0; $i<$ac; $i++) { return 0 if $a[$i] ne $b[$i]; } return 1; }

Replies are listed 'Best First'.
Re: Recursive generation of a sorted list from a hash
by merlyn (Sage) on Mar 23, 2001 at 06:36 UTC
Re (tilly) 1: Recursive generation of a sorted list from a hash
by tilly (Archbishop) on Mar 23, 2001 at 17:43 UTC
    I am wondering if you have circular dependencies.

    The following snippet won't actually figure out what the circular dependency is, but it will report if that is the problem, and will at least cut down the list to just the circular dependencies and things that depend on the circular dependencies. It shouldn't be too hard for you to modify this to find an actual recursive dependency in your list.

    use Data::Dumper; $Data::Dumper::Indent = 1; my @remove; while (%depend) { # Clear dependencies foreach my $dep (values %depend) { @$dep = grep {exists $depend{$_}} @$dep; } # What can I remove? my @can_remove = grep {0 == @{$depend{$_}}} keys %depend; if (@can_remove) { delete $depend{$_} foreach @can_remove; push @remove, @can_remove; } else { # Uh, oh print "CIRCULAR DEPENDENCIES DETECTED\n"; print Data::Dumper->Dump ([\%depend], ['*depend']); die "ABORTING"; } } print Data::Dumper->Dump([\@remove], ['*remove']);
      Thanks.

      It doesn't handle circular references..in fact, I think that is why it fails at the moment. I'm going to add some logic in there to see if a node has already been processed, and post the changes.

        A fairly simple change to my script fixed the problem. In each call to &Recurse I additionally pass a @stack list. This list contains all of the 'parent' nodes in the call tree. So when the function runs, it checks to see if the node is present in @stack, then I know there is circular reference.

        So, the inital invocation of &Recurse becomes: &Recurse($_,()), and subsequent calls (the truly recursive ones) turn into: &Recurse($node,@stack,$node).

        This works, although tilly has a much more compact solution. :-)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://66553]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (4)
As of 2023-01-30 21:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?