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

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