http://www.perlmonks.org?node_id=238843


in reply to Ordering hash replacements to avoid clobbering things (update chaining)

Here goes, interesting little problem ... my solution is non-recursive, can handle loops and allows to write my @order = demangle(\%replace);.

Update After sleeping over it I've greatly simplified the algoritm, now I think it's elegant. You have to decide yourself if this algorithm is nicer than the rather elegant recursive solution.

sub demangle { my $r = shift; my %illegal; @illegal{%$r} = (); my @chains; LOOP: while (my($k,$v) = each %$r) { for my $c (@chains) { if ($c->[-1] eq $k) { # append to end of chain push @$c, $v; next LOOP; }; if ($c->[0] eq $v) { # prepend to start of chain unshift @$c, $k; next LOOP; } } push @chains, [$k, $v]; # create new chain } # fix circular replacements for my $c (@chains) { if ($c->[0] eq $c->[-1]) { # we have a circle my $new_key; do { $new_key = join '', map { ('a'..'z')[rand 26] } 1..8; } while exists $illegal{$new_key}; $illegal{$new_key}++; unshift @$c, $new_key; push @$c, $new_key; } } my @order; while (@chains) { push @order, { map { $_->[-2] => pop @$_ } @chains }; @chains = grep @$_ > 1, @chains; } return @order; }

-- Hofmator