Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Re: "Intelligent" array joining

by jdporter (Chancellor)
on Aug 12, 2004 at 04:36 UTC ( [id://382167]=note: print w/replies, xml ) Need Help??


in reply to "Intelligent" array joining

Well, I don't know if this is a topical sort -- I kind of doubt it -- but it seems to me to give satisfactory results, and handles "loops" quite gracefully. It's pretty efficient, but doesn't necessarily give the optimal result. Pass a list of arrayrefs.
sub concensus_sort { my( %pre, %suf ); for my $ar ( @_ ) { my @a = @$ar; my @pre; while ( @a ) { my $k = shift @a; $pre{$k} ||= {}; $suf{$k} ||= {}; $pre{$k}{$_}++ for @pre; $suf{$k}{$_}++ for @a; push @pre, $k; } } if ( $main::DEBUG ) { for ( keys %pre ) { for my $p ( keys %{ $pre{$_} } ) { if ( exists $pre{$p}{$_} ) { print "$_-$p AND $p-$_ !!!\n"; } } } } my @result; for my $k ( sort { keys(%{$pre{$a}}) <=> keys(%{$pre{$b}}) or keys(%{$suf{$a}}) <=> keys(%{$suf{$b}}) } keys %suf ) { push @result, $k; # now remove all trace of it in the data structures: delete $pre{$_}{$k} for keys %{ $suf{$k} }; delete $suf{$_}{$k} for keys %{ $pre{$k} }; delete $pre{$k}; delete $suf{$k}; } @result }
But it still doesn't give a pretty result when the input lists are disjoint.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others chanting in the Monastery: (4)
As of 2024-03-19 05:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found