Perl: the Markov chain saw PerlMonks

Re: Ordering hash replacements to avoid clobbering things

by Hofmator (Curate)
 on Feb 26, 2003 at 17:04 UTC ( #238843=note: print w/replies, xml ) Need Help??

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

Create A New User
Node Status?
node history
Node Type: note [id://238843]
help
Chatterbox?
 [Happy-the-monk]: Discipulus: thanks! So in Ascii "CTRL" + "ARROW UP" + "<-- -->"? [hippo]: On my tab key the left pointing arrow is directly above the right-pointing arrow (and they are each pointing at a vertical line). It's a UK keyboard. [Discipulus]: choroba thanks.. now i understand: like find the tresaure.. but in this case seems true: no one noticed [Discipulus]: Happy-the-monk every Eatalian understand what ctrl+shift+tab means: we just have different names for # and @ ('cancelletto' and 'chiocciola')

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

Results (297 votes). Check out past polls.

Notices?